{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : Composition graphs are the simpliest way to create simple small categories by hand.
Copyright   : Guillaume Sabbagh 2021
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 underlying multidigraph is given by a list of nodes and a list of arrows.

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

The function `mkCompositionGraph` checks the structure of the category and is the preferred way of instantiatiating the `CompositionGraph` type.
If the check takes too long because the category is big, you can use the `CompositionGraph` if you're sure that the category structure is respected.

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.

Example.ExampleCompositionGraph provides an example of composition graph construction.    
-}


module CompositionGraph.CompositionGraph 
(
    -- * Types for a graph
    Arrow(..),
    Graph(..),
    -- * Types for a morphism of composition graph
    RawPath(..),
    Path(..),
    CGMorphism(..),
    -- * Types for a composition graph
    CompositionLaw(..),
    CompositionGraph(..),
    -- * Construction
    mkCompositionGraph,
    mkEmptyCompositionGraph,
    finiteCategoryToCompositionGraph,
    generatedFiniteCategoryToCompositionGraph,
    -- * Error gestion
    CompositionGraphError(..),
    -- * Insertion
    insertObject,
    insertMorphism,
    -- * Modification
    identifyMorphisms,
    unidentifyMorphism,
    replaceObject,
    replaceMorphism,
    -- * Deletion
    deleteObject,
    deleteMorphism,
    -- * Utility functions
    isGen,
    isComp,
    getLabel
    
)    
where
    import           Data.List                      ((\\), nub, intercalate, delete)
    import           FiniteCategory.FiniteCategory
    import           Utils.CartesianProduct         (cartesianProduct, (|^|))
    import           Data.Maybe                     (isNothing, fromJust)
    import           IO.PrettyPrint
    import           Utils.AssociationList
    import           Utils.Tuple
    import           Diagram.Diagram
    import           Config.Config
    import           Cat.PartialFinCat
    import           Control.Monad                  (foldM)
        
    -- | An `Arrow` is a source node, a target node and an identifier (for example a unique label).
    type Arrow a b = (a, a, b)
    
    -- | A `RawPath` is a list of arrows.
    type RawPath a b = [Arrow a b]
    
    -- | A `Path` is a `RawPath` with a source and a target specified.
    --
    -- An empty path is an identity in a free category. 
    -- Therefore, it is useful to keep the source and the target 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)
    
    -- | A `CompositionLaw` is a `Data.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 = AssociationList (RawPath a b) (RawPath a b)
    
    -- | The type `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 (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => PrettyPrintable (CGMorphism a b) where
        pprint CGMorphism {path=(s,[],t),compositionLaw=cl} = if s == t then "Id"++(pprint s) else error "Identity with source different of target."
        pprint CGMorphism {path=(_,rp,_),compositionLaw=cl} = intercalate " o " $ (\(_,_,l) -> pprint l) <$> rp
                     
    -- | A `Graph` is a list of nodes and a list of arrows.
    type Graph a b = ([a],[Arrow a b])

    -- | 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 = (!-?) list list cl
        simple_tail = simplifyOnce cl (tail list)
        simple_init = simplifyOnce cl (init list)
    
    -- | Returns 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
        (@) CGMorphism{path=(s2,rp2,t2), compositionLaw=cl2} CGMorphism{path=(s1,rp1,t1), compositionLaw=cl1}
            | t1 /= s2 = error "Composition of morphisms g@f where target of f is different of source of g"
            | cl1 /= cl2 = error "Composition of morphisms with different composition laws"
            | otherwise = CGMorphism{path=(s1,(simplify cl1 (rp2++rp1)),t2), compositionLaw=cl1}

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

    -- | Returns the list of arrows of a graph with a given source.
    findOutwardEdges :: (Eq a) => Graph a b -> a -> [Arrow a b]
    findOutwardEdges (nodes,edges) o = filter (\e@(s,t,_) -> s == o && elem t nodes) edges

    -- | Returns the list of arrows of a graph with a given target.
    findInwardEdges :: (Eq a) => Graph a b -> a -> [Arrow a b]
    findInwardEdges (nodes,edges) o = filter (\e@(s,t,_) -> t == o && elem s nodes) edges
    
    -- | Constructs the identity associated to a node of a composition graph.
    mkIdentity :: (Eq a) => Graph a b -> CompositionLaw a b -> a -> CGMorphism a b
    mkIdentity g@(n,_) cl x 
        | elem x n = CGMorphism {path=(x,[],x),compositionLaw=cl}
        | otherwise = error ("Trying to construct identity of an unknown object.")

    -- | Find all acyclic raw paths between two nodes in a graph.
    findAcyclicRawPaths :: (Eq a) => Graph a b -> a -> a -> [RawPath a b]
    findAcyclicRawPaths g s t = findAcyclicRawPathsVisitedNodes g s t [] where
        findAcyclicRawPathsVisitedNodes g@(n,e) s t v
            | elem t v = []
            | s == t = [[]]
            | otherwise = (concat (zipWith ($) (fmap fmap (fmap (:) inwardEdges)) (fmap (\x@(s1,t1,l1) -> (findAcyclicRawPathsVisitedNodes g s s1 (t:v))) inwardEdges))) where
                            inwardEdges = (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 -> [RawPath a b]
    findElementaryCycles g cl o = nub (simplify cl <$> []:(concat (zipWith sequence (fmap (fmap (\x y -> (y:x))) (fmap (\(s,_,_) ->  (findAcyclicRawPaths g o s)) inEdges)) inEdges))) where inEdges = (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.
    -- We throw an error to stop this function when we reach a depth of 5.
    findCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
    findCycles g cl o = findCyclesWithPreviousCycles g cl o (findElementaryCycles g cl o) maximumLoopDepth where 
        findCyclesWithPreviousCycles g cl o p n = if n == 0 then error "Suspected infinite loop because of a malformed composition graph." else if newCycles \\ p == [] then newCycles else (findCyclesWithPreviousCycles g cl o newCycles (n-1)) where
            newCycles = nub ((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 -> [RawPath a b]
    intertwineWithCycles g cl _ p@(x@(_,t,_):xs) = (concat <$> sequence (fmap intertwine prodCycles) (fmap (:[]) p)) where
        prodCycles = cartesianProduct cycles
        cycles = (findCycles g cl t):((\(s,_,_) -> (findCycles g cl s)) <$> 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 -> [CGMorphism a b]
    mkAr g cl s t = (\p -> CGMorphism{path=(s,p,t),compositionLaw=cl}) <$> nub (simplify cl <$> concat((intertwineWithCycles g cl s) <$> acyclicPaths)) where
        acyclicPaths = nub $ (simplify cl) <$> (findAcyclicRawPaths g s t)
    
    -- | A composition graph is a graph with a composition law. Use `mkCompositionGraph` to instantiate it unless it takes too long.
    data CompositionGraph a b = CompositionGraph {graph :: Graph a b, law :: CompositionLaw a b} deriving (Eq, Show)
    
    instance (Eq a, Eq b) => FiniteCategory (CompositionGraph a b) (CGMorphism a b) a where
        ob = fst.graph
        identity c = mkIdentity (graph c) (law c)
        ar c = mkAr (graph c) (law c)
    
    instance (Eq a, Eq b) => GeneratedFiniteCategory (CompositionGraph a b) (CGMorphism a b) a where
        genAr c@CompositionGraph{graph=g,law=l} s t
            | s == t = gen ++ [identity c s]
            | otherwise = gen 
            where gen = mkCGMorphism l <$> (filter (\a@(s1,t1,_) -> s == s1 && t == t1) $ snd g)
            
        decompose c m@CGMorphism{path=(_,rp,_),compositionLaw=l}
            | isIdentity c m = [m]
            | otherwise = mkCGMorphism l <$>  rp
            
    instance (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => PrettyPrintable (CompositionGraph a b) where
        pprint cg@CompositionGraph{graph=(nodes,arrs),law=_} = "CompositionGraph("++intercalate "," (pprint <$> nodes)++"\n"++intercalate "," ((\(a,b,c) -> pprint c ++ ":" ++ pprint a ++ "->" ++ pprint b) <$> arrs)        
    
    -- | Optimized version of isGenerator for `CompositionGraph`.
    isGen :: (Eq a) => CGMorphism a b -> Bool
    isGen m@CGMorphism{path=p@(s,rp,t),compositionLaw=_} = (length rp ) < 2
    
    -- | Optimized version of isComposite for `CompositionGraph`.
    isComp :: (Eq a) => CGMorphism a b -> Bool
    isComp = not.isGen
    
    -- | Returns the label of a generator arrow which is not an identity.
    getLabel :: (Eq a) => CGMorphism a b -> Maybe b
    getLabel CGMorphism{path=(_,[(_,_,label)],_),compositionLaw=_} = Just label
    getLabel _ = Nothing
            
    -- | Constructs a `CompositionGraph` from a `Graph` and a `CompositionLaw`.
    --
    --  This is the preferred way of instantiating a `CompositionGraph` with `mkEmptyCompositionGraph`. This function checks the category structure,
    --  that is why it can return a `FiniteCategoryError` if the graph and the composition law provided don't produce a valid category.
    --  If this function takes too much time, use the `CompositionGraph` constructor at your own risk (it is your responsability to check the
    --  the category structure is valid).
    mkCompositionGraph :: (Eq a, Eq b, Show a) => Graph a b -> CompositionLaw a b -> Either (FiniteCategoryError (CGMorphism a b) a) (CompositionGraph a b) 
    mkCompositionGraph g l
        | isNothing check = Right c_g
        | otherwise = Left (fromJust check)
        where
            c_g = CompositionGraph {graph = g, law = l}
            check = checkGeneratedFiniteCategoryProperties c_g
    
    -- | Constructs an empty `CompositionGraph`.
    --
    -- Use `insertObject`, `insertMorphism` and `identifyMorphisms` to build a `CompositionGraph` from it.
    mkEmptyCompositionGraph :: CompositionGraph a b
    mkEmptyCompositionGraph = CompositionGraph {graph=([],[]), law=[]}
    
    
    
    -- | Transforms any `FiniteCategory` into a composition graph.
    --
    -- The composition graph will take more space in memory compared to the original category because the composition law is stored as a Data.Map.
    --
    -- Returns the `CompositionGraph` and an isofunctor as a `Diagram`.
    finiteCategoryToCompositionGraph :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> (CompositionGraph o m, Diagram c m o (CompositionGraph o m) (CGMorphism o m) o)
    finiteCategoryToCompositionGraph cat = (cg,isofunct)
        where
            morphToArrow f = ((source f),(target f),f)
            catLaw = [
                if isNotIdentity cat (g @ f) then
                    ([morphToArrow g,morphToArrow f],[morphToArrow (g @ f)])
                else
                    ([morphToArrow g,morphToArrow f],[]) |
                f <- (arrows cat), g <- (arFrom cat (target f)), isNotIdentity cat f, isNotIdentity cat g]
            cg = (CompositionGraph{graph=(ob cat, [morphToArrow f | f <- (arrows cat), isNotIdentity cat f])
                                 , law= catLaw})
            isofunct = Diagram{src=cat,tgt=cg,omap=functToAssocList id (ob cat),mmap=functToAssocList (\f -> if isNotIdentity cat f
                                                                        then
                                                                            mkCGMorphism catLaw (morphToArrow f)
                                                                        else
                                                                            identity cg (source f)) (arrows cat)}
                                                                            
    -- | Transforms any `GeneratedFiniteCategory` into a composition graph.
    --
    -- The composition graph will take more space in memory compared to the original category because the composition law is stored as a Data.Map.
    --
    -- Returns the `CompositionGraph` and an isofunctor as a `Diagram`.
    generatedFiniteCategoryToCompositionGraph :: (GeneratedFiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> (CompositionGraph o m, Diagram c m o (CompositionGraph o m) (CGMorphism o m) o)
    generatedFiniteCategoryToCompositionGraph cat = (cg,isofunct)
        where
            morphToArrow f = ((source f),(target f),f)
            catLaw = [
                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{graph=(ob cat, [morphToArrow f | f <- (genArrows cat), isNotIdentity cat f])
                                 , law= catLaw})
            isofunct = Diagram{src=cat,tgt=cg,omap=functToAssocList id (ob cat),mmap= functToAssocList (\f -> if isNotIdentity cat f
                                                                        then
                                                                            CGMorphism {path=(source f,(morphToArrow <$> (decompose cat f)),target f),compositionLaw=catLaw}
                                                                        else
                                                                            identity cg (source f)) (arrows cat)}
    
    -- | The datatype for composition graph construction errors.
    data CompositionGraphError a b = InsertMorphismNonExistantSource {faultyMorph :: b, faultySrc :: a}
                                   | InsertMorphismNonExistantTarget {faultyMorph :: b, faultyTgt :: a}
                                   | IdentifyGenerator {gen :: CGMorphism a b}
                                   | UnidentifyNonExistantMorphism {morph :: CGMorphism a b}
                                   | ResultingCategoryError (FiniteCategoryError (CGMorphism a b) a)
                                   | ReplaceNonExistantObject {faultyObj :: a}
                                   | ReplaceCompositeMorphism {composite :: CGMorphism a b}
                                   | DeleteIdentity {faultyIdentity :: CGMorphism a b}
                                   | DeleteCompositeMorph {composite :: CGMorphism a b}
                                   | DeleteNonExistantObjectMorph {neMorph :: CGMorphism a b}
                                   | DeleteNonExistantObject {faultyObj :: a}
    
    -- | Inserts an object in a `CompositionGraph`, returns the new `CompositionGraph` and a `PartialFunctor` which is the insertion functor.
    insertObject :: (Eq a, Eq b) => CompositionGraph a b -> a -> (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    insertObject prev@CompositionGraph{graph=(nodes,arrs), law=l} obj = (new, funct)
        where
            new = CompositionGraph{graph=(obj:nodes,arrs), law=l}
            funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList id (arrows prev)}
            
    -- | Inserts a morphism in a `CompositionGraph`, returns the new `CompositionGraph` and a `PartialFunctor` which is the insertion functor if it can, returns Nothing otherwise.
    --
    -- This function fails if the two nodes provided as source and target for the new morphism are not both in the composition graph.
    --
    -- The result may not be a valid `CompositionGraph` (the new morphism might close a loop creating infinitely many morphisms).
    -- You can use the function `identifyMorphisms` to transform it back into a valid `CompositionGraph`.
    insertMorphism :: (Eq a, Eq b) => CompositionGraph a b -> a -> a -> b -> Either
                                                                                (CompositionGraphError a b)
                                                                                (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    insertMorphism prev@CompositionGraph{graph=(nodes,arrs), law=l} src tgt morph
        | elem src nodes && elem tgt nodes = Right (new, funct)
        | not $ elem src nodes = Left InsertMorphismNonExistantSource{faultyMorph=morph, faultySrc=src}
        | not $ elem tgt nodes = Left InsertMorphismNonExistantTarget{faultyMorph=morph, faultyTgt=tgt}
        where
            new = CompositionGraph{graph=(nodes,(src, tgt, morph):arrs), law=l}
            funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList id (arrows prev)}
            
    -- | Identify two morphisms if it is possible, if not returns an error in a Left member.
    --
    -- You can only identify a composite morphism to another morphism.
    --
    -- If the resulting composition graph is not associative, it returns Left CompositionNotAssociative.
    identifyMorphisms :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b -> CGMorphism a b -> Either
                                                                                                        (CompositionGraphError a b)
                                                                                                        (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    identifyMorphisms prev@CompositionGraph{graph=(nodes,arrs), law=l} srcM tgtM
        | isGen srcM = Left IdentifyGenerator{gen=srcM}
        | isNothing check = Right (new,funct)
        | otherwise = Left $ ResultingCategoryError (fromJust check)
        where
            newLaw = ((snd3.path) srcM,(snd3.path) tgtM):l
            new = CompositionGraph{graph=(nodes,arrs), law=newLaw}
            check = checkGeneratedFiniteCategoryProperties new
            replaceLaw m = CGMorphism{path=(path m)
                                     ,compositionLaw=newLaw}
            funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList replaceLaw (delete srcM (arrows prev))}
    
    -- | Unidentify a morphism if it is possible, if not returns an error in a Left member.
    --
    -- Unidentifying a morphism means removing all entries in the composition law with results the morphism.    
    unidentifyMorphism :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b -> Either
                                                                                        (CompositionGraphError a b)
                                                                                        (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    unidentifyMorphism prev@CompositionGraph{graph=(nodes,arrs), law=l} m
        | elem m (ar prev (source m) (target m)) = Right (new,funct)
        | otherwise = Left UnidentifyNonExistantMorphism{morph=m}
        where
            newLaw = filter (((snd3.path $ m)/=).snd) l
            replaceLawInMorph CGMorphism{path=p,compositionLaw=_} = CGMorphism{path=p,compositionLaw=newLaw}
            new = CompositionGraph{graph=(nodes,arrs), law=newLaw}
            funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList replaceLawInMorph (arrows prev)}
            
    -- | Replaces an object with a new one, if the object to replace is not in the composition graph, returns Nothing.
    --
    -- It is different from deleting the object and inserting the new one because deleting an object deletes all leaving and coming arrows.
    replaceObject :: (Eq a, Eq b) => CompositionGraph a b -> a -> a -> Either
                                                                        (CompositionGraphError a b)
                                                                        (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    replaceObject prev@CompositionGraph{graph=(nodes,arrs), law=l} prevObj newObj
        | elem prevObj (ob prev) = Right (new,funct)
        | otherwise = Left ReplaceNonExistantObject {faultyObj=prevObj}
        where
            replace x = if x == prevObj then newObj else x
            replaceArr (s,t,a) = (replace s, replace t, a)
            replaceLawEntry (k,v) = (replaceArr <$> k, replaceArr <$> v)
            replaceCGMorph CGMorphism{path=(s,rp,t),compositionLaw=l} = CGMorphism{path=(replace s,replaceArr <$> rp,replace t),compositionLaw=replaceLawEntry <$> l}
            new = CompositionGraph{graph=(replace <$> nodes,replaceArr <$> arrs), law=replaceLawEntry <$> l}
            funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList replace nodes,mmapPF=functToAssocList replaceCGMorph (arrows prev)}
            
    -- | Replaces a generating morphism with a new one, if the morphism to replace is not a generator of the composition graph, returns Nothing.
    --
    -- It is different from deleting the morphism and inserting the new one because deleting an object deletes related composition law entries.
    replaceMorphism :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b -> b -> Either
                                                                                        (CompositionGraphError a b)
                                                                                        (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    replaceMorphism prev@CompositionGraph{graph=(nodes,arrs), law=l} prevMorph newMorph
        | elem prevMorph (genAr prev (source prevMorph) (target prevMorph)) = Right (new,funct)
        | otherwise = Left ReplaceCompositeMorphism{composite=prevMorph}
        where
            replaceArr m@(s,t,a) = if [m] == (snd3.path $ prevMorph) then (s, t, newMorph) else m
            replaceLawEntry (k,v) = (replaceArr <$> k, replaceArr <$> v)
            replaceCGMorph CGMorphism{path=(s,rp,t),compositionLaw=l} = CGMorphism{path=(s,replaceArr <$> rp,t),compositionLaw=replaceLawEntry <$> l}
            new = CompositionGraph{graph=(nodes,replaceArr <$> arrs), law=replaceLawEntry <$> l}
            funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList replaceCGMorph (arrows prev)}
            
    -- | Deletes a generating morphism if it can, the generator should not be an identity.
    deleteMorphism :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b ->  Either
                                                                                    (CompositionGraphError a b)
                                                                                    (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    deleteMorphism prev@CompositionGraph{graph=(nodes,arrs), law=l} morph
        | isIdentity prev morph = Left DeleteIdentity {faultyIdentity=morph}
        | elem morph (genAr prev (source morph) (target morph)) = Right (new,funct)
        | elem morph (ar prev (source morph) (target morph)) = Left DeleteCompositeMorph{composite=morph}
        | otherwise = Left DeleteNonExistantObjectMorph{neMorph=morph}
        where
            arr = head.snd3.path $ morph
            newLaw = filter (\(k,v) -> and ((/=arr) <$> k) && and ((/=arr) <$> v)) l
            newArrows = filter (\CGMorphism{path=(s,rp,t),compositionLaw=_} -> not (elem arr rp)) (arrows prev)
            replaceLaw m = CGMorphism{path=(path m)
                                     ,compositionLaw=newLaw}
            new = CompositionGraph{graph=(nodes,delete arr arrs), law=newLaw}
            funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList replaceLaw newArrows}
            
    -- | Deletes an object and all morphism coming from it or leaving it.
    deleteObject :: (Eq a, Eq b) => CompositionGraph a b -> a ->  Either
                                                                    (CompositionGraphError a b)
                                                                    (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    deleteObject prev@CompositionGraph{graph=(nodes,arrs), law=l} obj
        | elem obj (ob prev) = (\(cg,f) -> (\(fcg,ffunct) -> (fcg,ffunct @ f)) (delObj cg)) <$> cgWithoutMorphs
        | otherwise = Left DeleteNonExistantObject {faultyObj=obj}
        where
            idFunct = PartialFunctor{srcPF=prev,tgtPF=prev,omapPF=functToAssocList id nodes,mmapPF=functToAssocList id (arrows prev)}
            cgWithoutMorphs = foldM (\(cg,f) d -> ((\(ncg,nf) -> (ncg,nf @ f)) <$> (deleteMorphism cg d))) (prev,idFunct) (filter (isNotIdentity prev) (nub ((genArFrom prev obj)++(genArTo prev obj))))
            delObj prev2@CompositionGraph{graph=(nodes2,arrs2), law=l2} = (finalCG,
                                                                           PartialFunctor{srcPF=prev2,tgtPF=finalCG,omapPF=functToAssocList id (delete obj nodes2),mmapPF=functToAssocList id ((arrows prev2)\\[(identity prev2 obj)])})
                where
                    finalCG = CompositionGraph{graph=(delete obj nodes2,arrs2), law=l2}