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

A parser to read .scg files.

A .scg file follows the following rules :
    1. The first line is an integer specifying the max number of loops morphisms can do.
    2. The rest of the file is a cg file. (See IO.Parsers.CompositionGraph)
-}

module IO.Parsers.SafeCompositionGraph 
(
    SCG(..),
    parseSCGString,
    readSCGFile,
    writeSCGFile
)
where
    import FiniteCategory.FiniteCategory
    import CompositionGraph.CompositionGraph
    import CompositionGraph.SafeCompositionGraph
    import IO.Parsers.Lexer
    import Data.IORef
    import Data.Text (Text, pack, unpack)
    import Data.List (elemIndex, nub, intercalate)
    import Utils.Tuple
    import IO.PrettyPrint
        
    import System.Directory (createDirectoryIfMissing)
    import System.FilePath.Posix (takeDirectory)
    
    -- | The type of SafeCompositionGraph created by reading a scg file.

    type SCG = SafeCompositionGraph Text Text
    
    addObject :: [Token] -> SCG -> SCG
    addObject :: [Token] -> SCG -> SCG
addObject [Name Text
str] cg :: SCG
cg@SafeCompositionGraph{graphS :: forall a b. SafeCompositionGraph a b -> Graph a b
graphS=([Text]
n,[Arrow Text Text]
a),lawS :: forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS=CompositionLaw Text Text
l,maxCycles :: forall a b. SafeCompositionGraph a b -> Int
maxCycles=Int
mc} = if Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
str (SCG -> [Text]
forall c m o. FiniteCategory c m o => c -> [o]
ob SCG
cg) then SCG
cg else SafeCompositionGraph :: forall a b.
Graph a b -> CompositionLaw a b -> Int -> SafeCompositionGraph a b
SafeCompositionGraph{graphS :: ([Text], [Arrow Text Text])
graphS=((Text
strText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:(SCG -> [Text]
forall c m o. FiniteCategory c m o => c -> [o]
ob SCG
cg)),[Arrow Text Text]
a),lawS :: CompositionLaw Text Text
lawS=CompositionLaw Text Text
l,maxCycles :: Int
maxCycles=Int
mc}
    addObject [Token]
otherTokens SCG
_ = String -> SCG
forall a. HasCallStack => String -> a
error (String -> SCG) -> String -> SCG
forall a b. (a -> b) -> a -> b
$ String
"addObject on invalid tokens : "String -> String -> String
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
otherTokens
    
    addMorphism :: [Token] -> SCG -> SCG
    addMorphism :: [Token] -> SCG -> SCG
addMorphism [Name Text
src, Token
BeginArrow, Name Text
arr, Token
EndArrow, Name Text
tgt] SCG
cg = if Maybe Text -> [Maybe Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
arr) (SCGMorphism Text Text -> Maybe Text
forall a b. Eq a => SCGMorphism a b -> Maybe b
getLabelS (SCGMorphism Text Text -> Maybe Text)
-> [SCGMorphism Text Text] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SCG -> Text -> Text -> [SCGMorphism Text Text]
forall c m o.
(FiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
ar SCG
newSCG2 Text
src Text
tgt)) then SCG
newSCG2 else SafeCompositionGraph :: forall a b.
Graph a b -> CompositionLaw a b -> Int -> SafeCompositionGraph a b
SafeCompositionGraph{graphS :: ([Text], [Arrow Text Text])
graphS=([Text]
n,((Text
src,Text
tgt,Text
arr)Arrow Text Text -> [Arrow Text Text] -> [Arrow Text Text]
forall a. a -> [a] -> [a]
:[Arrow Text Text]
a)),lawS :: CompositionLaw Text Text
lawS=CompositionLaw Text Text
l,maxCycles :: Int
maxCycles=Int
mc}
        where
            newSCG1 :: SCG
newSCG1 = [Token] -> SCG -> SCG
addObject [Text -> Token
Name Text
src] SCG
cg
            newSCG2 :: SCG
newSCG2@SafeCompositionGraph{graphS :: forall a b. SafeCompositionGraph a b -> Graph a b
graphS=([Text]
n,[Arrow Text Text]
a),lawS :: forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS=CompositionLaw Text Text
l,maxCycles :: forall a b. SafeCompositionGraph a b -> Int
maxCycles=Int
mc} = [Token] -> SCG -> SCG
addObject [Text -> Token
Name Text
tgt] SCG
newSCG1
    addMorphism [Token]
otherTokens SCG
_ = String -> SCG
forall a. HasCallStack => String -> a
error (String -> SCG) -> String -> SCG
forall a b. (a -> b) -> a -> b
$ String
"addMorphism on invalid tokens : "String -> String -> String
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
otherTokens
    
    extractPath :: [Token] -> RawPath Text Text
    extractPath :: [Token] -> [Arrow Text Text]
extractPath [] = []
    extractPath [Token
Identity] = []
    extractPath [(Name Text
_)] = []
    extractPath ((Name Text
src) : (Token
BeginArrow : ((Name Text
arr) : (Token
EndArrow : ((Name Text
tgt) : [Token]
ts))))) = ([Token] -> [Arrow Text Text]
extractPath ((Text -> Token
Name Text
tgt) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
ts)) [Arrow Text Text] -> [Arrow Text Text] -> [Arrow Text Text]
forall a. [a] -> [a] -> [a]
++ [(Text
src,Text
tgt,Text
arr)]
    extractPath [Token]
otherTokens = String -> [Arrow Text Text]
forall a. HasCallStack => String -> a
error (String -> [Arrow Text Text]) -> String -> [Arrow Text Text]
forall a b. (a -> b) -> a -> b
$ String
"extractPath on invalid tokens : "String -> String -> String
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
otherTokens
    
    addCompositionLawEntry :: [Token] -> SCG -> SCG
    addCompositionLawEntry :: [Token] -> SCG -> SCG
addCompositionLawEntry [Token]
tokens cg :: SCG
cg@SafeCompositionGraph{graphS :: forall a b. SafeCompositionGraph a b -> Graph a b
graphS=([Text]
n,[Arrow Text Text]
a),lawS :: forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS=CompositionLaw Text Text
l,maxCycles :: forall a b. SafeCompositionGraph a b -> Int
maxCycles=Int
mc} = SafeCompositionGraph :: forall a b.
Graph a b -> CompositionLaw a b -> Int -> SafeCompositionGraph a b
SafeCompositionGraph{graphS :: ([Text], [Arrow Text Text])
graphS=([Text]
n[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text]
newObj,[Arrow Text Text]
a[Arrow Text Text] -> [Arrow Text Text] -> [Arrow Text Text]
forall a. [a] -> [a] -> [a]
++[Arrow Text Text]
newMorph),lawS :: CompositionLaw Text Text
lawS=([Arrow Text Text]
pathLeft,[Arrow Text Text]
pathRight)([Arrow Text Text], [Arrow Text Text])
-> CompositionLaw Text Text -> CompositionLaw Text Text
forall a. a -> [a] -> [a]
:CompositionLaw Text Text
l,maxCycles :: Int
maxCycles=Int
mc}
        where
            Just Int
indexEquals = Token -> [Token] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Token
Equals [Token]
tokens
            ([Token]
tokensLeft,(Token
_:[Token]
tokensRight)) = Int -> [Token] -> ([Token], [Token])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
indexEquals [Token]
tokens
            pathLeft :: [Arrow Text Text]
pathLeft = [Token] -> [Arrow Text Text]
extractPath [Token]
tokensLeft
            pathRight :: [Arrow Text Text]
pathRight = [Token] -> [Arrow Text Text]
extractPath [Token]
tokensRight
            newObj :: [Text]
newObj = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text
s | (Text
s,Text
_,Text
_) <- [Arrow Text Text]
pathLeft[Arrow Text Text] -> [Arrow Text Text] -> [Arrow Text Text]
forall a. [a] -> [a] -> [a]
++[Arrow Text Text]
pathRight, Bool -> Bool
not (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
s [Text]
n)][Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text
t | (Text
_,Text
t,Text
_) <- [Arrow Text Text]
pathLeft[Arrow Text Text] -> [Arrow Text Text] -> [Arrow Text Text]
forall a. [a] -> [a] -> [a]
++[Arrow Text Text]
pathRight, Bool -> Bool
not (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
t [Text]
n)]
            newMorph :: [Arrow Text Text]
newMorph = [Arrow Text Text] -> [Arrow Text Text]
forall a. Eq a => [a] -> [a]
nub [Arrow Text Text
e | Arrow Text Text
e <- [Arrow Text Text]
pathLeft[Arrow Text Text] -> [Arrow Text Text] -> [Arrow Text Text]
forall a. [a] -> [a] -> [a]
++[Arrow Text Text]
pathRight, Bool -> Bool
not (Arrow Text Text -> [Arrow Text Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Arrow Text Text
e [Arrow Text Text]
a)]
    
    readLine :: String -> SCG -> SCG
    readLine :: String -> SCG -> SCG
readLine String
line SCG
cg
        | [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
lexedLine = SCG
cg
        | Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Token
Equals [Token]
lexedLine = [Token] -> SCG -> SCG
addCompositionLawEntry [Token]
lexedLine SCG
cg
        | Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Token
BeginArrow [Token]
lexedLine = [Token] -> SCG -> SCG
addMorphism [Token]
lexedLine SCG
cg
        | Bool
otherwise = [Token] -> SCG -> SCG
addObject [Token]
lexedLine SCG
cg
        where
            lexedLine :: [Token]
lexedLine = (String -> [Token]
parserLex String
line)
    
    -- | Parse a string extracted from a scg file. Returns a safe composition graph.

    parseSCGString :: String -> SCG
    parseSCGString :: String -> SCG
parseSCGString String
str = if Bool
test then SCG
newSCG else String -> SCG
forall a. HasCallStack => String -> a
error (String -> SCG) -> String -> SCG
forall a b. (a -> b) -> a -> b
$ String
"First line of scg file is not a number : "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => a -> String
show [String]
ls
        where
            test :: Bool
test = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
x [Char
'0'..Char
'9']) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
ls
            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
str
            maxCyc :: Int
maxCyc = (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
ls) :: Int
            cg :: SafeCompositionGraph a b
cg = Int -> SafeCompositionGraph a b
forall a b. Int -> SafeCompositionGraph a b
mkEmptySafeCompositionGraph Int
maxCyc
            newSCG :: SCG
newSCG = (String -> SCG -> SCG) -> SCG -> [String] -> SCG
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> SCG -> SCG
readLine SCG
forall {a} {b}. SafeCompositionGraph a b
cg ([String] -> [String]
forall a. [a] -> [a]
tail [String]
ls)
        
    -- | Reads a scg file and returns a safe composition graph.

    readSCGFile :: String -> IO SCG
    readSCGFile :: String -> IO SCG
readSCGFile String
path = do
        String
file <- String -> IO String
readFile String
path
        SCG -> IO SCG
forall (m :: * -> *) a. Monad m => a -> m a
return (SCG -> IO SCG) -> SCG -> IO SCG
forall a b. (a -> b) -> a -> b
$ String -> SCG
parseSCGString String
file
        
    reversedRawPathToString :: (PrettyPrintable a, PrettyPrintable b) => RawPath a b -> String
    reversedRawPathToString :: forall a b.
(PrettyPrintable a, PrettyPrintable b) =>
RawPath a b -> String
reversedRawPathToString [] = String
"<ID>"
    reversedRawPathToString [(a
s,a
t,b
l)] = a -> String
forall a. PrettyPrintable a => a -> String
pprint a
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -" String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. PrettyPrintable a => a -> String
pprint b
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. PrettyPrintable a => a -> String
pprint a
t
    reversedRawPathToString ((a
s,a
t,b
l):[Arrow a b]
xs) = a -> String
forall a. PrettyPrintable a => a -> String
pprint a
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -" String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. PrettyPrintable a => a -> String
pprint b
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Arrow a b] -> String
forall a b.
(PrettyPrintable a, PrettyPrintable b) =>
RawPath a b -> String
reversedRawPathToString [Arrow a b]
xs    
    
    unparseSCG :: (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => SafeCompositionGraph a b -> String
    unparseSCG :: forall a b.
(PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String
unparseSCG SafeCompositionGraph a b
cg = String
finalString
        where
            obString :: String
obString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. PrettyPrintable a => a -> String
pprint (a -> String) -> [a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SafeCompositionGraph a b -> [a]
forall c m o. FiniteCategory c m o => c -> [o]
ob SafeCompositionGraph a b
cg
            arNotIdentity :: [SCGMorphism a b]
arNotIdentity = (SCGMorphism a b -> Bool) -> [SCGMorphism a b] -> [SCGMorphism a b]
forall a. (a -> Bool) -> [a] -> [a]
filter (SafeCompositionGraph a b -> SCGMorphism a b -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity SafeCompositionGraph a b
cg) (SafeCompositionGraph a b -> [SCGMorphism a b]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows SafeCompositionGraph a b
cg)
            reversedRawPaths :: [[Arrow a b]]
reversedRawPaths = ([Arrow a b] -> [Arrow a b]
forall a. [a] -> [a]
reverse([Arrow a b] -> [Arrow a b])
-> (SCGMorphism a b -> [Arrow a b])
-> SCGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, [Arrow a b], a) -> [Arrow a b]
forall a b c. (a, b, c) -> b
snd3((a, [Arrow a b], a) -> [Arrow a b])
-> (SCGMorphism a b -> (a, [Arrow a b], a))
-> SCGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SCGMorphism a b -> (a, [Arrow a b], a)
forall a b. SCGMorphism a b -> Path a b
pathS) (SCGMorphism a b -> [Arrow a b])
-> [SCGMorphism a b] -> [[Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SCGMorphism a b]
arNotIdentity
            arStringBeforeComment :: [String]
arStringBeforeComment = [Arrow a b] -> String
forall a b.
(PrettyPrintable a, PrettyPrintable b) =>
RawPath a b -> String
reversedRawPathToString ([Arrow a b] -> String) -> [[Arrow a b]] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Arrow a b]]
reversedRawPaths
            commentOutComposite :: [String]
commentOutComposite = [if SafeCompositionGraph a b -> SCGMorphism a b -> Bool
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o, Eq m) =>
c -> m -> Bool
isComposite SafeCompositionGraph a b
cg SCGMorphism a b
m then (Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s) else String
s | (String
s,SCGMorphism a b
m) <- [String] -> [SCGMorphism a b] -> [(String, SCGMorphism a b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
arStringBeforeComment [SCGMorphism a b]
arNotIdentity]
            arString :: String
arString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
commentOutComposite
            lawString :: String
lawString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (\([Arrow a b]
rp1,[Arrow a b]
rp2) -> ([Arrow a b] -> String
forall a b.
(PrettyPrintable a, PrettyPrintable b) =>
RawPath a b -> String
reversedRawPathToString ([Arrow a b] -> [Arrow a b]
forall a. [a] -> [a]
reverse [Arrow a b]
rp1)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Arrow a b] -> String
forall a b.
(PrettyPrintable a, PrettyPrintable b) =>
RawPath a b -> String
reversedRawPathToString ([Arrow a b] -> [Arrow a b]
forall a. [a] -> [a]
reverse [Arrow a b]
rp2))) (([Arrow a b], [Arrow a b]) -> String)
-> [([Arrow a b], [Arrow a b])] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SafeCompositionGraph a b -> [([Arrow a b], [Arrow a b])]
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
cg)
            finalString :: String
finalString = String
"#Max number of cycles :\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show (SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
cg)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n\n#Objects :\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
obStringString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n\n# Arrows :\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
arStringString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n\n# Composition law :\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
lawString
    
    -- | Saves a safe composition graph into a file located at a given path.

    writeSCGFile :: (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => SafeCompositionGraph a b -> String -> IO ()
    writeSCGFile :: forall a b.
(PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String -> IO ()
writeSCGFile SafeCompositionGraph a b
cg String
filepath = do
        Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
filepath
        String -> String -> IO ()
writeFile String
filepath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SafeCompositionGraph a b -> String
forall a b.
(PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String
unparseSCG SafeCompositionGraph a b
cg