SafeCompositionGraph.hs

{-| 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 [Name str] cg@SafeCompositionGraph{graphS=(n,a),lawS=l,maxCycles=mc} = if elem str (ob cg) then cg else SafeCompositionGraph{graphS=((str:(ob cg)),a),lawS=l,maxCycles=mc}
    addObject otherTokens _ = error $ "addObject on invalid tokens : "++show otherTokens
    
    addMorphism :: [Token] -> SCG -> SCG
    addMorphism [Name src, BeginArrow, Name arr, EndArrow, Name tgt] cg = if elem (Just arr) (getLabelS <$> (ar newSCG2 src tgt)) then newSCG2 else SafeCompositionGraph{graphS=(n,((src,tgt,arr):a)),lawS=l,maxCycles=mc}
        where
            newSCG1 = addObject [Name src] cg
            newSCG2@SafeCompositionGraph{graphS=(n,a),lawS=l,maxCycles=mc} = addObject [Name tgt] newSCG1
    addMorphism otherTokens _ = error $ "addMorphism on invalid tokens : "++show otherTokens
    
    extractPath :: [Token] -> RawPath Text Text
    extractPath [] = []
    extractPath [Identity] = []
    extractPath [(Name _)] = []
    extractPath ((Name src) : (BeginArrow : ((Name arr) : (EndArrow : ((Name tgt) : ts))))) = (extractPath ((Name tgt) : ts)) ++ [(src,tgt,arr)]
    extractPath otherTokens = error $ "extractPath on invalid tokens : "++show otherTokens
    
    addCompositionLawEntry :: [Token] -> SCG -> SCG
    addCompositionLawEntry tokens cg@SafeCompositionGraph{graphS=(n,a),lawS=l,maxCycles=mc} = SafeCompositionGraph{graphS=(n++newObj,a++newMorph),lawS=(pathLeft,pathRight):l,maxCycles=mc}
        where
            Just indexEquals = elemIndex Equals tokens
            (tokensLeft,(_:tokensRight)) = splitAt indexEquals tokens
            pathLeft = extractPath tokensLeft
            pathRight = extractPath tokensRight
            newObj = nub $ [s | (s,_,_) <- pathLeft++pathRight, not (elem s n)]++[t | (_,t,_) <- pathLeft++pathRight, not (elem t n)]
            newMorph = nub [e | e <- pathLeft++pathRight, not (elem e a)]
    
    readLine :: String -> SCG -> SCG
    readLine line cg
        | null lexedLine = cg
        | elem Equals lexedLine = addCompositionLawEntry lexedLine cg
        | elem BeginArrow lexedLine = addMorphism lexedLine cg
        | otherwise = addObject lexedLine cg
        where
            lexedLine = (parserLex line)
    
    -- | Parse a string extracted from a scg file. Returns a safe composition graph.
    parseSCGString :: String -> SCG
    parseSCGString str = if test then newSCG else error $ "First line of scg file is not a number : "++show ls
        where
            test = null $ filter (\x -> not $ elem x ['0'..'9']) $ head ls
            ls = filter (not.null.parserLex) $ lines str
            maxCyc = (read $ head ls) :: Int
            cg = mkEmptySafeCompositionGraph maxCyc
            newSCG = foldr readLine cg (tail ls)
        
    -- | Reads a scg file and returns a safe composition graph.
    readSCGFile :: String -> IO SCG
    readSCGFile path = do
        file <- readFile path
        return $ parseSCGString file
        
    reversedRawPathToString :: (PrettyPrintable a, PrettyPrintable b) => RawPath a b -> String
    reversedRawPathToString [] = "<ID>"
    reversedRawPathToString [(s,t,l)] = pprint s ++ " -" ++ pprint l ++ "-> " ++ pprint t
    reversedRawPathToString ((s,t,l):xs) = pprint s ++ " -" ++ pprint l ++ "-> " ++ reversedRawPathToString xs    
    
    unparseSCG :: (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => SafeCompositionGraph a b -> String
    unparseSCG cg = finalString
        where
            obString = intercalate "\n" $ pprint <$> ob cg
            arNotIdentity = filter (isNotIdentity cg) (arrows cg)
            reversedRawPaths = (reverse.snd3.pathS) <$> arNotIdentity
            arStringBeforeComment = reversedRawPathToString <$> reversedRawPaths
            commentOutComposite = [if isComposite cg m then ('#':s) else s | (s,m) <- zip arStringBeforeComment arNotIdentity]
            arString = intercalate "\n" $ commentOutComposite
            lawString = intercalate "\n" $ (\(rp1,rp2) -> (reversedRawPathToString (reverse rp1)) ++ " = " ++ (reversedRawPathToString (reverse rp2))) <$> (lawS cg)
            finalString = "#Max number of cycles :\n"++show (maxCycles cg)++"\n\n#Objects :\n"++obString++"\n\n# Arrows :\n"++arString++"\n\n# Composition law :\n"++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 cg filepath = do
        createDirectoryIfMissing True $ takeDirectory filepath
        writeFile filepath $ unparseSCG cg