{-# 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 {forall a b. SCGMorphism a b -> Path a b
pathS :: Path a b 
                                       ,forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS :: CompositionLaw a b
                                       ,forall a b. SCGMorphism a b -> Int
maxNbCycles :: Int} deriving (Int -> SCGMorphism a b -> ShowS
[SCGMorphism a b] -> ShowS
SCGMorphism a b -> String
(Int -> SCGMorphism a b -> ShowS)
-> (SCGMorphism a b -> String)
-> ([SCGMorphism a b] -> ShowS)
-> Show (SCGMorphism a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> SCGMorphism a b -> ShowS
forall a b. (Show a, Show b) => [SCGMorphism a b] -> ShowS
forall a b. (Show a, Show b) => SCGMorphism a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> SCGMorphism a b -> ShowS
showsPrec :: Int -> SCGMorphism a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => SCGMorphism a b -> String
show :: SCGMorphism a b -> String
$cshowList :: forall a b. (Show a, Show b) => [SCGMorphism a b] -> ShowS
showList :: [SCGMorphism a b] -> ShowS
Show, SCGMorphism a b -> SCGMorphism a b -> Bool
(SCGMorphism a b -> SCGMorphism a b -> Bool)
-> (SCGMorphism a b -> SCGMorphism a b -> Bool)
-> Eq (SCGMorphism a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
SCGMorphism a b -> SCGMorphism a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
SCGMorphism a b -> SCGMorphism a b -> Bool
== :: SCGMorphism a b -> SCGMorphism a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
SCGMorphism a b -> SCGMorphism a b -> Bool
/= :: SCGMorphism a b -> SCGMorphism a b -> Bool
Eq)
    
    instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (SCGMorphism a b) where
        pprint :: SCGMorphism a b -> String
pprint SCGMorphism {pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s,[]),compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
cl} = String
"Id"String -> ShowS
forall a. [a] -> [a] -> [a]
++(a -> String
forall a. PrettyPrint a => a -> String
pprint a
s)
        pprint SCGMorphism {pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
_,RawPath a b
rp),compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
cl} = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" o " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (b -> String
forall a. PrettyPrint a => a -> String
pprint(b -> String) -> (Arrow a b -> b) -> Arrow a b -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Arrow a b -> b
forall n e. Arrow n e -> e
labelArrow) (Arrow a b -> String) -> RawPath a b -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPath a b
rp
        
    -- | Return the label of a 'SafeCompositionGraph' generator.

    getLabelS :: SCGMorphism a b -> Maybe b
    getLabelS :: forall a b. SCGMorphism a b -> Maybe b
getLabelS SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s,RawPath a b
rp), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
_, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
_}
        | RawPath a b -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RawPath a b
rp = Maybe b
forall a. Maybe a
Nothing
        | RawPath a b -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null(RawPath a b -> Bool)
-> (RawPath a b -> RawPath a b) -> RawPath a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RawPath a b -> RawPath a b
forall a. HasCallStack => [a] -> [a]
tail (RawPath a b -> Bool) -> RawPath a b -> Bool
forall a b. (a -> b) -> a -> b
$ RawPath a b
rp = b -> Maybe b
forall a. a -> Maybe a
Just (Arrow a b -> b
forall n e. Arrow n e -> e
labelArrow(Arrow a b -> b) -> (RawPath a b -> Arrow a b) -> RawPath a b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RawPath a b -> Arrow a b
forall a. HasCallStack => [a] -> a
head (RawPath a b -> b) -> RawPath a b -> b
forall a b. (a -> b) -> a -> b
$ RawPath a b
rp)
        | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
        
    rawpathToListOfVertices :: RawPath a b -> [a]
    rawpathToListOfVertices :: forall a b. RawPath a b -> [a]
rawpathToListOfVertices [] = []
    rawpathToListOfVertices [Arrow a b]
rp = ((Arrow a b -> a
forall n e. Arrow n e -> n
targetArrow(Arrow a b -> a) -> ([Arrow a b] -> Arrow a b) -> [Arrow a b] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Arrow a b] -> Arrow a b
forall a. HasCallStack => [a] -> a
head ([Arrow a b] -> a) -> [Arrow a b] -> a
forall a b. (a -> b) -> a -> b
$ [Arrow a b]
rp)a -> [a] -> [a]
forall a. a -> [a] -> [a]
:(Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow (Arrow a b -> a) -> [Arrow a b] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
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 :: forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
_ Int
_ [] = [] 
    simplifyOnce CompositionLaw a b
_ Int
_ [Arrow a b
e] = [Arrow a b
e]
    simplifyOnce CompositionLaw a b
cl Int
nb RawPath a b
list 
        | RawPath a b
new_list RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
== [] = []
        | Bool
isCycle Bool -> Bool -> Bool
&& Bool
tooManyCycles = []
        | RawPath a b
new_list RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
/= RawPath a b
list = RawPath a b
new_list
        | RawPath a b
simple_tail RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
/= (RawPath a b -> RawPath a b
forall a. HasCallStack => [a] -> [a]
tail RawPath a b
list) = (RawPath a b -> Arrow a b
forall a. HasCallStack => [a] -> a
head RawPath a b
list)Arrow a b -> RawPath a b -> RawPath a b
forall a. a -> [a] -> [a]
:RawPath a b
simple_tail
        | RawPath a b
simple_init RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
/= (RawPath a b -> RawPath a b
forall a. HasCallStack => [a] -> [a]
init RawPath a b
list) = RawPath a b
simple_initRawPath a b -> RawPath a b -> RawPath a b
forall a. [a] -> [a] -> [a]
++[(RawPath a b -> Arrow a b
forall a. HasCallStack => [a] -> a
last RawPath a b
list)]
        | Bool
otherwise = RawPath a b
list
        where
        listOfVertices :: [a]
listOfVertices = RawPath a b -> [a]
forall a b. RawPath a b -> [a]
rawpathToListOfVertices RawPath a b
list
        isCycle :: Bool
isCycle = ([a] -> a
forall a. HasCallStack => [a] -> a
head [a]
listOfVertices) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== ([a] -> a
forall a. HasCallStack => [a] -> a
last [a]
listOfVertices)
        tooManyCycles :: Bool
tooManyCycles = ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (([a] -> a
forall a. HasCallStack => [a] -> a
head [a]
listOfVertices) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) [a]
listOfVertices) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
nbInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
        new_list :: RawPath a b
new_list = RawPath a b -> RawPath a b -> CompositionLaw a b -> RawPath a b
forall k a. Eq k => a -> k -> Map k a -> a
Map.findWithDefault RawPath a b
list RawPath a b
list CompositionLaw a b
cl
        simple_tail :: RawPath a b
simple_tail = CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
cl Int
nb (RawPath a b -> RawPath a b
forall a. HasCallStack => [a] -> [a]
tail RawPath a b
list)
        simple_init :: RawPath a b
simple_init = CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
cl Int
nb (RawPath a b -> RawPath a b
forall a. HasCallStack => [a] -> [a]
init RawPath a b
list)
        
    -- | Returns a completely simplified raw path.

    simplify :: (Eq a, Eq b) => CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
    simplify :: forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
_ Int
_ [] = []
    simplify CompositionLaw a b
cl Int
nb RawPath a b
rp 
        | RawPath a b
simple_one RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
== RawPath a b
rp = RawPath a b
rp 
        | Bool
otherwise = CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl Int
nb RawPath a b
simple_one 
            where simple_one :: RawPath a b
simple_one = CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
cl Int
nb RawPath a b
rp
            
    instance (Eq a, Eq b) => Morphism (SCGMorphism a b) a where
        @? :: SCGMorphism a b -> SCGMorphism a b -> Maybe (SCGMorphism a b)
(@?) m2 :: SCGMorphism a b
m2@SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s2,[Arrow a b]
rp2), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
cl2, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
nb2} m1 :: SCGMorphism a b
m1@SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s1,[Arrow a b]
rp1), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
cl1, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
nb1}
            | Int
nb1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nb2 = Maybe (SCGMorphism a b)
forall a. Maybe a
Nothing
            | CompositionLaw a b
cl1 CompositionLaw a b -> CompositionLaw a b -> Bool
forall a. Eq a => a -> a -> Bool
/= CompositionLaw a b
cl2 = Maybe (SCGMorphism a b)
forall a. Maybe a
Nothing
            | SCGMorphism a b -> a
forall m o. Morphism m o => m -> o
source SCGMorphism a b
m2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= SCGMorphism a b -> a
forall m o. Morphism m o => m -> o
target SCGMorphism a b
m1 = Maybe (SCGMorphism a b)
forall a. Maybe a
Nothing
            | Bool
otherwise = SCGMorphism a b -> Maybe (SCGMorphism a b)
forall a. a -> Maybe a
Just SCGMorphism{pathS :: (a, [Arrow a b])
pathS=(a
s1,(CompositionLaw a b -> Int -> [Arrow a b] -> [Arrow a b]
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl1 Int
nb1 ([Arrow a b]
rp2[Arrow a b] -> [Arrow a b] -> [Arrow a b]
forall a. [a] -> [a] -> [a]
++[Arrow a b]
rp1))), compositionLawS :: CompositionLaw a b
compositionLawS=CompositionLaw a b
cl1, maxNbCycles :: Int
maxNbCycles=Int
nb1}
            
        source :: SCGMorphism a b -> a
source SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s,[Arrow a b]
_), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
_, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
_} = a
s
        target :: SCGMorphism a b -> a
target SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s,[]), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
_, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
_} = a
s
        target SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
_,[Arrow a b]
rp), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
_, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
_} = Arrow a b -> a
forall n e. Arrow n e -> n
targetArrow ([Arrow a b] -> Arrow a b
forall a. HasCallStack => [a] -> a
head [Arrow a b]
rp)
        
    -- | Constructs a `SCGMorphism` from a composition law, an arrow and maxNbCycles.

    mkSCGMorphism :: CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
    mkSCGMorphism :: forall a b.
CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
mkSCGMorphism CompositionLaw a b
cl Int
nb Arrow a b
e = SCGMorphism {pathS :: Path a b
pathS=(Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow Arrow a b
e,[Arrow a b
e]),compositionLawS :: CompositionLaw a b
compositionLawS=CompositionLaw a b
cl, maxNbCycles :: Int
maxNbCycles=Int
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 :: forall a b. Eq a => Graph a b -> a -> Set (Arrow a b)
findInwardEdges Graph a b
g a
o = (Arrow a b -> Bool) -> Set (Arrow a b) -> Set (Arrow a b)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\Arrow a b
e -> (Arrow a b -> a
forall n e. Arrow n e -> n
targetArrow Arrow a b
e) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
o Bool -> Bool -> Bool
&& (Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow Arrow a b
e) a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Graph a b -> Set a
forall n e. Graph n e -> Set n
nodes Graph a b
g)) (Graph a b -> Set (Arrow a b)
forall n e. Graph n e -> Set (Arrow n e)
edges Graph a b
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 :: forall a b.
(Eq a, Eq b) =>
Graph a b -> a -> a -> Set (RawPath a b)
findAcyclicRawPaths Graph a b
g a
s a
t = Graph a b -> a -> a -> Set a -> Set [Arrow a b]
forall {t} {e}.
(Eq t, Eq e) =>
Graph t e -> t -> t -> Set t -> Set [Arrow t e]
findAcyclicRawPathsVisitedNodes Graph a b
g a
s a
t Set a
forall a. Set a
Set.empty where
        findAcyclicRawPathsVisitedNodes :: Graph t e -> t -> t -> Set t -> Set [Arrow t e]
findAcyclicRawPathsVisitedNodes Graph t e
g t
s t
t Set t
v
            | t
t t -> Set t -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` Set t
v = Set [Arrow t e]
forall a. Set a
Set.empty
            | t
s t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
t = [[Arrow t e]] -> Set [Arrow t e]
forall a. [a] -> Set a
set [[]]
            | Bool
otherwise = [[Arrow t e]] -> Set [Arrow t e]
forall a. [a] -> Set a
set ([[[Arrow t e]]] -> [[Arrow t e]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((([[Arrow t e]] -> [[Arrow t e]])
 -> [[Arrow t e]] -> [[Arrow t e]])
-> [[[Arrow t e]] -> [[Arrow t e]]]
-> [[[Arrow t e]]]
-> [[[Arrow t e]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([[Arrow t e]] -> [[Arrow t e]]) -> [[Arrow t e]] -> [[Arrow t e]]
forall a b. (a -> b) -> a -> b
($) ((([Arrow t e] -> [Arrow t e]) -> [[Arrow t e]] -> [[Arrow t e]])
-> [[Arrow t e] -> [Arrow t e]] -> [[[Arrow t e]] -> [[Arrow t e]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Arrow t e] -> [Arrow t e]) -> [[Arrow t e]] -> [[Arrow t e]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Arrow t e -> [Arrow t e] -> [Arrow t e])
-> [Arrow t e] -> [[Arrow t e] -> [Arrow t e]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:) [Arrow t e]
inwardEdges)) ((Arrow t e -> [[Arrow t e]]) -> [Arrow t e] -> [[[Arrow t e]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Arrow t e
x -> Set [Arrow t e] -> [[Arrow t e]]
forall a. Eq a => Set a -> [a]
setToList (Graph t e -> t -> t -> Set t -> Set [Arrow t e]
findAcyclicRawPathsVisitedNodes Graph t e
g t
s (Arrow t e -> t
forall n e. Arrow n e -> n
sourceArrow Arrow t e
x) (t -> Set t -> Set t
forall a. a -> Set a -> Set a
Set.insert t
t Set t
v))) [Arrow t e]
inwardEdges)))
            where
                inwardEdges :: [Arrow t e]
inwardEdges = (Set (Arrow t e) -> [Arrow t e]
forall a. Eq a => Set a -> [a]
setToList (Graph t e -> t -> Set (Arrow t e)
forall a b. Eq a => Graph a b -> a -> Set (Arrow a b)
findInwardEdges Graph t e
g t
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 :: forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findElementaryCycles Graph a b
g CompositionLaw a b
cl Int
nb a
o = [[Arrow a b]] -> Set [Arrow a b]
forall a. [a] -> Set a
set ([[Arrow a b]] -> Set [Arrow a b])
-> [[Arrow a b]] -> Set [Arrow a b]
forall a b. (a -> b) -> a -> b
$ (CompositionLaw a b -> Int -> [Arrow a b] -> [Arrow a b]
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl Int
nb ([Arrow a b] -> [Arrow a b]) -> [[Arrow a b]] -> [[Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [][Arrow a b] -> [[Arrow a b]] -> [[Arrow a b]]
forall a. a -> [a] -> [a]
:([[[Arrow a b]]] -> [[Arrow a b]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Arrow a b -> [Arrow a b]] -> Arrow a b -> [[Arrow a b]])
-> [[Arrow a b -> [Arrow a b]]] -> [Arrow a b] -> [[[Arrow a b]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Arrow a b -> [Arrow a b]] -> Arrow a b -> [[Arrow a b]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (([[Arrow a b]] -> [Arrow a b -> [Arrow a b]])
-> [[[Arrow a b]]] -> [[Arrow a b -> [Arrow a b]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Arrow a b] -> Arrow a b -> [Arrow a b])
-> [[Arrow a b]] -> [Arrow a b -> [Arrow a b]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Arrow a b]
x Arrow a b
y -> (Arrow a b
yArrow a b -> [Arrow a b] -> [Arrow a b]
forall a. a -> [a] -> [a]
:[Arrow a b]
x))) ((Arrow a b -> [[Arrow a b]]) -> [Arrow a b] -> [[[Arrow a b]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Arrow a b
x ->  Set [Arrow a b] -> [[Arrow a b]]
forall a. Eq a => Set a -> [a]
setToList (Graph a b -> a -> a -> Set [Arrow a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> a -> a -> Set (RawPath a b)
findAcyclicRawPaths Graph a b
g a
o (Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow Arrow a b
x))) [Arrow a b]
inEdges)) [Arrow a b]
inEdges)))
        where 
            inEdges :: [Arrow a b]
inEdges = (Set (Arrow a b) -> [Arrow a b]
forall a. Eq a => Set a -> [a]
setToList (Graph a b -> a -> Set (Arrow a b)
forall a b. Eq a => Graph a b -> a -> Set (Arrow a b)
findInwardEdges Graph a b
g a
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 :: forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findCycles Graph a b
g CompositionLaw a b
cl Int
nb a
o = Graph a b
-> CompositionLaw a b
-> a
-> Set (RawPath a b)
-> Set (RawPath a b)
forall {t} {b}.
(Eq t, Eq b) =>
Graph t b
-> Map (RawPath t b) (RawPath t b)
-> t
-> Set (RawPath t b)
-> Set (RawPath t b)
findCyclesWithPreviousCycles Graph a b
g CompositionLaw a b
cl a
o (Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findElementaryCycles Graph a b
g CompositionLaw a b
cl Int
nb a
o)
        where 
            findCyclesWithPreviousCycles :: Graph t b
-> Map (RawPath t b) (RawPath t b)
-> t
-> Set (RawPath t b)
-> Set (RawPath t b)
findCyclesWithPreviousCycles Graph t b
g Map (RawPath t b) (RawPath t b)
cl t
o Set (RawPath t b)
p
                | Set (RawPath t b)
newCycles Set (RawPath t b) -> Set (RawPath t b) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (RawPath t b)
p = Set (RawPath t b)
newCycles
                | Bool
otherwise = Graph t b
-> Map (RawPath t b) (RawPath t b)
-> t
-> Set (RawPath t b)
-> Set (RawPath t b)
findCyclesWithPreviousCycles Graph t b
g Map (RawPath t b) (RawPath t b)
cl t
o Set (RawPath t b)
newCycles
                where
                    newCycles :: Set (RawPath t b)
newCycles = (Map (RawPath t b) (RawPath t b)
-> Int -> RawPath t b -> RawPath t b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify Map (RawPath t b) (RawPath t b)
cl Int
nb) (RawPath t b -> RawPath t b)
-> Set (RawPath t b) -> Set (RawPath t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RawPath t b -> RawPath t b -> RawPath t b
forall a. [a] -> [a] -> [a]
(++) (RawPath t b -> RawPath t b -> RawPath t b)
-> Set (RawPath t b) -> Set (RawPath t b -> RawPath t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (RawPath t b)
p Set (RawPath t b -> RawPath t b)
-> Set (RawPath t b) -> Set (RawPath t b)
forall a b. Set (a -> b) -> Set a -> Set b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Graph t b
-> Map (RawPath t b) (RawPath t b) -> Int -> t -> Set (RawPath t b)
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findElementaryCycles Graph t b
g Map (RawPath t b) (RawPath t b)
cl Int
nb t
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 :: forall a. [a] -> [a] -> [a]
intertwine [] [a]
l = [a]
l
    intertwine [a]
l [] = [a]
l
    intertwine l1 :: [a]
l1@(a
x1:[a]
xs1) l2 :: [a]
l2@(a
x2:[a]
xs2) = (a
x1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
intertwine [a]
xs1 [a]
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 :: forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b
-> Int
-> a
-> RawPath a b
-> Set (RawPath a b)
intertwineWithCycles Graph a b
g CompositionLaw a b
cl Int
nb a
_ p :: [Arrow a b]
p@(Arrow a b
x:[Arrow a b]
xs) = [[Arrow a b]] -> Set [Arrow a b]
forall a. [a] -> Set a
set ([[Arrow a b]] -> Set [Arrow a b])
-> [[Arrow a b]] -> Set [Arrow a b]
forall a b. (a -> b) -> a -> b
$ [[Arrow a b]] -> [Arrow a b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Arrow a b]] -> [Arrow a b]) -> [[[Arrow a b]]] -> [[Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((([[Arrow a b]] -> [[Arrow a b]] -> [[Arrow a b]])
-> ([[Arrow a b]], [[Arrow a b]]) -> [[Arrow a b]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [[Arrow a b]] -> [[Arrow a b]] -> [[Arrow a b]]
forall a. [a] -> [a] -> [a]
intertwine) (([[Arrow a b]], [[Arrow a b]]) -> [[Arrow a b]])
-> [([[Arrow a b]], [[Arrow a b]])] -> [[[Arrow a b]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[[Arrow a b]]]
-> [[[Arrow a b]]] -> [([[Arrow a b]], [[Arrow a b]])]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set [[Arrow a b]] -> [[[Arrow a b]]]
forall a. Eq a => Set a -> [a]
setToList Set [[Arrow a b]]
prodCycles) ([[Arrow a b]] -> [[[Arrow a b]]]
forall a. a -> [a]
repeat ((Arrow a b -> [Arrow a b] -> [Arrow a b]
forall a. a -> [a] -> [a]
:[]) (Arrow a b -> [Arrow a b]) -> [Arrow a b] -> [[Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
p))) where
        prodCycles :: Set [[Arrow a b]]
prodCycles = [Set [Arrow a b]] -> Set [[Arrow a b]]
forall (m :: * -> *) a.
(Monoid (m a), Monad m, Foldable m, Eq a) =>
m (Set a) -> Set (m a)
cartesianProductOfSets [Set [Arrow a b]]
cycles
        cycles :: [Set [Arrow a b]]
cycles = ((Graph a b -> CompositionLaw a b -> Int -> a -> Set [Arrow a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findCycles Graph a b
g CompositionLaw a b
cl Int
nb (Arrow a b -> a
forall n e. Arrow n e -> n
targetArrow Arrow a b
x)))Set [Arrow a b] -> [Set [Arrow a b]] -> [Set [Arrow a b]]
forall a. a -> [a] -> [a]
:(((\Arrow a b
y -> (Graph a b -> CompositionLaw a b -> Int -> a -> Set [Arrow a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findCycles Graph a b
g CompositionLaw a b
cl Int
nb (Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow Arrow a b
y)))) (Arrow a b -> Set [Arrow a b]) -> [Arrow a b] -> [Set [Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
p)
    intertwineWithCycles Graph a b
g CompositionLaw a b
cl Int
nb a
s [] = (Graph a b -> CompositionLaw a b -> Int -> a -> Set [Arrow a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findCycles Graph a b
g CompositionLaw a b
cl Int
nb a
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 :: forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b -> Int -> a -> a -> Set (SCGMorphism a b)
mkAr Graph a b
g CompositionLaw a b
cl Int
nb a
s a
t = (\RawPath a b
p -> SCGMorphism{pathS :: Path a b
pathS=(a
s,RawPath a b
p),compositionLawS :: CompositionLaw a b
compositionLawS=CompositionLaw a b
cl,maxNbCycles :: Int
maxNbCycles=Int
nb}) (RawPath a b -> SCGMorphism a b)
-> Set (RawPath a b) -> Set (SCGMorphism a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (RawPath a b)
allPaths where
        acyclicPaths :: Set (RawPath a b)
acyclicPaths = (CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl Int
nb) (RawPath a b -> RawPath a b)
-> Set (RawPath a b) -> Set (RawPath a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Graph a b -> a -> a -> Set (RawPath a b)
forall a b.
(Eq a, Eq b) =>
Graph a b -> a -> a -> Set (RawPath a b)
findAcyclicRawPaths Graph a b
g a
s a
t)
        allPaths :: Set (RawPath a b)
allPaths = (CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl Int
nb (RawPath a b -> RawPath a b)
-> Set (RawPath a b) -> Set (RawPath a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Set (RawPath a b)] -> Set (RawPath a b)
forall (f :: * -> *) a. Foldable f => f (Set a) -> Set a
Set.unions (Set (Set (RawPath a b)) -> [Set (RawPath a b)]
forall a. Eq a => Set a -> [a]
setToList ((Graph a b
-> CompositionLaw a b
-> Int
-> a
-> RawPath a b
-> Set (RawPath a b)
forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b
-> Int
-> a
-> RawPath a b
-> Set (RawPath a b)
intertwineWithCycles Graph a b
g CompositionLaw a b
cl Int
nb a
s) (RawPath a b -> Set (RawPath a b))
-> Set (RawPath a b) -> Set (Set (RawPath a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (RawPath a b)
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 {
                                                            forall a b. SafeCompositionGraph a b -> Graph a b
supportS :: Graph a b, -- ^ The generating graph of the safe composition graph.

                                                            forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS :: CompositionLaw a b, -- ^ The composition law of the safe composition graph.

                                                            forall a b. SafeCompositionGraph a b -> Int
maxCycles :: Int -- ^ The maximum number of times a cycle can be composed with itself.

                                                         } deriving (SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
(SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool)
-> (SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool)
-> Eq (SafeCompositionGraph a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
== :: SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
/= :: SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
Eq)
 
    instance (Show a, Show b) => Show (SafeCompositionGraph a b) where
        show :: SafeCompositionGraph a b -> String
show SafeCompositionGraph a b
scg = String
"(unsafeSafeCompositionGraph "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Graph a b -> String
forall a. Show a => a -> String
show (SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS SafeCompositionGraph a b
scg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CompositionLaw a b -> String
forall a. Show a => a -> String
show (SafeCompositionGraph a b -> CompositionLaw a b
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
scg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
scg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
        
    instance (Eq a, Eq b) => Category (SafeCompositionGraph a b) (SCGMorphism a b) a where
        identity :: Morphism (SCGMorphism a b) a =>
SafeCompositionGraph a b -> a -> SCGMorphism a b
identity SafeCompositionGraph a b
c a
x
            | a
x a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Graph a b -> Set a
forall n e. Graph n e -> Set n
nodes (SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS SafeCompositionGraph a b
c)) = SCGMorphism {pathS :: Path a b
pathS=(a
x,[]),compositionLawS :: CompositionLaw a b
compositionLawS=(SafeCompositionGraph a b -> CompositionLaw a b
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
c), maxNbCycles :: Int
maxNbCycles = SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
c}
            | Bool
otherwise = String -> SCGMorphism a b
forall a. HasCallStack => String -> a
error (String
"Math.FiniteCategories.SafeCompositionGraph.identity: Trying to construct identity of an unknown object.")
        ar :: Morphism (SCGMorphism a b) a =>
SafeCompositionGraph a b -> a -> a -> Set (SCGMorphism a b)
ar SafeCompositionGraph a b
c a
s a
t = Graph a b
-> CompositionLaw a b -> Int -> a -> a -> Set (SCGMorphism a b)
forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b -> Int -> a -> a -> Set (SCGMorphism a b)
mkAr (SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS SafeCompositionGraph a b
c) (SafeCompositionGraph a b -> CompositionLaw a b
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
c) (SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
c) a
s a
t
        genAr :: Morphism (SCGMorphism a b) a =>
SafeCompositionGraph a b -> a -> a -> Set (SCGMorphism a b)
genAr SafeCompositionGraph a b
cg a
s a
t
            | a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t = SCGMorphism a b -> Set (SCGMorphism a b) -> Set (SCGMorphism a b)
forall a. a -> Set a -> Set a
Set.insert (SafeCompositionGraph a b -> a -> SCGMorphism a b
forall c m o. (Category c m o, Morphism m o) => c -> o -> m
identity SafeCompositionGraph a b
cg a
s) Set (SCGMorphism a b)
gen
            | Bool
otherwise = Set (SCGMorphism a b)
gen 
            where gen :: Set (SCGMorphism a b)
gen = CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
forall a b.
CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
mkSCGMorphism (SafeCompositionGraph a b -> CompositionLaw a b
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
cg) (SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
cg) (Arrow a b -> SCGMorphism a b)
-> Set (Arrow a b) -> Set (SCGMorphism a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Arrow a b -> Bool) -> Set (Arrow a b) -> Set (Arrow a b)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\Arrow a b
a -> a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow Arrow a b
a) Bool -> Bool -> Bool
&& a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (Arrow a b -> a
forall n e. Arrow n e -> n
targetArrow Arrow a b
a)) (Set (Arrow a b) -> Set (Arrow a b))
-> Set (Arrow a b) -> Set (Arrow a b)
forall a b. (a -> b) -> a -> b
$ (Graph a b -> Set (Arrow a b)
forall n e. Graph n e -> Set (Arrow n e)
edges (SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS SafeCompositionGraph a b
cg)))
            
        decompose :: Morphism (SCGMorphism a b) a =>
SafeCompositionGraph a b -> SCGMorphism a b -> [SCGMorphism a b]
decompose SafeCompositionGraph a b
c m :: SCGMorphism a b
m@SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
_,[Arrow a b]
rp),compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
l,maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
nb}
            | SafeCompositionGraph a b -> SCGMorphism a b -> Bool
forall c m o.
(Category c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isIdentity SafeCompositionGraph a b
c SCGMorphism a b
m = [SCGMorphism a b
m]
            | Bool
otherwise = CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
forall a b.
CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
mkSCGMorphism CompositionLaw a b
l Int
nb (Arrow a b -> SCGMorphism a b) -> [Arrow a b] -> [SCGMorphism a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
rp
    
    instance (Eq a, Eq b) => FiniteCategory (SafeCompositionGraph a b) (SCGMorphism a b) a where
        ob :: SafeCompositionGraph a b -> Set a
ob = (Graph a b -> Set a
forall n e. Graph n e -> Set n
nodes(Graph a b -> Set a)
-> (SafeCompositionGraph a b -> Graph a b)
-> SafeCompositionGraph a b
-> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS)
            
    instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (SafeCompositionGraph a b) where
        pprint :: SafeCompositionGraph a b -> String
pprint SafeCompositionGraph{supportS :: forall a b. SafeCompositionGraph a b -> Graph a b
supportS=Graph a b
g,lawS :: forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS=CompositionLaw a b
l,maxCycles :: forall a b. SafeCompositionGraph a b -> Int
maxCycles=Int
nb} = String
"SafeCompositionGraph("String -> ShowS
forall a. [a] -> [a] -> [a]
++Graph a b -> String
forall a. PrettyPrint a => a -> String
pprint Graph a b
gString -> ShowS
forall a. [a] -> [a] -> [a]
++String
","String -> ShowS
forall a. [a] -> [a] -> [a]
++CompositionLaw a b -> String
forall a. PrettyPrint a => a -> String
pprint CompositionLaw a b
lString -> ShowS
forall a. [a] -> [a] -> [a]
++String
","String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. PrettyPrint a => a -> String
pprint Int
nbString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"         
        
    -- | 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 :: forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b
-> Int
-> Either
     (FiniteCategoryError (SCGMorphism a b) a)
     (SafeCompositionGraph a b)
safeCompositionGraph Graph a b
g CompositionLaw a b
l Int
nb
        | Maybe (FiniteCategoryError (SCGMorphism a b) a) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (FiniteCategoryError (SCGMorphism a b) a)
check = SafeCompositionGraph a b
-> Either
     (FiniteCategoryError (SCGMorphism a b) a)
     (SafeCompositionGraph a b)
forall a b. b -> Either a b
Right SafeCompositionGraph a b
c_g
        | Bool
otherwise = FiniteCategoryError (SCGMorphism a b) a
-> Either
     (FiniteCategoryError (SCGMorphism a b) a)
     (SafeCompositionGraph a b)
forall a b. a -> Either a b
Left FiniteCategoryError (SCGMorphism a b) a
err
        where
            c_g :: SafeCompositionGraph a b
c_g = SafeCompositionGraph{supportS :: Graph a b
supportS = Graph a b
g, lawS :: CompositionLaw a b
lawS = CompositionLaw a b
l, maxCycles :: Int
maxCycles = Int
nb}
            check :: Maybe (FiniteCategoryError (SCGMorphism a b) a)
check = SafeCompositionGraph a b
-> Maybe (FiniteCategoryError (SCGMorphism a b) a)
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> Maybe (FiniteCategoryError m o)
checkFiniteCategory SafeCompositionGraph a b
c_g
            Just FiniteCategoryError (SCGMorphism a b) a
err = Maybe (FiniteCategoryError (SCGMorphism a b) a)
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 :: forall a b.
Graph a b -> CompositionLaw a b -> Int -> SafeCompositionGraph a b
unsafeSafeCompositionGraph Graph a b
g CompositionLaw a b
l Int
nb = SafeCompositionGraph{supportS :: Graph a b
supportS = Graph a b
g, lawS :: CompositionLaw a b
lawS = CompositionLaw a b
l, maxCycles :: Int
maxCycles = Int
nb}
    
    
    -- | A token for a .scg file.

    data Token = Name Text | BeginArrow | EndArrow | Equals | Identity | BeginSrc | EndSrc | BeginTgt | EndTgt | MapsTo deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show)
    
    -- | Strip a token of unnecessary spaces.

    strip :: Token -> Token
    strip :: Token -> Token
strip (Name Text
txt) = Text -> Token
Name (String -> Text
pack(String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
forall a. [a] -> [a]
reverseShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
stripLeftShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
forall a. [a] -> [a]
reverseShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
stripLeft (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
str)
        where
            str :: String
str = Text -> String
unpack Text
txt
            stripLeft :: ShowS
stripLeft (Char
' ':String
s) = String
s 
            stripLeft String
s = String
s 
    strip Token
x = Token
x
        
    -- | Transforms a string into a list of tokens.

    parserLex :: String -> [Token]
    parserLex :: String -> [Token]
parserLex String
str = Token -> Token
strip (Token -> Token) -> [Token] -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [Token]
parserLexHelper String
str
        where
            parserLexHelper :: String -> [Token]
parserLexHelper [] = [] 
            parserLexHelper (Char
'#':String
str) = []
            parserLexHelper (Char
' ':Char
'-':String
str) = Token
BeginArrow Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'-':Char
'>':Char
' ':String
str) = Token
EndArrow Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
' ':Char
'=':Char
' ':String
str) = Token
Equals Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'I':Char
'D':Char
'/':Char
'>':String
str) = Token
Identity Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'I':Char
'D':Char
'>':String
str) = Token
Identity Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'S':Char
'R':Char
'C':Char
'>':String
str) = Token
BeginSrc Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'T':Char
'G':Char
'T':Char
'>':String
str) = Token
BeginTgt Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'/':Char
'S':Char
'R':Char
'C':Char
'>':String
str) = Token
EndSrc Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'/':Char
'T':Char
'G':Char
'T':Char
'>':String
str) = Token
EndTgt Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
' ':Char
'=':Char
'>':Char
' ':String
str) = Token
MapsTo Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
c:String
str) =  ([Token] -> [Token]
result [Token]
restLexed)
                where
                    restLexed :: [Token]
restLexed = (String -> [Token]
parserLexHelper String
str)
                    result :: [Token] -> [Token]
result (Name Text
txt:[Token]
xs) = (Text -> Token
Name (Char -> Text -> Text
cons Char
c Text
txt)Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
xs)
                    result [Token]
a = ((Text -> Token
Name (Char -> Text
singleton Char
c))Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
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 :: String
-> Either
     (FiniteCategoryError (SCGMorphism Text Text) Text)
     (SafeCompositionGraph Text Text)
readSCGString String
str
        | Maybe (FiniteCategoryError (SCGMorphism Text Text) Text) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check = SafeCompositionGraph Text Text
-> Either
     (FiniteCategoryError (SCGMorphism Text Text) Text)
     (SafeCompositionGraph Text Text)
forall a b. b -> Either a b
Right SafeCompositionGraph Text Text
scg
        | Bool
otherwise = FiniteCategoryError (SCGMorphism Text Text) Text
-> Either
     (FiniteCategoryError (SCGMorphism Text Text) Text)
     (SafeCompositionGraph Text Text)
forall a b. a -> Either a b
Left FiniteCategoryError (SCGMorphism Text Text) Text
err
        where
            maxCyc :: Int
maxCyc = (String -> Int
forall a. Read a => String -> a
read(String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> String
forall a. HasCallStack => [a] -> a
head([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
lines (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
str) :: Int
            cg :: CG
cg = String -> CG
unsafeReadCGString ((String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n")([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
lines ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
str)
            scg :: SafeCompositionGraph Text Text
scg = SafeCompositionGraph{supportS :: Graph Text Text
supportS = CG -> Graph Text Text
forall a b. CompositionGraph a b -> Graph a b
support CG
cg, lawS :: CompositionLaw Text Text
lawS = CG -> CompositionLaw Text Text
forall a b. CompositionGraph a b -> CompositionLaw a b
law CG
cg, maxCycles :: Int
maxCycles = Int
maxCyc}
            check :: Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check = SafeCompositionGraph Text Text
-> Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> Maybe (FiniteCategoryError m o)
checkFiniteCategory SafeCompositionGraph Text Text
scg
            Just FiniteCategoryError (SCGMorphism Text Text) Text
err = Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check
    
    -- | Unsafe version of 'readSCGString' which does not check the structure of the resulting 'SafeCompositionGraph'.

    unsafeReadSCGString :: String -> SCG
    unsafeReadSCGString :: String -> SafeCompositionGraph Text Text
unsafeReadSCGString String
str = SafeCompositionGraph Text Text
scg
        where
            maxCyc :: Int
maxCyc = (String -> Int
forall a. Read a => String -> a
read(String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> String
forall a. HasCallStack => [a] -> a
head([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
lines (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
str) :: Int
            cg :: CG
cg = String -> CG
unsafeReadCGString ((String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n")([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
lines ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
str)
            scg :: SafeCompositionGraph Text Text
scg = SafeCompositionGraph{supportS :: Graph Text Text
supportS = CG -> Graph Text Text
forall a b. CompositionGraph a b -> Graph a b
support CG
cg, lawS :: CompositionLaw Text Text
lawS = CG -> CompositionLaw Text Text
forall a b. CompositionGraph a b -> CompositionLaw a b
law CG
cg, maxCycles :: Int
maxCycles = Int
maxCyc}
            
    -- | Unsafe version of 'readSCGFile' which does not check the structure of the resulting 'SafeCompositionGraph'.

    unsafeReadSCGFile :: String -> IO SCG
    unsafeReadSCGFile :: String -> IO (SafeCompositionGraph Text Text)
unsafeReadSCGFile String
path = do
        String
file <- String -> IO String
readFile String
path
        SafeCompositionGraph Text Text
-> IO (SafeCompositionGraph Text Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SafeCompositionGraph Text Text
 -> IO (SafeCompositionGraph Text Text))
-> SafeCompositionGraph Text Text
-> IO (SafeCompositionGraph Text Text)
forall a b. (a -> b) -> a -> b
$ String -> SafeCompositionGraph Text Text
unsafeReadSCGString String
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 :: String
-> IO
     (Either
        (FiniteCategoryError (SCGMorphism Text Text) Text)
        (SafeCompositionGraph Text Text))
readSCGFile String
str = do
        SafeCompositionGraph Text Text
scg <- String -> IO (SafeCompositionGraph Text Text)
unsafeReadSCGFile String
str
        let check :: Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check = SafeCompositionGraph Text Text
-> Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> Maybe (FiniteCategoryError m o)
checkFiniteCategory SafeCompositionGraph Text Text
scg
        Either
  (FiniteCategoryError (SCGMorphism Text Text) Text)
  (SafeCompositionGraph Text Text)
-> IO
     (Either
        (FiniteCategoryError (SCGMorphism Text Text) Text)
        (SafeCompositionGraph Text Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Maybe (FiniteCategoryError (SCGMorphism Text Text) Text) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check then SafeCompositionGraph Text Text
-> Either
     (FiniteCategoryError (SCGMorphism Text Text) Text)
     (SafeCompositionGraph Text Text)
forall a b. b -> Either a b
Right SafeCompositionGraph Text Text
scg else FiniteCategoryError (SCGMorphism Text Text) Text
-> Either
     (FiniteCategoryError (SCGMorphism Text Text) Text)
     (SafeCompositionGraph Text Text)
forall a b. a -> Either a b
Left (FiniteCategoryError (SCGMorphism Text Text) Text
 -> Either
      (FiniteCategoryError (SCGMorphism Text Text) Text)
      (SafeCompositionGraph Text Text))
-> FiniteCategoryError (SCGMorphism Text Text) Text
-> Either
     (FiniteCategoryError (SCGMorphism Text Text) Text)
     (SafeCompositionGraph Text Text)
forall a b. (a -> b) -> a -> b
$ Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
-> FiniteCategoryError (SCGMorphism Text Text) Text
forall {a}. Maybe a -> a
fromJust (Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
 -> FiniteCategoryError (SCGMorphism Text Text) Text)
-> Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
-> FiniteCategoryError (SCGMorphism Text Text) Text
forall a b. (a -> b) -> a -> b
$ Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check)
        where
            fromJust :: Maybe a -> a
fromJust (Just a
x) = a
x
            
    
    reversedRawPathToString :: (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
    reversedRawPathToString :: forall a b. (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString [] = String
"<ID>"
    reversedRawPathToString [Arrow{sourceArrow :: forall n e. Arrow n e -> n
sourceArrow = a
s, targetArrow :: forall n e. Arrow n e -> n
targetArrow = a
t,labelArrow :: forall n e. Arrow n e -> e
labelArrow = b
l}] = a -> String
forall a. PrettyPrint a => a -> String
pprint a
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. PrettyPrint a => a -> String
pprint b
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. PrettyPrint a => a -> String
pprint a
t
    reversedRawPathToString (Arrow{sourceArrow :: forall n e. Arrow n e -> n
sourceArrow = a
s, targetArrow :: forall n e. Arrow n e -> n
targetArrow = a
t,labelArrow :: forall n e. Arrow n e -> e
labelArrow = b
l}:[Arrow a b]
xs) = a -> String
forall a. PrettyPrint a => a -> String
pprint a
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. PrettyPrint a => a -> String
pprint b
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Arrow a b] -> String
forall a b. (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString [Arrow a b]
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 :: forall a b.
(PrettyPrint a, PrettyPrint b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String
writeSCGString SafeCompositionGraph a b
cg = String
finalString
        where
            obString :: String
obString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. PrettyPrint a => a -> String
pprint (a -> String) -> [a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList(Set a -> [a])
-> (SafeCompositionGraph a b -> Set a)
-> SafeCompositionGraph a b
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SafeCompositionGraph a b -> Set a
forall c m o. FiniteCategory c m o => c -> Set o
ob (SafeCompositionGraph a b -> [a])
-> SafeCompositionGraph a b -> [a]
forall a b. (a -> b) -> a -> b
$ SafeCompositionGraph a b
cg)
            arNotIdentityAndNotComposite :: [SCGMorphism a b]
arNotIdentityAndNotComposite = Set (SCGMorphism a b) -> [SCGMorphism a b]
forall a. Eq a => Set a -> [a]
setToList (Set (SCGMorphism a b) -> [SCGMorphism a b])
-> Set (SCGMorphism a b) -> [SCGMorphism a b]
forall a b. (a -> b) -> a -> b
$ (SCGMorphism a b -> Bool)
-> Set (SCGMorphism a b) -> Set (SCGMorphism a b)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (SafeCompositionGraph a b -> SCGMorphism a b -> Bool
forall c m o.
(Category c m o, Morphism m o, Eq m) =>
c -> m -> Bool
isGenerator SafeCompositionGraph a b
cg) (Set (SCGMorphism a b) -> Set (SCGMorphism a b))
-> Set (SCGMorphism a b) -> Set (SCGMorphism a b)
forall a b. (a -> b) -> a -> b
$ (SCGMorphism a b -> Bool)
-> Set (SCGMorphism a b) -> Set (SCGMorphism a b)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (SafeCompositionGraph a b -> SCGMorphism a b -> Bool
forall c m o.
(Category c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity SafeCompositionGraph a b
cg) (SafeCompositionGraph a b -> Set (SCGMorphism a b)
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
genArrows SafeCompositionGraph a b
cg)
            reversedRawPaths :: [[Arrow a b]]
reversedRawPaths = ([Arrow a b] -> [Arrow a b]
forall a. [a] -> [a]
reverse([Arrow a b] -> [Arrow a b])
-> (SCGMorphism a b -> [Arrow a b])
-> SCGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, [Arrow a b]) -> [Arrow a b]
forall a b. (a, b) -> b
snd((a, [Arrow a b]) -> [Arrow a b])
-> (SCGMorphism a b -> (a, [Arrow a b]))
-> SCGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SCGMorphism a b -> (a, [Arrow a b])
forall a b. SCGMorphism a b -> Path a b
pathS) (SCGMorphism a b -> [Arrow a b])
-> [SCGMorphism a b] -> [[Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SCGMorphism a b]
arNotIdentityAndNotComposite
            arString :: String
arString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [Arrow a b] -> String
forall a b. (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString ([Arrow a b] -> String) -> [[Arrow a b]] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Arrow a b]]
reversedRawPaths
            lawString :: String
lawString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (\([Arrow a b]
rp1,[Arrow a b]
rp2) -> ([Arrow a b] -> String
forall a b. (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString ([Arrow a b] -> [Arrow a b]
forall a. [a] -> [a]
reverse [Arrow a b]
rp1)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Arrow a b] -> String
forall a b. (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString ([Arrow a b] -> [Arrow a b]
forall a. [a] -> [a]
reverse [Arrow a b]
rp2))) (([Arrow a b], [Arrow a b]) -> String)
-> [([Arrow a b], [Arrow a b])] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map [Arrow a b] [Arrow a b] -> [([Arrow a b], [Arrow a b])]
forall k a. Eq k => Map k a -> [(k, a)]
Map.toList)(Map [Arrow a b] [Arrow a b] -> [([Arrow a b], [Arrow a b])])
-> (SafeCompositionGraph a b -> Map [Arrow a b] [Arrow a b])
-> SafeCompositionGraph a b
-> [([Arrow a b], [Arrow a b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SafeCompositionGraph a b -> Map [Arrow a b] [Arrow a b]
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS (SafeCompositionGraph a b -> [([Arrow a b], [Arrow a b])])
-> SafeCompositionGraph a b -> [([Arrow a b], [Arrow a b])]
forall a b. (a -> b) -> a -> b
$ SafeCompositionGraph a b
cg)
            finalString :: String
finalString = (Int -> String
forall a. Show a => a -> String
show (SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
cg))String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n#Objects :\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
obStringString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n\n# Arrows :\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
arStringString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n\n# Composition law :\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
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 :: forall a b.
(PrettyPrint a, PrettyPrint b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String -> IO ()
writeSCGFile SafeCompositionGraph a b
cg String
filepath = do
        Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
filepath
        String -> String -> IO ()
writeFile String
filepath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SafeCompositionGraph a b -> String
forall a b.
(PrettyPrint a, PrettyPrint b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String
writeSCGString SafeCompositionGraph a b
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 :: [Token] -> SCGD -> SCGD
addOMapEntry [Name Text
x, Token
MapsTo, Name Text
y] SCGD
diag
        | Text
x Text -> Set Text -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Map Text Text -> Set Text
forall k a. Map k a -> Set k
domain (SCGD -> Map Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap SCGD
diag)) = if Text
y Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (SCGD
diag SCGD -> Text -> Text
forall o1 c1 m1 c2 m2 o2.
Eq o1 =>
Diagram c1 m1 o1 c2 m2 o2 -> o1 -> o2
->$ Text
x) then SCGD
diag else String -> SCGD
forall a. HasCallStack => String -> a
error (String
"Incoherent maps of object : F("String -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show Text
xString -> ShowS
forall a. [a] -> [a] -> [a]
++String
") = "String -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show Text
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and "String -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show (SCGD
diag SCGD -> Text -> Text
forall o1 c1 m1 c2 m2 o2.
Eq o1 =>
Diagram c1 m1 o1 c2 m2 o2 -> o1 -> o2
->$ Text
x))
        | Bool
otherwise = Diagram{src :: SafeCompositionGraph Text Text
src=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src SCGD
diag, tgt :: SafeCompositionGraph Text Text
tgt=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt SCGD
diag, omap :: Map Text Text
omap=Text -> Text -> Map Text Text -> Map Text Text
forall k a. k -> a -> Map k a -> Map k a
Map.insert Text
x Text
y (SCGD -> Map Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap SCGD
diag), mmap :: Map (SCGMorphism Text Text) (SCGMorphism Text Text)
mmap=SCGD -> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap SCGD
diag}
    addOMapEntry [Token]
otherTokens SCGD
_ = String -> SCGD
forall a. HasCallStack => String -> a
error (String -> SCGD) -> String -> SCGD
forall a b. (a -> b) -> a -> b
$ String
"addOMapEntry on invalid tokens : "String -> ShowS
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
otherTokens
    
    addMMapEntry :: [Token] -> SCGD -> SCGD
    addMMapEntry :: [Token] -> SCGD -> SCGD
addMMapEntry tks :: [Token]
tks@[Name Text
sx, Token
BeginArrow, Name Text
lx, Token
EndArrow, Name Text
tx, Token
MapsTo, Token
Identity] SCGD
diag = if Text
sx Text -> Set Text -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Map Text Text -> Set Text
forall k a. Map k a -> Set k
domain (SCGD -> Map Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap SCGD
diag)) then Diagram{src :: SafeCompositionGraph Text Text
src=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src SCGD
diag, tgt :: SafeCompositionGraph Text Text
tgt=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt SCGD
diag, omap :: Map Text Text
omap=SCGD -> Map Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap SCGD
diag, mmap :: Map (SCGMorphism Text Text) (SCGMorphism Text Text)
mmap=SCGMorphism Text Text
-> SCGMorphism Text Text
-> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
-> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
forall k a. k -> a -> Map k a -> Map k a
Map.insert SCGMorphism Text Text
sourceMorph (SafeCompositionGraph Text Text -> Text -> SCGMorphism Text Text
forall c m o. (Category c m o, Morphism m o) => c -> o -> m
identity (SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt SCGD
diag) (SCGD
diag SCGD -> Text -> Text
forall o1 c1 m1 c2 m2 o2.
Eq o1 =>
Diagram c1 m1 o1 c2 m2 o2 -> o1 -> o2
->$ Text
sx)) (SCGD -> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap SCGD
diag)} else String -> SCGD
forall a. HasCallStack => String -> a
error (String
"You must specify the image of the source of the morphism before mapping to an identity : "String -> ShowS
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
tks)
        where
            sourceMorphCand :: Set (SCGMorphism Text Text)
sourceMorphCand = (SCGMorphism Text Text -> Bool)
-> Set (SCGMorphism Text Text) -> Set (SCGMorphism Text Text)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\SCGMorphism Text Text
e -> SCGMorphism Text Text -> Maybe Text
forall a b. SCGMorphism a b -> Maybe b
getLabelS SCGMorphism Text Text
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lx) (SafeCompositionGraph Text Text
-> Text -> Text -> Set (SCGMorphism Text Text)
forall c m o.
(Category c m o, Morphism m o) =>
c -> o -> o -> Set m
genAr (SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src SCGD
diag) Text
sx Text
tx)
            sourceMorph :: SCGMorphism Text Text
sourceMorph = if Set (SCGMorphism Text Text) -> Bool
forall a. Set a -> Bool
Set.null Set (SCGMorphism Text Text)
sourceMorphCand then String -> SCGMorphism Text Text
forall a. HasCallStack => String -> a
error (String -> SCGMorphism Text Text)
-> String -> SCGMorphism Text Text
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry : morphism not found in source category for the following map : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Token] -> String
forall a. Show a => a -> String
show [Token]
tks else Set (SCGMorphism Text Text) -> SCGMorphism Text Text
forall a. Set a -> a
anElement Set (SCGMorphism Text Text)
sourceMorphCand
    addMMapEntry tks :: [Token]
tks@[Name Text
sx, Token
BeginArrow, Name Text
lx, Token
EndArrow, Name Text
tx, Token
MapsTo, Name Text
sy, Token
BeginArrow, Name Text
ly, Token
EndArrow, Name Text
ty] SCGD
diag = Diagram{src :: SafeCompositionGraph Text Text
src=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src SCGD
newDiag2, tgt :: SafeCompositionGraph Text Text
tgt=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt SCGD
newDiag2, omap :: Map Text Text
omap=SCGD -> Map Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap SCGD
newDiag2, mmap :: Map (SCGMorphism Text Text) (SCGMorphism Text Text)
mmap=SCGMorphism Text Text
-> SCGMorphism Text Text
-> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
-> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
forall k a. k -> a -> Map k a -> Map k a
Map.insert SCGMorphism Text Text
sourceMorph SCGMorphism Text Text
targetMorph (SCGD -> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap SCGD
newDiag2)}
        where
            sourceMorphCand :: Set (SCGMorphism Text Text)
sourceMorphCand = (SCGMorphism Text Text -> Bool)
-> Set (SCGMorphism Text Text) -> Set (SCGMorphism Text Text)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\SCGMorphism Text Text
e -> SCGMorphism Text Text -> Maybe Text
forall a b. SCGMorphism a b -> Maybe b
getLabelS SCGMorphism Text Text
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lx) (SafeCompositionGraph Text Text
-> Text -> Text -> Set (SCGMorphism Text Text)
forall c m o.
(Category c m o, Morphism m o) =>
c -> o -> o -> Set m
genAr (SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src SCGD
diag) Text
sx Text
tx)
            targetMorphCand :: Set (SCGMorphism Text Text)
targetMorphCand = (SCGMorphism Text Text -> Bool)
-> Set (SCGMorphism Text Text) -> Set (SCGMorphism Text Text)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\SCGMorphism Text Text
e -> SCGMorphism Text Text -> Maybe Text
forall a b. SCGMorphism a b -> Maybe b
getLabelS SCGMorphism Text Text
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ly) (SafeCompositionGraph Text Text
-> Text -> Text -> Set (SCGMorphism Text Text)
forall c m o.
(Category c m o, Morphism m o) =>
c -> o -> o -> Set m
genAr (SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt SCGD
diag) Text
sy Text
ty)
            sourceMorph :: SCGMorphism Text Text
sourceMorph = if Set (SCGMorphism Text Text) -> Bool
forall a. Set a -> Bool
Set.null Set (SCGMorphism Text Text)
sourceMorphCand then String -> SCGMorphism Text Text
forall a. HasCallStack => String -> a
error (String -> SCGMorphism Text Text)
-> String -> SCGMorphism Text Text
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry : morphism not found in source category for the following map : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Token] -> String
forall a. Show a => a -> String
show [Token]
tks else Set (SCGMorphism Text Text) -> SCGMorphism Text Text
forall a. Set a -> a
anElement Set (SCGMorphism Text Text)
sourceMorphCand
            targetMorph :: SCGMorphism Text Text
targetMorph = if Set (SCGMorphism Text Text) -> Bool
forall a. Set a -> Bool
Set.null Set (SCGMorphism Text Text)
targetMorphCand then String -> SCGMorphism Text Text
forall a. HasCallStack => String -> a
error (String -> SCGMorphism Text Text)
-> String -> SCGMorphism Text Text
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry : morphism not found in target category for the following map : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Token] -> String
forall a. Show a => a -> String
show [Token]
tks else Set (SCGMorphism Text Text) -> SCGMorphism Text Text
forall a. Set a -> a
anElement Set (SCGMorphism Text Text)
targetMorphCand
            newDiag1 :: SCGD
newDiag1 = [Token] -> SCGD -> SCGD
addOMapEntry [Text -> Token
Name Text
sx, Token
MapsTo, Text -> Token
Name Text
sy] SCGD
diag
            newDiag2 :: SCGD
newDiag2 = [Token] -> SCGD -> SCGD
addOMapEntry [Text -> Token
Name Text
tx, Token
MapsTo, Text -> Token
Name Text
ty] SCGD
newDiag1    
    addMMapEntry [Token]
otherTokens SCGD
_ = String -> SCGD
forall a. HasCallStack => String -> a
error (String -> SCGD) -> String -> SCGD
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry on invalid tokens : "String -> ShowS
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
otherTokens
    
    readLineD :: String -> SCGD -> SCGD
    readLineD :: String -> SCGD -> SCGD
readLineD String
line diag :: SCGD
diag@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=SafeCompositionGraph Text Text
s, tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=SafeCompositionGraph Text Text
t, omap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap=Map Text Text
om, mmap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap=Map (SCGMorphism Text Text) (SCGMorphism Text Text)
mm}
        | [Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
lexedLine = SCGD
diag
        | Token -> [Token] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Token
MapsTo [Token]
lexedLine = if Token -> [Token] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Token
BeginArrow [Token]
lexedLine
            then [Token] -> SCGD -> SCGD
addMMapEntry [Token]
lexedLine SCGD
diag
            else [Token] -> SCGD -> SCGD
addOMapEntry [Token]
lexedLine SCGD
diag
        | Bool
otherwise = SCGD
diag
        where
            lexedLine :: [Token]
lexedLine = (String -> [Token]
parserLex String
line)

    extractSrcSection :: [String] -> [String]
    extractSrcSection :: [String] -> [String]
extractSrcSection [String]
lines
        | Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
BeginSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <SRC> section or malformed <SRC> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
EndSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <SRC> section or malformed <SRC> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Int
indexEndSrc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indexBeginSrc = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"Malformed <SRC> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Bool
otherwise = [String]
c
        where
            Just Int
indexBeginSrc = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
BeginSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
            Just Int
indexEndSrc = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
EndSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
            ([String]
a,[String]
b) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexBeginSrcInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [String]
lines
            ([String]
c,[String]
d) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexEndSrcInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
indexBeginSrcInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [String]
b
            
    extractTgtSection :: [String] -> [String]
    extractTgtSection :: [String] -> [String]
extractTgtSection [String]
lines
        | Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
BeginTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <TGT> section or malformed <TGT> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
EndTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <TGT> section or malformed <TGT> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Int
indexEndTgt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indexBeginTgt = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"Malformed <TGT> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
        | Bool
otherwise = [String]
c
        where
            Just Int
indexBeginTgt = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
BeginTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
            Just Int
indexEndTgt = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
EndTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
            ([String]
a,[String]
b) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexBeginTgtInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [String]
lines
            ([String]
c,[String]
d) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexEndTgtInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
indexBeginTgtInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [String]
b
          
        
    -- | Unsafe version of 'readCGDString' which does not check the structure of the resulting 'Diagram'.

    unsafeReadSCGDString :: String -> SCGD
    unsafeReadSCGDString :: String -> SCGD
unsafeReadSCGDString String
str = SCGD -> SCGD
forall c1 m1 o1 c2 m2 o2.
(FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
 Category c2 m2 o2, Morphism m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Diagram c1 m1 o1 c2 m2 o2
completeDiagram SCGD
finalDiag
        where
            ls :: [String]
ls = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([Token] -> Bool) -> (String -> [Token]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [Token]
parserLex) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
str
            s :: SafeCompositionGraph Text Text
s = String -> SafeCompositionGraph Text Text
unsafeReadSCGString (String -> SafeCompositionGraph Text Text)
-> String -> SafeCompositionGraph Text Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> [String]
extractSrcSection [String]
ls)
            t :: SafeCompositionGraph Text Text
t = String -> SafeCompositionGraph Text Text
unsafeReadSCGString (String -> SafeCompositionGraph Text Text)
-> String -> SafeCompositionGraph Text Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> [String]
extractTgtSection [String]
ls)
            diag :: Diagram
  (SafeCompositionGraph Text Text)
  m1
  o1
  (SafeCompositionGraph Text Text)
  m2
  o2
diag = Diagram{src :: SafeCompositionGraph Text Text
src=SafeCompositionGraph Text Text
s, tgt :: SafeCompositionGraph Text Text
tgt=SafeCompositionGraph Text Text
t,omap :: Map o1 o2
omap=AssociationList o1 o2 -> Map o1 o2
forall k v. AssociationList k v -> Map k v
weakMap [], mmap :: Map m1 m2
mmap=AssociationList m1 m2 -> Map m1 m2
forall k v. AssociationList k v -> Map k v
weakMap []}
            finalDiag :: SCGD
finalDiag = (String -> SCGD -> SCGD) -> SCGD -> [String] -> SCGD
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> SCGD -> SCGD
readLineD SCGD
forall {m1} {o1} {m2} {o2}.
Diagram
  (SafeCompositionGraph Text Text)
  m1
  o1
  (SafeCompositionGraph Text Text)
  m2
  o2
diag [String]
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 :: String
-> Either
     (DiagramError
        (SafeCompositionGraph Text Text)
        (SCGMorphism Text Text)
        Text
        (SafeCompositionGraph Text Text)
        (SCGMorphism Text Text)
        Text)
     SCGD
readSCGDString String
str
        | Maybe
  (DiagramError
     (SafeCompositionGraph Text Text)
     (SCGMorphism Text Text)
     Text
     (SafeCompositionGraph Text Text)
     (SCGMorphism Text Text)
     Text)
-> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe
  (DiagramError
     (SafeCompositionGraph Text Text)
     (SCGMorphism Text Text)
     Text
     (SafeCompositionGraph Text Text)
     (SCGMorphism Text Text)
     Text)
check = SCGD
-> Either
     (DiagramError
        (SafeCompositionGraph Text Text)
        (SCGMorphism Text Text)
        Text
        (SafeCompositionGraph Text Text)
        (SCGMorphism Text Text)
        Text)
     SCGD
forall a b. b -> Either a b
Right SCGD
diag
        | Bool
otherwise = DiagramError
  (SafeCompositionGraph Text Text)
  (SCGMorphism Text Text)
  Text
  (SafeCompositionGraph Text Text)
  (SCGMorphism Text Text)
  Text
-> Either
     (DiagramError
        (SafeCompositionGraph Text Text)
        (SCGMorphism Text Text)
        Text
        (SafeCompositionGraph Text Text)
        (SCGMorphism Text Text)
        Text)
     SCGD
forall a b. a -> Either a b
Left DiagramError
  (SafeCompositionGraph Text Text)
  (SCGMorphism Text Text)
  Text
  (SafeCompositionGraph Text Text)
  (SCGMorphism Text Text)
  Text
err
        where
            diag :: SCGD
diag = String -> SCGD
unsafeReadSCGDString String
str
            check :: Maybe
  (DiagramError
     (SafeCompositionGraph Text Text)
     (SCGMorphism Text Text)
     Text
     (SafeCompositionGraph Text Text)
     (SCGMorphism Text Text)
     Text)
check = SCGD
-> Maybe
     (DiagramError
        (SafeCompositionGraph Text Text)
        (SCGMorphism Text Text)
        Text
        (SafeCompositionGraph Text Text)
        (SCGMorphism Text Text)
        Text)
forall c1 m1 o1 c2 m2 o2.
(FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
 FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Maybe (DiagramError c1 m1 o1 c2 m2 o2)
checkFiniteDiagram SCGD
diag
            Just DiagramError
  (SafeCompositionGraph Text Text)
  (SCGMorphism Text Text)
  Text
  (SafeCompositionGraph Text Text)
  (SCGMorphism Text Text)
  Text
err = Maybe
  (DiagramError
     (SafeCompositionGraph Text Text)
     (SCGMorphism Text Text)
     Text
     (SafeCompositionGraph Text Text)
     (SCGMorphism Text Text)
     Text)
check
            
    -- | Unsafe version 'readSCGDFile' which does not check the structure of the resulting 'Diagram'.

    unsafeReadSCGDFile :: String -> IO SCGD
    unsafeReadSCGDFile :: String -> IO SCGD
unsafeReadSCGDFile String
path = do
        String
raw <- String -> IO String
readFile String
path
        SCGD -> IO SCGD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SCGD
unsafeReadSCGDString String
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 :: String
-> IO
     (Either
        (DiagramError
           (SafeCompositionGraph Text Text)
           (SCGMorphism Text Text)
           Text
           (SafeCompositionGraph Text Text)
           (SCGMorphism Text Text)
           Text)
        SCGD)
readSCGDFile String
path = do
        String
raw <- String -> IO String
readFile String
path
        Either
  (DiagramError
     (SafeCompositionGraph Text Text)
     (SCGMorphism Text Text)
     Text
     (SafeCompositionGraph Text Text)
     (SCGMorphism Text Text)
     Text)
  SCGD
-> IO
     (Either
        (DiagramError
           (SafeCompositionGraph Text Text)
           (SCGMorphism Text Text)
           Text
           (SafeCompositionGraph Text Text)
           (SCGMorphism Text Text)
           Text)
        SCGD)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> Either
     (DiagramError
        (SafeCompositionGraph Text Text)
        (SCGMorphism Text Text)
        Text
        (SafeCompositionGraph Text Text)
        (SCGMorphism Text Text)
        Text)
     SCGD
readSCGDString String
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 :: forall a1 b1 a2 b2.
(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 Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag = String
srcString String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tgtString String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
omapString String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mmapString
        where
            srcString :: String
srcString = String
"<SRC>\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++SafeCompositionGraph a1 b1 -> String
forall a b.
(PrettyPrint a, PrettyPrint b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String
writeSCGString (Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> SafeCompositionGraph a1 b1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n</SRC>\n"
            tgtString :: String
tgtString = String
"<TGT>\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++SafeCompositionGraph a2 b2 -> String
forall a b.
(PrettyPrint a, PrettyPrint b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String
writeSCGString (Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> SafeCompositionGraph a2 b2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"</TGT>\n"
            omapString :: String
omapString = String
"#Object mapping\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (\a1
o -> (a1 -> String
forall a. PrettyPrint a => a -> String
pprint a1
o) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" => " String -> ShowS
forall a. [a] -> [a] -> [a]
++  (a2 -> String
forall a. PrettyPrint a => a -> String
pprint (Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> a1 -> a2
forall o1 c1 m1 c2 m2 o2.
Eq o1 =>
Diagram c1 m1 o1 c2 m2 o2 -> o1 -> o2
->$ a1
o)) )(a1 -> String) -> [a1] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set a1 -> [a1]
forall a. Eq a => Set a -> [a]
setToList(Set a1 -> [a1])
-> (Diagram
      (SafeCompositionGraph a1 b1)
      (SCGMorphism a1 b1)
      a1
      (SafeCompositionGraph a2 b2)
      (SCGMorphism a2 b2)
      a2
    -> Set a1)
-> Diagram
     (SafeCompositionGraph a1 b1)
     (SCGMorphism a1 b1)
     a1
     (SafeCompositionGraph a2 b2)
     (SCGMorphism a2 b2)
     a2
-> [a1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SafeCompositionGraph a1 b1 -> Set a1
forall c m o. FiniteCategory c m o => c -> Set o
ob(SafeCompositionGraph a1 b1 -> Set a1)
-> (Diagram
      (SafeCompositionGraph a1 b1)
      (SCGMorphism a1 b1)
      a1
      (SafeCompositionGraph a2 b2)
      (SCGMorphism a2 b2)
      a2
    -> SafeCompositionGraph a1 b1)
-> Diagram
     (SafeCompositionGraph a1 b1)
     (SCGMorphism a1 b1)
     a1
     (SafeCompositionGraph a2 b2)
     (SCGMorphism a2 b2)
     a2
-> Set a1
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> SafeCompositionGraph a1 b1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src (Diagram
   (SafeCompositionGraph a1 b1)
   (SCGMorphism a1 b1)
   a1
   (SafeCompositionGraph a2 b2)
   (SCGMorphism a2 b2)
   a2
 -> [a1])
-> Diagram
     (SafeCompositionGraph a1 b1)
     (SCGMorphism a1 b1)
     a1
     (SafeCompositionGraph a2 b2)
     (SCGMorphism a2 b2)
     a2
-> [a1]
forall a b. (a -> b) -> a -> b
$ Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
            mmapString :: String
mmapString = String
"#Morphism mapping\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (\SCGMorphism a1 b1
m -> a1 -> String
forall a. PrettyPrint a => a -> String
pprint (SCGMorphism a1 b1 -> a1
forall m o. Morphism m o => m -> o
source SCGMorphism a1 b1
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SCGMorphism a1 b1 -> String
forall a. PrettyPrint a => a -> String
pprint SCGMorphism a1 b1
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a1 -> String
forall a. PrettyPrint a => a -> String
pprint (SCGMorphism a1 b1 -> a1
forall m o. Morphism m o => m -> o
target SCGMorphism a1 b1
m)String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ if SafeCompositionGraph a2 b2 -> SCGMorphism a2 b2 -> Bool
forall c m o.
(Category c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isIdentity (Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> SafeCompositionGraph a2 b2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag) (Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> SCGMorphism a1 b1 -> SCGMorphism a2 b2
forall m1 c1 o1 c2 m2 o2.
Eq m1 =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> m2
->£ SCGMorphism a1 b1
m) then String
"<ID/>" else a2 -> String
forall a. PrettyPrint a => a -> String
pprint (SCGMorphism a2 b2 -> a2
forall m o. Morphism m o => m -> o
source (Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> SCGMorphism a1 b1 -> SCGMorphism a2 b2
forall m1 c1 o1 c2 m2 o2.
Eq m1 =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> m2
->£ SCGMorphism a1 b1
m)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SCGMorphism a2 b2 -> String
forall a. PrettyPrint a => a -> String
pprint (Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> SCGMorphism a1 b1 -> SCGMorphism a2 b2
forall m1 c1 o1 c2 m2 o2.
Eq m1 =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> m2
->£ SCGMorphism a1 b1
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a2 -> String
forall a. PrettyPrint a => a -> String
pprint (SCGMorphism a2 b2 -> a2
forall m o. Morphism m o => m -> o
target (Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> SCGMorphism a1 b1 -> SCGMorphism a2 b2
forall m1 c1 o1 c2 m2 o2.
Eq m1 =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> m2
->£ SCGMorphism a1 b1
m)))(SCGMorphism a1 b1 -> String) -> [SCGMorphism a1 b1] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set (SCGMorphism a1 b1) -> [SCGMorphism a1 b1]
forall a. Eq a => Set a -> [a]
setToList(Set (SCGMorphism a1 b1) -> [SCGMorphism a1 b1])
-> (Diagram
      (SafeCompositionGraph a1 b1)
      (SCGMorphism a1 b1)
      a1
      (SafeCompositionGraph a2 b2)
      (SCGMorphism a2 b2)
      a2
    -> Set (SCGMorphism a1 b1))
-> Diagram
     (SafeCompositionGraph a1 b1)
     (SCGMorphism a1 b1)
     a1
     (SafeCompositionGraph a2 b2)
     (SCGMorphism a2 b2)
     a2
-> [SCGMorphism a1 b1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((SCGMorphism a1 b1 -> Bool)
-> Set (SCGMorphism a1 b1) -> Set (SCGMorphism a1 b1)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (SafeCompositionGraph a1 b1 -> SCGMorphism a1 b1 -> Bool
forall c m o.
(Category c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity (Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> SafeCompositionGraph a1 b1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag)))(Set (SCGMorphism a1 b1) -> Set (SCGMorphism a1 b1))
-> (Diagram
      (SafeCompositionGraph a1 b1)
      (SCGMorphism a1 b1)
      a1
      (SafeCompositionGraph a2 b2)
      (SCGMorphism a2 b2)
      a2
    -> Set (SCGMorphism a1 b1))
-> Diagram
     (SafeCompositionGraph a1 b1)
     (SCGMorphism a1 b1)
     a1
     (SafeCompositionGraph a2 b2)
     (SCGMorphism a2 b2)
     a2
-> Set (SCGMorphism a1 b1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SafeCompositionGraph a1 b1 -> Set (SCGMorphism a1 b1)
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
genArrows(SafeCompositionGraph a1 b1 -> Set (SCGMorphism a1 b1))
-> (Diagram
      (SafeCompositionGraph a1 b1)
      (SCGMorphism a1 b1)
      a1
      (SafeCompositionGraph a2 b2)
      (SCGMorphism a2 b2)
      a2
    -> SafeCompositionGraph a1 b1)
-> Diagram
     (SafeCompositionGraph a1 b1)
     (SCGMorphism a1 b1)
     a1
     (SafeCompositionGraph a2 b2)
     (SCGMorphism a2 b2)
     a2
-> Set (SCGMorphism a1 b1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> SafeCompositionGraph a1 b1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src (Diagram
   (SafeCompositionGraph a1 b1)
   (SCGMorphism a1 b1)
   a1
   (SafeCompositionGraph a2 b2)
   (SCGMorphism a2 b2)
   a2
 -> [SCGMorphism a1 b1])
-> Diagram
     (SafeCompositionGraph a1 b1)
     (SCGMorphism a1 b1)
     a1
     (SafeCompositionGraph a2 b2)
     (SCGMorphism a2 b2)
     a2
-> [SCGMorphism a1 b1]
forall a b. (a -> b) -> a -> b
$ Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\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 :: forall a1 b1 a2 b2.
(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 Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag String
filepath = do
        Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
filepath
        String -> String -> IO ()
writeFile String
filepath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
-> String
forall a1 b1 a2 b2.
(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 Diagram
  (SafeCompositionGraph a1 b1)
  (SCGMorphism a1 b1)
  a1
  (SafeCompositionGraph a2 b2)
  (SCGMorphism a2 b2)
  a2
diag
        
    -- | Transform a 'CompositionGraph' into a 'SafeCompositionGraph' given a maximum number of loops.

    safeCompositionGraphFromCompositionGraph :: Int -> CompositionGraph a b -> SafeCompositionGraph a b
    safeCompositionGraphFromCompositionGraph :: forall a b. Int -> CompositionGraph a b -> SafeCompositionGraph a b
safeCompositionGraphFromCompositionGraph Int
i CompositionGraph a b
cg = SafeCompositionGraph{supportS :: Graph a b
supportS = CompositionGraph a b -> Graph a b
forall a b. CompositionGraph a b -> Graph a b
support CompositionGraph a b
cg, lawS :: CompositionLaw a b
lawS = CompositionGraph a b -> CompositionLaw a b
forall a b. CompositionGraph a b -> CompositionLaw a b
law CompositionGraph a b
cg, maxCycles :: Int
maxCycles = Int
i}
    
    -- | Transform a 'SafeCompositionGraph' into a 'CompositionGraph'.

    compositionGraphFromSafeCompositionGraph :: SafeCompositionGraph a b -> CompositionGraph a b
    compositionGraphFromSafeCompositionGraph :: forall a b. SafeCompositionGraph a b -> CompositionGraph a b
compositionGraphFromSafeCompositionGraph SafeCompositionGraph a b
scg = Graph a b -> CompositionLaw a b -> CompositionGraph a b
forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
unsafeCompositionGraph (SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS SafeCompositionGraph a b
scg) (SafeCompositionGraph a b -> CompositionLaw a b
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
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 :: forall g.
RandomGen g =>
Int -> Int -> Int -> g -> Int -> (SafeCompositionGraph Int Int, g)
constructRandomSafeCompositionGraph Int
a Int
b Int
c g
g Int
i = (Int -> CompositionGraph Int Int -> SafeCompositionGraph Int Int
forall a b. Int -> CompositionGraph a b -> SafeCompositionGraph a b
safeCompositionGraphFromCompositionGraph Int
i CompositionGraph Int Int
cg, g
g2)
        where
            (CompositionGraph Int Int
cg, g
g2) = Int -> Int -> Int -> g -> (CompositionGraph Int Int, g)
forall g.
RandomGen g =>
Int -> Int -> Int -> g -> (CompositionGraph Int Int, g)
constructRandomCompositionGraph Int
a Int
b Int
c g
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 :: forall g. RandomGen g => g -> (SafeCompositionGraph Int Int, g)
defaultConstructRandomSafeCompositionGraph g
g = (Int -> CompositionGraph Int Int -> SafeCompositionGraph Int Int
forall a b. Int -> CompositionGraph a b -> SafeCompositionGraph a b
safeCompositionGraphFromCompositionGraph Int
100 CompositionGraph Int Int
cg, g
g2)
        where
            (CompositionGraph Int Int
cg,g
g2) = g -> (CompositionGraph Int Int, g)
forall g. RandomGen g => g -> (CompositionGraph Int Int, g)
defaultConstructRandomCompositionGraph g
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 :: forall g.
RandomGen g =>
g
-> (Diagram
      (SafeCompositionGraph Int Int)
      (SCGMorphism Int Int)
      Int
      (SafeCompositionGraph Int Int)
      (SCGMorphism Int Int)
      Int,
    g)
defaultConstructRandomSafeDiagram g
g1 = SafeCompositionGraph Int Int
-> SafeCompositionGraph Int Int
-> g
-> (Diagram
      (SafeCompositionGraph Int Int)
      (SCGMorphism Int Int)
      Int
      (SafeCompositionGraph Int Int)
      (SCGMorphism Int Int)
      Int,
    g)
forall c1 m1 o1 c2 m2 o2 g.
(FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
 FiniteCategory c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2,
 RandomGen g) =>
c1 -> c2 -> g -> (Diagram c1 m1 o1 c2 m2 o2, g)
pickRandomDiagram SafeCompositionGraph Int Int
cat1 SafeCompositionGraph Int Int
cat2 g
g3
        where 
            (Int
nbArrows1, g
g2) = (Int, Int) -> g -> (Int, g)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
1,Int
8) g
g1
            (Int
nbAttempts1, g
g3) = (Int, Int) -> g -> (Int, g)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
0,Int
nbArrows1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nbArrows1) g
g2
            (SafeCompositionGraph Int Int
cat1, g
g4) = Int -> Int -> Int -> g -> Int -> (SafeCompositionGraph Int Int, g)
forall g.
RandomGen g =>
Int -> Int -> Int -> g -> Int -> (SafeCompositionGraph Int Int, g)
constructRandomSafeCompositionGraph Int
nbArrows1 Int
nbAttempts1 Int
5 g
g3 Int
100
            (Int
nbArrows2, g
g5) = (Int, Int) -> g -> (Int, g)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
1,Int
11Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nbArrows1) g
g4
            (Int
nbAttempts2, g
g6) = (Int, Int) -> g -> (Int, g)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
0,Int
nbArrows2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nbArrows2) g
g5
            (SafeCompositionGraph Int Int
cat2, g
g7) = Int -> Int -> Int -> g -> Int -> (SafeCompositionGraph Int Int, g)
forall g.
RandomGen g =>
Int -> Int -> Int -> g -> Int -> (SafeCompositionGraph Int Int, g)
constructRandomSafeCompositionGraph Int
nbArrows2 Int
nbAttempts2 Int
5 g
g6 Int
100