{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, MonadComprehensions #-}
{-| Module  : FiniteCategories
Description : A 'SafeCompositionGraph' is a 'CompositionGraph' where infinite loops are prevented.
Copyright   : Guillaume Sabbagh 2022
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

A 'SafeCompositionGraph' is a 'CompositionGraph' where infinite loops are prevented.

The 'readSCGFile' function is the most important for ease of use.
-}

module Math.FiniteCategories.SafeCompositionGraph
(
    -- * Types for a morphism of safe composition graph
    SCGMorphism(..),
    -- ** Functions for morphism
    getLabelS,
    -- * Safe composition graph
    SafeCompositionGraph,
    -- ** Getters
    supportS,
    lawS,
    maxCycles,
    -- * Construction
    safeCompositionGraph,
    unsafeSafeCompositionGraph,
    readSCGString,
    unsafeReadSCGString,
    readSCGFile,
    unsafeReadSCGFile,
    safeCompositionGraphFromCompositionGraph,
    compositionGraphFromSafeCompositionGraph,
    -- * Serialization
    writeSCGString,
    writeSCGFile,
    -- * Construction of diagrams
    unsafeReadSCGDString,
    readSCGDString,
    unsafeReadSCGDFile,
    readSCGDFile,
    -- * Serialization of diagrams
    writeSCGDString,
    writeSCGDFile,
    -- * Random safe composition graph
    constructRandomSafeCompositionGraph,
    defaultConstructRandomSafeCompositionGraph,
    defaultConstructRandomSafeDiagram,
)
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.Text           (Text, singleton, cons, unpack, pack)
    
    import              Math.Category
    import              Math.FiniteCategory
    import              Math.FiniteCategories.CompositionGraph
    import              Math.FiniteCategoryError
    import              Math.IO.PrettyPrint
    import              Math.Categories.FinGrph
    import              Math.Categories.FunctorCategory
    
    import              System.Directory            (createDirectoryIfMissing)
    import              System.FilePath.Posix       (takeDirectory)
    import              System.Random               (RandomGen, uniformR)
    
    -- | The type `SCGMorphism` is the type of 'SafeCompositionGraph's morphisms.
    --
    -- It is just like a 'CGMorphism', we also store the maximum number of cycles.
    data SCGMorphism a b = SCGMorphism {pathS :: Path a b 
                                       ,compositionLawS :: CompositionLaw a b
                                       ,maxNbCycles :: Int} deriving (Show, Eq)
    
    instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (SCGMorphism a b) where
        pprint SCGMorphism {pathS=(s,[]),compositionLawS=cl} = "Id"++(pprint s)
        pprint SCGMorphism {pathS=(_,rp),compositionLawS=cl} = intercalate " o " $ (pprint.labelArrow) <$> rp
        
    -- | Return the label of a 'SafeCompositionGraph' generator.
    getLabelS :: SCGMorphism a b -> Maybe b
    getLabelS SCGMorphism{pathS=(s,rp), compositionLawS=_, maxNbCycles=_}
        | null rp = Nothing
        | null.tail $ rp = Just (labelArrow.head $ rp)
        | otherwise = Nothing
        
    rawpathToListOfVertices :: RawPath a b -> [a]
    rawpathToListOfVertices [] = []
    rawpathToListOfVertices rp = ((targetArrow.head $ rp):(sourceArrow <$> rp))
    
    -- | Helper function for `simplify`. Returns a simplified raw path.
    simplifyOnce :: (Eq a, Eq b) => CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
    simplifyOnce _ _ [] = [] 
    simplifyOnce _ _ [e] = [e]
    simplifyOnce cl nb list 
        | new_list == [] = []
        | isCycle && tooManyCycles = []
        | new_list /= list = new_list
        | simple_tail /= (tail list) = (head list):simple_tail
        | simple_init /= (init list) = simple_init++[(last list)]
        | otherwise = list
        where
        listOfVertices = rawpathToListOfVertices list
        isCycle = (head listOfVertices) == (last listOfVertices)
        tooManyCycles = (length $ filter ((head listOfVertices) ==) listOfVertices) == (nb+2)
        new_list = Map.findWithDefault list list cl
        simple_tail = simplifyOnce cl nb (tail list)
        simple_init = simplifyOnce cl nb (init list)
        
    -- | Returns a completely simplified raw path.
    simplify :: (Eq a, Eq b) => CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
    simplify _ _ [] = []
    simplify cl nb rp 
        | simple_one == rp = rp 
        | otherwise = simplify cl nb simple_one 
            where simple_one = simplifyOnce cl nb rp
            
    instance (Eq a, Eq b) => Morphism (SCGMorphism a b) a where
        (@?) m2@SCGMorphism{pathS=(s2,rp2), compositionLawS=cl2, maxNbCycles=nb2} m1@SCGMorphism{pathS=(s1,rp1), compositionLawS=cl1, maxNbCycles=nb1}
            | nb1 /= nb2 = Nothing
            | cl1 /= cl2 = Nothing
            | source m2 /= target m1 = Nothing
            | otherwise = Just SCGMorphism{pathS=(s1,(simplify cl1 nb1 (rp2++rp1))), compositionLawS=cl1, maxNbCycles=nb1}
            
        source SCGMorphism{pathS=(s,_), compositionLawS=_, maxNbCycles=_} = s
        target SCGMorphism{pathS=(s,[]), compositionLawS=_, maxNbCycles=_} = s
        target SCGMorphism{pathS=(_,rp), compositionLawS=_, maxNbCycles=_} = targetArrow (head rp)
        
    -- | Constructs a `SCGMorphism` from a composition law, an arrow and maxNbCycles.
    mkSCGMorphism :: CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
    mkSCGMorphism cl nb e = SCGMorphism {pathS=(sourceArrow e,[e]),compositionLawS=cl, maxNbCycles=nb}
    
    -- | 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 -> Int -> a -> Set (RawPath a b)
    findElementaryCycles g cl nb o = set $ (simplify cl nb <$> []:(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 or they go beyond the max number of cycles.
    findCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
    findCycles g cl nb o = findCyclesWithPreviousCycles g cl o (findElementaryCycles g cl nb o)
        where 
            findCyclesWithPreviousCycles g cl o p
                | newCycles == p = newCycles
                | otherwise = findCyclesWithPreviousCycles g cl o newCycles
                where
                    newCycles = (simplify cl nb) <$> ((++) <$> p <*> findElementaryCycles g cl nb 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 -> Int -> a -> RawPath a b -> Set (RawPath a b)
    intertwineWithCycles g cl nb _ p@(x:xs) = set $ concat <$> ((uncurry intertwine) <$> zip (setToList prodCycles) (repeat ((:[]) <$> p))) where
        prodCycles = cartesianProductOfSets cycles
        cycles = ((findCycles g cl nb (targetArrow x))):(((\y -> (findCycles g cl nb (sourceArrow y)))) <$> p)
    intertwineWithCycles g cl nb s [] = (findCycles g cl nb 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 -> Int -> a -> a -> Set (SCGMorphism a b)
    mkAr g cl nb s t = (\p -> SCGMorphism{pathS=(s,p),compositionLawS=cl,maxNbCycles=nb}) <$> allPaths where
        acyclicPaths = (simplify cl nb) <$> (findAcyclicRawPaths g s t)
        allPaths = (simplify cl nb <$> Set.unions (setToList ((intertwineWithCycles g cl nb s) <$> acyclicPaths)))
        
    -- | A 'SafeCompositionGraph' 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'. It has a maximum number of composition for loops.
    -- 
    -- 'SafeCompositionGraph' is private, use the smart constructors 'safeCompositionGraph' or 'unsafeSafeCompositionGraph' to instantiate one.
    data SafeCompositionGraph a b = SafeCompositionGraph {
                                                            supportS :: Graph a b, -- ^ The generating graph of the safe composition graph.
                                                            lawS :: CompositionLaw a b, -- ^ The composition law of the safe composition graph.
                                                            maxCycles :: Int -- ^ The maximum number of times a cycle can be composed with itself.
                                                         } deriving (Eq)
 
    instance (Show a, Show b) => Show (SafeCompositionGraph a b) where
        show scg = "(unsafeSafeCompositionGraph "++ show (supportS scg) ++ " " ++ show (lawS scg) ++ " " ++ show (maxCycles scg) ++ ")"
        
    instance (Eq a, Eq b) => Category (SafeCompositionGraph a b) (SCGMorphism a b) a where
        identity c x
            | x `isIn` (nodes (supportS c)) = SCGMorphism {pathS=(x,[]),compositionLawS=(lawS c), maxNbCycles = maxCycles c}
            | otherwise = error ("Math.FiniteCategories.SafeCompositionGraph.identity: Trying to construct identity of an unknown object.")
        ar c s t = mkAr (supportS c) (lawS c) (maxCycles c) s t
        genAr cg s t
            | s == t = Set.insert (identity cg s) gen
            | otherwise = gen 
            where gen = mkSCGMorphism (lawS cg) (maxCycles cg) <$> (Set.filter (\a -> s == (sourceArrow a) && t == (targetArrow a)) $ (edges (supportS cg)))
            
        decompose c m@SCGMorphism{pathS=(_,rp),compositionLawS=l,maxNbCycles=nb}
            | isIdentity c m = [m]
            | otherwise = mkSCGMorphism l nb <$> rp
    
    instance (Eq a, Eq b) => FiniteCategory (SafeCompositionGraph a b) (SCGMorphism a b) a where
        ob = (nodes.supportS)
            
    instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (SafeCompositionGraph a b) where
        pprint SafeCompositionGraph{supportS=g,lawS=l,maxCycles=nb} = "SafeCompositionGraph("++pprint g++","++pprint l++","++pprint nb++")"         
        
    -- | Smart constructor of `SafeCompositionGraph`.
    --
    -- If the 'SafeCompositionGraph' constructed is valid, returns 'Right' the composition graph, otherwise returns Left a 'FiniteCategoryError'.
    safeCompositionGraph :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> Int -> Either (FiniteCategoryError (SCGMorphism a b) a) (SafeCompositionGraph a b) 
    safeCompositionGraph g l nb
        | null check = Right c_g
        | otherwise = Left err
        where
            c_g = SafeCompositionGraph{supportS = g, lawS = l, maxCycles = nb}
            check = checkFiniteCategory c_g
            Just err = check
    
    -- | Unsafe constructor of 'SafeCompositionGraph' for performance purposes. It does not check the structure of the 'SafeCompositionGraph'.
    --
    -- Use this constructor only if the 'SafeCompositionGraph' is necessarily well formed.
    unsafeSafeCompositionGraph :: Graph a b -> CompositionLaw a b -> Int -> SafeCompositionGraph a b
    unsafeSafeCompositionGraph g l nb = SafeCompositionGraph{supportS = g, lawS = l, maxCycles = nb}
    
    
    -- | A token for a .scg 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 SCG = SafeCompositionGraph Text Text
    
    -- | Read a .scg string to create a 'SafeCompositionGraph'.
    --
    -- A .scg 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.
    --
    -- 6. The first line of the should be a number, this number determines the maximum number of cycles.
    readSCGString :: String -> Either (FiniteCategoryError (SCGMorphism Text Text) Text) SCG
    readSCGString str
        | null check = Right scg
        | otherwise = Left err
        where
            maxCyc = (read.head.lines $ str) :: Int
            cg = unsafeReadCGString ((intercalate "\n").tail.lines $ str)
            scg = SafeCompositionGraph{supportS = support cg, lawS = law cg, maxCycles = maxCyc}
            check = checkFiniteCategory scg
            Just err = check
    
    -- | Unsafe version of 'readSCGString' which does not check the structure of the resulting 'SafeCompositionGraph'.
    unsafeReadSCGString :: String -> SCG
    unsafeReadSCGString str = scg
        where
            maxCyc = (read.head.lines $ str) :: Int
            cg = unsafeReadCGString ((intercalate "\n").tail.lines $ str)
            scg = SafeCompositionGraph{supportS = support cg, lawS = law cg, maxCycles = maxCyc}
            
    -- | Unsafe version of 'readSCGFile' which does not check the structure of the resulting 'SafeCompositionGraph'.
    unsafeReadSCGFile :: String -> IO SCG
    unsafeReadSCGFile path = do
        file <- readFile path
        return $ unsafeReadSCGString file
    
    
    -- | Read a .scg file to create a 'SafeCompositionGraph'.
    --
    -- A .scg 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.
    --
    -- 6. The first line of the should be a number, this number determines the maximum number of cycles.
    readSCGFile :: String -> IO (Either (FiniteCategoryError (SCGMorphism Text Text) Text) SCG)
    readSCGFile str = do
        scg <- unsafeReadSCGFile str
        let check = checkFiniteCategory scg
        return (if null check then Right scg 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 .scg convention.
    writeSCGString :: (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => SafeCompositionGraph a b -> String
    writeSCGString 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.pathS) <$> arNotIdentityAndNotComposite
            arString = intercalate "\n" $ reversedRawPathToString <$> reversedRawPaths
            lawString = intercalate "\n" $ (\(rp1,rp2) -> (reversedRawPathToString (reverse rp1)) ++ " = " ++ (reversedRawPathToString (reverse rp2))) <$> ((Map.toList).lawS $ cg)
            finalString = (show (maxCycles cg))++"\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 :: (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => SafeCompositionGraph a b -> String -> IO ()
    writeSCGFile cg filepath = do
        createDirectoryIfMissing True $ takeDirectory filepath
        writeFile filepath $ writeSCGString cg
        
    
    
    
    
     -----------------------
    -- SCGD FILE
    -----------------------

    type SCGD = Diagram (SafeCompositionGraph Text Text) (SCGMorphism Text Text) Text (SafeCompositionGraph Text Text) (SCGMorphism Text Text) Text 
    
    addOMapEntry :: [Token] -> SCGD -> SCGD
    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] -> SCGD -> SCGD
    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 -> getLabelS 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 -> getLabelS e == Just lx) (genAr (src diag) sx tx)
            targetMorphCand = Set.filter (\e -> getLabelS 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 -> SCGD -> SCGD
    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'.
    unsafeReadSCGDString :: String -> SCGD
    unsafeReadSCGDString str = completeDiagram finalDiag
        where
            ls = filter (not.null.parserLex) $ lines str
            s = unsafeReadSCGString $ intercalate "\n" (extractSrcSection ls)
            t = unsafeReadSCGString $ intercalate "\n" (extractTgtSection ls)
            diag = Diagram{src=s, tgt=t,omap=weakMap [], mmap=weakMap []}
            finalDiag = foldr readLineD diag ls
        
    -- | Read a .scgd string and returns a diagram. A .scgd 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 scg 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 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.
    readSCGDString :: String -> Either (DiagramError SCG (SCGMorphism Text Text) Text SCG (SCGMorphism Text Text) Text) SCGD
    readSCGDString str
        | null check = Right diag
        | otherwise = Left err
        where
            diag = unsafeReadSCGDString str
            check = checkFiniteDiagram diag
            Just err = check
            
    -- | Unsafe version 'readSCGDFile' which does not check the structure of the resulting 'Diagram'.
    unsafeReadSCGDFile :: String -> IO SCGD
    unsafeReadSCGDFile path = do
        raw <- readFile path
        return (unsafeReadSCGDString raw)
        
    -- | Read a .scgd file and returns a diagram. A .scgd 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 scg 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 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.
    readSCGDFile :: String -> IO (Either (DiagramError SCG (SCGMorphism Text Text) Text SCG (SCGMorphism Text Text) Text) SCGD)
    readSCGDFile path = do
        raw <- readFile path
        return (readSCGDString raw)
        
        
    -- | Transform a safe composition graph diagram into a string following the .scgd convention.
    writeSCGDString :: (PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1,
                        PrettyPrint a2, PrettyPrint b2, Eq a2, Eq b2) => 
                    Diagram (SafeCompositionGraph a1 b1) (SCGMorphism a1 b1) a1 (SafeCompositionGraph a2 b2) (SCGMorphism a2 b2) a2 -> String
    writeSCGDString diag = srcString ++ tgtString ++ "\n" ++ omapString ++ "\n" ++ mmapString
        where
            srcString = "<SRC>\n"++writeSCGString (src diag)++"\n</SRC>\n"
            tgtString = "<TGT>\n"++writeSCGString (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 safe composition graph diagram into a file located at a given path.
    writeSCGDFile :: (PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1,
                     PrettyPrint a2, PrettyPrint b2, Eq a2, Eq b2) => 
                    Diagram (SafeCompositionGraph a1 b1) (SCGMorphism a1 b1) a1 (SafeCompositionGraph a2 b2) (SCGMorphism a2 b2) a2 -> String -> IO ()
    writeSCGDFile diag filepath = do
        createDirectoryIfMissing True $ takeDirectory filepath
        writeFile filepath $ writeSCGDString diag
        
    -- | Transform a 'CompositionGraph' into a 'SafeCompositionGraph' given a maximum number of loops.
    safeCompositionGraphFromCompositionGraph :: Int -> CompositionGraph a b -> SafeCompositionGraph a b
    safeCompositionGraphFromCompositionGraph i cg = SafeCompositionGraph{supportS = support cg, lawS = law cg, maxCycles = i}
    
    -- | Transform a 'SafeCompositionGraph' into a 'CompositionGraph'.
    compositionGraphFromSafeCompositionGraph :: SafeCompositionGraph a b -> CompositionGraph a b
    compositionGraphFromSafeCompositionGraph scg = unsafeCompositionGraph (supportS scg) (lawS scg)
    
    -- | Generates a random 'CompositionGraph' and transforms it into a 'SafeCompositionGraph' (see 'constructRandomCompositionGraph').
    constructRandomSafeCompositionGraph :: (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.
                                              -> Int -- ^ The maximum number of loops of the SafeCompositionGraph
                                              -> (SafeCompositionGraph Int Int, g)
    constructRandomSafeCompositionGraph a b c g i = (safeCompositionGraphFromCompositionGraph i cg, g2)
        where
            (cg, g2) = constructRandomCompositionGraph a b c g
    
    -- | Creates a random safe composition graph with default random values.
    --
    -- The number of arrows will be in the interval [1, 20].
    --
    -- The max number of loops is set to 100 as it is almost impossible to have a greater number of loops with monoidification attempts.
    defaultConstructRandomSafeCompositionGraph :: (RandomGen g) => g -> (SafeCompositionGraph Int Int, g)
    defaultConstructRandomSafeCompositionGraph g = (safeCompositionGraphFromCompositionGraph 100 cg, g2)
        where
            (cg,g2) = defaultConstructRandomCompositionGraph g
    
    -- | Constructs two random safe composition graphs and choose a random diagram between the two.
    --
    -- The max number of loops is set to 100 as it is almost impossible to have a greater number of loops with monoidification attempts.
    defaultConstructRandomSafeDiagram :: (RandomGen g) => g ->  (Diagram (SafeCompositionGraph Int Int) (SCGMorphism Int Int) Int (SafeCompositionGraph Int Int) (SCGMorphism Int Int) Int, g)
    defaultConstructRandomSafeDiagram g1 = pickRandomDiagram cat1 cat2 g3
        where 
            (nbArrows1, g2) = uniformR (1,8) g1
            (nbAttempts1, g3) = uniformR (0,nbArrows1+nbArrows1) g2
            (cat1, g4) = constructRandomSafeCompositionGraph nbArrows1 nbAttempts1 5 g3 100
            (nbArrows2, g5) = uniformR (1,11-nbArrows1) g4
            (nbAttempts2, g6) = uniformR (0,nbArrows2+nbArrows2) g5
            (cat2, g7) = constructRandomSafeCompositionGraph nbArrows2 nbAttempts2 5 g6 100