{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, MonadComprehensions #-}

{-| Module  : FiniteCategories
Description : Composition graphs are the simpliest way to create simple small categories by hand. See 'readCGFile'.
Copyright   : Guillaume Sabbagh 2022
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

A 'CompositionGraph' is the free category generated by a multidigraph quotiented by an equivalence relation on the paths of the graphs.
A multidigraph is a directed multigraph which means that edges are oriented and there can be multiple arrows between two objects.

The equivalence relation is given by a map on paths of the graph.

Morphisms from different composition graphs should not be composed or compared, if they are, the behavior is undefined.

When taking subcategories of a composition graph, the composition law might lead to morphisms not existing anymore.
It is not a problem because they are equivalent, it is only counterintuitive for human readability.  
-}


module Math.FiniteCategories.CompositionGraph
(
    -- * Types for composition graph morphism
    RawPath(..),
    Path(..),
    CGMorphism(..),
    -- ** Functions for composition graph morphism
    getLabel,
    -- * Composition graph
    CompositionLaw(..),
    CompositionGraph,
    support,
    law,
    -- * Construction
    compositionGraph,
    unsafeCompositionGraph,
    emptyCompositionGraph,
    finiteCategoryToCompositionGraph,
    unsafeReadCGString,
    readCGString,
    unsafeReadCGFile,
    readCGFile,
    -- * Serialization
    writeCGString,
    writeCGFile,
    -- * Construction of diagrams
    unsafeReadCGDString,
    readCGDString,
    unsafeReadCGDFile,
    readCGDFile,
    -- * Serialization of diagrams
    writeCGDString,
    writeCGDFile,
    -- * Random composition graph
    constructRandomCompositionGraph,
    defaultConstructRandomCompositionGraph,
    defaultConstructRandomDiagram,
)    
where
    import              Data.WeakSet                (Set)
    import qualified    Data.WeakSet             as  Set
    import              Data.WeakSet.Safe
    import              Data.WeakMap                (Map)
    import qualified    Data.WeakMap             as  Map
    import              Data.WeakMap.Safe
    import              Data.List                   (intercalate, elemIndex, splitAt)
    import              Data.Maybe                  (fromJust, isNothing)
    import              Data.Text                   (Text, cons, singleton, unpack, pack)
    
    import              Math.Categories.FinGrph
    import              Math.Categories.FunctorCategory
    import              Math.Category
    import              Math.FiniteCategory
    import              Math.FiniteCategoryError
    import              Math.IO.PrettyPrint
    
    import              System.Directory            (createDirectoryIfMissing)
    import              System.FilePath.Posix       (takeDirectory)
    import              System.Random               (RandomGen, uniformR)
    
    -- | A `RawPath` is a list of arrows, arrows should be compatible.
    type RawPath a b = [Arrow a b]
    
    -- | A `Path` is a `RawPath` with a source specified.
    --
    -- An empty path is an identity in a free category. 
    -- Therefore, it is useful to keep the source when the path is empty
    -- because there is one identity for each node of the graph. (We need to differentiate identites for each node.)
    type Path a b = (a, RawPath a b)
    
    -- | A `CompositionLaw` is a `Map` that maps raw paths to smaller raw paths in order to simplify paths
    -- so that they don't compose infinitely many times when there is a cycle.
    --
    -- prop> length (law |!| p) <= length p 
    type CompositionLaw a b = Map (RawPath a b) (RawPath a b)
    
    -- | The datatype `CGMorphism` is the type of composition graph morphisms.
    --
    -- It is a path with a composition law, it is necessary to keep the composition law of the composition graph
    -- in every morphism of the graph because we need it to compose two morphisms and the morphisms compose 
    -- independently of the composition graph.
    data CGMorphism a b = CGMorphism {path :: Path a b, 
                                      compositionLaw :: CompositionLaw a b} deriving (Show, Eq)
    
    instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (CGMorphism a b) where
        pprint CGMorphism {path=(s,[]),compositionLaw=cl} = "Id"++(pprint s)
        pprint CGMorphism {path=(_,rp),compositionLaw=cl} = intercalate " o " $ (pprint.labelArrow) <$> rp

    -- | Helper function for `simplify`. Returns a simplified raw path.
    simplifyOnce :: (Eq a, Eq b) => CompositionLaw a b -> RawPath a b -> RawPath a b
    simplifyOnce _ [] = [] 
    simplifyOnce _ [e] = [e]
    simplifyOnce cl list 
        | new_list == [] = []
        | new_list /= list = new_list
        | simple_tail /= (tail list) = (head list):simple_tail
        | simple_init /= (init list) = simple_init++[(last list)]
        | otherwise = list
        where
        new_list = Map.findWithDefault list list cl
        simple_tail = simplifyOnce cl (tail list)
        simple_init = simplifyOnce cl (init list)
    
    -- | Return a completely simplified raw path.
    simplify :: (Eq a, Eq b) => CompositionLaw a b -> RawPath a b -> RawPath a b
    simplify _ [] = []
    simplify cl rp 
        | simple_one == rp = rp 
        | otherwise = simplify cl simple_one 
            where simple_one = simplifyOnce cl rp

    instance (Eq a, Eq b) => Morphism (CGMorphism a b) a where
        (@?) m2@CGMorphism{path=(s2,rp2), compositionLaw=cl2} m1@CGMorphism{path=(s1,rp1), compositionLaw=cl1}
            | cl1 /= cl2 = Nothing
            | source m2 /= target m1 = Nothing
            | otherwise = Just CGMorphism{path=(s1,(simplify cl1 (rp2++rp1))), compositionLaw=cl1}

                                    
        source CGMorphism{path=(s,_), compositionLaw=_} = s
        target CGMorphism{path=(s,[]), compositionLaw=_} = s
        target CGMorphism{path=(_,rp), compositionLaw=_} = targetArrow (head rp)
                                    
        
    -- | Constructs a `CGMorphism` from a composition law and an arrow.
    mkCGMorphism :: CompositionLaw a b -> Arrow a b -> CGMorphism a b
    mkCGMorphism cl e = CGMorphism {path=(sourceArrow e,[e]),compositionLaw=cl}

    -- | Returns the list of arrows of a graph with a given target.
    findInwardEdges :: (Eq a) => Graph a b -> a -> Set (Arrow a b)
    findInwardEdges g o = Set.filter (\e -> (targetArrow e) == o && (sourceArrow e) `isIn` (nodes g)) (edges g)

    -- | Find all acyclic raw paths between two nodes in a graph.
    findAcyclicRawPaths :: (Eq a, Eq b) => Graph a b -> a -> a -> Set (RawPath a b)
    findAcyclicRawPaths g s t = findAcyclicRawPathsVisitedNodes g s t Set.empty where
        findAcyclicRawPathsVisitedNodes g s t v
            | t `isIn` v = Set.empty
            | s == t = set [[]]
            | otherwise = set (concat (zipWith ($) (fmap fmap (fmap (:) inwardEdges)) (fmap (\x -> setToList (findAcyclicRawPathsVisitedNodes g s (sourceArrow x) (Set.insert t v))) inwardEdges)))
            where
                inwardEdges = (setToList (findInwardEdges g t)) 
    
    -- | An elementary cycle is a cycle which is not composed of any other cycle.
    findElementaryCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> a -> Set (RawPath a b)
    findElementaryCycles g cl o = set $ (simplify cl <$> []:(concat (zipWith sequence (fmap (fmap (\x y -> (y:x))) (fmap (\x ->  setToList (findAcyclicRawPaths g o (sourceArrow x))) inEdges)) inEdges)))
        where 
            inEdges = (setToList (findInwardEdges g o))
    
    -- | Composes every elementary cycles of a node until they simplify into a fixed set of cycles.
    --
    -- Warning : this function can do an infinite loop if the composition law does not simplify a cycle or all of its child cycles.
    findCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> a -> Set (RawPath a b)
    findCycles g cl o = findCyclesWithPreviousCycles g cl o (findElementaryCycles g cl o)
        where 
            findCyclesWithPreviousCycles g cl o p
                | newCycles == p = newCycles
                | otherwise = findCyclesWithPreviousCycles g cl o newCycles
                where
                    newCycles = (simplify cl) <$> ((++) <$> p <*> findElementaryCycles g cl o)
    
    -- | Helper function which intertwine the second list in the first list.
    --
    -- Example : intertwine [1,2,3] [4,5] = [1,4,2,5,3]
    intertwine :: [a] -> [a] -> [a]
    intertwine [] l = l
    intertwine l [] = l
    intertwine l1@(x1:xs1) l2@(x2:xs2) = (x1:(x2:(intertwine xs1 xs2)))
    
    -- | Takes a path and intertwine every cycles possible along its path.
    intertwineWithCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> a -> RawPath a b -> Set (RawPath a b)
    intertwineWithCycles g cl _ p@(x:xs) = set $ concat <$> ((uncurry intertwine) <$> zip (setToList prodCycles) (repeat ((:[]) <$> p))) where
        prodCycles = cartesianProductOfSets cycles
        cycles = ((findCycles g cl (targetArrow x))):(((\y -> (findCycles g cl (sourceArrow y)))) <$> p)
    intertwineWithCycles g cl s [] = (findCycles g cl s)
        
    -- | Enumerates all paths between two nodes and construct composition graph morphisms with them.
    mkAr :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> a -> a -> Set (CGMorphism a b)
    mkAr g cl s t = (\p -> CGMorphism{path=(s,p),compositionLaw=cl}) <$> allPaths where
        acyclicPaths = (simplify cl) <$> (findAcyclicRawPaths g s t)
        allPaths = (simplify cl <$> Set.unions (setToList ((intertwineWithCycles g cl s) <$> acyclicPaths)))
    
    -- | Return the label of a 'CompositionGraph' generator.
    getLabel :: CGMorphism a b -> Maybe b
    getLabel CGMorphism{path=(s,rp), compositionLaw=_}
        | null rp = Nothing
        | null.tail $ rp = Just (labelArrow.head $ rp)
        | otherwise = Nothing
    
    -- | A 'CompositionGraph' is a graph with a composition law such that the free category generated by the graph quotiented out by the composition law gives a 'FiniteCategory'.
    -- 
    -- 'CompositionGraph' is private, use the smart constructors 'compositionGraph' or 'unsafeCompositionGraph' to instantiate one.
    data CompositionGraph a b = CompositionGraph {
                                                    support :: Graph a b, -- ^ The generating graph (or support) of the composition graph.
                                                    law :: CompositionLaw a b -- ^ The composition law of the composition graph.
                                                 } deriving (Eq)
 
    instance (Show a, Show b) => Show (CompositionGraph a b) where
        show CompositionGraph{support=g, law=l} = "(unsafeCompositionGraph "++ show g ++ " " ++ show l ++ ")"
 
    instance (Eq a, Eq b) => Category (CompositionGraph a b) (CGMorphism a b) a where
        identity c x
            | x `isIn` (nodes (support c)) = CGMorphism {path=(x,[]),compositionLaw=(law c)}
            | otherwise = error ("Math.FiniteCategories.CompositionGraph.identity: Trying to construct identity of an unknown object.")
        ar c s t = mkAr (support c) (law c) s t
        genAr c@CompositionGraph{support=g,law=l} s t
            | s == t = Set.insert (identity c s) gen
            | otherwise = gen 
            where gen = mkCGMorphism l <$> (Set.filter (\a -> s == (sourceArrow a) && t == (targetArrow a)) $ (edges g))
            
        decompose c m@CGMorphism{path=(_,rp),compositionLaw=l}
            | isIdentity c m = [m]
            | otherwise = mkCGMorphism l <$> rp
    
    instance (Eq a, Eq b) => FiniteCategory (CompositionGraph a b) (CGMorphism a b) a where
        ob = (nodes.support)
            
    instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (CompositionGraph a b) where
        pprint CompositionGraph{support=g,law=l} = "CompositionGraph("++pprint g++","++pprint l++")"         
    
    -- | Smart constructor of `CompositionGraph`.
    --
    -- If the 'CompositionGraph' constructed is valid, return 'Right' the composition graph, otherwise return Left a 'FiniteCategoryError'.
    compositionGraph :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> Either (FiniteCategoryError (CGMorphism a b) a) (CompositionGraph a b) 
    compositionGraph g l
        | null check = Right c_g
        | otherwise = Left err
        where
            c_g = CompositionGraph{support = g, law = l}
            check = checkFiniteCategory c_g
            Just err = check
    
    -- | Unsafe constructor of 'CompositionGraph' for performance purposes. It does not check the structure of the 'CompositionGraph'.
    --
    -- Use this constructor only if the 'CompositionGraph' is necessarily well formed.
    unsafeCompositionGraph :: Graph a b -> CompositionLaw a b -> CompositionGraph a b
    unsafeCompositionGraph g l = CompositionGraph{support = g, law = l}
            
                                                                            
    -- | Transforms any 'FiniteCategory' into a 'CompositionGraph'.
    --
    -- The 'CompositionGraph' will take more space in memory compared to the original category because the composition law is stored as a 'Map'.
    --
    -- Returns an isofunctor as a `Diagram` from the original category to the created 'CompositionGraph'.
    --
    -- If you only want the 'CompositionGraph', take the 'tgt' of the 'Diagram'.
    finiteCategoryToCompositionGraph :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> Diagram c m o (CompositionGraph o m) (CGMorphism o m) o
    finiteCategoryToCompositionGraph cat = isofunct
        where
            morphToArrow f = Arrow{sourceArrow = source f, targetArrow = target f, labelArrow = f}
            catLaw = weakMapFromSet [
                if isNotIdentity cat (g @ f) then
                    ((morphToArrow <$> (decompose cat g))++(morphToArrow <$> (decompose cat f)), morphToArrow <$> (decompose cat (g @ f)))
                else
                    ((morphToArrow <$> (decompose cat g))++(morphToArrow <$> (decompose cat f)),[]) |
                f <- (arrows cat), g <- (arFrom cat (target f)), isNotIdentity cat f, isNotIdentity cat g]
            cg = CompositionGraph{support=(unsafeGraph (ob cat) [morphToArrow f | f <- (genArrows cat), isNotIdentity cat f])
                                , law=catLaw}
            isofunct = Diagram{src=cat,tgt=cg,omap=memorizeFunction id (ob cat),mmap=memorizeFunction (\f -> if isNotIdentity cat f
                                                                        then
                                                                            CGMorphism {path=(source f,(morphToArrow <$> (decompose cat f))),compositionLaw=catLaw}
                                                                        else
                                                                            identity cg (source f)) (arrows cat)}



    -- | The empty 'CompositionGraph'.
    emptyCompositionGraph :: CompositionGraph a b
    emptyCompositionGraph = CompositionGraph{support=unsafeGraph Set.empty Set.empty, law=Map.empty}

    -----------------------
    -- CG FILE
    -----------------------


    -- | A token for a .cg file.
    data Token = Name Text | BeginArrow | EndArrow | Equals | Identity | BeginSrc | EndSrc | BeginTgt | EndTgt | MapsTo deriving (Eq, Show)
    
    -- | Strip a token of unnecessary spaces.
    strip :: Token -> Token
    strip (Name txt) = Name (pack.reverse.stripLeft.reverse.stripLeft $ str)
        where
            str = unpack txt
            stripLeft (' ':s) = s 
            stripLeft s = s 
    strip x = x
        
    -- | Transforms a string into a list of tokens.
    parserLex :: String -> [Token]
    parserLex str = strip <$> parserLexHelper str
        where
            parserLexHelper [] = [] 
            parserLexHelper ('#':str) = []
            parserLexHelper (' ':'-':str) = BeginArrow : (parserLexHelper str)
            parserLexHelper ('-':'>':' ':str) = EndArrow : (parserLexHelper str)
            parserLexHelper (' ':'=':' ':str) = Equals : (parserLexHelper str)
            parserLexHelper ('<':'I':'D':'/':'>':str) = Identity : (parserLexHelper str)
            parserLexHelper ('<':'S':'R':'C':'>':str) = BeginSrc : (parserLexHelper str)
            parserLexHelper ('<':'T':'G':'T':'>':str) = BeginTgt : (parserLexHelper str)
            parserLexHelper ('<':'/':'S':'R':'C':'>':str) = EndSrc : (parserLexHelper str)
            parserLexHelper ('<':'/':'T':'G':'T':'>':str) = EndTgt : (parserLexHelper str)
            parserLexHelper (' ':'=':'>':' ':str) = MapsTo : (parserLexHelper str)
            parserLexHelper (c:str) =  (result restLexed)
                where
                    restLexed = (parserLexHelper str)
                    result (Name txt:xs) = (Name (cons c txt):xs)
                    result a = ((Name (singleton c)):a)

    type CG = CompositionGraph Text Text
    
    addObject :: [Token] -> CG -> CG
    addObject [Name str] cg@CompositionGraph{support=g,law=l} = CompositionGraph{support=unsafeGraph (Set.insert str (nodes g)) (edges g),law=l}
    addObject otherTokens _ = error $ "addObject on invalid tokens : "++show otherTokens
    
    addMorphism :: [Token] -> CG -> CG
    addMorphism [Name src, BeginArrow, Name arr, EndArrow, Name tgt] cg = CompositionGraph{support=(unsafeGraph (nodes g) (Set.insert Arrow{sourceArrow=src, targetArrow=tgt, labelArrow=arr} (edges g))),law=l}
        where
            newCG1 = addObject [Name src] cg
            newCG2@CompositionGraph{support=g,law=l} = addObject [Name tgt] newCG1
    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)) ++ [Arrow{sourceArrow=src, targetArrow=tgt, labelArrow=arr}]
    extractPath otherTokens = error $ "extractPath on invalid tokens : "++show otherTokens
    
    addCompositionLawEntry :: [Token] -> CG -> CG
    addCompositionLawEntry tokens cg@CompositionGraph{support=g,law=l} = CompositionGraph{support=(unsafeGraph ((nodes g) ||| newObj) ((edges g) ||| newMorph)),law=Map.insert pathLeft pathRight l}
        where
            Just indexEquals = elemIndex Equals tokens
            (tokensLeft,(_:tokensRight)) = splitAt indexEquals tokens
            pathLeft = extractPath tokensLeft
            pathRight = extractPath tokensRight
            newObj = set $ (sourceArrow <$> pathLeft++pathRight)++(targetArrow <$> pathLeft++pathRight)
            newMorph = set $ pathLeft++pathRight
    
    readLine :: String -> CG -> CG
    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)
    
    -- | Unsafe version of 'readCGString' which does not check the structure of the result 'CompositionGraph'.
    unsafeReadCGString :: String -> CG
    unsafeReadCGString str = newCG
        where
            ls = lines str
            cg = emptyCompositionGraph
            newCG = foldr readLine cg ls
    
    -- | Read a .cg string to create a 'CompositionGraph'.
    --
    -- A .cg string follows the following rules :
    --
    -- 0. Every character of a line following a "#" character are ignored.
    --
    -- 1. Each line defines either an object, a morphism or a composition law entry.
    --
    -- 2. The following strings are reserved : " -","-> "," = ", "\<ID/\>", "\<SRC\>", "\</SRC\>", "\<TGT\>", "\</TGT\>", " => "
    --
    -- 3. To define an object, write a line containing its name.
    --
    -- 4. To define an arrow, the syntax "source_object -name_of_morphism-> target_object" is used, where "source_object", "target_object" and "name_of_morphism" should be replaced.
    --
    -- 4.1. If an object mentionned in an arrow does not exist, it is created.
    --
    -- 4.2. The spaces are important. 
    --
    -- 5. To define a composition law entry, the syntax "source_object1 -name_of_first_morphism-> middle_object -name_of_second_morphism-> target_object1 = source_object2 -name_of_composite_morphism-> target_object2" is used, where "source_object1", "name_of_first_morphism", "middle_object", "name_of_second_morphism", "target_object1", "source_object2", "name_of_composite_morphism", "target_object2" should be replaced.
    --
    -- 5.1 If an object mentionned does not exist, it is created.
    --
    -- 5.2 If a morphism mentionned does not exist, it is created.
    --
    -- 5.3 You can use the tag \<ID/\> in order to map a morphism to an identity.    
    readCGString :: String -> Either (FiniteCategoryError (CGMorphism Text Text) Text) CG
    readCGString str
        | null check = Right c_g
        | otherwise = Left err
        where
            c_g = unsafeReadCGString str
            check = checkFiniteCategory c_g
            Just err = check
            
    
    -- | Unsafe version of 'readCGFile' which does not check the structure of the resulting 'CompositionGraph'.
    unsafeReadCGFile :: String -> IO CG
    unsafeReadCGFile path = do
        file <- readFile path
        return $ unsafeReadCGString file
    
    
    -- | Read a .cg file to create a 'CompositionGraph'.
    --
    -- A .cg file follows the following rules :
    --
    -- 0. Every character of a line following a "#" character are ignored.
    --
    -- 1. Each line defines either an object, a morphism or a composition law entry.
    --
    -- 2. The following strings are reserved : " -","-> "," = ", "\<ID/\>", "\<SRC\>", "\</SRC\>", "\<TGT\>", "\</TGT\>", " => "
    --
    -- 3. To define an object, write a line containing its name.
    --
    -- 4. To define an arrow, the syntax "source_object -name_of_morphism-> target_object" is used, where "source_object", "target_object" and "name_of_morphism" should be replaced.
    --
    -- 4.1. If an object mentionned in an arrow does not exist, it is created.
    --
    -- 4.2. The spaces are important. 
    --
    -- 5. To define a composition law entry, the syntax "source_object1 -name_of_first_morphism-> middle_object -name_of_second_morphism-> target_object1 = source_object2 -name_of_composite_morphism-> target_object2" is used, where "source_object1", "name_of_first_morphism", "middle_object", "name_of_second_morphism", "target_object1", "source_object2", "name_of_composite_morphism", "target_object2" should be replaced.
    --
    -- 5.1 If an object mentionned does not exist, it is created.
    --
    -- 5.2 If a morphism mentionned does not exist, it is created.
    --
    -- 5.3 You can use the tag \<ID/\> in order to map a morphism to an identity.
    readCGFile :: String -> IO (Either (FiniteCategoryError (CGMorphism Text Text) Text) CG)
    readCGFile str = do
        cg <- unsafeReadCGFile str
        let check = checkFiniteCategory cg
        return (if null check then Right cg else Left $ fromJust $ check)
        where
            fromJust (Just x) = x
        
    reversedRawPathToString :: (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
    reversedRawPathToString [] = "<ID>"
    reversedRawPathToString [Arrow{sourceArrow = s, targetArrow = t,labelArrow = l}] = pprint s ++ " -" ++ pprint l ++ "-> " ++ pprint t
    reversedRawPathToString (Arrow{sourceArrow = s, targetArrow = t,labelArrow = l}:xs) = pprint s ++ " -" ++ pprint l ++ "-> " ++ reversedRawPathToString xs
    
    -- | Transform a composition graph into a string following the .cg convention.
    writeCGString :: (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => CompositionGraph a b -> String
    writeCGString cg = finalString
        where
            obString = intercalate "\n" $ pprint <$> (setToList.ob $ cg)
            arNotIdentityAndNotComposite = setToList $ Set.filter (isGenerator cg) $ Set.filter (isNotIdentity cg) (genArrows cg)
            reversedRawPaths = (reverse.snd.path) <$> arNotIdentityAndNotComposite
            arString = intercalate "\n" $ reversedRawPathToString <$> reversedRawPaths
            lawString = intercalate "\n" $ (\(rp1,rp2) -> (reversedRawPathToString (reverse rp1)) ++ " = " ++ (reversedRawPathToString (reverse rp2))) <$> ((Map.toList).law $ cg)
            finalString = "#Objects :\n"++obString++"\n\n# Arrows :\n"++arString++"\n\n# Composition law :\n"++lawString
        
    -- | Saves a composition graph into a file located at a given path.
    writeCGFile :: (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => CompositionGraph a b -> String -> IO ()
    writeCGFile cg filepath = do
        createDirectoryIfMissing True $ takeDirectory filepath
        writeFile filepath $ writeCGString cg
        
        
    -----------------------
    -- CGD FILE
    -----------------------

    type CGD = Diagram (CompositionGraph Text Text) (CGMorphism Text Text) Text (CompositionGraph Text Text) (CGMorphism Text Text) Text 
    
    addOMapEntry :: [Token] -> CGD -> CGD
    addOMapEntry [Name x, MapsTo, Name y] diag
        | x `isIn` (domain (omap diag)) = if y == (diag ->$ x) then diag else error ("Incoherent maps of object : F("++show x++") = "++show y ++ " and "++show (diag ->$ x))
        | otherwise = Diagram{src=src diag, tgt=tgt diag, omap=Map.insert x y (omap diag), mmap=mmap diag}
    addOMapEntry otherTokens _ = error $ "addOMapEntry on invalid tokens : "++show otherTokens
    
    addMMapEntry :: [Token] -> CGD -> CGD
    addMMapEntry tks@[Name sx, BeginArrow, Name lx, EndArrow, Name tx, MapsTo, Identity] diag = if sx `isIn` (domain (omap diag)) then Diagram{src=src diag, tgt=tgt diag, omap=omap diag, mmap=Map.insert sourceMorph (identity (tgt diag) (diag ->$ sx)) (mmap diag)} else error ("You must specify the image of the source of the morphism before mapping to an identity : "++show tks)
        where
            sourceMorphCand = Set.filter (\e -> getLabel e == Just lx) (genAr (src diag) sx tx)
            sourceMorph = if Set.null sourceMorphCand then error $ "addMMapEntry : morphism not found in source category for the following map : "++ show tks else anElement sourceMorphCand
    addMMapEntry tks@[Name sx, BeginArrow, Name lx, EndArrow, Name tx, MapsTo, Name sy, BeginArrow, Name ly, EndArrow, Name ty] diag = Diagram{src=src newDiag2, tgt=tgt newDiag2, omap=omap newDiag2, mmap=Map.insert sourceMorph targetMorph (mmap newDiag2)}
        where
            sourceMorphCand = Set.filter (\e -> getLabel e == Just lx) (genAr (src diag) sx tx)
            targetMorphCand = Set.filter (\e -> getLabel e == Just ly) (genAr (tgt diag) sy ty)
            sourceMorph = if Set.null sourceMorphCand then error $ "addMMapEntry : morphism not found in source category for the following map : "++ show tks else anElement sourceMorphCand
            targetMorph = if Set.null targetMorphCand then error $ "addMMapEntry : morphism not found in target category for the following map : "++ show tks else anElement targetMorphCand
            newDiag1 = addOMapEntry [Name sx, MapsTo, Name sy] diag
            newDiag2 = addOMapEntry [Name tx, MapsTo, Name ty] newDiag1    
    addMMapEntry otherTokens _ = error $ "addMMapEntry on invalid tokens : "++show otherTokens
    
    readLineD :: String -> CGD -> CGD
    readLineD line diag@Diagram{src=s, tgt=t, omap=om, mmap=mm}
        | null lexedLine = diag
        | elem MapsTo lexedLine = if elem BeginArrow lexedLine
            then addMMapEntry lexedLine diag
            else addOMapEntry lexedLine diag
        | otherwise = diag
        where
            lexedLine = (parserLex line)

    extractSrcSection :: [String] -> [String]
    extractSrcSection lines
        | not (elem [BeginSrc] (parserLex <$> lines)) = error $ "No <SRC> section or malformed <SRC> section in file : "++ show lines
        | not (elem [EndSrc] (parserLex <$> lines)) = error $ "No <SRC> section or malformed <SRC> section in file : "++ show lines
        | indexEndSrc < indexBeginSrc = error $ "Malformed <SRC> section in file : "++ show lines
        | otherwise = c
        where
            Just indexBeginSrc = (elemIndex [BeginSrc] (parserLex <$> lines))
            Just indexEndSrc = (elemIndex [EndSrc] (parserLex <$> lines))
            (a,b) = splitAt (indexBeginSrc+1) lines
            (c,d) = splitAt (indexEndSrc-indexBeginSrc-1) b
            
    extractTgtSection :: [String] -> [String]
    extractTgtSection lines
        | not (elem [BeginTgt] (parserLex <$> lines)) = error $ "No <TGT> section or malformed <TGT> section in file : "++ show lines
        | not (elem [EndTgt] (parserLex <$> lines)) = error $ "No <TGT> section or malformed <TGT> section in file : "++ show lines
        | indexEndTgt < indexBeginTgt = error $ "Malformed <TGT> section in file : "++ show lines
        | otherwise = c
        where
            Just indexBeginTgt = (elemIndex [BeginTgt] (parserLex <$> lines))
            Just indexEndTgt = (elemIndex [EndTgt] (parserLex <$> lines))
            (a,b) = splitAt (indexBeginTgt+1) lines
            (c,d) = splitAt (indexEndTgt-indexBeginTgt-1) b
          
        
    -- | Unsafe version of 'readCGDString' which does not check the structure of the resulting 'Diagram'.
    unsafeReadCGDString :: String -> CGD
    unsafeReadCGDString str = completeDiagram finalDiag
        where
            ls = filter (not.null.parserLex) $ lines str
            s = unsafeReadCGString $ intercalate "\n" (extractSrcSection ls)
            t = unsafeReadCGString $ intercalate "\n" (extractTgtSection ls)
            diag = Diagram{src=s, tgt=t,omap=weakMap [], mmap=weakMap []}
            finalDiag = foldr readLineD diag ls
        
    -- | Read a .cgd string and returns a diagram. A .cgd string obeys the following rules :
    --
    -- 1. There is a line "\<SRC\>" and a line "\</SRC\>".
    --
    -- 1.1 Between these two lines, the source composition graph is defined as in a cg file.
    --
    -- 2. There is a line "\<TGT\>" and a line "\</TGT\>".
    --
    -- 2.1 Between these two lines, the target composition graph is defined as in a cg 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.
    readCGDString :: String -> Either (DiagramError CG (CGMorphism Text Text) Text CG (CGMorphism Text Text) Text) CGD
    readCGDString str
        | null check = Right diag
        | otherwise = Left err
        where
            diag = unsafeReadCGDString str
            check = checkFiniteDiagram diag
            Just err = check
            
    -- | Unsafe version 'readCGDFile' which does not check the structure of the resulting 'Diagram'.
    unsafeReadCGDFile :: String -> IO CGD
    unsafeReadCGDFile path = do
        raw <- readFile path
        return (unsafeReadCGDString raw)
        
    -- | Read a .cgd file and returns a diagram. A .cgd file obeys the following rules :
    --
    -- 1. There is a line "\<SRC\>" and a line "\</SRC\>".
    --
    -- 1.1 Between these two lines, the source composition graph is defined as in a cg file.
    --
    -- 2. There is a line "\<TGT\>" and a line "\</TGT\>".
    --
    -- 2.1 Between these two lines, the target composition graph is defined as in a cg 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.
    readCGDFile :: String -> IO (Either (DiagramError CG (CGMorphism Text Text) Text CG (CGMorphism Text Text) Text) CGD)
    readCGDFile path = do
        raw <- readFile path
        return (readCGDString raw)
        
    -- | Transform a composition graph diagram into a string following the .cgd convention.
    writeCGDString :: (PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1,
                       PrettyPrint a2, PrettyPrint b2, Eq a2, Eq b2) => 
                    Diagram (CompositionGraph a1 b1) (CGMorphism a1 b1) a1 (CompositionGraph a2 b2) (CGMorphism a2 b2) a2 -> String
    writeCGDString diag = srcString ++ tgtString ++ "\n" ++ omapString ++ "\n" ++ mmapString
        where
            srcString = "<SRC>\n"++writeCGString (src diag)++"\n</SRC>\n"
            tgtString = "<TGT>\n"++writeCGString (tgt diag)++"</TGT>\n"
            omapString = "#Object mapping\n" ++ (intercalate "\n" $ (\o -> (pprint o) ++ " => " ++  (pprint (diag ->$ o)) )<$> (setToList.ob.src $ diag)) ++ "\n"
            mmapString = "#Morphism mapping\n" ++ (intercalate "\n" $ (\m -> pprint (source m) ++ " -" ++ pprint m ++ "-> " ++ pprint (target m)++ " => " ++ if isIdentity (tgt diag) (diag ->£ m) then "<ID/>" else pprint (source (diag ->£ m)) ++ " -" ++ pprint (diag ->£ m) ++ "-> " ++ pprint (target (diag ->£ m)))<$> (setToList.(Set.filter (isNotIdentity (src diag))).genArrows.src $ diag)) ++ "\n"
        
    -- | Saves a composition graph diagram into a file located at a given path.
    writeCGDFile :: (PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1,
                     PrettyPrint a2, PrettyPrint b2, Eq a2, Eq b2) => 
                    Diagram (CompositionGraph a1 b1) (CGMorphism a1 b1) a1 (CompositionGraph a2 b2) (CGMorphism a2 b2) a2 -> String -> IO ()
    writeCGDFile diag filepath = do
        createDirectoryIfMissing True $ takeDirectory filepath
        writeFile filepath $ writeCGDString diag
        
        

-----------------------
-- Random CompositionGraph
-----------------------
        
        
        
        
        
    -- | Find first order composites arrows in a composition graph.
    compositeMorphisms :: (Eq a, Eq b, Show a) => CompositionGraph a b -> [CGMorphism a b]
    compositeMorphisms c = setToList [g @ f | f <- genArrows c, g <- genArFrom c (target f), not (isIn (g @ f) (genAr c (source f) (target g)))]

    -- | Merge two nodes.
    mergeNodes :: (Eq a, Eq b) => CompositionGraph a b -> a -> a -> CompositionGraph a b
    mergeNodes cg@CompositionGraph{support=g,law=l} s t
        | not (isIn s (nodes g)) = error "mapped but not in rcg."
        | not (isIn t (nodes g)) = error "mapped to but not in rcg."
        | s == t = cg
        | otherwise = CompositionGraph {support=unsafeGraph (Set.filter (/=s) (nodes g)) (replaceArrow <$> (edges g)), law=newLaw}
        where
            replace x = if x == s then t else x
            replaceArrow Arrow{sourceArrow=s3,targetArrow=t3,labelArrow=l3} = Arrow{sourceArrow=replace s3,targetArrow=replace t3,labelArrow=l3}
            newLaw = weakMap $ (\(k,v) -> (replaceArrow <$> k, replaceArrow <$> v)) <$> (Map.mapToList l)
    
    -- | Merge two morphisms of a composition graph, the morphism mapped should be composite, the morphism mapped to should be a generator.
    mergeMorphisms :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b -> CGMorphism a b -> CompositionGraph a b
    mergeMorphisms cg@CompositionGraph{support=g,law=l} s@CGMorphism{path=p1@(s1,rp1),compositionLaw=l1} t@CGMorphism{path=p2@(s2,rp2),compositionLaw=l2}
        | (isGenerator cg s) = error "Generator at the start of a merge"
        | (isComposite cg t) = error "Composite at the end of a merge"
        | s1 == targetPath p1 =  mergeNodes CompositionGraph{support=g, law=newLaw} (source s) (source t)
        | s1 == targetPath p2 = mergeNodes (mergeNodes CompositionGraph{support=g, law=newLaw} (source s) (source t)) (target s) (source t)
        | otherwise = mergeNodes (mergeNodes CompositionGraph{support=g, law=newLaw} (source s) (source t)) (target s) (target t) where
        targetPath path = if null (snd path) then fst path else (targetArrow (head (snd path)))
        newLaw = Map.insert (replaceArrow <$> rp1) (replaceArrow <$> rp2) (weakMap $ (\(k,v) -> (replaceArrow <$> k, replaceArrow <$> v)) <$> (Map.mapToList l))
            where
                replace x = if x == s1 then s2 else (if x == targetPath p1 then targetPath p2 else x)
                replaceArrow Arrow{sourceArrow=s3,targetArrow=t3,labelArrow=l3} = Arrow{sourceArrow=replace s3,targetArrow=replace t3,labelArrow=l3}
    
    -- | Checks associativity of a composition graph.
    checkAssociativity :: (Eq a, Eq b, Show a) => CompositionGraph a b -> Bool
    checkAssociativity cg = Set.foldr (&&) True [checkTriplet (f,g,h) | f <- genArrows cg, g <- genArFrom cg (target f), h <- genArFrom cg (target g)]
        where
            checkTriplet (f,g,h) = (h @ g) @ f == h @ (g @ f)
        
    -- | Find all composite arrows and try to map them to generating arrows. 
    identifyCompositeToGen :: (RandomGen g, Eq a, Eq b, Show a) => CompositionGraph a b -> Int -> g -> (Maybe (CompositionGraph a b), g)
    identifyCompositeToGen _ 0 rGen = (Nothing, rGen)
    identifyCompositeToGen cg n rGen
        | not (checkAssociativity cg) = (Nothing, rGen)
        | null compositeMorphs = (Just cg, rGen)
        | otherwise = if isNothing newCG then identifyCompositeToGen cg (n `div` 2) newGen2 else (newCG, newGen2)
        where
            compositeMorphs = compositeMorphisms cg
            morphToMap = (head compositeMorphs)
            (selectedGen,newGen1) = if (source morphToMap == target morphToMap) then pickOne [fs | obj <- (setToList (ob cg)), fs <- (setToList (genAr cg obj obj))] rGen else pickOne (setToList (genArrows cg)) rGen
            (newCG,newGen2) = identifyCompositeToGen (mergeMorphisms cg morphToMap selectedGen) n newGen1 
            
    -- | Pick one element of a list randomly.
    pickOne :: (RandomGen g) => [a] -> g -> (a,g)
    pickOne [] g = error "pickOne in an empty list."
    pickOne l g = ((l !! index),newGen) where
        (index,newGen) = (uniformR (0,(length l)-1) g)
        
    listWithoutNthElem :: [a] -> Int -> [a]
    listWithoutNthElem [] _ = []
    listWithoutNthElem (x:xs) 0 = xs
    listWithoutNthElem (x:xs) k = x:(listWithoutNthElem xs (k-1))
        
    -- | Sample /n/ elements of a list randomly.
    sample :: (RandomGen g) => [a] -> Int -> g -> ([a],g)
    sample _ 0 g = ([],g)
    sample [] k g = error "Sample size bigger than the list size."
    sample l n g = (((l !! index):rest),finalGen) where
        (index,newGen) = (uniformR (0,(length l)-1) g)
        new_l = listWithoutNthElem l index
        (rest,finalGen) = sample new_l (n-1) newGen
            
    -- | Algorithm described in `mkRandomCompositionGraph`.
    monoidificationAttempt :: (RandomGen g, Eq a, Eq b, Show a) => CompositionGraph a b -> Int -> g -> (CompositionGraph a b, g, [a])
    monoidificationAttempt cg p g = if isNothing result then (cg,finalGen,[]) else (fromJust result, finalGen, [s,t])
        where
            ([s,t],newGen) = if ((cardinal (ob cg)) > 1) then sample (setToList.ob $ cg) 2 g else (setToList (ob cg ||| ob cg),g)
            newCG = mergeNodes cg s t
            (result,finalGen) = identifyCompositeToGen newCG p newGen
    
    -- | Initialize a composition graph with all arrows seperated.
    initRandomCG :: Int -> CompositionGraph Int Int
    initRandomCG n = CompositionGraph{support=unsafeGraph (set [0..n+n-1]) (set [Arrow{sourceArrow=(i+i), targetArrow=(i+i+1), labelArrow=i} | i <- [0..n]]),law=weakMap []}
    
    -- | Generates a random composition graph.
    --
    -- We use the fact that a category is a generalized monoid.
    --
    -- We try to create a composition law of a monoid greedily.
    --
    -- To get a category, we begin with a category with all arrows seperated and not composing with each other. 
    -- It is equivalent to the monoid with an empty composition law.
    --
    -- Then, a monoidification attempt is the following algorihm :
    --
    -- 1. Pick two objects, merge them.
    -- 2. While there are composite morphisms, try to merge them with generating arrows.
    -- 3. If it fails, don't change the composition graph.
    -- 4. Else return the new composition graph
    -- 
    -- A monoidification attempt takes a valid category and outputs a valid category, furthermore, the number of arrows is constant
    -- and the number of objects is decreasing (not strictly).
    constructRandomCompositionGraph :: (RandomGen g) => Int -- ^ Number of arrows of the random composition graph.
                                              -> Int -- ^ Number of monoidification attempts, a bigger number will produce more morphisms that will compose but the function will be slower.
                                              -> Int -- ^ Perseverance : how much we pursure an attempt far away to find a law that works, a bigger number will make the attemps more successful, but slower. (When in doubt put 4.)
                                              -> g   -- ^ Random generator.
                                              -> (CompositionGraph Int Int, g)
    constructRandomCompositionGraph nbAr nbAttempts perseverance gen = attempt (initRandomCG nbAr) nbAttempts perseverance gen
        where
            attempt cg 0 _ gen = (cg, gen)
            attempt cg n p gen = attempt newCG (n-1) p newGen
                where
                    (newCG, newGen,_) = (monoidificationAttempt cg p gen)
    
    -- | Creates a random composition graph with default random values.
    --
    -- The number of arrows will be in the interval [1, 20].
    defaultConstructRandomCompositionGraph  :: (RandomGen g) => g -> (CompositionGraph Int Int, g)
    defaultConstructRandomCompositionGraph g1 = constructRandomCompositionGraph nbArrows (min nbAttempts 20) 4 g3
        where 
            (nbArrows, g2) = uniformR (1,20) g1
            (nbAttempts, g3) = uniformR (0,nbArrows+nbArrows) g2
    
    
    -- | Constructs two random composition graphs and choose a random diagram between the two.
    defaultConstructRandomDiagram  :: (RandomGen g) => g ->  (Diagram (CompositionGraph Int Int) (CGMorphism Int Int) Int (CompositionGraph Int Int) (CGMorphism Int Int) Int, g)
    defaultConstructRandomDiagram g1 = pickRandomDiagram cat1 cat2 g3
        where 
            (nbArrows1, g2) = uniformR (1,8) g1
            (nbAttempts1, g3) = uniformR (0,nbArrows1+nbArrows1) g2
            (cat1, g4) = constructRandomCompositionGraph nbArrows1 nbAttempts1 5 g3
            (nbArrows2, g5) = uniformR (1,11-nbArrows1) g4
            (nbAttempts2, g6) = uniformR (0,nbArrows2+nbArrows2) g5
            (cat2, g7) = constructRandomCompositionGraph nbArrows2 nbAttempts2 5 g6