Commit 1abb4e9a authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢
Browse files

Require functors to parse a list of mappings

Instead of letting each individual functor parse the whole morphism,
only let them influence the parsing of individual mappings.
parent 8c6d03ca
......@@ -27,7 +27,7 @@ instance RefinementInterface FixedProduct where
type H1 FixedProduct = Int
type H3 FixedProduct = (Int, Three)
parse (FixedProduct labels) = Yaml.withArray "Morphisms" $ \arr -> do
parse (FixedProduct labels) arr = do
zipped <- V.imapM parseNode arr
let structure = V.map fst zipped
edges = V.map snd zipped
......
......@@ -21,7 +21,7 @@ instance RefinementInterface Powerset where
type H1 Powerset = Bool
type H3 Powerset = (Bool, Bool, Bool)
parse _ = Yaml.withArray "Morphisms" $ \arr -> do
parse _ arr = do
succsessors <- V.imapM parseNode arr
let structure = V.map (not . V.null . snd) succsessors
......
......@@ -11,6 +11,8 @@ module Data.MorphismEncoding
, graph
) where
import Data.Maybe (fromMaybe)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.HashMap.Strict (HashMap)
......@@ -46,7 +48,8 @@ new structure edges =
outgoingSize = HashMap.size outnodes
predecessors = V.generate outgoingSize (outnodes HashMap.!)
predecessors = V.generate outgoingSize $ \i ->
fromMaybe [] (HashMap.lookup i outnodes)
in
Encoding {..}
......
......@@ -8,6 +8,7 @@ module Data.RefinementInterface where
import Data.Text (Text)
import Data.Yaml as Yaml
import Data.Vector as Vector
import Data.MorphismEncoding
......@@ -26,5 +27,5 @@ class (Show h, Show (Label h), Show (H1 h)) => RefinementInterface h where
type H1 h :: *
type H3 h :: *
parse :: h -> Yaml.Value -> Yaml.Parser (Encoding (Label h) (H1 h))
parse :: h -> Vector Yaml.Value -> Yaml.Parser (Encoding (Label h) (H1 h))
init :: h -> H1 h -> [Label h] -> Weight h
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
module Parser where
module Parser (decodeCoalgebra) where
import Control.Monad
......@@ -59,7 +60,7 @@ data SomeEncoding where
deriving instance Show SomeEncoding
parseSomeEncoding :: SomeRefinementInterface -> Yaml.Value -> Yaml.Parser SomeEncoding
parseSomeEncoding :: SomeRefinementInterface -> Vector Yaml.Value -> Yaml.Parser SomeEncoding
parseSomeEncoding (SRI ri) value = SomeEncoding <$> parse ri value
newtype CoalgebraSpecification = CoalgebraSpecification (Vector SomeEncoding)
......@@ -68,10 +69,11 @@ newtype CoalgebraSpecification = CoalgebraSpecification (Vector SomeEncoding)
instance Yaml.FromJSON CoalgebraSpecification where
parseJSON = Yaml.withObject "coalgebra" $ \obj -> do
functors <- fromRFIList <$> obj .: "functors"
morphisms <- obj .: "morphisms"
morphisms :: Vector (Vector Yaml.Value) <- obj .: "morphisms"
-- TODO Ensure functors and morphisms are of equal length
encodings <- forM (V.zip functors morphisms) $ \(functor, morphs) ->
parseSomeEncoding functor morphs
encodings <- forM (V.zip functors morphisms) $ \(functor, morph) ->
parseSomeEncoding functor morph
return (CoalgebraSpecification encodings)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment