{-| Module  : FiniteCategories
Description : A parser to read .fscg files.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

A parser to read .fscg files.

A .fscg file follows the following rules :
    1. There is a line "<SRC>" and a line "</SRC>".
    1.1 Between these two lines, the source safe composition graph is defined as in a scg file.
    2. There is a line "<TGT>" and a line "</TGT>".
    2.1 Between these two lines, the target safe composition graph is defined as in a scg file.
    3. Outside of the two previously described sections, you can declare the maps between objects and morphisms.
    3.1 You map an object to another with the following syntax : "object1 => object2".
    3.2 You map a morphism to another with the following syntax : "objSrc1 -arrowSrc1-> objSrc2 => objTgt1 -arrowTgt1-> objTgt2".
    4. You don't have to (and you shouldn't) specify maps from identities, nor maps from composite arrows.
-}

module IO.Parsers.SafeCompositionGraphFunctor
(
    readFSCGFile
)
where
    import FiniteCategory.FiniteCategory
    import Cat.PartialFinCat
    import CompositionGraph.CompositionGraph
    import CompositionGraph.SafeCompositionGraph
    import IO.Parsers.Lexer
    import IO.Parsers.SafeCompositionGraph
    import Data.IORef
    import Data.Text (Text, pack, unpack)
    import Data.List (elemIndex, nub, intercalate)
    import Utils.Tuple
    import IO.PrettyPrint
    import Utils.AssociationList
    import Diagram.Diagram
        
    import System.Directory (createDirectoryIfMissing)
    import System.FilePath.Posix (takeDirectory)
    
    type SCGF = PartialFunctor SCG (SCGMorphism Text Text) Text
    type SCGD = Diagram SCG (SCGMorphism Text Text) Text SCG (SCGMorphism Text Text) Text
    
    addOMapEntry :: [Token] -> SCGF -> SCGF
    addOMapEntry :: [Token] -> SCGF -> SCGF
addOMapEntry [Name Text
x, Token
MapsTo, Name Text
y] SCGF
pf
        | Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
x (AssociationList Text Text -> [Text]
forall a b. AssociationList a b -> [a]
keys (SCGF -> AssociationList Text Text
forall c m o. PartialFunctor c m o -> AssociationList o o
omapPF SCGF
pf)) = if Text
y Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ((SCGF -> AssociationList Text Text
forall c m o. PartialFunctor c m o -> AssociationList o o
omapPF SCGF
pf) AssociationList Text Text -> Text -> Text
forall a b. Eq a => AssociationList a b -> a -> b
!-! Text
x) then SCGF
pf else String -> SCGF
forall a. HasCallStack => String -> a
error (String
"Incoherent maps of object : F("String -> String -> String
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show Text
xString -> String -> String
forall a. [a] -> [a] -> [a]
++String
") = "String -> String -> String
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show Text
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and "String -> String -> String
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show ((SCGF -> AssociationList Text Text
forall c m o. PartialFunctor c m o -> AssociationList o o
omapPF SCGF
pf) AssociationList Text Text -> Text -> Text
forall a b. Eq a => AssociationList a b -> a -> b
!-! Text
x))
        | Bool
otherwise = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: SCG
srcPF=SCGF -> SCG
forall c m o. PartialFunctor c m o -> c
srcPF SCGF
pf, tgtPF :: SCG
tgtPF=SCGF -> SCG
forall c m o. PartialFunctor c m o -> c
tgtPF SCGF
pf, omapPF :: AssociationList Text Text
omapPF=((Text
x,Text
y)(Text, Text)
-> AssociationList Text Text -> AssociationList Text Text
forall a. a -> [a] -> [a]
:(SCGF -> AssociationList Text Text
forall c m o. PartialFunctor c m o -> AssociationList o o
omapPF SCGF
pf)), mmapPF :: AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
mmapPF=SCGF
-> AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
forall c m o. PartialFunctor c m o -> AssociationList m m
mmapPF SCGF
pf}
    addOMapEntry [Token]
otherTokens SCGF
_ = String -> SCGF
forall a. HasCallStack => String -> a
error (String -> SCGF) -> String -> SCGF
forall a b. (a -> b) -> a -> b
$ String
"addOMapEntry on invalid tokens : "String -> String -> String
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
otherTokens
    
    addMMapEntry :: [Token] -> SCGF -> SCGF
    addMMapEntry :: [Token] -> SCGF -> SCGF
addMMapEntry tks :: [Token]
tks@[Name Text
sx, Token
BeginArrow, Name Text
lx, Token
EndArrow, Name Text
tx, Token
MapsTo, Token
Identity] SCGF
pf = if Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
sx (AssociationList Text Text -> [Text]
forall a b. AssociationList a b -> [a]
keys (SCGF -> AssociationList Text Text
forall c m o. PartialFunctor c m o -> AssociationList o o
omapPF SCGF
pf)) then PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: SCG
srcPF=SCGF -> SCG
forall c m o. PartialFunctor c m o -> c
srcPF SCGF
pf, tgtPF :: SCG
tgtPF=SCGF -> SCG
forall c m o. PartialFunctor c m o -> c
tgtPF SCGF
pf, omapPF :: AssociationList Text Text
omapPF=SCGF -> AssociationList Text Text
forall c m o. PartialFunctor c m o -> AssociationList o o
omapPF SCGF
pf, mmapPF :: AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
mmapPF=((SCGMorphism Text Text
sourceMorph,(SCG -> Text -> SCGMorphism Text Text
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> o -> m
identity (SCGF -> SCG
forall m o. Morphism m o => m -> o
target SCGF
pf) ((SCGF -> AssociationList Text Text
forall c m o. PartialFunctor c m o -> AssociationList o o
omapPF SCGF
pf) AssociationList Text Text -> Text -> Text
forall a b. Eq a => AssociationList a b -> a -> b
!-! Text
sx)))(SCGMorphism Text Text, SCGMorphism Text Text)
-> AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
-> AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
forall a. a -> [a] -> [a]
:(SCGF
-> AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
forall c m o. PartialFunctor c m o -> AssociationList m m
mmapPF SCGF
pf))} else String -> SCGF
forall a. HasCallStack => String -> a
error (String
"You must specify the image of the source of the morphism before mapping to an identity : "String -> String -> String
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
tks)
        where
            sourceMorphCand :: [SCGMorphism Text Text]
sourceMorphCand = (SCGMorphism Text Text -> Bool)
-> [SCGMorphism Text Text] -> [SCGMorphism Text Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SCGMorphism Text Text
e -> SCGMorphism Text Text -> Maybe Text
forall a b. Eq a => SCGMorphism a b -> Maybe b
getLabelS SCGMorphism Text Text
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lx) (SCG -> Text -> Text -> [SCGMorphism Text Text]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
genAr (SCGF -> SCG
forall m o. Morphism m o => m -> o
source SCGF
pf) Text
sx Text
tx)
            sourceMorph :: SCGMorphism Text Text
sourceMorph = if [SCGMorphism Text Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SCGMorphism Text Text]
sourceMorphCand then String -> SCGMorphism Text Text
forall a. HasCallStack => String -> a
error (String -> SCGMorphism Text Text)
-> String -> SCGMorphism Text Text
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry : morphism not found in source category for the following map : "String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Token] -> String
forall a. Show a => a -> String
show [Token]
tks else [SCGMorphism Text Text] -> SCGMorphism Text Text
forall a. [a] -> a
head [SCGMorphism Text Text]
sourceMorphCand
    addMMapEntry tks :: [Token]
tks@[Name Text
sx, Token
BeginArrow, Name Text
lx, Token
EndArrow, Name Text
tx, Token
MapsTo, Name Text
sy, Token
BeginArrow, Name Text
ly, Token
EndArrow, Name Text
ty] SCGF
pf = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: SCG
srcPF=SCGF -> SCG
forall c m o. PartialFunctor c m o -> c
srcPF SCGF
newPF2, tgtPF :: SCG
tgtPF=SCGF -> SCG
forall c m o. PartialFunctor c m o -> c
tgtPF SCGF
newPF2, omapPF :: AssociationList Text Text
omapPF=SCGF -> AssociationList Text Text
forall c m o. PartialFunctor c m o -> AssociationList o o
omapPF SCGF
newPF2, mmapPF :: AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
mmapPF=((SCGMorphism Text Text
sourceMorph,SCGMorphism Text Text
targetMorph)(SCGMorphism Text Text, SCGMorphism Text Text)
-> AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
-> AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
forall a. a -> [a] -> [a]
:(SCGF
-> AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
forall c m o. PartialFunctor c m o -> AssociationList m m
mmapPF SCGF
newPF2))}
        where
            sourceMorphCand :: [SCGMorphism Text Text]
sourceMorphCand = (SCGMorphism Text Text -> Bool)
-> [SCGMorphism Text Text] -> [SCGMorphism Text Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SCGMorphism Text Text
e -> SCGMorphism Text Text -> Maybe Text
forall a b. Eq a => SCGMorphism a b -> Maybe b
getLabelS SCGMorphism Text Text
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lx) (SCG -> Text -> Text -> [SCGMorphism Text Text]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
genAr (SCGF -> SCG
forall m o. Morphism m o => m -> o
source SCGF
pf) Text
sx Text
tx)
            targetMorphCand :: [SCGMorphism Text Text]
targetMorphCand = (SCGMorphism Text Text -> Bool)
-> [SCGMorphism Text Text] -> [SCGMorphism Text Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SCGMorphism Text Text
e -> SCGMorphism Text Text -> Maybe Text
forall a b. Eq a => SCGMorphism a b -> Maybe b
getLabelS SCGMorphism Text Text
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ly) (SCG -> Text -> Text -> [SCGMorphism Text Text]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
genAr (SCGF -> SCG
forall m o. Morphism m o => m -> o
target SCGF
pf) Text
sy Text
ty)
            sourceMorph :: SCGMorphism Text Text
sourceMorph = if [SCGMorphism Text Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SCGMorphism Text Text]
sourceMorphCand then String -> SCGMorphism Text Text
forall a. HasCallStack => String -> a
error (String -> SCGMorphism Text Text)
-> String -> SCGMorphism Text Text
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry : morphism not found in source category for the following map : "String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Token] -> String
forall a. Show a => a -> String
show [Token]
tks else [SCGMorphism Text Text] -> SCGMorphism Text Text
forall a. [a] -> a
head [SCGMorphism Text Text]
sourceMorphCand
            targetMorph :: SCGMorphism Text Text
targetMorph = if [SCGMorphism Text Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SCGMorphism Text Text]
targetMorphCand then String -> SCGMorphism Text Text
forall a. HasCallStack => String -> a
error (String -> SCGMorphism Text Text)
-> String -> SCGMorphism Text Text
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry : morphism not found in target category for the following map : "String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Token] -> String
forall a. Show a => a -> String
show [Token]
tks else [SCGMorphism Text Text] -> SCGMorphism Text Text
forall a. [a] -> a
head [SCGMorphism Text Text]
targetMorphCand
            newPF1 :: SCGF
newPF1 = [Token] -> SCGF -> SCGF
addOMapEntry [Text -> Token
Name Text
sx, Token
MapsTo, Text -> Token
Name Text
sy] SCGF
pf
            newPF2 :: SCGF
newPF2 = [Token] -> SCGF -> SCGF
addOMapEntry [Text -> Token
Name Text
tx, Token
MapsTo, Text -> Token
Name Text
ty] SCGF
newPF1
            
    addMMapEntry [Token]
otherTokens SCGF
_ = String -> SCGF
forall a. HasCallStack => String -> a
error (String -> SCGF) -> String -> SCGF
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry on invalid tokens : "String -> String -> String
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
otherTokens
    
    readLineF :: String -> SCGF -> SCGF
    readLineF :: String -> SCGF -> SCGF
readLineF String
line pf :: SCGF
pf@PartialFunctor{srcPF :: forall c m o. PartialFunctor c m o -> c
srcPF=SCG
s, tgtPF :: forall c m o. PartialFunctor c m o -> c
tgtPF=SCG
t, omapPF :: forall c m o. PartialFunctor c m o -> AssociationList o o
omapPF=AssociationList Text Text
om, mmapPF :: forall c m o. PartialFunctor c m o -> AssociationList m m
mmapPF=AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
mm}
        | [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
lexedLine = SCGF
pf
        | Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Token
MapsTo [Token]
lexedLine = if Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Token
BeginArrow [Token]
lexedLine
            then [Token] -> SCGF -> SCGF
addMMapEntry [Token]
lexedLine SCGF
pf
            else [Token] -> SCGF -> SCGF
addOMapEntry [Token]
lexedLine SCGF
pf
        | Bool
otherwise = SCGF
pf
        where
            lexedLine :: [Token]
lexedLine = (String -> [Token]
parserLex String
line)

    extractSrcSection :: [String] -> [String]
    extractSrcSection :: [String] -> [String]
extractSrcSection [String]
lines
        | Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
BeginSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <SRC> section or malformed <SRC> section in file : "String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
EndSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <SRC> section or malformed <SRC> section in file : "String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Int
indexEndSrc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indexBeginSrc = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"Malformed <SRC> section in file : "String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Bool
otherwise = [String]
c
        where
            Just Int
indexBeginSrc = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
BeginSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
            Just Int
indexEndSrc = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
EndSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
            ([String]
a,[String]
b) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexBeginSrcInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [String]
lines
            ([String]
c,[String]
d) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexEndSrcInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
indexBeginSrcInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [String]
b
            
    extractTgtSection :: [String] -> [String]
    extractTgtSection :: [String] -> [String]
extractTgtSection [String]
lines
        | Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
BeginTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <TGT> section or malformed <TGT> section in file : "String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
EndTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <TGT> section or malformed <TGT> section in file : "String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Int
indexEndTgt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indexBeginTgt = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"Malformed <TGT> section in file : "String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Bool
otherwise = [String]
c
        where
            Just Int
indexBeginTgt = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
BeginTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
            Just Int
indexEndTgt = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
EndTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
            ([String]
a,[String]
b) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexBeginTgtInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [String]
lines
            ([String]
c,[String]
d) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexEndTgtInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
indexBeginTgtInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [String]
b
    
    rawreadFSCGFile :: String -> IO SCGF
    rawreadFSCGFile :: String -> IO SCGF
rawreadFSCGFile String
path = do
        String
file <- String -> IO String
readFile String
path
        let ls :: [String]
ls = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([Token] -> Bool) -> (String -> [Token]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [Token]
parserLex) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
file
        let src :: SCG
src = String -> SCG
parseSCGString (String -> SCG) -> String -> SCG
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> [String]
extractSrcSection [String]
ls)
        let tgt :: SCG
tgt = String -> SCG
parseSCGString (String -> SCG) -> String -> SCG
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> [String]
extractTgtSection [String]
ls)
        let pf :: PartialFunctor SCG m o
pf = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: SCG
srcPF=SCG
src, tgtPF :: SCG
tgtPF=SCG
tgt,omapPF :: AssociationList o o
omapPF=[], mmapPF :: AssociationList m m
mmapPF=[]}
        let finalPF :: SCGF
finalPF = (String -> SCGF -> SCGF) -> SCGF -> [String] -> SCGF
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> SCGF -> SCGF
readLineF SCGF
forall {m} {o}. PartialFunctor SCG m o
pf [String]
ls
        SCGF -> IO SCGF
forall (m :: * -> *) a. Monad m => a -> m a
return SCGF
finalPF
    
    -- | Reads a fscg file and completes everything so that it becomes a diagram.

    completeFSCG :: SCGF -> SCGD
    completeFSCG :: SCGF -> SCGD
completeFSCG pf :: SCGF
pf@PartialFunctor{srcPF :: forall c m o. PartialFunctor c m o -> c
srcPF=SCG
s, tgtPF :: forall c m o. PartialFunctor c m o -> c
tgtPF=SCG
t, omapPF :: forall c m o. PartialFunctor c m o -> AssociationList o o
omapPF=AssociationList Text Text
om, mmapPF :: forall c m o. PartialFunctor c m o -> AssociationList m m
mmapPF=AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
mm} =
        Diagram :: forall c1 m1 o1 c2 m2 o2.
c1
-> c2
-> AssociationList o1 o2
-> AssociationList m1 m2
-> Diagram c1 m1 o1 c2 m2 o2
Diagram{src :: SCG
src=SCG
s, tgt :: SCG
tgt=SCG
t, omap :: AssociationList Text Text
omap=AssociationList Text Text
om, mmap :: AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
mmap=SCG
-> SCG
-> AssociationList Text Text
-> AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
-> AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
forall c1 m1 o1 c2 m2 o2.
(GeneratedFiniteCategory c1 m1 o1, Morphism m1 o1, Eq o1, Eq m1,
 FiniteCategory c2 m2 o2, Morphism m2 o2, Eq o2, Eq m2) =>
c1
-> c2
-> AssociationList o1 o2
-> AssociationList m1 m2
-> AssociationList m1 m2
completeMmap SCG
s SCG
t AssociationList Text Text
om AssociationList (SCGMorphism Text Text) (SCGMorphism Text Text)
mm}
        
    -- | Reads a fscg file and returns a diagram.

    readFSCGFile :: String -> IO SCGD
    readFSCGFile :: String -> IO SCGD
readFSCGFile String
path = do
        SCGF
raw <- String -> IO SCGF
rawreadFSCGFile String
path
        SCGD -> IO SCGD
forall (m :: * -> *) a. Monad m => a -> m a
return (SCGF -> SCGD
completeFSCG SCGF
raw)