packages feed

FiniteCategories 0.5.0.0 → 0.6.5.1

raw patch · 109 files changed

Files

CHANGELOG.md view
@@ -22,4 +22,48 @@ 
 ## 0.5.0.0 -- 2023-10-10
 
-* Better bounds+* Better bounds.
+
+## 0.6.0.0 -- 2024-01-11
+
+* Sketches, (co)complete categories and cartesian closed categories.
+
+## 0.6.0.1 -- 2024-01-14
+
+* Correct bug in completeDiagram.
+
+## 0.6.0.2 -- 2024-01-22
+
+* Bug fix in checkNaturalTransformation.
+
+## 0.6.1.0 -- 2024-01-23
+
+* Add checkFiniteSketch to be more specific.
+
+## 0.6.1.1 -- 2024-01-23
+
+* Bug fix in sketchMorphism
+
+## 0.6.2.0 -- 2024-01-24
+
+* Add mapOnObjects2 and mapOnArrows2
+
+## 0.6.3.0 -- 2024-02-05
+
+* Add helpers for cones and cocones
+
+## 0.6.3.1 -- 2024-03-06
+
+* Bug fixes in helpers for cones and cocones
+
+## 0.6.4.0 -- 2024-03-08
+
+* Adding leg getter in CartesianClosedCategory
+
+## 0.6.5.0 -- 2024-05-16
+
+* Changes to simplification of CGMorphism
+
+## 0.6.5.1 -- 2024-05-31
+
+* Relax container version bounds
FiniteCategories.cabal view
@@ -14,7 +14,7 @@ -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:            0.5.0.0
+version:             0.6.5.1
 
 -- A short (one-line) description of the package.
 synopsis: Finite categories and usual categorical constructions on them.
@@ -55,6 +55,9 @@     exposed-modules:    Math.FiniteCategories.All,
                         Math.Category,
                         Math.FiniteCategory,
+                        Math.CompleteCategory,
+                        Math.CocompleteCategory,
+                        Math.CartesianClosedCategory,
                         Math.FiniteCategoryError,
                         Math.Categories,
                         Math.Categories.TotalOrder,
@@ -69,6 +72,7 @@                         Math.Categories.CommaCategory,
                         Math.Categories.ConeCategory,
                         Math.Categories.PresheafCategory,
+                        Math.Categories.FinSketch,
                         Math.FiniteCategories,
                         Math.FiniteCategories.FullSubcategory,
                         Math.FiniteCategories.NumberCategory,
@@ -86,23 +90,24 @@                         Math.FiniteCategories.One,
                         Math.FiniteCategories.ConeCategory,
                         Math.FiniteCategories.Subcategory,
+                        Math.FiniteCategories.DiscreteTwo,
+                        Math.FiniteCategories.LimitCategory,
+                        Math.FiniteCategories.ColimitCategory,
+                        Math.FiniteCategories.ExponentialCategory,
                         Math.FiniteCategories.Examples,
-                        Math.FiniteCategories.NumberCategory.Example,
-                        Math.FiniteCategories.DiscreteCategory.Example,
-                        Math.FiniteCategories.Hat.Example,
-                        Math.FiniteCategories.V.Example,
-                        Math.FiniteCategories.Parallel.Example,
-                        Math.FiniteCategories.Square.Example,
-                        Math.FiniteCategories.Ens.Example,
-                        Math.FiniteCategories.FinGrph.Example,
-                        Math.FiniteCategories.Opposite.Example,
-                        Math.FiniteCategories.FinCat.Example,
-                        Math.FiniteCategories.FunctorCategory.Example,
-                        Math.FiniteCategories.CompositionGraph.Example,
-                        Math.FiniteCategories.SafeCompositionGraph.Example,
-                        Math.FiniteCategories.CommaCategory.Example,
-                        Math.FiniteCategories.One.Example,
-                        Math.FiniteCategories.ConeCategory.Example,
+                        Math.FiniteCategories.CommaCategory.Examples,
+                        Math.FiniteCategories.CompositionGraph.Examples,
+                        Math.FiniteCategories.ConeCategory.Examples,
+                        Math.FiniteCategories.DiscreteCategory.Examples,
+                        Math.FiniteCategories.Ens.Examples,
+                        Math.FiniteCategories.FinCat.Examples,
+                        Math.FiniteCategories.FinGrph.Examples,
+                        Math.FiniteCategories.FinSketch.Examples,
+                        Math.FiniteCategories.FunctorCategory.Examples,
+                        Math.FiniteCategories.LimitCategory.Examples,
+                        Math.FiniteCategories.NumberCategory.Examples,
+                        Math.FiniteCategories.Opposite.Examples,
+                        Math.FiniteCategories.SafeCompositionGraph.Examples,
                         Math.Functors,
                         Math.Functors.Adjunction,
                         Math.Functors.DiagonalFunctor,
@@ -110,25 +115,25 @@                         Math.Functors.KanExtension,
                         Math.Functors.SetValued,
                         Math.Functors.Examples,
-                        Math.Functors.Adjunction.Example,
-                        Math.Functors.DiagonalFunctor.Example,
-                        Math.Functors.DataMigration.Example,
-                        Math.Functors.KanExtension.Example,
-                        Math.Functors.YonedaEmbedding.Example,
-                        Math.Functors.SetValued.Example,
+                        Math.Functors.Adjunction.Examples,
+                        Math.Functors.DataMigration.Examples,
+                        Math.Functors.DiagonalFunctor.Examples,
+                        Math.Functors.KanExtension.Examples,
+                        Math.Functors.SetValued.Examples,
+                        Math.Functors.YonedaEmbedding.Examples,
                         Math.IO.PrettyPrint
 
     -- Modules included in this library but not exported.
     -- other-modules:  
 
     -- LANGUAGE extensions used by modules in this package.
-    other-extensions: MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances
+    other-extensions: MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, MonadComprehensions, DeriveGeneric, DeriveAnyClass, DefaultSignatures, TypeOperators, FlexibleContexts
 
     -- Other library packages from which modules are imported.
     build-depends:      base             >= 4 && < 5,
                         random           >= 1.2.1 && < 1.3,
-                        WeakSets         >= 1.5.0.0 && < 1.6,
-                        containers       >= 0.6.6.0 && < 0.7,
+                        WeakSets         >= 1.6.1.0 && < 1.7,
+                        containers       >= 0.6.0.0 && < 0.7,
                         text             >= 1.0 && < 2.2,
                         filepath         >= 1.4.100.1 && < 1.5,
                         directory        >= 1.3.8.1 && < 1.4,
@@ -157,9 +162,27 @@     build-depends:      FiniteCategories,
                         base             >= 4 && < 5,
                         random           >= 1.2.1 && < 2,
-                        WeakSets         >= 1.5 && < 1.6,
-                        containers       >= 0.6.6.0 && < 0.7,
+                        WeakSets         >= 1.6.1 && < 1.7,
+                        containers       >= 0.6.0.0 && < 0.7,
                         text             >= 1.0 && < 2.2,
                         filepath         >= 1.4.100.1 && < 1.5,
                         directory        >= 1.3.8.1 && < 1.4,
-    other-modules:  CheckAllFiniteCategories+    other-modules:  CheckAllFiniteCategories,
+                    FiniteCategoryExamples.CommaCategory,
+                    FiniteCategoryExamples.CompositionGraph,
+                    FiniteCategoryExamples.ConeCategory,
+                    FiniteCategoryExamples.DiscreteCategory,
+                    FiniteCategoryExamples.Ens,
+                    FiniteCategoryExamples.FinCat,
+                    FiniteCategoryExamples.FinGrph,
+                    FiniteCategoryExamples.FunctorCategory,
+                    FiniteCategoryExamples.LimitCategory,
+                    FiniteCategoryExamples.NumberCategory,
+                    FiniteCategoryExamples.Opposite,
+                    FiniteCategoryExamples.SafeCompositionGraph,
+                    FunctorExamples.Adjunction,
+                    FunctorExamples.DataMigration,
+                    FunctorExamples.DiagonalFunctor,
+                    FunctorExamples.KanExtension,
+                    FunctorExamples.SetValued,
+                    FunctorExamples.YonedaEmbedding,
Readme.md view
@@ -11,7 +11,7 @@ 
 ## General Info
 
-This package provides tools to create categories at the value level. This is different from the __Hask__ category where types are objects in a category with an infinite number of objects and arrows, here we construct categories where objects and arrows are arbitrary values so that we can change categories during runtime. Each category implements two functions following the category structure axioms : `ar` which returns arrows between two objects of the category and `identity` which returns the identity of an object. Each `FiniteCategory` implements an additional function : `ob` which returns the objects of the category. Thanks to theses functions, we can construct automatically all the usual constructions on the categories (limits and colimits, adjunctions, Yoneda embedding, etc.) Functors are different from usual `Functor` typeclass, we store functors as mapping between objects and morphisms of two categories which respect the category structure.
+This package provides tools to create categories at the value level. This is different from the __Hask__ category where types are objects in a category with an infinite number of objects and arrows, here we construct categories where objects and arrows are arbitrary values so that we can change categories during runtime. Each category implements two functions following the category structure axioms : `ar` which returns arrows between two objects of the category and `identity` which returns the identity of an object. Each `FiniteCategory` implements an additional function : `ob` which returns the objects of the category. Thanks to these functions, we can construct automatically all the usual constructions on the categories (limits and colimits, adjunctions, Yoneda embedding, etc.) Functors are different from usual `Functor` typeclass, we store functors as mapping between objects and morphisms of two categories which respect the category structure.
 
 This package is also different from the package `data-category` because we can enumerate objects and arrows in a category.  This allows us to construct limit, colimits, adjunctions, etc. automatically for arbitrary finite categories. On the other hand, we loose typecheck at compilation time which ensures that composition is sound in __Hask__, composition in our package might lead to an error raised during runtime.
+ src/Math/CartesianClosedCategory.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+{-| Module  : FiniteCategories
+Description : Typeclasses for 'Category' which are cartesian complete.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Typeclasses for 'Category' which are cartesian complete.
+
+A 'TwoBase' specifies an internal domain and an internal codomain.
+
+A 'Tripod' is the data necessary to specify an exponential object.
+
+An exponential object is a terminal object in the category of candidate exponential objects.
+-}
+
+module Math.CartesianClosedCategory
+(
+    -- * 2-base
+    TwoBase(..),
+    -- * Tripod
+    Tripod,
+    -- ** Getters
+    twoCone,
+    evalMap,
+    internalDomainLeg,
+    internalCodomainLeg,
+    powerObjectLeg,
+    internalDomain,
+    internalCodomain,
+    powerObject,
+    universeCategoryTripod,
+    -- ** Smart constructors
+    tripod,
+    unsafeTripod,
+    -- * Cartesian closed category
+    CartesianClosedCategory(..),
+    TwoProduct(..),
+    Exponential(..),
+    unexproject,
+    Cartesian(..),
+    -- * Exponential object
+    -- ** Candidate exponential object
+    isCandidateExponentialObject,
+    CandidateExponentialObject(..),
+    -- ** Candidate exponential object morphism
+    CandidateExponentialObjectMorphism,
+    -- *** Getters
+    transpose,
+    -- *** Smart constructors
+    candidateExponentialObjectMorphism,
+    unsafeCandidateExponentialObjectMorphism,
+    -- ** Candidate exponential object category,
+    CandidateExponentialObjectCategory(..),
+    -- ** Exponential object function
+    exponentialObjects,
+)
+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)
+    import              Data.Simplifiable
+    
+    import              Math.Category
+    import              Math.FiniteCategory
+    import              Math.CompleteCategory
+    import              Math.FiniteCategories.DiscreteTwo
+    import              Math.FiniteCategories.ConeCategory
+    import              Math.FiniteCategories.FunctorCategory
+    import              Math.IO.PrettyPrint
+    
+    import              GHC.Generics
+    
+    -- | A 'TwoBase' is the specification of an internal domain and an internal codomain.
+    --
+    -- The object 'A' selects the internal domain, the object 'B' selects the internal codomain.
+    --
+    -- Don't confuse the 2-base of an exponential object with the base of its 2-cone. The 2-base selects the internal domain and internal codomain of the exponential object. The base of the 2-cone selects the power object and the internal domain.
+    type TwoBase c m o = Diagram DiscreteTwo DiscreteTwoAr DiscreteTwoOb c m o
+    
+    -- | A 'Tripod' is a 2-cone on the power object and the internal domain, and an evaluation map from the apex of the 2-cone to the internal codomain.
+    --
+    -- 'Tripod' is private, use smart constructor 'tripod' which checks the structure of the 'Tripod' or use 'unsafeTripod' if you know that the 'evalMap' has the apex of the 'twoCone' as a source.
+    data Tripod c m o = Tripod {
+        twoCone :: (Cone DiscreteTwo DiscreteTwoAr DiscreteTwoOb c m o), -- ^ In the base of the cone, the power object should be the image of 'A' and the internal domain should be the image of 'B'.
+        evalMap :: m -- ^ The evaluation map should go from the apex of the 2-cone to the internal codomain
+        } deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)
+        
+    -- | Smart constructor of 'Tripod', checks that the apex of the 'twoCone' is the source of the 'evalMap'.
+    tripod :: (Morphism m o, Eq o) => Cone DiscreteTwo DiscreteTwoAr DiscreteTwoOb c m o -> m -> Maybe (Tripod c m o)
+    tripod cone em
+        | source em /= apex cone = Nothing
+        | otherwise = Just Tripod{twoCone = cone, evalMap = em}
+        
+    -- | Construct a 'Tripod' without checking the sructure of the 'Tripod', use with caution.
+    unsafeTripod :: Cone DiscreteTwo DiscreteTwoAr DiscreteTwoOb c m o -> m -> Tripod c m o
+    unsafeTripod cone em = Tripod{twoCone = cone, evalMap = em}    
+    
+    -- | Return the internal domain leg of a 'Tripod'.
+    internalDomainLeg :: (Morphism m o) => Tripod c m o -> m
+    internalDomainLeg t = (legsCone (twoCone t)) =>$ B
+    
+    -- | Return the internal domain of a 'Tripod'.
+    internalDomain :: (Morphism m o) => Tripod c m o -> o
+    internalDomain = target.internalDomainLeg
+    
+    -- | Return the internal codomain leg of a 'Tripod'.
+    internalCodomainLeg :: (Morphism m o) => Tripod c m o -> m
+    internalCodomainLeg t = evalMap t
+    
+    -- | Return the internal codomain of a 'Tripod'.
+    internalCodomain :: (Morphism m o) => Tripod c m o -> o
+    internalCodomain = target.internalCodomainLeg
+    
+    -- | Return the power object leg of a 'Tripod'.
+    powerObjectLeg :: (Morphism m o) => Tripod c m o -> m
+    powerObjectLeg t = (legsCone (twoCone t)) =>$ A
+    
+    -- | Return the power object of a 'Tripod'.
+    powerObject :: (Morphism m o) => Tripod c m o -> o
+    powerObject = target.powerObjectLeg
+    
+    -- | Return the category in which a 'Tripod' lives.
+    universeCategoryTripod :: (Category c m o, Morphism m o, Eq c, Eq m, Eq o) => 
+        Tripod c m o -> c
+    universeCategoryTripod = universeCategoryCone.twoCone
+    
+    -- | For a 'Category' parametrized over a type t, the power object of an exponential object of a 2-base will contain 'ExponentialElement' constructions (an exponential element is a mapping). A given mapping has as domain and codomain values 'Exprojection's.
+    --
+    -- For example, in 'FinSet', let's consider the 2-base selecting {1,2} and {3,4} as internal domain and codomain. The power object of the 2-base is {{1->3,2->3},{1->3,2->4},{1->4,2->3},{1->4,2->4}}, note that it is not an object of ('Finset' Int) but an object of ('FinSet' (Set (Map Int))). The 'Exponential' type allows to construct type ('FinSet' ('Exponential' Int)) in which we can consider the original objects with 'Exprojection' and the new mappings with 'ExponentialElement'. Here, instead of mappings, we can construct the type ('FinSet' (Set (Exponential Int))), a mapping is then ('ExponentialElement' (weakMap [(1,3),(2,3)])). We can construct exprojections in the same category, for example along 'A' which will map ('ExponentialElement' (weakMap [(1,3),(2,3)])) to (set ['Exprojection' 1, 'Exprojection' 2]).
+    data Exponential t = Exprojection t -- ^A 'ExponentialElement' can be applied to an 'Exprojection' yielding another 'Exprojection'.  
+                       | ExponentialElement (Map t t) -- ^ An 'ExponentialElement' is an element in an exponential object, it is a mapping between objects of type t.
+        deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)
+        
+    -- | Remove the constructor 'Exprojection' from an original object t, throws an error if an 'ExponentialElement' is given.
+    unexproject :: Exponential t -> t
+    unexproject (Exprojection t) = t
+    unexproject (ExponentialElement _) = error "Unexproject an exponential element."
+        
+    -- | For a category to be cartesian closed, we need to construct 2-products.
+    type TwoProduct t = Limit DiscreteTwoOb t
+    
+    -- | For a category to be cartesian closed, we need to construct 2-products of exponential objects with exprojected objects.
+    type Cartesian t = TwoProduct (Exponential t)
+    
+    
+    class CartesianClosedCategory c m o cLim mLim oLim cLimExp mLimExp oLimExp | 
+        c -> m, m -> o, cLim -> mLim, mLim -> oLim, cLimExp -> mLimExp, mLimExp -> oLimExp, c m o -> cLimExp where
+        
+        internalHom :: (CompleteCategory c m o cLim mLim oLim DiscreteTwo DiscreteTwoAr DiscreteTwoOb) => TwoBase c m o -> Tripod cLimExp mLimExp oLimExp
+
+    -- | Return wether a 'Tripod' is a candidate exponential object or not. A 'Tripod' is a candidate exponential object if its 'twoCone' is a limit. Tests if the 2-cone is a 2-product by computing the limits in the universe category with the function 'limits' : it is slow.
+    isCandidateExponentialObject :: (FiniteCategory c m o, Morphism m o, Eq c, Eq m, Eq o) => Tripod c m o -> Bool
+    isCandidateExponentialObject t = (twoCone t) `Set.elem` (limits.baseCone.twoCone $ t)
+    
+    -- | A 'CandidateExponentialObject' is a 'Tripod' such that its 'twoCone' is a limit.
+    type CandidateExponentialObject c m o = Tripod c m o
+    
+    -- | A 'CandidateExponentialObjectMorphism' is a morphism between two 'CandidateExponentialObject's. It is private, use smart constructors 'candidateExponentialObjectMorphism' and 'unsafeCandidateExponentialObjectMorphism' to instantiate.
+    data CandidateExponentialObjectMorphism c m o = CandidateExponentialObjectMorphism {
+                                                        sourceCandidateExponentialObject :: CandidateExponentialObject c m o,
+                                                        targetCandidateExponentialObject :: CandidateExponentialObject c m o,
+                                                        transpose :: m
+                                                    }
+                                                    deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)
+    
+    
+    -- | Smart constructor for 'CandidateExponentialObjectMorphism'. Checks wether the transpose has valid domain and valid codomain.
+    candidateExponentialObjectMorphism :: (Morphism m o, Eq m, Eq o) => CandidateExponentialObject c m o -> CandidateExponentialObject c m o -> m -> Maybe (CandidateExponentialObjectMorphism c m o)
+    candidateExponentialObjectMorphism s t transp
+        | source transp == target ((legsCone $ twoCone s) =>$ A) && target transp == target ((legsCone $ twoCone t) =>$ A) = Just CandidateExponentialObjectMorphism {sourceCandidateExponentialObject = s, targetCandidateExponentialObject = t, transpose = transp}
+        | otherwise = Nothing
+        
+    -- | Unsafe version of 'candidateExponentialObjectMorphism', use with caution as it does not check wether the transpose has valid domain and valid codomain.
+    unsafeCandidateExponentialObjectMorphism :: CandidateExponentialObject c m o -> CandidateExponentialObject c m o -> m -> CandidateExponentialObjectMorphism c m o
+    unsafeCandidateExponentialObjectMorphism s t transp = CandidateExponentialObjectMorphism {sourceCandidateExponentialObject = s, targetCandidateExponentialObject = t, transpose = transp}
+    
+    instance (Morphism m o) => Morphism (CandidateExponentialObjectMorphism c m o) (CandidateExponentialObject c m o) where
+        source = sourceCandidateExponentialObject
+        target = targetCandidateExponentialObject
+        ceom2 @ ceom1 = CandidateExponentialObjectMorphism {sourceCandidateExponentialObject = sourceCandidateExponentialObject ceom1, targetCandidateExponentialObject = targetCandidateExponentialObject ceom2, transpose = (transpose ceom2) @ (transpose ceom1)}
+    
+    data CandidateExponentialObjectCategory c m o = CandidateExponentialObjectCategory (TwoBase c m o)
+        deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)
+        
+    instance (Category c m o, Morphism m o, Eq c, Eq m ,Eq o) => Category (CandidateExponentialObjectCategory c m o) (CandidateExponentialObjectMorphism c m o) (CandidateExponentialObject c m o) where
+        
+        identity (CandidateExponentialObjectCategory base) tripod
+            | differentInternalDomain = error "identity in a CandidateExponentialObjectCategory of a tripod with a different internal domain."
+            | differentInternalCodomain = error "identity in a CandidateExponentialObjectCategory of a tripod with a different internal codomain."
+            | differentUniverseCategory = error "identity in a CandidateExponentialObjectCategory of a tripod with a different universe category."
+            | otherwise = CandidateExponentialObjectMorphism {sourceCandidateExponentialObject = tripod, targetCandidateExponentialObject = tripod, transpose = identity (universeCategoryTripod tripod) (powerObject tripod)}
+            where
+                differentInternalDomain = internalDomain tripod /= base ->$ A
+                differentInternalCodomain = internalCodomain tripod /= base ->$ B
+                differentUniverseCategory = universeCategoryTripod tripod /= tgt base
+            
+        
+        ar (CandidateExponentialObjectCategory base) tripod1 tripod2
+            | differentInternalDomain1 = error "ar in a CandidateExponentialObjectCategory where the source has different internal domain."
+            | differentInternalCodomain1 = error "ar in a CandidateExponentialObjectCategory where the source has different internal codomain."
+            | differentUniverseCategory1 = error "ar in a CandidateExponentialObjectCategory where the source has different universe Category."
+            | differentInternalDomain2 = error "ar in a CandidateExponentialObjectCategory where the target has different internal domain."
+            | differentInternalCodomain2 = error "ar in a CandidateExponentialObjectCategory where the target has different internal codomain."
+            | differentUniverseCategory2 = error "ar in a CandidateExponentialObjectCategory where the target has different universe Category."
+            | otherwise = (\m -> CandidateExponentialObjectMorphism{sourceCandidateExponentialObject = tripod1, targetCandidateExponentialObject = tripod2, transpose = m}) <$> ar (universeCategoryTripod tripod1) (powerObject tripod1) (powerObject tripod2)
+            where
+                differentInternalDomain1 = internalDomain tripod1 /= base ->$ A
+                differentInternalCodomain1 = internalCodomain tripod1 /= base ->$ B
+                differentUniverseCategory1 = universeCategoryTripod tripod1 /= tgt base
+                differentInternalDomain2 = internalDomain tripod2 /= base ->$ A
+                differentInternalCodomain2 = internalCodomain tripod2 /= base ->$ B
+                differentUniverseCategory2 = universeCategoryTripod tripod2 /= tgt base
+    
+    instance (FiniteCategory c m o, Morphism m o, Eq c, Eq m ,Eq o) => FiniteCategory (CandidateExponentialObjectCategory c m o) (CandidateExponentialObjectMorphism c m o) (CandidateExponentialObject c m o) where
+        
+        ob (CandidateExponentialObjectCategory base) = [Tripod{twoCone = c, evalMap = m} | powerObj <- ob (tgt base), c <- limits (twoDiagram (tgt base) powerObj (base ->$ A)), m <- ar (tgt base) (apex c) (base ->$ B), isCandidateExponentialObject Tripod{twoCone = c, evalMap = m}]
+        
+    -- | Return the exponential objects of a given 2-base.
+    exponentialObjects :: (FiniteCategory c m o, Morphism m o, Eq c, Eq m ,Eq o) => TwoBase c m o -> Set (CandidateExponentialObject c m o)
+    exponentialObjects base = terminalObjects (CandidateExponentialObjectCategory base)
src/Math/Categories.hs view
@@ -24,6 +24,7 @@     module Math.Categories.CommaCategory,
     module Math.Categories.ConeCategory,
     module Math.Categories.PresheafCategory,
+    module Math.Categories.FinSketch,
 ) where
     import  Math.Categories.Omega
     import  Math.Categories.OrdinalCategory
@@ -36,4 +37,5 @@     import  Math.Categories.FunctorCategory
     import  Math.Categories.CommaCategory
     import  Math.Categories.ConeCategory
-    import  Math.Categories.PresheafCategory+    import  Math.Categories.PresheafCategory
+    import  Math.Categories.FinSketch
src/Math/Categories/CommaCategory.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE MultiParamTypeClasses, MonadComprehensions #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
 Description : A 'CommaCategory' is intuitively a category where objects are selected morphisms of another category /C/ and morphisms are selected commutative squares in /C/.
@@ -52,6 +55,7 @@     import   qualified  Data.WeakMap        as Map
     import              Data.WeakMap          (Map)
     import              Data.WeakMap.Safe
+    import              Data.Simplifiable
     
     import              Math.Category
     import              Math.FiniteCategory
@@ -60,6 +64,8 @@     import              Math.FiniteCategories.One
     import              Math.IO.PrettyPrint
     
+    import              GHC.Generics
+    
     -- | A `CommaObject` in the `CommaCategory` (/T/|/S/) is a triplet \<e,d,f\> where @f : /T/(e) -> /S/(d)@.
     --
     -- See "Categories for the working mathematician", Saunders Mac Lane, P.46.
@@ -68,12 +74,16 @@     data CommaObject o1 o2 m3 = CommaObject { indexSource :: o1 -- ^ e, the indexing object of the source of the 'selectedArrow'.
                                             , indexTarget :: o2 -- ^ d, the indexing object of the target of the 'selectedArrow'.
                                             , selectedArrow :: m3 -- ^ f, the selected arrow of the target category.
-                                            } deriving (Eq)
+                                            } deriving (Eq, Generic, Simplifiable)
     
     instance (PrettyPrint o1, PrettyPrint o2, PrettyPrint m3) =>
              PrettyPrint (CommaObject o1 o2 m3) where
-        pprint CommaObject{indexSource=e, indexTarget=d, selectedArrow=f} = "<"++pprint e++", "++pprint d++", "++pprint f++">"
+        pprint 0 _ = "..."
+        pprint v CommaObject{indexSource=e, indexTarget=d, selectedArrow=f} = "<"++pprint (v-1) e++", "++pprint (v-1) d++", "++pprint (v-1) f++">"
         
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        -- pprintWithIndentations cv ov indent CommaObject{indexSource=e, indexTarget=d, selectedArrow=f} = indentation (ov - cv) indent ++ "<"++pprint (cv-1) e++", "++pprint (cv-1) d++", "++pprint (cv-1) f++">\n"
+        
     instance (Show o1, Show o2, Show m3) =>
             Show (CommaObject o1 o2 m3) where
         show CommaObject{indexSource=e, indexTarget=d, selectedArrow=f} = "(unsafeCommaObject ("++ show e ++ ") (" ++ show d ++ ") (" ++ show f ++ "))"        
@@ -95,10 +105,10 @@                                                      , tgtCM :: (CommaObject o1 o2 m3) -- ^ The target `CommaObject`, (private, use 'target' instead).
                                                      , indexFirstArrow :: m1 -- ^ k, the indexing arrow of the first functor.
                                                      , indexSecondArrow :: m2} -- ^ h, the indexing arrow of the second functor.
-                                                     deriving (Eq)
+                                                     deriving (Eq, Generic, Simplifiable)
     
     -- | Smart constructor of 'CommaMorphism', checks the structure of the 'CommaMorphism' at construction.
-    commaMorphism :: (Morphism m3 o3, Eq o1, Eq o2, Eq o3, Eq m1, Eq m2, Eq m3) => Diagram c1 m1 o1 c3 m3 o3 -> Diagram c2 m2 o2 c3 m3 o3 -> (CommaObject o1 o2 m3) -> (CommaObject o1 o2 m3) -> m1 -> m2 -> Maybe (CommaMorphism o1 o2 m1 m2 m3)
+    commaMorphism :: (Category c1 m1 o1, Morphism m1 o1, Category c2 m2 o2, Morphism m2 o2, Morphism m3 o3, Eq o1, Eq o2, Eq o3, Eq m1, Eq m2, Eq m3) => Diagram c1 m1 o1 c3 m3 o3 -> Diagram c2 m2 o2 c3 m3 o3 -> (CommaObject o1 o2 m3) -> (CommaObject o1 o2 m3) -> m1 -> m2 -> Maybe (CommaMorphism o1 o2 m1 m2 m3)
     commaMorphism d1 d2 s t firstArr secondArr
         | null m1 || null m2 || m1 /= m2 = Nothing
         | otherwise = Just CommaMorphism{srcCM=s, tgtCM=t, indexFirstArrow=firstArr, indexSecondArrow=secondArr}
@@ -114,11 +124,19 @@             Show (CommaMorphism o1 o2 m1 m2 m3) where
         show CommaMorphism{srcCM=s, tgtCM =t, indexFirstArrow=k, indexSecondArrow=h} = "(unsafeCommaMorphism ("++show s++") ("++show t++") ("++show k++") ("++show h++"))"
         
-    instance (PrettyPrint m1, PrettyPrint m2) =>
+    instance (PrettyPrint m1, PrettyPrint m2, PrettyPrint o1, PrettyPrint o2, PrettyPrint m3) =>
               PrettyPrint (CommaMorphism o1 o2 m1 m2 m3) where
-        pprint CommaMorphism{srcCM=_, tgtCM =_, indexFirstArrow=k, indexSecondArrow=h} = "<"++pprint k++", "++pprint h++">"
-        
+        pprint 0 _ = "..."
+        pprint v CommaMorphism{srcCM=_, tgtCM =_, indexFirstArrow=k, indexSecondArrow=h} = "<"++pprint (v-1) k++", "++pprint (v-1) h++">"
+    
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        -- pprintWithIndentations cv ov indent CommaMorphism{srcCM=_, tgtCM =_, indexFirstArrow=k, indexSecondArrow=h} = indentation (ov - cv) indent ++ "<"++pprint (cv-1) k++", "++pprint (cv-1) h++">\n"
+    
     instance (Morphism m1 o1, Morphism m2 o2, Eq o1, Eq o2, Eq m3) => Morphism (CommaMorphism o1 o2 m1 m2 m3) (CommaObject o1 o2 m3) where
+        source = srcCM
+        
+        target = tgtCM
+        
         (@?) CommaMorphism{srcCM=s2,tgtCM=t2,indexFirstArrow=k2,indexSecondArrow=h2} CommaMorphism{srcCM=s1,tgtCM=t1,indexFirstArrow=k1,indexSecondArrow=h1}
             | t1 /= s2 = Nothing
             | null compoK = Nothing
@@ -129,15 +147,16 @@                 Just k = compoK
                 compoH = h2 @? h1
                 Just h = compoH
-        source = srcCM
-        target = tgtCM
         
+        (@) CommaMorphism{srcCM=s2,tgtCM=t2,indexFirstArrow=k2,indexSecondArrow=h2} CommaMorphism{srcCM=s1,tgtCM=t1,indexFirstArrow=k1,indexSecondArrow=h1} = CommaMorphism{srcCM=s1,tgtCM=t2,indexFirstArrow = k2 @ k1,indexSecondArrow = h2 @ h1}
+        
     -- | A `CommaCategory` is a couple (/T/|/S/) with /T/ and /S/ two diagrams with the same target.
     --
     -- See "Categories for the working mathematician", Saunders Mac Lane, P.46.
     data CommaCategory c1 m1 o1 c2 m2 o2 c3 m3 o3 = CommaCategory {leftDiagram :: Diagram c1 m1 o1 c3 m3 o3 -- ^ /T/
                                                                  , rightDiagram :: Diagram c2 m2 o2 c3 m3 o3} -- ^ /S/
-                                                    deriving (Eq, Show)
+                                                    deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
+    
                                                     
     instance (Category c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
               Category c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2,
@@ -177,12 +196,6 @@               FiniteCategory c3 m3 o3, Morphism m3 o3, Eq m3, Eq o3) => FiniteCategory (CommaCategory c1 m1 o1 c2 m2 o2 c3 m3 o3) (CommaMorphism o1 o2 m1 m2 m3) (CommaObject o1 o2 m3) where
         ob CommaCategory{leftDiagram = t, rightDiagram = s} = [CommaObject{indexSource=e,indexTarget=d,selectedArrow=f}| e <- (ob (src t)), d <- (ob (src s)), f <- ar (tgt t) (t ->$ e) (s ->$ d)]
         
-    
-    instance (PrettyPrint c1, PrettyPrint m1, PrettyPrint o1,
-              PrettyPrint c2, PrettyPrint m2, PrettyPrint o2,
-              PrettyPrint c3, PrettyPrint m3, PrettyPrint o3,
-              Eq m1, Eq o1, Eq m2, Eq o2, Eq m3, Eq o3) => PrettyPrint (CommaCategory c1 m1 o1 c2 m2 o2 c3 m3 o3) where
-        pprint cc = "CommaCategory("++ pprint (leftDiagram cc) ++ ", "++ pprint (rightDiagram cc)++")"
         
     -- | Construct the slice category of a category /C/ over an object /o/.
     --
src/Math/Categories/ConeCategory.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE MonadComprehensions #-}
 {-| Module  : FiniteCategories
 Description : Category of 'Cone's of a 'Diagram'.
 Copyright   : Guillaume Sabbagh 2021
@@ -8,18 +9,26 @@ 
 Category of 'Cone's of a 'Diagram'.
 
-This module allows to find the (co)'limit' of a 'Diagram'.
+This module allows to find the (co)'limits' of a 'Diagram'. Note that the functions 'limits' and 'colimits' scan the entire 'ConeCategory' to find the limits and colimits of a 'Diagram'. It is therefore quite slow, if you work with a 'Category' where limits and colimits are easily constructible like in Set or in Cat, you should maybe construct them yourself or use Kan extensions of 'Math.Functors.SetValued' and the function 'colimitOfCompositionGraphs'.
 -}
 
 module Math.Categories.ConeCategory
 (
     -- * Cone
-    Cone,
+    Cone(..),
+    -- ** Cone construcion
+    cone,
+    unsafeCone,
+    completeCone,
     -- ** Helper functions
     apex,
     baseCone,
     legsCone,
-    naturalTransformationToCone,
+    universeCategoryCone,
+    indexingCategoryCone,
+    precomposeConeWithMorphism,
+    postcomposeConeWithFunctor,
+    topInjectionsCone,
     -- * Cone Morphism
     ConeMorphism,
     -- ** Helper function
@@ -30,12 +39,20 @@     coneCategory,
     limits,
     -- * Cocone
-    Cocone,
+    Cocone(..),
+    -- ** Cocone construction
+    cocone,
+    unsafeCocone,
+    completeCocone,
     -- ** Helper functions
     nadir,
     baseCocone,
     legsCocone,
-    naturalTransformationToCocone,
+    universeCategoryCocone,
+    indexingCategoryCocone,
+    precomposeCoconeWithFunctor,
+    postcomposeCoconeWithMorphism,
+    bottomInjectionsCocone,
     -- * Cocone Morphism
     CoconeMorphism,
     -- ** Helper function
@@ -53,6 +70,7 @@     import              Data.WeakMap        (Map)
     import qualified    Data.WeakMap    as  Map
     import              Data.WeakMap.Safe
+    import              Data.Simplifiable
     
     import              Math.Category
     import              Math.FiniteCategory
@@ -73,31 +91,53 @@     -- See "Categories for the working mathematician", Saunders Mac Lane, P.67.
     type Cone c1 m1 o1 c2 m2 o2 = CommaObject o2 One (NaturalTransformation c1 m1 o1 c2 m2 o2)
     
+    -- | Constructs a 'Cone' from an apex and a 'NaturalTransformation'. Return nothing if the source of the 'NaturalTransformation' is not a constant diagram on the apex.
+    cone :: (Morphism m1 o1, FiniteCategory c1 m1 o1,
+             Morphism m2 o2, FiniteCategory c2 m2 o2,
+             Eq c1, Eq m1, Eq o1, Eq c2, Eq m2, Eq o2) => 
+            o2 -> NaturalTransformation c1 m1 o1 c2 m2 o2 -> Maybe (Cone c1 m1 o1 c2 m2 o2)
+    cone apex nat
+        | constantDiagram indexingCat universeCat apex /= source nat = Nothing
+        | otherwise = Just result
+        where 
+            indexingCat = src.source $ nat
+            universeCat = tgt.source $ nat
+            result = unsafeCommaObject apex One nat
+            
+    -- | Constructs a 'Cone' from an apex and a 'NaturalTransformation'. Does NOT check if the source of the 'NaturalTransformation' is a constant diagram on the apex. You may use this function at your own risk, consider using 'cone' if you are not sure.
+    --
+    -- If you give an incomplete natural transformation to this function, you can use 'completeCone' to complete the natural transformation.
+    unsafeCone :: o2 -> NaturalTransformation c1 m1 o1 c2 m2 o2 -> Cone c1 m1 o1 c2 m2 o2
+    unsafeCone apex nat = unsafeCommaObject apex One nat
+    
+    -- | Given a cone with a partial underlying natural transformation, tries to complete it. You can use 'checkNaturalTransformation.legsCone' to check that the cone was correctly completed. 
+    completeCone :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1, Morphism m2 o2) => Cone c1 m1 o1 c2 m2 o2 -> Cone c1 m1 o1 c2 m2 o2
+    completeCone c = unsafeCommaObject (apex c) One newNat
+        where
+            nat = legsCone c
+            prevComp = components nat
+            validArrowOnTop x = [f | f <- arTo (indexingCategory nat) x, (source f) `Set.isIn` (keys' prevComp)]
+            comp x
+                | not $ null $ prevComp |?| x = prevComp |?| x
+                | not $ Set.null $ validArrowOnTop x = Just $ ((target nat) ->£ (anElement $ validArrowOnTop x)) @ (prevComp |!| (source (anElement $ validArrowOnTop x)))
+                | otherwise = Nothing
+            newComp = weakMapFromSet $ Set.catMaybes [sequence (x,comp x) | x <- ob (indexingCategory nat)]
+            newNat = unsafeNaturalTransformation (source nat) (target nat) newComp
+    
+    
     -- | Return the apex of a `Cone`.
     apex :: Cone c1 m1 o1 c2 m2 o2 -> o2
     apex = indexSource
 
     -- | Return the base of a 'Cone'.
     baseCone :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
-                                      Morphism m2 o2, Eq c2, Eq m2, Eq o2) => 
+                                          Morphism m2 o2) => 
             Cone c1 m1 o1 c2 m2 o2 -> Diagram c1 m1 o1 c2 m2 o2
     baseCone = target.selectedArrow
     
     -- | Return the legs of a 'Cone' as a 'NaturalTransformation'.
     legsCone :: Cone c1 m1 o1 c2 m2 o2 -> NaturalTransformation c1 m1 o1 c2 m2 o2
     legsCone = selectedArrow
-
-    -- | Transform a `NaturalTransformation` from a 'constantDiagram' to a 'Diagram' /D/ into a `Cone` on /D/.
-    naturalTransformationToCone :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1
-                                   ,Category c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2) =>
-                                    NaturalTransformation c1 m1 o1 c2 m2 o2 -> Maybe (Cone c1 m1 o1 c2 m2 o2)
-    naturalTransformationToCone nt
-        | Set.null (ob (src.source $ nt)) = Nothing
-        | source nt /= constDiag = Nothing
-        | otherwise = Just $ unsafeCommaObject apexCandidate One nt
-        where
-            apexCandidate = (source nt) ->$ (anElement.ob.src.source $ nt)
-            constDiag = constantDiagram (src.source $ nt) (tgt.source $ nt) apexCandidate
         
     -- | A `ConeMorphism` is a morphism binding two 'Cone's. Formally, it is a 'CommaMorphism' in the 'CommaCategory' (/D/|1_/F/) where /D/ is the 'diagonalFunctor' and /F/ is the 'Diagram' of interest.
     type ConeMorphism c1 m1 o1 c2 m2 o2 = CommaMorphism o2 One m2 One (NaturalTransformation c1 m1 o1 c2 m2 o2)
@@ -120,12 +160,69 @@                                                                     diagonalFunct = diagonalFunctor s t
             
     -- | Returns limits of a diagram (terminal cones).
+    --
+    -- Note that the functions 'limits' and 'colimits' scan the entire 'ConeCategory' to find the limits and colimits of a 'Diagram'. It is therefore quite slow, if you work with a 'Category' where limits and colimits are easily constructible like in Set or in Cat, you should maybe construct them yourself or use Kan extensions of 'Math.Functors.SetValued' and the function 'colimitOfCompositionGraphs'.
     limits :: (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) =>
                Diagram c1 m1 o1 c2 m2 o2 -> Set (Cone c1 m1 o1 c2 m2 o2)
     limits = terminalObjects.coneCategory
     
-                                
+    
+    -- | Given a category, return equivalence classes according to the loop relation : two objects A and B are equivalent if and only if there is a morphism from A to B and a morphism from B to A.
+    loopClasses :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
+        c -> Set (Set o)
+    loopClasses c = [[y | y <- ob c, not $ Set.null $ ar c x y, not $ Set.null $ ar c y x] | x <- ob c]
+    
+    -- | The top objects of a category are all loop classes X such that all arrows going to X have source in X.                               
+    topObjects :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
+        c -> Set (Set o)
+    topObjects c = [loopClass | loopClass <- loopClasses c, Set.null $ Set.filter (\f -> (not (source f `isIn` loopClass)) && (target f `isIn` loopClass)) $ arrows c]
+                     
+    -- | Possible domains of the injective map to determine if a cone is top contained in another.
+    possibleDomainsTopContained :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
+        c -> Set [o]
+    possibleDomainsTopContained c = set.setToList $ cartesianProductOfSets $ setToList $ topObjects c
+    
+    -- | Enumerate injective maps which satisfy a condition.
+    enumerateInjectiveMaps :: (Eq a, Eq b) => (a -> b -> Bool) -> Set a -> Set b -> Set (Map a b)
+    enumerateInjectiveMaps cond dom codom
+        | Set.null dom = set [weakMap []]
+        | Set.null codom = set []
+        | Set.null compatibleYs = set []
+        | otherwise = Map.insert x y <$> enumerateInjectiveMaps cond xs ys
+            where
+                x = anElement dom
+                xs = Set.delete x dom
+                compatibleYs = [a | a <- codom, cond x a]
+                y = anElement compatibleYs
+                ys = Set.delete y codom
+    
+    
+    -- | A 'Cone' c1 is top contained in another 'Cone' c2 if every top leg of c1 is a leg of c2 in an injective manner.
+    topInjectionsCone :: (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,
+                          Morphism m3 o3, Eq c3, Eq m3, Eq o3) => 
+        Cone c1 m1 o1 c3 m3 o3 -> Cone c2 m2 o2 c3 m3 o3 -> Set (Map o1 o2)
+    topInjectionsCone c1 c2
+        | apex c1 == apex c2 = maps
+        | otherwise = set []
+        where
+            doms = possibleDomainsTopContained $ indexingCategoryCone c1
+            maps = Set.concat2 [enumerateInjectiveMaps (\x y -> legsCone c1 =>$ x == legsCone c2 =>$ y) (set dom) (ob (indexingCategoryCone c2)) | dom <- doms]
+    
+    -- | Precompose a cone with a morphism going to the apex. (Does not check that the morphism has the apex as target.)
+    precomposeConeWithMorphism :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
+                                         Category c2 m2 o2, Morphism m2 o2) => 
+        Cone c1 m1 o1 c2 m2 o2 -> m2 -> Cone c1 m1 o1 c2 m2 o2
+    precomposeConeWithMorphism c m = unsafeCommaObject (source m) One (unsafeNaturalTransformation (constantDiagram (src.source.legsCone $ c) (tgt.source.legsCone $ c) (source m)) (target $ legsCone c) ((@ m) <$> (components $ legsCone c)))
+    
+    -- | Postcompose a cone with a functor going from the universe category. 
+    postcomposeConeWithFunctor :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
+                                     Category c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2,
+                                                        Morphism m3 o3) => 
+        Cone c1 m1 o1 c2 m2 o2 -> Diagram c2 m2 o2 c3 m3 o3 -> Cone c1 m1 o1 c3 m3 o3
+    postcomposeConeWithFunctor c f = unsafeCommaObject (f ->$ (apex c)) One (f <-@<= (legsCone c))
+    
     -- -- --------------------------------
     -- -- Cocone related functions and types.
     -- -- --------------------------------
@@ -137,13 +234,46 @@     -- A 'Cocone' is simply the dual of a 'Cone'.
     type Cocone c1 m1 o1 c2 m2 o2 = CommaObject One o2 (NaturalTransformation c1 m1 o1 c2 m2 o2)
     
+    -- | Constructs a 'Cocone' from a nadir and a 'NaturalTransformation'. Return nothing if the target of the 'NaturalTransformation' is not a constant diagram on the nadir.
+    cocone :: (Morphism m1 o1, FiniteCategory c1 m1 o1,
+             Morphism m2 o2, FiniteCategory c2 m2 o2,
+             Eq c1, Eq m1, Eq o1, Eq c2, Eq m2, Eq o2) => 
+            o2 -> NaturalTransformation c1 m1 o1 c2 m2 o2 -> Maybe (Cocone c1 m1 o1 c2 m2 o2)
+    cocone nadir nat
+        | constantDiagram indexingCat universeCat nadir /= target nat = Nothing
+        | otherwise = Just result
+        where 
+            indexingCat = src.source $ nat
+            universeCat = tgt.source $ nat
+            result = unsafeCommaObject One nadir nat
+            
+    -- | Constructs a 'Cocone' from a nadir and a 'NaturalTransformation'. Does NOT check if the target of the 'NaturalTransformation' is a constant diagram on the nadir. You may use this function at your own risk, consider using 'cocone' if you are not sure.
+    --
+    -- If you give an incomplete natural transformation to this function, you can use 'completeCocone' to complete the natural transformation.
+    unsafeCocone :: o2 -> NaturalTransformation c1 m1 o1 c2 m2 o2 -> Cocone c1 m1 o1 c2 m2 o2
+    unsafeCocone nadir nat = unsafeCommaObject One nadir nat
+    
+    -- | Given a cocone with a partial underlying natural transformation, tries to complete it. You can use 'checkNaturalTransformation.legsCocone' to check that the cocone was correctly completed. 
+    completeCocone :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1, Morphism m2 o2) => Cocone c1 m1 o1 c2 m2 o2 -> Cocone c1 m1 o1 c2 m2 o2
+    completeCocone cc = unsafeCommaObject One (nadir cc) newNat
+        where
+            nat = legsCocone cc
+            prevComp = components nat
+            validArrowOnBottom x = [f | f <- arFrom (indexingCategory nat) x, (target f) `Set.isIn` (keys' prevComp)]
+            comp x
+                | not $ null $ prevComp |?| x = prevComp |?| x
+                | not $ Set.null $ validArrowOnBottom x = Just $ (prevComp |!| (target (anElement $ validArrowOnBottom x))) @ ((source nat) ->£ (anElement $ validArrowOnBottom x))
+                | otherwise = Nothing
+            newComp = weakMapFromSet $ Set.catMaybes [sequence (x,comp x) | x <- ob (indexingCategory nat)]
+            newNat = unsafeNaturalTransformation (source nat) (target nat) newComp
+    
     -- | Return the nadir of a `Cocone`.
     nadir :: Cocone c1 m1 o1 c2 m2 o2 -> o2
     nadir = indexTarget
 
     -- | Return the base of a 'Cocone'.
     baseCocone :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
-                                            Morphism m2 o2, Eq c2, Eq m2, Eq o2) => 
+                                            Morphism m2 o2) => 
             Cocone c1 m1 o1 c2 m2 o2 -> Diagram c1 m1 o1 c2 m2 o2
     baseCocone = source.selectedArrow
     
@@ -183,8 +313,69 @@                                                                     diagonalFunct = diagonalFunctor s t
             
     -- | Returns colimits of a diagram (initial cocones).
+    -- 
+    -- Note that the functions 'limits' and 'colimits' scan the entire 'ConeCategory' to find the limits and colimits of a 'Diagram'. It is therefore quite slow, if you work with a 'Category' where limits and colimits are easily constructible like in Set or in Cat, you should maybe construct them yourself or use Kan extensions of 'Math.Functors.SetValued' and the function 'colimitOfCompositionGraphs'.
     colimits :: (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) =>
                Diagram c1 m1 o1 c2 m2 o2 -> Set (Cocone c1 m1 o1 c2 m2 o2)
     colimits = initialObjects.coconeCategory
-    +    
+    -- | Return the category in which a 'Cone' lives.
+    universeCategoryCone :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
+                             Morphism m2 o2, Eq c2, Eq m2, Eq o2) => 
+        Cone c1 m1 o1 c2 m2 o2 -> c2
+    universeCategoryCone = tgt.source.legsCone
+    
+    -- | Return the category in which a 'Cocone' lives.
+    universeCategoryCocone :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
+                               Morphism m2 o2, Eq c2, Eq m2, Eq o2) => 
+        Cocone c1 m1 o1 c2 m2 o2 -> c2
+    universeCategoryCocone = tgt.source.legsCocone
+    
+    -- | Return the indexing category of a 'Cone'.
+    indexingCategoryCone :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
+                             Morphism m2 o2, Eq c2, Eq m2, Eq o2) => 
+        Cone c1 m1 o1 c2 m2 o2 -> c1
+    indexingCategoryCone = src.source.legsCone
+    
+    -- | Return the indexing category of a 'Cocone'.
+    indexingCategoryCocone :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
+                               Morphism m2 o2, Eq c2, Eq m2, Eq o2) => 
+        Cocone c1 m1 o1 c2 m2 o2 -> c1
+    indexingCategoryCocone = src.source.legsCocone
+    
+    
+    -- | The bottom objects of a category are all loop classes X such that all arrows going from X have target in X.                               
+    bottomObjects :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
+        c -> Set (Set o)
+    bottomObjects c = [loopClass | loopClass <- loopClasses c, Set.null $ Set.filter (\f -> (not (target f `isIn` loopClass)) && (source f `isIn` loopClass)) $ arrows c]
+                     
+    -- | Possible domains of the injective map to determine if a cocone is bottom contained in another.
+    possibleDomainsBottomContained :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
+        c -> Set [o]
+    possibleDomainsBottomContained c = set.setToList $ cartesianProductOfSets $ setToList $ bottomObjects c
+    
+    -- | A 'Cocone' c1 is bottom contained in another 'Cocone' c2 if every bottom leg of c1 is a leg of c2 in an injective manner.
+    bottomInjectionsCocone :: (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,
+                          Morphism m3 o3, Eq c3, Eq m3, Eq o3) => 
+        Cocone c1 m1 o1 c3 m3 o3 -> Cocone c2 m2 o2 c3 m3 o3 -> Set (Map o1 o2)
+    bottomInjectionsCocone cc1 cc2
+        | nadir cc1 == nadir cc2 = maps
+        | otherwise = set []
+        where
+            doms = possibleDomainsBottomContained $ indexingCategoryCocone cc1
+            maps = Set.concat2 [enumerateInjectiveMaps (\x y -> legsCocone cc1 =>$ x == legsCocone cc2 =>$ y) (set dom) (ob (indexingCategoryCocone cc2)) | dom <- doms]
+            
+     -- | Precompose a cocone with a functor going to the universe category.
+    precomposeCoconeWithFunctor :: (      Category 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,
+                                                       Morphism m3 o3, Eq c3, Eq m3, Eq o3) =>
+        Cocone c2 m2 o2 c3 m3 o3 -> Diagram c1 m1 o1 c2 m2 o2 -> Cocone c1 m1 o1 c3 m3 o3
+    precomposeCoconeWithFunctor cc f = unsafeCommaObject One (nadir cc) ((legsCocone cc) <=@<- f)
+    
+    -- | Postcompose a cone with a morphism going from the nadir. (Does not check that the morphism has the nadir as source.)
+    postcomposeCoconeWithMorphism :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
+                                            Category c2 m2 o2, Morphism m2 o2) =>
+        Cocone c1 m1 o1 c2 m2 o2 -> m2 -> Cocone c1 m1 o1 c2 m2 o2
+    postcomposeCoconeWithMorphism cc m = unsafeCommaObject One (target m) (unsafeNaturalTransformation (source $ legsCocone cc) (constantDiagram (src.target.legsCocone $ cc) (tgt.target.legsCocone $ cc) (target m)) ((m @) <$> (components $ legsCocone cc)))
src/Math/Categories/FinCat.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, MonadComprehensions  #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
 Description : __'FinCat'__ is the category of finite categories, 'FinFunctor's are the morphisms of __'FinCat'__.
@@ -31,12 +35,15 @@     import              Data.WeakMap             (Map)
     import qualified    Data.WeakMap           as Map
     import              Data.WeakMap.Safe
+    import              Data.Simplifiable
     
     import              Math.Category
     import              Math.FiniteCategory
     import              Math.Categories.FunctorCategory
     import              Math.IO.PrettyPrint
     
+    import              GHC.Generics
+    
     -- | A `FinFunctor` /funct/ between two categories is a map between objects and a map between arrows of the two categories such that :
     --
     -- prop> funct ->$ (source f) == source (funct ->£ f)
@@ -51,22 +58,18 @@     -- See 'Diagram' in Math.Categories.FunctorCategory for heterogeneous ones.
     type FinFunctor c m o = Diagram c m o c m o
     
-    instance (Eq c, Eq m, Eq o) => Morphism (Diagram c m o c m o) c where
-        (@?) Diagram{src=s2,tgt=t2,omap=om2,mmap=fm2} Diagram{src=s1,tgt=t1,omap=om1,mmap=fm1}
-            | t1 /= s2 = Nothing
-            | otherwise = Just Diagram{src=s1,tgt=t2,omap=om2|.|om1,mmap=fm2|.|fm1}
+    instance (Category c m o, Morphism m o, Eq m, Eq o) => Morphism (FinFunctor c m o) c where
+        (@) d2 d1 = d2 <-@<- d1
         source = src
         target = tgt
           
     -- | The __'FinCat'__ category has as objects finite categories and as morphisms homogeneous functors between them.
-    data FinCat c m o = FinCat deriving (Eq, Show)
+    data FinCat c m o = FinCat deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
-    instance (FiniteCategory c m o, Morphism m o, Eq c, Eq m, Eq o) => Category (FinCat c m o) (Diagram c m o c m o) c where
-        identity _ cat = Diagram{src=cat,tgt=cat,omap=memorizeFunction id (ob cat),mmap=memorizeFunction id (arrows cat)}
+    instance (FiniteCategory c m o, Morphism m o, Eq c, Eq m, Eq o) => Category (FinCat c m o) (FinFunctor c m o) c where
+        identity _ cat = Diagram{src=cat,tgt=cat,omap=memorizeFunction id (ob cat),mmap=memorizeFunction id (genArrows cat)}
         ar _ s t = snd.(Set.catEither) $ [diagram s t appO appF | appO <- appObj, appF <- ((fmap $ (Map.unions)).cartesianProductOfSets) [twoObjToMaps a b appO| a <- (setToList $ ob s), b <- (setToList $ ob s)]]
             where
                 appObj = Map.enumerateMaps (ob s) (ob t)
                 twoObjToMaps a b appO = Map.enumerateMaps (ar s a b) (ar t (appO |!| a) (appO |!| b))
-                    
-    instance PrettyPrint (FinCat c m o) where
-        pprint = show+
src/Math/Categories/FinGrph.hs view
@@ -1,5 +1,10 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, MonadComprehensions #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
+
 {-| Module  : FiniteCategories
 Description : The __'FinGrph'__ category has finite multidigraphs as objects and multidigraph homomorphisms as morphisms.
 Copyright   : Guillaume Sabbagh 2022
@@ -22,6 +27,9 @@     -- ** Smart constructors
     graph,
     unsafeGraph,
+    -- ** Transformation
+    mapOnNodes,
+    mapOnEdges,
     -- * Graph homomorphism
     GraphHomomorphism,
     -- ** Getters
@@ -39,7 +47,12 @@ where
     import              Math.Category
     import              Math.FiniteCategory
+    import              Math.CompleteCategory
+    import              Math.CocompleteCategory
     import              Math.IO.PrettyPrint
+    import              Math.Categories.FunctorCategory
+    import              Math.Categories.ConeCategory
+    import              Math.FiniteCategories.Parallel
     
     import              Data.WeakSet        (Set)
     import qualified    Data.WeakSet    as  Set
@@ -47,17 +60,22 @@     import              Data.WeakMap        (Map)
     import qualified    Data.WeakMap    as  Map
     import              Data.WeakMap.Safe
+    import              Data.Simplifiable
     
+    import              GHC.Generics
+    
     -- | An 'Arrow' is composed of a source node, a target node and a label.
     data Arrow n e = Arrow{
                             sourceArrow :: n,
                             targetArrow :: n,
                             labelArrow :: e
                           }
-                          deriving (Eq, Show)
+                          deriving (Eq, Show, Generic, Simplifiable)
     
     instance (PrettyPrint n, PrettyPrint e) => PrettyPrint (Arrow n e) where
-        pprint a = (pprint $ sourceArrow a)++"-"++(pprint $ labelArrow a)++"->"++(pprint $ targetArrow a)
+        pprint v a = (pprint v $ sourceArrow a)++"-"++(pprint v $ labelArrow a)++"->"++(pprint v $ targetArrow a)
+        
+        -- pprintWithIndentations cv ov indent a = indentation (ov - cv) indent ++  (pprint cv $ sourceArrow a)++"-"++(pprint cv $ labelArrow a)++"->"++(pprint cv $ targetArrow a) ++ "\n"
     
     -- | A 'Graph' is a set of nodes and a set of 'Arrow's.
     -- 
@@ -65,12 +83,12 @@     data Graph n e = Graph {
                         nodes :: Set n, -- ^ The set of nodes of the graph.
                         edges :: Set (Arrow n e) -- ^ The set of arrows of the graph.
-                        } deriving (Eq)
+                        } deriving (Eq, Generic, PrettyPrint, Simplifiable)
     
     instance (Show n, Show e) => Show (Graph n e) where
         show g = "(unsafeGraph "++(show $ nodes g)++" "++(show $ edges g)++")"
     
-    -- | Smart constructor of 'Graph'.
+    -- | Smart constructor of 'Graph'. The only error possible when creating a 'Graph' is that the source or target of an arrow is not in the set of nodes of the 'Graph'.
     graph :: (Eq n) => Set n -> Set (Arrow n e) -> Maybe (Graph n e)
     graph ns es
         | (sourceArrow <$> es) `isIncludedIn` ns && (targetArrow <$> es) `isIncludedIn` ns = Just Graph{nodes=ns, edges=es}
@@ -80,9 +98,18 @@     unsafeGraph :: Set n -> Set (Arrow n e) -> Graph n e
     unsafeGraph n e = Graph{nodes=n, edges=e}
     
-    instance (PrettyPrint n, PrettyPrint e, Eq n, Eq e) => PrettyPrint (Graph n e) where
-        pprint g = "Graph ("++(pprint $ nodes g)++", "++(pprint $ edges g)++")"
+    -- | Map a function on nodes of a 'Graph'.
+    mapOnNodes :: (n1 -> n2) -> Graph n1 e -> Graph n2 e
+    mapOnNodes transformNode g = Graph {nodes = transformNode <$> nodes g, edges = transformArrow <$> edges g}
+        where
+            transformArrow arr = Arrow{sourceArrow = transformNode $ sourceArrow arr, targetArrow = transformNode $ targetArrow arr, labelArrow = labelArrow arr}
     
+    -- | Map a function on edges of a 'Graph'.
+    mapOnEdges :: (e1 -> e2) -> Graph n e1 -> Graph n e2
+    mapOnEdges transformEdge g = Graph {nodes = nodes g, edges = transformArrow <$> edges g}
+        where
+            transformArrow arr = Arrow{sourceArrow = sourceArrow arr, targetArrow = targetArrow arr, labelArrow = transformEdge $ labelArrow arr}
+    
     -- | A 'GraphHomomorphism' is composed of a map between the nodes of the graphs, a map between the edges of the graphs, and the target 'Graph' so that we can recover it from the morphism.
     --
     -- It must follow axioms such that the image of an arrow is not torn appart, that is why the constructor is private. Use the smart constructor 'graphHomomorphism' instead.
@@ -90,7 +117,7 @@                                     nodeMap :: Map n n, -- ^ The mapping of nodes.
                                     edgeMap :: Map (Arrow n e) (Arrow n e), -- ^ The mapping of edges.
                                     targetGraph :: Graph n e -- ^ The target graph.
-                                    } deriving (Eq)
+                                    } deriving (Eq, Generic, Simplifiable)
     
     -- | Check wether the structure of 'GraphHomomorphism' is respected or not.
     checkGraphHomomorphism :: (Eq n, Eq e) => GraphHomomorphism n e -> Bool
@@ -115,22 +142,20 @@         show gh = "(unsafeGraphHomomorphism "++(show $ nodeMap gh)++" "++(show $ edgeMap gh)++ " " ++ (show $ targetGraph gh) ++")"
     
     instance (PrettyPrint n, PrettyPrint e, Eq n, Eq e) => PrettyPrint (GraphHomomorphism n e) where
-        pprint gh = "("++(pprint $ nodeMap gh)++", "++(pprint $ edgeMap gh)++")"
+        pprint v gh = "GH("++(pprint (v-1) $ nodeMap gh)++", "++(pprint (v-1) $ edgeMap gh)++")"
         
+        -- pprintWithIndentations 0 ov indent gh = indentation ov indent ++ "...\n"
+        -- pprintWithIndentations cv ov indent gh = indentation (ov - cv) indent ++  "GH\n" ++ (pprintWithIndentations (cv-1) ov indent (nodeMap gh)) ++ (pprintWithIndentations (cv-1) ov indent (edgeMap gh))
+        
     instance (Eq n, Eq e) => Morphism (GraphHomomorphism n e) (Graph n e) where
         source gh = Graph {nodes = (domain.nodeMap) gh, edges = (domain.edgeMap) gh}
         target = targetGraph
-        (@?) gh2 gh1
-            | target gh1 == source gh2 = Just $ GraphHomomorphism {nodeMap = (nodeMap gh2) |.| (nodeMap gh1), edgeMap = (edgeMap gh2) |.| (edgeMap gh1), targetGraph = target gh2}
-            | otherwise = Nothing
+        (@) gh2 gh1 =  GraphHomomorphism {nodeMap = (nodeMap gh2) |.| (nodeMap gh1), edgeMap = (edgeMap gh2) |.| (edgeMap gh1), targetGraph = target gh2}
     
     -- | The category of finite graphs.
-    data FinGrph n e = FinGrph deriving (Eq, Show)
-    
-    instance (PrettyPrint n, PrettyPrint e, Eq n, Eq e) => PrettyPrint (FinGrph n e) where
-        pprint = show
+    data FinGrph n e = FinGrph deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
         
-    instance (Eq n, Eq e, Show n ,Show e) => Category (FinGrph n e) (GraphHomomorphism n e) (Graph n e) where
+    instance (Eq n, Eq e) => Category (FinGrph n e) (GraphHomomorphism n e) (Graph n e) where
         identity _ g = GraphHomomorphism {nodeMap = (idFromSet.nodes) g, edgeMap = (idFromSet.edges) g, targetGraph = g}
         ar _ s t = [GraphHomomorphism
             {
@@ -140,6 +165,110 @@                 appObj = Map.enumerateMaps (nodes s) (nodes t)
                 twoObjToEdgeMaps n1 n2 nMap = Map.enumerateMaps (Set.filter (\a -> sourceArrow a == n1 && targetArrow a == n2) (edges s)) (Set.filter (\a -> sourceArrow a == nMap |!| n1 && targetArrow a == nMap |!| n2) (edges t))
     
+    instance (Eq n, Eq e, Eq oIndex) => HasProducts (FinGrph n e) (GraphHomomorphism n e) (Graph n e) (FinGrph (Limit oIndex n) (Limit oIndex e)) (GraphHomomorphism (Limit oIndex n) (Limit oIndex e)) (Graph (Limit oIndex n) (Limit oIndex e)) oIndex where
+        product discreteDiag = unsafeCone productGraph nat
+            where
+                indexingCat = src discreteDiag
+                productGraph = Graph{nodes = productNodes, edges = productEdges}
+                productNodes = (ProductElement).weakMap <$> cartesianProductOfSets (setToList [(\x -> (i,x)) <$> (nodes (discreteDiag ->$ i)) | i <- ob indexingCat])
+                productEdges = (\tupleEdges -> Arrow{sourceArrow = ProductElement (sourceArrow <$> tupleEdges), targetArrow = ProductElement (targetArrow <$> tupleEdges), labelArrow = ProductElement (labelArrow <$> tupleEdges)}) <$> weakMap <$> cartesianProductOfSets (setToList [(\x -> (i,x)) <$> (edges (discreteDiag ->$ i)) | i <- ob indexingCat])
+                newDiag = completeDiagram Diagram{src = indexingCat, tgt = FinGrph, omap = projectGraph <$> omap discreteDiag, mmap = weakMap []}
+                nat = unsafeNaturalTransformation (constantDiagram (src discreteDiag) FinGrph productGraph) newDiag (Map.weakMapFromSet [(i, leg i) | i <- ob indexingCat])
+                projectArrow a = Arrow{sourceArrow = Projection $ sourceArrow a, targetArrow = Projection $ targetArrow a, labelArrow = Projection $ labelArrow a}
+                projectGraph g = Graph{nodes = Projection <$> nodes g, edges = projectArrow <$> edges g}
+                leg i = GraphHomomorphism{targetGraph = projectGraph (discreteDiag ->$ i), nodeMap = Map.weakMapFromSet [(n, Projection $ tuple |!| i) | n@(ProductElement tuple)  <- nodes productGraph], edgeMap = Map.weakMapFromSet [(e, Arrow{sourceArrow = Projection $ (extractProd.sourceArrow $ e) |!| i , targetArrow = Projection $  (extractProd.targetArrow $ e) |!| i, labelArrow = Projection $ (extractProd.labelArrow $ e) |!| i}) | e <- edges productGraph]}
+                extractProd (ProductElement x) = x
+    
+    instance (Eq n, Eq e) => HasEqualizers (FinGrph n e) (GraphHomomorphism n e) (Graph n e) where
+        equalize parallelDiag = unsafeCone equalizedGraph nat
+            where
+                equalizedGraph = Graph{nodes = Set.filter (\n -> (nodeMap (parallelDiag ->£ ParallelF)) |!| n == (nodeMap (parallelDiag ->£ ParallelG)) |!| n)  (nodes (parallelDiag ->$ ParallelA)), edges = Set.filter (\e -> (edgeMap (parallelDiag ->£ ParallelF)) |!| e == (edgeMap (parallelDiag ->£ ParallelG)) |!| e)  (edges (parallelDiag ->$ ParallelA))}
+                mappingNode i = memorizeFunction id (nodes equalizedGraph)
+                mappingEdge i = memorizeFunction id (edges equalizedGraph)
+                constDiag = constantDiagram Parallel FinGrph equalizedGraph
+                nat = (unsafeNaturalTransformation constDiag parallelDiag (weakMap [(ParallelA,legA), (ParallelB, (parallelDiag ->£ ParallelF) @ legA) ]))
+                legA = GraphHomomorphism {nodeMap=mappingNode ParallelA, edgeMap = mappingEdge ParallelA, targetGraph = parallelDiag ->$ ParallelA}
+                
+    instance (Eq n, Eq e, Eq mIndex, Eq oIndex) => CompleteCategory (FinGrph n e) (GraphHomomorphism n e) (Graph n e) (FinGrph (Limit oIndex n) (Limit oIndex e)) (GraphHomomorphism (Limit oIndex n) (Limit oIndex e)) (Graph (Limit oIndex n) (Limit oIndex e)) cIndex mIndex oIndex where
+        limit = limitFromProductsAndEqualizers projectGraphHomomorphism
+            where
+                projectArrow a = Arrow{sourceArrow = Projection $ sourceArrow a, targetArrow = Projection $ targetArrow a, labelArrow = Projection $ labelArrow a}
+                projectGraph g = Graph{nodes = Projection <$> nodes g, edges = projectArrow <$> edges g}
+                projectGraphHomomorphism gh = GraphHomomorphism{nodeMap = doubleProject <|$|> nodeMap gh, edgeMap = doubleProjectArrow <|$|> edgeMap gh, targetGraph = projectGraph $ targetGraph gh}
+                doubleProject (x,y) = (Projection x, Projection y)
+                doubleProjectArrow (x,y) = (projectArrow x, projectArrow y)
+                
+        projectBase diag = Diagram{src = FinGrph, tgt = FinGrph, omap = memorizeFunction projectGraph (Map.values (omap diag)), mmap = memorizeFunction projectGraphHomomorphism (Map.values (mmap diag))}
+            where
+                projectArrow a = Arrow{sourceArrow = Projection $ sourceArrow a, targetArrow = Projection $ targetArrow a, labelArrow = Projection $ labelArrow a}
+                projectGraph g = Graph{nodes = Projection <$> nodes g, edges = projectArrow <$> edges g}
+                projectGraphHomomorphism gh = GraphHomomorphism{nodeMap = doubleProject <|$|> nodeMap gh, edgeMap = doubleProjectArrow <|$|> edgeMap gh, targetGraph = projectGraph $ targetGraph gh}
+                doubleProject (x,y) = (Projection x, Projection y)
+                doubleProjectArrow (x,y) = (projectArrow x, projectArrow y)
+                
+    instance (Eq n, Eq e, Eq oIndex) => HasCoproducts (FinGrph n e) (GraphHomomorphism n e) (Graph n e) (FinGrph (Colimit oIndex n) (Colimit oIndex e)) (GraphHomomorphism (Colimit oIndex n) (Colimit oIndex e)) (Graph (Colimit oIndex n) (Colimit oIndex e)) oIndex where
+        coproduct discreteDiag = result
+            where
+                indexingCat = src discreteDiag
+                coprod = Graph{nodes = Set.unions (setToList [CoproductElement i <$> nodes (discreteDiag ->$ i) | i <- ob indexingCat]), edges = Set.unions (setToList [coproductArrow i <$> edges (discreteDiag ->$ i) | i <- ob indexingCat])}
+                coproductArrow i a = Arrow{sourceArrow = CoproductElement i (sourceArrow a), targetArrow = CoproductElement i (targetArrow a), labelArrow = CoproductElement i (labelArrow a)}
+                constDiag = constantDiagram indexingCat FinGrph coprod
+                coprojectArrow a = Arrow{sourceArrow = Coprojection $ sourceArrow a, targetArrow = Coprojection $ targetArrow a, labelArrow = Coprojection $ labelArrow a}
+                transformGraph g = Graph{nodes = Coprojection <$> nodes g, edges = coprojectArrow <$> edges g}
+                transformGH GraphHomomorphism{nodeMap = nm, edgeMap = em, targetGraph = tg} = GraphHomomorphism{nodeMap = weakMapFromSet [(Coprojection k, Coprojection v) | (k,v) <- Map.mapToSet nm], edgeMap = weakMapFromSet [(coprojectArrow k, coprojectArrow v) | (k,v) <- Map.mapToSet em], targetGraph = transformGraph tg}
+                newDiag = Diagram{src = indexingCat, tgt = FinGrph, omap = transformGraph <$> (omap discreteDiag), mmap = transformGH <$> (mmap discreteDiag)}
+                mapping i = GraphHomomorphism{nodeMap = memorizeFunction (\(Coprojection x) -> CoproductElement i x) (nodes (newDiag ->$ i)), edgeMap = memorizeFunction (\Arrow{sourceArrow = Coprojection s, targetArrow = Coprojection t, labelArrow = Coprojection l} -> Arrow{sourceArrow = CoproductElement i s, targetArrow = CoproductElement i t, labelArrow = CoproductElement i l}) (edges (newDiag ->$ i)), targetGraph = coprod}
+                result = unsafeCocone coprod $ unsafeNaturalTransformation newDiag constDiag (memorizeFunction mapping (ob indexingCat))
+                
+    -- | BEWARE, for the coequalizer to be correct, ALL arrow labels should be different (two arrows with different source and target might have the same source and target after the coequalization process).
+    instance (Eq e, Eq n) => HasCoequalizers (FinGrph n e) (GraphHomomorphism n e) (Graph n e) where
+        coequalize parallelDiag = result
+            where
+                glueEdge edge gh
+                    | imageEdgeByF == imageEdgeByG = gh
+                    | otherwise = GraphHomomorphism{nodeMap = nodeMap gh, edgeMap = Map.adjust (const $ imageEdgeByG) imageEdgeByF (edgeMap gh), targetGraph = newGraph}
+                    where
+                        imageEdgeByF = (edgeMap (parallelDiag ->£ ParallelF)) |!| edge
+                        imageEdgeByG = (edgeMap (parallelDiag ->£ ParallelG)) |!| edge
+                        newGraph = Graph{nodes = nodes (target gh), edges = Set.delete imageEdgeByF (edges (target gh))}
+                glueNode node gh
+                    | imageNodeByF == imageNodeByG = gh
+                    | otherwise = GraphHomomorphism{nodeMap = Map.adjust (const $ imageNodeByG) imageNodeByF (nodeMap gh), edgeMap = updateArrow <$> edgeMap gh, targetGraph = newGraph}
+                    where
+                        imageNodeByF = (nodeMap (parallelDiag ->£ ParallelF)) |!| node
+                        imageNodeByG = (nodeMap (parallelDiag ->£ ParallelG)) |!| node
+                        updateNode n = if n == imageNodeByF then imageNodeByG else n
+                        updateArrow a = Arrow{sourceArrow = updateNode (sourceArrow a), targetArrow = updateNode (targetArrow a), labelArrow = labelArrow a}
+                        newGraph = Graph{nodes = Set.delete imageNodeByF (nodes (target gh)), edges = updateArrow <$> edges (target gh)}
+                gh1 = Set.foldr glueEdge (identity FinGrph (parallelDiag ->$ ParallelB)) (edges (parallelDiag ->$ ParallelA))
+                gh2 = Set.foldr glueNode gh1 (nodes (parallelDiag ->$ ParallelA))
+                constDiag = constantDiagram Parallel FinGrph (target gh2)
+                result = unsafeCocone (target gh2) (unsafeNaturalTransformation parallelDiag constDiag (weakMap [(ParallelA,gh2 @ (parallelDiag ->£ ParallelF)), (ParallelB, gh2) ]))
+        
+    instance (Eq e, Eq n, Eq mIndex, Eq oIndex) => CocompleteCategory (FinGrph n e) (GraphHomomorphism n e) (Graph n e) (FinGrph (Colimit oIndex n) (Colimit oIndex e)) (GraphHomomorphism (Colimit oIndex n) (Colimit oIndex e)) (Graph (Colimit oIndex n) (Colimit oIndex e)) cIndex mIndex oIndex where
+        colimit = colimitFromCoproductsAndCoequalizers transformGHToColimGH
+            where
+                transformGHToColimGH gh = GraphHomomorphism{nodeMap = both Coprojection <|$|> nodeMap gh, edgeMap = both coprojectArrow <|$|> edgeMap gh, targetGraph = coprojectTargetGraph (targetGraph gh)}
+                coprojectArrow a = Arrow{sourceArrow = Coprojection $ sourceArrow a, targetArrow = Coprojection $ targetArrow a, labelArrow = Coprojection $ labelArrow a}
+                both f (x,y) = (f x,f y)
+                coprojectTargetGraph g = Graph{nodes = Coprojection <$> nodes g, edges = coprojectArrow <$> edges g}
+        
+        coprojectBase diag = Diagram{src = FinGrph, tgt = FinGrph, omap = memorizeFunction coprojectGraph (Map.values (omap diag)), mmap = memorizeFunction transformGHToColimGH (Map.values (mmap diag))}
+            where
+                transformGHToColimGH gh = GraphHomomorphism{nodeMap = both Coprojection <|$|> nodeMap gh, edgeMap = both coprojectArrow <|$|> edgeMap gh, targetGraph = coprojectGraph (targetGraph gh)}
+                coprojectArrow a = Arrow{sourceArrow = Coprojection $ sourceArrow a, targetArrow = Coprojection $ targetArrow a, labelArrow = Coprojection $ labelArrow a}
+                both f (x,y) = (f x,f y)
+                coprojectGraph g = Graph{nodes = Coprojection <$> nodes g, edges = coprojectArrow <$> edges g}
+        
+        
+        
+        
+        
+        
+        
+        
+        
+        
     -- | Return the underlying graph of a 'FiniteCategory'.
     underlyingGraph :: (FiniteCategory c m o, Morphism m o) => c -> Graph o m
     underlyingGraph c = Graph{
src/Math/Categories/FinSet.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
 Description : The __'FinSet'__ category has finite sets as objects and functions as morphisms.
@@ -27,11 +31,18 @@ )
 where
     import              Math.Category
+    import              Math.FiniteCategory
     import              Math.Categories.ConeCategory
     import              Math.Categories.FunctorCategory
     import              Math.FiniteCategories.DiscreteCategory
+    import              Math.FiniteCategories.DiscreteTwo
+    import              Math.FiniteCategories.Parallel
     import              Math.IO.PrettyPrint
     
+    import              Math.CompleteCategory
+    import              Math.CocompleteCategory
+    import              Math.CartesianClosedCategory
+    
     import              Data.WeakSet        (Set)
     import qualified    Data.WeakSet    as  Set
     import              Data.WeakSet.Safe
@@ -40,6 +51,9 @@     import              Data.WeakMap.Safe
     import              Data.List           (nub)
     import              Data.Maybe          (fromJust)
+    import              Data.Simplifiable
+    
+    import              GHC.Generics
 
     
     -- | A 'Function' (finite function) is a weak map enriched with a codomain.
@@ -51,21 +65,24 @@                                 codomain :: Set a
                             }
                         deriving
-                            (Eq, Show)
+                            (Eq, Show, Generic, Simplifiable)
     
+    instance (PrettyPrint a, Eq a) => PrettyPrint (Function a) where
+        pprint v a = pprint v (function a)
+        
+        -- pprintWithIndentations cv ov indent a = pprintWithIndentations cv ov indent (function a)
+        
     instance (Eq a) => Morphism (Function a) (Set a) where
         source = domain.function
         target = codomain
-        (@?) f2 f1
-            | target f1 == source f2 = Just Function{function = (function f2) |.| (function f1), codomain = codomain f2}
-            | otherwise = Nothing
+        (@) f2 f1 = Function{function = (function f2) |.| (function f1), codomain = codomain f2}
             
     -- | A function to apply a 'Function' to an object in the domain of the 'Function'.
     (||!||) :: (Eq a) => Function a -> a -> a
     (||!||) f x = (function f) |!| x
     
     -- | __'FinSet'__ is the category of finite sets.
-    data FinSet a = FinSet deriving (Eq, Show)
+    data FinSet a = FinSet deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance (Eq a) => Category (FinSet a) (Function a) (Set a) where
         identity _ s = Function {function = idFromSet s, codomain = s}
@@ -78,16 +95,77 @@                 images = (t |^| (length domain))
                 functions = weakMap <$> zip domain <$> images
                 
-    -- instance (Eq a) => HasFiniteProducts (FinSet a) (Set a) (Function [a]) (Set [a]) where
-        -- product _ diag2 = result
-            -- where
-                -- prod = cartesianProductOfSets (elems (omap diag2))
-                -- diag1 = constantDiagram (source diag2) FinSet prod
-                -- mapping i = memorizeFunction (\_ -> (!! i) <$> prod) prod
-                -- Just result = naturalTransformationToCone $ unsafeNaturalTransformation diag1 diag2 (weakMap [(i,Function {function=mapping i, codomain = image (mapping i)}) | i <- [0..((Map.size (omap diag2))-1)]])
-       
-    instance (PrettyPrint a, Eq a) => PrettyPrint (Function a) where
-        pprint = pprint.function
+    instance (Eq a, Eq oIndex) => HasProducts (FinSet a) (Function a) (Set a) (FinSet (Limit oIndex a)) (Function (Limit oIndex a)) (Set (Limit oIndex a)) oIndex where
+        product discreteDiag = result
+            where
+                indexingCat = src discreteDiag
+                prod = (ProductElement).weakMap <$> cartesianProductOfSets (setToList [(\x -> (i,x)) <$> (discreteDiag ->$ i) | i <- ob indexingCat])
+                mapping i = memorizeFunction (\(ProductElement tuple) -> Projection (tuple |!| i)) prod
+                constDiag = constantDiagram indexingCat FinSet prod
+                transformObject x = [Projection e | e <- x]
+                transformFunction Function{function = m, codomain = cod} = Function{function = weakMapFromSet [(Projection k, Projection v) | (k,v) <- Map.mapToSet m], codomain = transformObject cod}
+                newDiag = Diagram{src = src discreteDiag, tgt = FinSet, omap = transformObject <$> (omap discreteDiag), mmap = transformFunction <$> (mmap discreteDiag)}
+                result = unsafeCone prod (unsafeNaturalTransformation constDiag newDiag (weakMapFromSet [(i,Function {function=mapping i, codomain = newDiag ->$ i}) | i <- ob indexingCat]))
+                
+    instance (Eq a) => HasEqualizers (FinSet a) (Function a) (Set a) where
+        equalize parallelDiag = result
+            where
+                equalizer = [e | e <- parallelDiag ->$ ParallelA, (parallelDiag ->£ ParallelF) ||!|| e == (parallelDiag ->£ ParallelG) ||!|| e]
+                mapping i = memorizeFunction id equalizer
+                constDiag = constantDiagram Parallel FinSet equalizer
+                result = unsafeCone equalizer (unsafeNaturalTransformation constDiag parallelDiag (weakMap [(ParallelA,legA), (ParallelB, (parallelDiag ->£ ParallelF) @ legA) ]))
+                legA = Function {function=mapping ParallelA, codomain = parallelDiag ->$ ParallelA}
+    
+    _projectMorphism m = Function{function = weakMapFromSet [(Projection k, Projection v) | (k,v) <- (Map.mapToSet.function) m], codomain = Projection <$> codomain m}
+    
+    instance (Eq a, Eq mIndex, Eq oIndex) => CompleteCategory (FinSet a) (Function a) (Set a) (FinSet (Limit oIndex a)) (Function (Limit oIndex a)) (Set (Limit oIndex a)) cIndex mIndex oIndex where
+        limit = limitFromProductsAndEqualizers _projectMorphism
         
-    instance (PrettyPrint a, Eq a) => PrettyPrint (FinSet a) where
-        pprint = show
+        projectBase diag = Diagram{src = FinSet, tgt = FinSet, omap = memorizeFunction (fmap Projection) (Map.values (omap diag)), mmap = memorizeFunction _projectMorphism (Map.values (mmap diag))}
+        
+    
+    instance (Eq a, Eq oIndex) => HasCoproducts (FinSet a) (Function a) (Set a) (FinSet (Colimit oIndex a)) (Function (Colimit oIndex a)) (Set (Colimit oIndex a)) oIndex where
+        coproduct discreteDiag = result
+            where
+                indexingCat = src discreteDiag
+                coprod = Set.unions (setToList [CoproductElement i <$> (discreteDiag ->$ i) | i <- ob indexingCat])
+                constDiag = constantDiagram indexingCat FinSet coprod
+                transformObject x = [Coprojection e | e <- x]
+                transformFunction Function{function = m, codomain = cod} = Function{function = weakMapFromSet [(Coprojection k, Coprojection v) | (k,v) <- Map.mapToSet m], codomain = transformObject cod}
+                newDiag = Diagram{src = indexingCat, tgt = FinSet, omap = transformObject <$> (omap discreteDiag), mmap = transformFunction <$> (mmap discreteDiag)}
+                mapping i = memorizeFunction (\(Coprojection x) -> CoproductElement i x) (newDiag ->$ i)
+                result = unsafeCocone coprod (unsafeNaturalTransformation newDiag constDiag (weakMapFromSet [(i,Function {function=mapping i, codomain = coprod}) | i <- ob indexingCat]))
+                
+    instance (Eq a) => HasCoequalizers (FinSet a) (Function a) (Set a) where
+        coequalize parallelDiag = result
+            where
+                glue x (s,mapping)
+                    | (parallelDiag ->£ ParallelF) ||!|| x == (parallelDiag ->£ ParallelG) ||!|| x = (s,mapping)
+                    | otherwise = (Set.delete ((parallelDiag ->£ ParallelF) ||!|| x) s, Map.adjust (const $ (parallelDiag ->£ ParallelG) ||!|| x) ((parallelDiag ->£ ParallelF) ||!|| x) mapping)
+                (coequalizer,mapping) = Set.foldr glue ((parallelDiag ->$ ParallelB),memorizeFunction id (parallelDiag ->$ ParallelB)) (parallelDiag ->$ ParallelA) 
+                constDiag = constantDiagram Parallel FinSet coequalizer
+                result = unsafeCocone coequalizer (unsafeNaturalTransformation parallelDiag constDiag (weakMap [(ParallelA,Function {function=mapping, codomain = coequalizer} @ (parallelDiag ->£ ParallelF)), (ParallelB, Function {function=mapping, codomain = coequalizer}) ]))
+                
+    
+    instance (Eq a, Eq mIndex, Eq oIndex) => CocompleteCategory (FinSet a) (Function a) (Set a) (FinSet (Colimit oIndex a)) (Function (Colimit oIndex a)) (Set (Colimit oIndex a)) cIndex mIndex oIndex where
+        colimit = colimitFromCoproductsAndCoequalizers transformMorphismIntoColimMorphism
+            where   
+                transformMorphismIntoColimMorphism m = Function{function = weakMapFromSet [(Coprojection k, Coprojection v) | (k,v) <- (Map.mapToSet.function) m], codomain = Coprojection <$> codomain m}
+                
+        coprojectBase diag = Diagram{src = FinSet, tgt = FinSet, omap = memorizeFunction (fmap Coprojection) (Map.values (omap diag)), mmap = memorizeFunction transformMorphismIntoColimMorphism (Map.values (mmap diag))}
+            where
+                transformMorphismIntoColimMorphism m = Function{function = weakMapFromSet [(Coprojection k, Coprojection v) | (k,v) <- (Map.mapToSet.function) m], codomain = Coprojection <$> codomain m}
+                
+    instance (Eq a) => CartesianClosedCategory (FinSet a) (Function a) (Set a) (FinSet (TwoProduct a)) (Function (TwoProduct a)) (Set (TwoProduct a)) (FinSet (Cartesian a)) (Function (Cartesian a)) (Set (Cartesian a))  where
+        internalHom twoBase = unsafeTripod twoLimit evalMap_
+            where
+                powerObject = [ExponentialElement (function m) | m <- ar FinSet (twoBase ->$ A) (twoBase ->$ B)]
+                newInternalDomain = Exprojection <$> twoBase ->$ A
+                baseTwoCone = completeDiagram Diagram{src = DiscreteTwo, tgt = FinSet, omap = weakMap [(A,powerObject),(B,newInternalDomain)], mmap = weakMap []}
+                twoLimit = limit baseTwoCone
+                eval tuple = (Projection (Exprojection $ m |!| x))
+                    where
+                        (ExponentialElement m) = tuple |!| A
+                        (Exprojection x)  = tuple |!| B
+                finalInternalCodomain = Projection <$> (Exprojection <$> twoBase ->$ A)
+                evalMap_ = Function{function = Map.weakMapFromSet [(ProductElement tuple, eval tuple) | (ProductElement tuple) <- apex twoLimit], codomain = finalInternalCodomain}
+ src/Math/Categories/FinSketch.hs view
@@ -0,0 +1,532 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonadComprehensions #-}+{-# LANGUAGE MultiParamTypeClasses #-}++{-| Module  : FiniteCategories+Description : A 'Sketch' is a category equipped with distinguished cones, cocones and tripods.+Copyright   : Guillaume Sabbagh 2022+License     : GPL-3+Maintainer  : guillaumesabbagh@protonmail.com+Stability   : experimental+Portability : portable++A 'Sketch' is a category equipped with distinguished cones, cocones and tripods. (In litterature, a mixed sketch only distinguishes cones and cocones but we add exponential objects to model second-order logical structures.)++The category is represented by a composition graph.++-}++module Math.Categories.FinSketch+(+    -- * Types for Sketch+    CategorySketch(..),+    ArrowSketch(..),+    ObjectSketch(..),+    ConeSketch(..),+    CoconeSketch(..),+    TripodSketch(..),+    FunctorSketch(..),+    SketchError(..),+    constructTwoConeFromTripod,+    constructTwoConeFromTripodText,+    -- * Sketch+    Sketch,+    -- ** Getters+    underlyingCategory,+    supportSketch,+    distinguishedCones,+    distinguishedCocones,+    distinguishedTripods,+    -- ** Smart constructors+    unsafeSketch,+    sketch,+    sketchText,+    -- ** Helpers+    checkSketch,+    checkFiniteSketch,+    -- * Sketch morphism,+    SketchMorphism,+    SketchMorphismError(..),+    -- ** Getter+    underlyingFunctor,+    -- ** Smart constructors+    unsafeSketchMorphism,+    sketchMorphism,+    -- ** Other functions+    canFunctorBePromotedIntoSketchMorphism,+    +    -- * The category of finite sketches+    FinSketch(..),+    +    -- * Functions for shiny sketches+    -- Lantern(..),+    containsLantern,+    -- Spotlight(..),+    containsSpotlight,+    -- CrescentMoon(..),+    containsCrescentMoon,+    -- Colantern(..),+    containsColantern,+    -- Cospotlight(..),+    containsCospotlight,+    -- CocrescentMoon(..),+    containsCocrescentMoon,+    LightConstruction(..),+    containsLightConstruction,+    +    -- * Ehresmann realization+    -- factorsCone,+    -- factorsCocone,+    -- lonelyCones,+    -- lonelyCocones,+    -- crowdedCones,+    -- crowdedCocones,+    -- createLonelyConeCorrectionArrow,+    -- createLonelyCoconeCorrectionArrow,+    -- addLonelinessCorrectionArrows,+    -- quotientArrows,+    -- stepRealization,+    -- stepRealizationText,+)++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.Text            (Text, pack)+    import              Data.Simplifiable+    import              Data.Maybe           (isJust, isNothing, fromJust)+    import              Data.Either          (isLeft)++    import              Math.FiniteCategory+    import              Math.CocompleteCategory+    import              Math.CartesianClosedCategory+    import              Math.FiniteCategories.Parallel+    import              Math.FiniteCategories.CompositionGraph+    import              Math.FiniteCategories.ColimitCategory+    import              Math.FiniteCategories.DiscreteTwo+    import              Math.Categories.FunctorCategory+    import              Math.Categories.CommaCategory+    import              Math.Categories.ConeCategory+    import              Math.Categories.FinCat+    import              Math.Categories.FinGrph+    import              Math.FiniteCategoryError+    import              Math.IO.PrettyPrint+    +    import              GHC.Generics++    type CategorySketch n e = CompositionGraph n e+    type ArrowSketch n e = CGMorphism n e+    type ObjectSketch n e = n+     +    type ConeSketch n e = Cone (CategorySketch n e) (ArrowSketch n e) (ObjectSketch n e) (CategorySketch n e) (ArrowSketch n e) (ObjectSketch n e)+    type CoconeSketch n e = Cocone (CategorySketch n e) (ArrowSketch n e) (ObjectSketch n e) (CategorySketch n e) (ArrowSketch n e) (ObjectSketch n e)+    type TripodSketch n e = Tripod (CategorySketch n e) (ArrowSketch n e) (ObjectSketch n e)++    type FunctorSketch n e = FinFunctor (CategorySketch n e) (ArrowSketch n e) (ObjectSketch n e)+    +   +    -- | Construct a 2-cone selecting the power object and the internal domain of a 'Tripod'. This 2-cone can then be added to the distinguished cones of a 'Sketch'. The two first arguments are arbitrary distinct objects of type n (they will be the objects of the indexing category of the 2-cone).+    constructTwoConeFromTripod :: (Eq n, Eq e) => n -> n -> TripodSketch n e -> ConeSketch n e+    constructTwoConeFromTripod a b t+        | a == b = error "constructTwoConeFromTripod with two same indexing objects."+        | otherwise = unsafeCone (apex $ twoCone $ t) nat+        where+            indexingCategory = unsafeCompositionGraph (unsafeGraph (set [a,b]) (set [])) (weakMap [])+            srcDiag = constantDiagram indexingCategory (universeCategoryTripod t) (apex $ twoCone $ t)+            tgtDiag = completeDiagram $ Diagram{src = indexingCategory, tgt = universeCategoryTripod t, omap = weakMap [(a, powerObject t),(b, internalDomain t)], mmap = weakMap []}+            nat = unsafeNaturalTransformation srcDiag tgtDiag (weakMap [(a, (legsCone $ twoCone t) =>$ A),(b, (legsCone $ twoCone t) =>$ B)])+   +    -- | Specialized version of 'constructTwoConeFromTripod' for 'Sketch' of 'Text'.+    constructTwoConeFromTripodText :: TripodSketch Text Text -> ConeSketch Text Text+    constructTwoConeFromTripodText = constructTwoConeFromTripod (pack "A") (pack "B")+   ++    -- | Sketch is private, use the smart constructor 'sketch' or 'unsafeSketch' to construct one. Note that for each distinguished 'Tripod', the 2-cone of the 'Tripod' should belong to the distinguished 'cones' (the 2-cone can be constructed with 'constructTwoConeFromTripod').+    data Sketch n e = Sketch {+        underlyingCategory :: CategorySketch n e,+        distinguishedCones :: Set (ConeSketch n e),+        distinguishedCocones :: Set (CoconeSketch n e),+        distinguishedTripods :: Set (TripodSketch n e)+    } deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)+    +    -- | The support of a 'Sketch' is the multidigraph generating the underlying category of the 'Sketch'.+    supportSketch :: Sketch n e -> Graph n e+    supportSketch = support.underlyingCategory+    +    -- | Unsafe constructor for a 'Sketch'. Use with caution, prefer 'sketch' which checks the structure of the 'Sketch.+    --+    --  Note that for each distinguished 'Tripod', the 2-cone of the 'Tripod' should belong to the distinguished 'cones'.+    unsafeSketch :: CategorySketch n e -> Set (ConeSketch n e) -> Set (CoconeSketch n e) -> Set (TripodSketch n e) -> Sketch n e+    unsafeSketch uc c cc t = Sketch{underlyingCategory = uc, distinguishedCones = c, distinguishedCocones = cc, distinguishedTripods= t }++    -- | A 'SketchError' could be a cone with a base outside the underlying category, a cocone with base outside the underlying category, a tripod with a base outside the underlying category, a tripod where the 2-cone does not belong to the distinguished cones of the sketch or an error in the underlying category.+    data SketchError n e = BaseOfConeIsNotInUnderlyingCategory (ConeSketch n e)+                     | BaseOfCoconeIsNotInUnderlyingCategory (CoconeSketch n e)+                     | BaseOfTripodIsNotInUnderlyingCategory (TripodSketch n e)+                     | TripodTwoConeDoesNotBelongToDistinguishedCones (TripodSketch n e)+                     | UnderlyingCategoryError (FiniteCategoryError (ArrowSketch n e) (ObjectSketch n e))+                     | TwoSameIndexingObjects n+        deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)+++    -- | Find the first occurence which evaluates to true.+    find :: (Eq a) => (a -> Bool) -> Set a -> Maybe a+    find p s = if Set.null filtered then Nothing else Just (anElement filtered)+        where+            filtered = Set.filter p s++    -- | Smart constructor for a finite 'Sketch'. Note that for each distinguished 'Tripod', the 2-cone of the 'Tripod' is added to the distinguished 'cones' of the sketch. The two first arguments are arbitrary distinct objects of type n which will be the indexing objects of the new 2-cones.+    sketch :: (Eq n, Eq e) => n -> n -> CategorySketch n e -> (Set (ConeSketch n e)) -> (Set (CoconeSketch n e)) -> (Set (TripodSketch n e)) -> Either (SketchError n e) (Sketch n e)+    sketch a b cat c cc t+        | not $ null $ errCat = Left $ UnderlyingCategoryError $ fromJust errCat+        | not $ null $ faultyCone = Left $ BaseOfConeIsNotInUnderlyingCategory (fromJust faultyCone) +        | not $ null $ faultyCocone = Left $ BaseOfCoconeIsNotInUnderlyingCategory (fromJust faultyCocone)+        | not $ null $ faultyTripod = Left $ BaseOfTripodIsNotInUnderlyingCategory (fromJust faultyTripod)+        | a == b = Left $ TwoSameIndexingObjects a+        | otherwise = Right s+        where   +            errCat = checkFiniteCategory cat+            fromJust (Just x) = x+            newCones = constructTwoConeFromTripod a b <$> t+            s = Sketch{underlyingCategory = cat, distinguishedCones = c ||| newCones, distinguishedCocones = cc, distinguishedTripods = t}+            faultyCone = find (\x -> universeCategoryCone x /= cat) c+            faultyCocone = find (\x -> universeCategoryCocone x /= cat) cc+            faultyTripod = find (\x -> universeCategoryTripod x /= cat) t+       +    -- | Specialized version of 'sketch' for sketches of 'Text'.+    sketchText :: CategorySketch Text Text -> (Set (ConeSketch Text Text)) -> (Set (CoconeSketch Text Text)) -> (Set (TripodSketch Text Text)) -> Either (SketchError Text Text) (Sketch Text Text)+    sketchText = sketch (pack "A") (pack "B")+       +    -- | Check wether a 'Sketch' is well formed or not, return a 'SketchError' if it is malformed, Nothing otherwise. Does not check the underlying 'CompositionGraph'.+    checkSketch :: (Eq n, Eq e) => Sketch n e -> Maybe (SketchError n e)+    checkSketch Sketch{underlyingCategory = cat, distinguishedCones = c, distinguishedCocones = cc, distinguishedTripods = t}+        | not $ null $ faultyCone = BaseOfConeIsNotInUnderlyingCategory <$> faultyCone +        | not $ null $ faultyCocone = BaseOfCoconeIsNotInUnderlyingCategory <$> faultyCocone+        | not $ null $ faultyTripod = BaseOfTripodIsNotInUnderlyingCategory <$> faultyTripod+        | not $ null $ faultyTripod2 = TripodTwoConeDoesNotBelongToDistinguishedCones <$> faultyTripod2+        | otherwise = Nothing+        where+            faultyCone = find (\x -> universeCategoryCone x /= cat) c+            faultyCocone = find (\x -> universeCategoryCocone x /= cat) cc+            faultyTripod = find (\x -> universeCategoryTripod x /= cat) t+            faultyTripod2 = find (\x -> not $ Set.or [apex cone == (apex $ twoCone x) && (cardinal $ ob $ indexingCategoryCone cone) == 2 && (cardinal $ arrows $ indexingCategoryCone cone) == 2 && (target <$> Map.values (components $ legsCone cone)) == set [powerObject x, internalDomain x] | cone <- c]) t+       +    -- | Check wether a finite 'Sketch' is well formed or not, return a 'SketchError' if it is malformed, Nothing otherwise.+    checkFiniteSketch :: (Eq n, Eq e) => Sketch n e -> Maybe (SketchError n e)+    checkFiniteSketch Sketch{underlyingCategory = cat, distinguishedCones = c, distinguishedCocones = cc, distinguishedTripods = t}+        | not $ null $ errCat = UnderlyingCategoryError <$> errCat+        | not $ null $ faultyCone = BaseOfConeIsNotInUnderlyingCategory <$> faultyCone +        | not $ null $ faultyCocone = BaseOfCoconeIsNotInUnderlyingCategory <$> faultyCocone+        | not $ null $ faultyTripod = BaseOfTripodIsNotInUnderlyingCategory <$> faultyTripod+        | not $ null $ faultyTripod2 = TripodTwoConeDoesNotBelongToDistinguishedCones <$> faultyTripod2+        | otherwise = Nothing+        where+            errCat = checkFiniteCategory cat+            faultyCone = find (\x -> universeCategoryCone x /= cat) c+            faultyCocone = find (\x -> universeCategoryCocone x /= cat) cc+            faultyTripod = find (\x -> universeCategoryTripod x /= cat) t+            faultyTripod2 = find (\x -> not $ Set.or [apex cone == (apex $ twoCone x) && (cardinal $ ob $ indexingCategoryCone cone) == 2 && (cardinal $ arrows $ indexingCategoryCone cone) == 2 && (target <$> Map.values (components $ legsCone cone)) == set [powerObject x, internalDomain x] | cone <- c]) t+            ++    -- | SketchMorphism is private, use the smart constructor 'sketchMorphism' or 'unsafeSketchMorphism' to construct one.+    data SketchMorphism n e = SketchMorphism {+                                underlyingFunctor :: FunctorSketch n e, -- ^ Underlying functor of a 'SketchMorphism'.+                                sourceSketch :: Sketch n e, -- ^ The source of a 'SketchMorphism'. We have to store this to implement the source function of the 'Morphism' typeclass. This getter is not exported as you can get the source of the 'SketchMorphism' using the 'source' function.+                                targetSketch :: Sketch n e -- ^ The target of a 'SketchMorphism'. See 'sourceSketch'.+                            } deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)+    +    -- | A 'SketchError' could be a cone not sent to a cone, a cocone not sent to a cocone or an error in the underlying functor.+    data SketchMorphismError n e = ConeNotSentToACone (ConeSketch n e)+                                 | CoconeNotSentToACocone (CoconeSketch n e)+                                 | TripodNotSentToATripod (TripodSketch n e)+                                 | UnderlyingFunctorError (DiagramError (CategorySketch n e) (ArrowSketch n e) (ObjectSketch n e) (CategorySketch n e) (ArrowSketch n e) (ObjectSketch n e))+                                 | WrongSource (CategorySketch n e) (CategorySketch n e)+                                 | WrongTarget (CategorySketch n e) (CategorySketch n e)+                                 deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)+    +    -- | Unsafe constructor for a 'SketchMorphism'. Use with caution, prefer 'sketch' which checks the structure of the 'SketchMorphism'.+    unsafeSketchMorphism :: Sketch n e -> Sketch n e -> FunctorSketch n e -> SketchMorphism n e+    unsafeSketchMorphism s t f = SketchMorphism{underlyingFunctor = f, sourceSketch = s, targetSketch = t}+    +    -- | Smart constructor for a 'SketchMorphism'. It checks wether cones are sent to cones and cocones are sent to cocones.+    sketchMorphism :: (Eq n, Eq e) => Sketch n e -> Sketch n e -> FunctorSketch n e -> Either (SketchMorphismError n e) (SketchMorphism n e)+    sketchMorphism s t f+        | not $ null errFunct = Left $ UnderlyingFunctorError $ fromJust $ errFunct+        | not $ null faultyCone = Left $ ConeNotSentToACone (fromJust faultyCone) +        | not $ null faultyCocone = Left $ CoconeNotSentToACocone (fromJust faultyCocone)+        | not $ null faultyTripod = Left $ TripodNotSentToATripod (fromJust faultyTripod)+        | src f /= underlyingCategory s = Left $ WrongSource (src f) (underlyingCategory s)+        | tgt f /= underlyingCategory t = Left $ WrongTarget (tgt f) (underlyingCategory t)+        | otherwise = Right $ SketchMorphism{underlyingFunctor = f, sourceSketch = s, targetSketch = t}+        where+            errFunct = checkDiagram f+            fromJust (Just x) = x+            faultyCone = find (\cone_ -> not $ (unsafeCone (f ->$ (apex cone_)) (f <-@<= legsCone cone_)) `Set.isIn` (distinguishedCones t)) (distinguishedCones s)+            faultyCocone = find (\cocone_ -> not $ (unsafeCocone (f ->$ (nadir cocone_)) (f <-@<= legsCocone cocone_)) `Set.isIn` (distinguishedCocones t)) (distinguishedCocones s)+            faultyTripod = find (\tripod_ -> not $ (unsafeTripod (unsafeCone (f ->$ (apex (twoCone tripod_))) (f <-@<= legsCone (twoCone tripod_))) (f ->£ (evalMap tripod_))) `Set.isIn` (distinguishedTripods t)) (distinguishedTripods s)+            ++    -- | Return wether a 'Functor' can be promoted into a 'SketchMorphism'.+    canFunctorBePromotedIntoSketchMorphism :: (Eq e, Eq n) => Sketch n e -> Sketch n e -> (FunctorSketch n e) -> Bool+    canFunctorBePromotedIntoSketchMorphism s t f = null faultyCone && null faultyCocone && null faultyTripod+        where+            faultyCone = find (\cone_ -> not $ (unsafeCone (f ->$ (apex cone_)) (f <-@<= legsCone cone_)) `Set.isIn` (distinguishedCones t)) (distinguishedCones s)+            faultyCocone = find (\cocone_ -> not $ (unsafeCocone (f ->$ (nadir cocone_)) (f <-@<= legsCocone cocone_)) `Set.isIn` (distinguishedCocones t)) (distinguishedCocones s)+            faultyTripod = find (\tripod_ -> not $ (unsafeTripod (unsafeCone (f ->$ (apex (twoCone tripod_))) (f <-@<= legsCone (twoCone tripod_))) (f ->£ (evalMap tripod_))) `Set.isIn` (distinguishedTripods t)) (distinguishedTripods s)+++    instance (Eq e, Eq n) => Morphism (SketchMorphism n e) (Sketch n e) where+        source = sourceSketch+        target = targetSketch+        sm2 @ sm1 = SketchMorphism{underlyingFunctor = (underlyingFunctor sm2) @ (underlyingFunctor sm1), sourceSketch = sourceSketch sm1, targetSketch = targetSketch sm2}+++    data FinSketch n e = FinSketch deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)+    +    instance (Eq e, Eq n) => Category (FinSketch n e) (SketchMorphism n e) (Sketch n e) where+        identity _ s = SketchMorphism{underlyingFunctor = identity FinCat (underlyingCategory s), sourceSketch = s, targetSketch = s}+        +        ar _ s t = unsafeSketchMorphism s t <$> Set.filter (canFunctorBePromotedIntoSketchMorphism s t) (ar FinCat (underlyingCategory s) (underlyingCategory t))+        +    instance (Eq e, Eq n) => +        HasCoequalizers (FinSketch n e) (SketchMorphism n e) (Sketch n e) where+        coequalize parallelDiag = unsafeCocone nadirSketch legs+            where+                parallelDiagOfCg = Diagram{src = Parallel, tgt = FinCat, omap = underlyingCategory <$> omap parallelDiag, mmap = underlyingFunctor <$> mmap parallelDiag}+                coeqCg = coequalize parallelDiagOfCg+                transformCone c = unsafeCone (((legsCocone coeqCg) =>$ ParallelB) ->$ (apex c)) (((legsCocone coeqCg) =>$ ParallelB) <-@<= (legsCone c))+                transformCocone cc = unsafeCocone (((legsCocone coeqCg) =>$ ParallelB) ->$ (nadir cc)) (((legsCocone coeqCg) =>$ ParallelB) <-@<=(legsCocone cc))+                transformTripod t = unsafeTripod (transformCone (twoCone t)) (((legsCocone coeqCg) =>$ ParallelB) ->£ (evalMap t))+                nadirSketch = Sketch{underlyingCategory = nadir coeqCg, distinguishedCones = transformCone <$> distinguishedCones (parallelDiag ->$ ParallelB), distinguishedCocones = transformCocone <$> distinguishedCocones (parallelDiag ->$ ParallelB), distinguishedTripods = transformTripod <$> distinguishedTripods (parallelDiag ->$ ParallelB)}+                leg1 = SketchMorphism{sourceSketch = parallelDiag ->$ ParallelA, targetSketch = nadirSketch, underlyingFunctor = (legsCocone coeqCg) =>$ ParallelA}+                leg2 = SketchMorphism{sourceSketch = parallelDiag ->$ ParallelB, targetSketch = nadirSketch, underlyingFunctor = (legsCocone coeqCg) =>$ ParallelB}+                legs = unsafeNaturalTransformation parallelDiag (constantDiagram Parallel FinSketch nadirSketch) (weakMap [(ParallelA, leg1),(ParallelB, leg2)])+                +        +    instance (Eq e, Eq n, Eq oIndex, Eq mIndex, Morphism mIndex oIndex, FiniteCategory cIndex mIndex oIndex) => CocompleteCategory (FinSketch n e) (SketchMorphism n e) (Sketch n e) (FinSketch (Colimit oIndex n) (Colimit oIndex e)) (SketchMorphism (Colimit oIndex n) (Colimit oIndex e)) (Sketch (Colimit oIndex n) (Colimit oIndex e)) cIndex mIndex oIndex where+        colimit diagOfSketches = unsafeCocone nadirSketch legs+            where+                indexingCategory = src diagOfSketches+                diagOfCG = Diagram{src = indexingCategory, tgt = FinCat, omap = Map.weakMapFromSet [(i,underlyingCategory (diagOfSketches ->$ i)) | i <- ob indexingCategory], mmap = Map.weakMapFromSet [(f,underlyingFunctor (diagOfSketches ->£ f)) | f <- genArrows indexingCategory]}+                colimitCG = colimitOfCompositionGraphs diagOfCG+                coprojBase = coprojectBaseCompositionGraphs diagOfCG+                transformCone i c = unsafeCone (((legsCocone colimitCG) =>$ i) ->$ (apex c)) (((legsCocone colimitCG) =>$ i) <-@<= (legsCone c))+                transformCocone i cc = unsafeCocone (((legsCocone colimitCG) =>$ i) ->$ (nadir cc)) (((legsCocone colimitCG) =>$ i) <-@<=(legsCocone cc))+                transformTripod i t = unsafeTripod (transformCone i (twoCone t)) (((legsCocone colimitCG) =>$ i) ->£ (evalMap t))+                nadirSketch = Sketch{underlyingCategory = (nadir colimitCG), distinguishedCones = Set.unions [transformCone i <$> distinguishedCones (newBase ->$ i)| i <- Set.setToList $ ob $ src newBase], distinguishedCocones = Set.unions [transformCocone i <$> distinguishedCocones (newBase ->$ i)| i <- Set.setToList $ ob $ src newBase], distinguishedTripods = Set.unions [transformTripod i <$> distinguishedTripods (newBase ->$ i)| i <- Set.setToList $ ob $ src newBase]}+                newBase = coprojectBase diagOfSketches <-@<- diagOfSketches+                legs = unsafeNaturalTransformation newBase (constantDiagram indexingCategory FinSketch nadirSketch) (Map.weakMapFromSet [(i,SketchMorphism{sourceSketch = newBase ->$ i, targetSketch = nadirSketch, underlyingFunctor = (legsCocone colimitCG) =>$ i}) | i <- ob indexingCategory])+                +        coprojectBase diag = Diagram{src = FinSketch, tgt = FinSketch, omap = Map.weakMapFromSet [(diag ->$ i,coprojectSketch $  diag ->$ i) | i <- ob $ src diag], mmap = Map.weakMapFromSet [(diag ->£ f,coprojectSketchMorphism $ diag ->£ f) | f <- arrows $ src diag]}+            where+                coprojectArrow a = Arrow{sourceArrow = Coprojection $ sourceArrow a, targetArrow = Coprojection $ targetArrow a, labelArrow = Coprojection $ labelArrow a}+                coprojectGraph g = unsafeGraph ((Coprojection) <$> nodes g) ((coprojectArrow) <$> edges g)+                coprojectLaw cl = Map.weakMapFromSet [(coprojectArrow <$> rp1, coprojectArrow <$> rp2) | (rp1,rp2) <- Map.mapToSet cl]+                coprojectCG cg = unsafeCompositionGraph (coprojectGraph $ support cg) (coprojectLaw $ law cg)+                coprojectCGMorphism CGMorphism{path = (a, rp),compositionLaw = cl} = CGMorphism{path = (Coprojection a, coprojectArrow <$> rp), compositionLaw = coprojectLaw cl}+                coprojectDiag d = Diagram{src = coprojectCG $ src d, tgt = coprojectCG $ tgt d, omap = (\(x,y) -> (Coprojection x, Coprojection y)) <|$|> omap d, mmap = (\(x,y) -> (coprojectCGMorphism x, coprojectCGMorphism y)) <|$|> mmap d}              +                coprojectNat nat = unsafeNaturalTransformation (coprojectDiag (source nat)) (coprojectDiag (target nat)) ((\(x,y) -> (Coprojection x, coprojectCGMorphism y)) <|$|> components nat)+                coprojectCone cone = unsafeCone (Coprojection $ apex cone) (coprojectNat $ legsCone cone)+                coprojectCocone cocone = unsafeCocone (Coprojection $ nadir cocone) (coprojectNat $ legsCocone cocone)+                coprojectDiag2 d = Diagram{src = src d, tgt = coprojectCG $ tgt d, omap = Coprojection <$> omap d, mmap = coprojectCGMorphism <$> mmap d}    +                coprojectNat2 nat = unsafeNaturalTransformation (coprojectDiag2 (source nat)) (coprojectDiag2 (target nat)) (coprojectCGMorphism <$> components nat)+                coprojectCone2 cone = unsafeCone (Coprojection $ apex cone) (coprojectNat2 $ legsCone cone)+                coprojectTripod tripod = unsafeTripod (coprojectCone2 (twoCone tripod)) (coprojectCGMorphism (evalMap tripod))+                coprojectSketch s = Sketch{underlyingCategory = coprojectCG $ underlyingCategory s, distinguishedCocones = coprojectCocone <$> distinguishedCocones s, distinguishedCones = coprojectCone <$> distinguishedCones s, distinguishedTripods = coprojectTripod <$> distinguishedTripods s}+                coprojectSketchMorphism sm = SketchMorphism{sourceSketch = coprojectSketch $ sourceSketch sm, targetSketch = coprojectSketch $ targetSketch sm, underlyingFunctor = coprojectDiag $ underlyingFunctor sm}+++    +    -- | Returns a 'Lantern' found in a 'Sketch' if it can.+    containsLantern :: (Eq n, Eq e) => Sketch n e -> Maybe (LightConstruction n e)+    containsLantern s = Set.setToMaybe lanterns+        where+            lanterns = [Lantern dinstinguishedCone (bindingMorphismCone f) (bindingMorphismCone g) | dinstinguishedCone <- distinguishedCones s, cone <- ob (coneCategory (baseCone dinstinguishedCone)), f <- ar (coneCategory (baseCone dinstinguishedCone)) cone dinstinguishedCone, g <- ar (coneCategory (baseCone dinstinguishedCone)) cone dinstinguishedCone, f /= g]+            +    +    -- | Returns a 'Spotlight' found in a 'Sketch' if it can.    +    containsSpotlight :: (Eq n, Eq e) => Sketch n e -> Maybe (LightConstruction n e)+    containsSpotlight s = Set.setToMaybe spotlights+        where+            spotlights = [Spotlight dinstinguishedCone i j cone | dinstinguishedCone <- distinguishedCones s, i <- ob (indexingCategoryCone dinstinguishedCone), j <- ob (indexingCategoryCone dinstinguishedCone), i /= j, (legsCone dinstinguishedCone) =>$ i == (legsCone dinstinguishedCone) =>$ j, cone <- ob (coneCategory (baseCone dinstinguishedCone)), (legsCone cone) =>$ i /= (legsCone cone) =>$ j]+    +    -- | Returns a 'CrescentMoon' found in a 'Sketch' if it can. +    containsCrescentMoon :: (Eq n, Eq e) => Sketch n e -> Maybe (LightConstruction n e)+    containsCrescentMoon s = Set.setToMaybe crescentMoons+        where+            atLeastTwo x+                | Set.null x = False+                | Set.null (Set.filter (/= (anElement x)) x) = False+                | otherwise = True+            crescentMoons = [CrescentMoon dc1 dc2 inj c x | dc1 <- distinguishedCones s, dc2 <- distinguishedCones s, inj <- dc1 `topInjectionsCone` dc2, c <- ob (coneCategory (baseCone dc1)), x <- ob (indexingCategoryCone dc2), not ((Just $ (baseCone dc2) ->$ x) `isIn` ((fmap (baseCone dc2 ->$)) <$> ((inj |?|) <$> (ob (indexingCategoryCone dc1))))), atLeastTwo $ ar (underlyingCategory s) (apex c) (baseCone dc2 ->$ x)]+            ++    -- | Returns a 'Colantern' found in a 'Sketch' if it can.+    containsColantern :: (Eq n, Eq e) => Sketch n e -> Maybe (LightConstruction n e)+    containsColantern s = Set.setToMaybe colanterns+        where+            colanterns = [Colantern dinstinguishedCocone (bindingMorphismCocone f) (bindingMorphismCocone g) | dinstinguishedCocone <- distinguishedCocones s, cocone <- ob (coconeCategory (baseCocone dinstinguishedCocone)), f <- ar (coconeCategory (baseCocone dinstinguishedCocone)) dinstinguishedCocone cocone, g <- ar (coconeCategory (baseCocone dinstinguishedCocone)) dinstinguishedCocone cocone, f /= g]+            +    +    -- | Returns a 'Cospotlight' found in a 'Sketch' if it can.    +    containsCospotlight :: (Eq n, Eq e) => Sketch n e -> Maybe (LightConstruction n e)+    containsCospotlight s = Set.setToMaybe cospotlights+        where+            cospotlights = [Cospotlight dinstinguishedCocone i j cocone | dinstinguishedCocone <- distinguishedCocones s, i <- ob (indexingCategoryCocone dinstinguishedCocone), j <- ob (indexingCategoryCocone dinstinguishedCocone), i /= j, (legsCocone dinstinguishedCocone) =>$ i == (legsCocone dinstinguishedCocone) =>$ j, cocone <- ob (coconeCategory (baseCocone dinstinguishedCocone)), (legsCocone cocone) =>$ i /= (legsCocone cocone) =>$ j]+    +    -- | Returns a 'CocrescentMoon' found in a 'Sketch' if it can. +    containsCocrescentMoon :: (Eq n, Eq e) => Sketch n e -> Maybe (LightConstruction n e)+    containsCocrescentMoon s = Set.setToMaybe cocrescentMoons+        where+            atLeastTwo x+                | Set.null x = False+                | Set.null (Set.filter (/= (anElement x)) x) = False+                | otherwise = True+            cocrescentMoons = [CocrescentMoon dcc1 dcc2 inj cc x | dcc1 <- distinguishedCocones s, dcc2 <- distinguishedCocones s, inj <- dcc1 `bottomInjectionsCocone` dcc2, cc <- ob (coconeCategory (baseCocone dcc1)), x <- ob (indexingCategoryCocone dcc2), not ((Just $ (baseCocone dcc2) ->$ x) `isIn` ((fmap (baseCocone dcc2 ->$)) <$> ((inj |?|) <$> (ob (indexingCategoryCocone dcc1))))), atLeastTwo $ ar (underlyingCategory s) (baseCocone dcc2 ->$ x) (nadir cc)]+            +    +    -- | A 'LightConstruction' is either a 'Lantern', a 'Spotlight', a 'CrescentMoon', a 'Colantern', a 'Cospotlight' or a 'CocrescentMoon'.+    --+    -- A 'Lantern' is a distinguished cone c1, and two different morphisms m1 m2 such that c1 precomposed with m1 and m2 yield the same cone.+    --+    -- A 'Spotlight' is a distinguished cone c1, two different indexing objects o1 o2 and a cone c2 such that the legs of c1 at index o1 and o2 are equal and the legs of c2 at index o1 and o2 are different.+    --+    -- A 'CrescentMoon' is a distinguished cone c1, a distinguished cone c2 such that c1 is contained in c2, a cone c with same base as c1, an indexing object x of the base of c2 not in the base of c1 such that there are at least two arrows from the apex of c to x. +    --+    -- A 'Colantern' is a distinguished cocone c1, and two different morphisms m1 m2 such that c1 postcomposed with m1 and m2 yield the same cocone.+    --+    -- A 'Cospotlight' is a distinguished cocone c1, two different indexing objects o1 o2 and a cocone c2 such that the legs of c1 at index o1 and o2 are equal and the legs of c2 at index o1 and o2 are different.+    --+    -- A 'CocrescentMoon' is a distinguished cocone c1, a distinguished cocone c2 such that c1 is contained in c2, a cocone c with same base as c1, an indexing object x of the base of c2 not in the base of c1 such that there are at least two arrows from x to the nadir of c.+    data LightConstruction n e = +        Lantern (ConeSketch n e) (CGMorphism n e) (CGMorphism n e) |+        Spotlight (ConeSketch n e) n n (ConeSketch n e) |+        CrescentMoon (ConeSketch n e) (ConeSketch n e) (Map n n) (ConeSketch n e) n |+        Colantern (CoconeSketch n e) (CGMorphism n e) (CGMorphism n e) |+        Cospotlight (CoconeSketch n e) n n (CoconeSketch n e) |+        CocrescentMoon (CoconeSketch n e) (CoconeSketch n e) (Map n n) (CoconeSketch n e) n+        deriving (Eq, Show, Generic, PrettyPrint, Simplifiable) +    +    containsLightConstruction :: (Eq n, Eq e) => Sketch n e -> Maybe (LightConstruction n e)+    containsLightConstruction s+        | not $ null $ lant = lant+        | not $ null $ spot = spot+        | not $ null $ moon = moon+        | not $ null $ colant = colant+        | not $ null $ cospot = cospot+        | not $ null $ comoon = comoon+        | otherwise = Nothing+        where+            lant = containsLantern s+            spot = containsSpotlight s+            moon = containsCrescentMoon s+            colant = containsColantern s+            cospot = containsCospotlight s+            comoon = containsCocrescentMoon s+            +            +    +    -- -- | Return all binding morphisms from a cone to another cone with same base. If the two cones have different base, return an empty set.+    -- factorsCone :: (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) => +        -- Cone c1 m1 o1 c2 m2 o2 -> Cone c1 m1 o1 c2 m2 o2 -> Set m2+    -- factorsCone c1 c2+        -- | baseCone c1 /= baseCone c2 = set []+        -- | otherwise = [bindingMorphismCone f | f <- ar (coneCategory (baseCone c1)) c1 c2]+        +    -- -- | Return all binding morphisms from a cocone to another cocone with same base. If the two cocones have different base, return an empty set.+    -- factorsCocone :: (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) => +        -- Cocone c1 m1 o1 c2 m2 o2 -> Cocone c1 m1 o1 c2 m2 o2 -> Set m2+    -- factorsCocone c1 c2+        -- | baseCocone c1 /= baseCocone c2 = set []+        -- | otherwise = [bindingMorphismCocone f | f <- ar (coconeCategory (baseCocone c1)) c1 c2]+        +    +    -- -- | Given a cone c1, return all cones c2 with same base as c1 with no factor from c1 to c2.+    -- lonelyCones :: (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) => +        -- Cone c1 m1 o1 c2 m2 o2 -> Set (Cone c1 m1 o1 c2 m2 o2)+    -- lonelyCones c1 = [c2 | c2 <- ob (coneCategory (baseCone c1)), Set.null (factorsCone c2 c1)]+    +    -- -- | Given a cocone c1, return all cocones c2 with same base as c1 with no factor from c2 to c1.+    -- lonelyCocones :: (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) => +        -- Cocone c1 m1 o1 c2 m2 o2 -> Set (Cocone c1 m1 o1 c2 m2 o2)+    -- lonelyCocones c1 = [c2 | c2 <- ob (coconeCategory (baseCocone c1)), Set.null (factorsCocone c1 c2)]+    +    -- -- | Return wether a set has at least two elements.+    -- atLeastTwoElement :: (Eq a) => Set a -> Bool+    -- atLeastTwoElement s = (not $ Set.null s) && (Set.or ((anElement s /=) <$> s))+    +    -- -- | Given a cone c1, return all cones c2 with same base as c1 with two or more factors from c1 to c2.+    -- crowdedCones :: (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) => +        -- Cone c1 m1 o1 c2 m2 o2 -> Set (Cone c1 m1 o1 c2 m2 o2)+    -- crowdedCones c1 = [c2 | c2 <- ob (coneCategory (baseCone c1)), atLeastTwoElement (factorsCone c2 c1)]+    +    -- -- | Given a cocone c1, return all cocones c2 with same base as c1 with two or more factors from c2 to c1.+    -- crowdedCocones :: (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) => +        -- Cocone c1 m1 o1 c2 m2 o2 -> Set (Cocone c1 m1 o1 c2 m2 o2)+    -- crowdedCocones c1 = [c2 | c2 <- ob (coconeCategory (baseCocone c1)), atLeastTwoElement (factorsCocone c1 c2)]+    +    -- createLonelyConeCorrectionArrow :: (ConeSketch n e -> ConeSketch n e -> e) -> ConeSketch n e -> ConeSketch n e -> Arrow n e+    -- createLonelyConeCorrectionArrow createEdge dc lc = Arrow{sourceArrow = apex lc, targetArrow = apex dc, labelArrow = createEdge dc lc}+    +    -- createLonelyCoconeCorrectionArrow :: (CoconeSketch n e -> CoconeSketch n e -> e) -> CoconeSketch n e -> CoconeSketch n e -> Arrow n e+    -- createLonelyCoconeCorrectionArrow createEdge dcc lcc = Arrow{sourceArrow = nadir dcc, targetArrow = nadir lcc, labelArrow = createEdge dcc lcc}+    +    -- -- | Add lonely cone and cocone correction arrows to a 'Sketch', return the insertion 'SketchMorphism' from the original 'Sketch' to the new 'Sketch'.+    -- addLonelinessCorrectionArrows :: (Eq n, Eq e) => (ConeSketch n e -> ConeSketch n e -> e) -> (CoconeSketch n e -> CoconeSketch n e -> e) -> Sketch n e -> SketchMorphism n e+    -- addLonelinessCorrectionArrows createEdgeCone createEdgeCocone s = SketchMorphism{sourceSketch = s, targetSketch = newSketch, underlyingFunctor = insertionFunctor}+        -- where+            -- originalCg = underlyingCategory s+            -- newCg = unsafeCompositionGraph (unsafeGraph (ob originalCg) ((edges (support originalCg)) ||| [createLonelyConeCorrectionArrow createEdgeCone dc lc | dc <- distinguishedCones s, lc <- lonelyCones dc] ||| [createLonelyCoconeCorrectionArrow createEdgeCocone dcc lcc | dcc <- distinguishedCocones s, lcc <- lonelyCocones dcc] )) (law originalCg)+            -- insertionFunctor = Diagram{src = originalCg, tgt = newCg, omap = memorizeFunction id (ob originalCg), mmap = memorizeFunction id (arrows originalCg)}+            -- newSketch = Sketch{underlyingCategory = newCg, distinguishedCones = distinguishedCones s, distinguishedCocones = distinguishedCocones s, distinguishedTripods = distinguishedTripods s}+            +    -- -- -- -- -- | Quotient arrows in the free category generated by the new graph. Return the quotient morphism.+    -- -- -- -- quotientArrows :: (Eq e, Eq n) => (ConeSketch n e -> ConeSketch n e -> e) -> (CoconeSketch n e -> CoconeSketch n e -> e) -> Sketch n e -> SketchMorphism n e+    -- -- -- -- quotientArrows createEdgeCone createEdgeCocone s = SketchMorphism{sourceSketch = s, targetSketch = newSketch, underlyingFunctor = quotientFunctor}+        -- -- -- -- where+            -- -- -- -- originalCg = underlyingCategory s+            -- -- -- -- rLonelyCones = Map.weakMapFromSet [((snd.path $ (legsCone dc) =>$ x)++[createLonelyConeCorrectionArrow createEdgeCone dc lc],(snd.path $ (legsCone lc) =>$ x)) | dc <- distinguishedCones s, lc <- lonelyCones dc, x <- ob (indexingCategoryCone dc)]+            -- -- -- -- rLonelyCocones = Map.weakMapFromSet [([createLonelyCoconeCorrectionArrow createEdgeCocone dcc lcc] ++ (snd.path $ (legsCocone dcc) =>$ x),(snd.path $ (legsCocone lcc) =>$ x)) | dcc <- distinguishedCocones s, lcc <- lonelyCocones dcc, x <- ob (indexingCategoryCocone dcc)]+            -- -- -- -- bestFactor factors = Set.minimumBy (\f g -> (length.snd.path $ f) `compare` (length.snd.path $ g)) factors+            -- -- -- -- rCrowdedCones = Map.weakMapFromSet [((snd.path $ f), (snd.path $ bestFactor (factorsCone cc dc)))| dc <- distinguishedCones s, cc <- crowdedCones dc, f <- factorsCone cc dc, f /= bestFactor (factorsCone cc dc)]+            -- -- -- -- rCrowdedCocones = Map.weakMapFromSet [((snd.path $ f), (snd.path $ bestFactor (factorsCocone dcc ccc)))| dcc <- distinguishedCocones s, ccc <- crowdedCocones dcc, f <- factorsCocone dcc ccc, f /= bestFactor (factorsCocone dcc ccc)]+            -- -- -- -- newLaw = rCrowdedCocones `Map.union` rCrowdedCones `Map.union` rLonelyCocones `Map.union` rLonelyCones -- `Map.union` (law originalCg)+            +            +            +            -- newCg = unsafeCompositionGraph (support originalCg) newLaw+            -- transformCGMorphism m+                -- | isIdentity originalCg m = identity newCg (source m)+                -- | otherwise = compose $ (unsafeArrowToCGMorphism newCg) <$> (snd $ path m) +            -- quotientFunctor = Diagram{src = originalCg, tgt = newCg, omap = memorizeFunction id (ob originalCg), mmap = memorizeFunction transformCGMorphism (arrows originalCg)}+            -- transformDiagram d = Diagram{src = src d, tgt = newCg, omap = omap d, mmap = transformCGMorphism <$> mmap d}+            -- transformNat n = unsafeNaturalTransformation (transformDiagram $ source n) (transformDiagram $ target n) (transformCGMorphism <$> components n)+            -- transformCone c = unsafeCone (apex c) (transformNat (legsCone c))+            -- transformCocone cc = unsafeCocone (nadir cc) (transformNat (legsCocone cc))+            -- transformTripod t = unsafeTripod (transformCone (twoCone t)) (transformCGMorphism $ evalMap t)+            -- newSketch = Sketch{underlyingCategory = newCg, distinguishedCones = transformCone <$> distinguishedCones s, distinguishedCocones = transformCocone <$> distinguishedCocones s, distinguishedTripods = transformTripod <$> distinguishedTripods s}+            +            -- problème car on identifie deux flèches génératrices dans la loi de composition+            +    -- -- | A step of the Ehresmann realization algorithm.+    -- stepRealization :: (Eq e, Eq n) => (ConeSketch n e -> ConeSketch n e -> e) -> (CoconeSketch n e -> CoconeSketch n e -> e) -> Sketch n e -> SketchMorphism n e+    -- stepRealization createEdgeCone createEdgeCocone s = quotient @ addArr+        -- where+            -- addArr = addLonelinessCorrectionArrows createEdgeCone createEdgeCocone s+            -- quotient = quotientArrows createEdgeCone createEdgeCocone (target addArr)+    +    -- -- | Specialized version of 'stepRealization' for 'Text' sketches.+    -- stepRealizationText :: Sketch Text Text -> SketchMorphism Text Text+    -- stepRealizationText = stepRealization (curry (pack.show)) (curry (pack.show))
src/Math/Categories/FunctorCategory.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE MultiParamTypeClasses, MonadComprehensions  #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE MonadComprehensions  #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
 
 {-| Module  : FiniteCategories
 Description : A 'FunctorCategory' has 'Diagram's as objects and 'NaturalTransformation's between them as morphisms.
@@ -10,11 +13,11 @@ 
 A 'FunctorCategory' /D/^/C/ (also written [/C/,/D/]) where /C/ is a 'FiniteCategory' and /D/ is a 'Category' has 'Diagram's @F : C -> D@ as objects and 'NaturalTransformation's between them as morphisms. 'NaturalTransformation's compose vertically in this category. See the operator ('<=@<=') for horizontal composition.
 
-A 'Diagram' is a heterogeneous functor, meaning that the source category might be different from the target category. We don't see a diagram as a morphism of categories but as a selection in the target category. See 'FinCat' for a context where 'Diagram's are seen as morphisms of categories.
+A 'Diagram' is a heterogeneous functor, meaning that the source category might be different from the target category. See 'FinCat' for a homogeneous ones.
 
 'Diagram's are objects in a 'FunctorCategory', they therefore can not be composed with the usual operator ('@'). See ('<-@<-') for composing 'Diagram's.
 
-Beware that 'source' and 'target' are not defined on 'Diagram' because it is not a 'Morphism', use 'src' and 'tgt' instead.
+Beware that 'source' and 'target' are not defined on 'Diagram' because it is not a 'Morphism', use 'src' and 'tgt' instead. Also note that a 'Diagram' does not need to contain the mapping of all morphisms from the source category, it may only contain a mapping for the generating morphisms of the source category. 
 
 You can also do left and right whiskering with the operators ('<=@<-') and ('<-@<=').
 
@@ -33,6 +36,7 @@     checkFiniteDiagram,
     checkDiagram,
     diagram,
+    finiteDiagram,
     -- ** Operators
     (->$),
     (->£),
@@ -48,6 +52,9 @@     -- ** Diagram construction helper
     completeDiagram,
     pickRandomDiagram,
+    -- ** Other diagram functions
+    inverseDiagram,
+    unsafeInverseDiagram,
     -- * Natural transformation
     NaturalTransformation,
     -- ** Getter
@@ -65,6 +72,8 @@     leftWhiskering,
     (<-@<=),
     rightWhiskering,
+    -- ** Misc
+    indexingCategory,
     -- * Functor categories
     FunctorCategory(..),
     PrecomposedFunctorCategory(..),
@@ -77,6 +86,7 @@     import              Data.WeakMap             (Map)
     import qualified    Data.WeakMap           as Map
     import              Data.WeakMap.Safe
+    import              Data.Simplifiable
     
     import              Math.Category
     import              Math.FiniteCategories.One
@@ -89,7 +99,9 @@     
     import              System.Random            (RandomGen, uniformR)
     
+    import              GHC.Generics
     
+    
     -- | A 'Diagram' is a functor from a 'FiniteCategory' to a 'Category'.
     --    
     -- A 'Diagram' can have a source category and a target category with different types. It must obey the following rules :
@@ -100,29 +112,39 @@     -- prop> funct ->£ (identity a) = identity (funct ->$ a)
     --
     -- 'Diagram' is not private because we can't always check functoriality if the target category is infinite.
-    -- However it is recommanded to use the smart constructor 'diagram' which checks the structure of the 'Diagram' at construction.
+    -- However it is recommanded to use the smart constructors 'diagram' or 'finiteDiagram' which check the structure of the 'Diagram' at construction. See also the useful function 'completeDiagram'.
+    --
+    -- You can omit the mapping of generated morphisms of the source category.
     data Diagram c1 m1 o1 c2 m2 o2 = Diagram { 
                                                 src :: c1, -- ^ The source category
                                                 tgt :: c2, -- ^ The target category
                                                 omap :: Map o1 o2, -- ^ The object map
-                                                mmap :: Map m1 m2 -- ^ The morphism map
-                                              } deriving (Eq, Show)
+                                                mmap :: Map m1 m2 -- ^ The morphism map, generated morphisms can be omitted.
+                                              } deriving (Show, Generic, PrettyPrint, Simplifiable)
     
-    instance (  PrettyPrint c1, PrettyPrint m1, PrettyPrint o1, Eq m1, Eq o1,
-                PrettyPrint c2, PrettyPrint m2, PrettyPrint o2, Eq m2, Eq o2) => PrettyPrint (Diagram c1 m1 o1 c2 m2 o2) where
-        pprint funct = "Diagram(" ++ pprint (src funct) ++ "->" ++ pprint (tgt funct) ++ "," ++ pprint (omap funct) ++ "," ++ pprint (mmap funct) ++ ")"
+    instance (Eq c1, Eq m1, Eq o1, Eq c2, Eq m2, Eq o2, FiniteCategory c1 m1 o1, Morphism m1 o1) => Eq (Diagram c1 m1 o1 c2 m2 o2) where
+        d1 == d2 = src d1 == src d2 && tgt d1 == tgt d2 && omap d1 == omap d2 && Map.restrictKeys (mmap d1) (genArrows (src d1)) == Map.restrictKeys (mmap d2) (genArrows (src d2))     
     
     -- | Apply a 'Diagram' on an object of the source category.
     (->$) :: (Eq o1) => Diagram c1 m1 o1 c2 m2 o2 -> o1 -> o2
     (->$) f x = omap f |!| x
     
     -- | Apply a 'Diagram' on a morphism of the source category.
-    (->£) :: (Eq m1) => Diagram c1 m1 o1 c2 m2 o2 -> m1 -> m2
-    (->£) f x = mmap f |!| x
+    (->£) :: (Category c1 m1 o1, Morphism m1 o1, Morphism m2 o2, Eq m1) => Diagram c1 m1 o1 c2 m2 o2 -> m1 -> m2
+    (->£) f x
+        | null mapped = compose $ (mmap f |!|) <$> decompose (src f) x
+        | otherwise = y
+        where
+            mapped = mmap f |?| x
+            Just y = mapped
     
     -- | Compose two 'Diagram's.
-    (<-@<-) :: (Eq o2, Eq m2) => Diagram c2 m2 o2 c3 m3 o3 -> Diagram c1 m1 o1 c2 m2 o2 -> Diagram c1 m1 o1 c3 m3 o3
-    (<-@<-) g f = Diagram{src = src f, tgt = tgt g, omap = (omap g) |.| (omap f), mmap = (mmap g) |.| (mmap f)}
+    (<-@<-) :: (Category c1 m1 o1, Morphism m1 o1, Eq m1,
+                Category c2 m2 o2, Morphism m2 o2, Eq o2, Eq m2,
+                Morphism m3 o3) => Diagram c2 m2 o2 c3 m3 o3 -> Diagram c1 m1 o1 c2 m2 o2 -> Diagram c1 m1 o1 c3 m3 o3
+    (<-@<-) g f = Diagram{src = src f, tgt = tgt g, omap = (omap g) |.| (omap f), mmap = mm}
+        where
+            mm = weakMapFromSet [(x, g ->£ (f ->£ x)) | x <- keys' (mmap f)]
     
     -- | Construct a 'Diagram' selecting an object in a category.
     --
@@ -155,7 +177,7 @@     parallelDiagram :: (Category c m o, Morphism m o, Eq o) => 
             c -> m -> m -> Diagram Parallel ParallelAr ParallelOb c m o
     parallelDiagram targ f g = completeDiagram Diagram{src=Parallel, tgt=targ, omap=weakMap [(ParallelA,source f),(ParallelB,target f)], mmap=weakMap [(ParallelF, f), (ParallelG, g)]}
-    
+        
     
     -- Diagram structure check
     
@@ -167,15 +189,15 @@                                         | TornMorphism{f :: m1, fImage :: m2} -- ^ A morphism /f/ is torn apart.
                                         | IdentityNotPreserved{originalId :: m1, imageId :: m2} -- ^ The image of an identity is not an identity.
                                         | CompositionNotPreserved{f :: m1, g :: m1, imageFG :: m2} -- ^ Composition is not preserved by the functor.
-                               deriving (Eq, Show)
+                               deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)
                                
-    -- | Check wether the properties of a 'Diagram' are respected where the target category is finite.
+    -- | Check wether the properties of a 'Diagram' are respected where the source and target category are finite.
     checkFiniteDiagram :: (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 d@Diagram{src=s,tgt=t,omap=om,mmap=fm}
         | domain om /= ob s = Just WrongDomainObjects{srcObjs = ob s, domainObjs = domain om}
-        | domain fm /= arrows s = Just WrongDomainMorphisms{srcMorphs = arrows s, domainMorphs = domain fm}
+        | not $ (genArrows s) `isIncludedIn` (domain fm) = Just WrongDomainMorphisms{srcMorphs = genArrows s, domainMorphs = domain fm}
         | not $ image om `isIncludedIn` ob t = Just WrongImageObjects{imageObjs = image om, codomainObjs = ob t}
         | not $ image fm `isIncludedIn` arrows t = Just WrongImageMorphisms{imageMorphs = image fm, codomainMorphs = arrows t}
         | not.(Set.null) $ tear = Just TornMorphism{f = anElement tear, fImage = d ->£ (anElement tear)}
@@ -185,25 +207,51 @@         where
             tear = [arr | arr <- domain fm, om |!| (source arr) /= source (fm |!| arr) || om |!| (target arr) /= target (fm |!| arr)]
             imId = [a | a <- ob s, fm |!| (identity s a) /= identity t (om |!| a)]
-            errCompo = [(f,g) | f <- (arrows s), g <- (arFrom s (target f)), fm |!| (g @ f) /= (fm |!| g) @ (fm |!| f)]
+            errCompo = [(f,g) | f <- (genArrows s), g <- (genArFrom s (target f)), not (null $ fm |?| (g @ f)) && fm |!| (g @ f) /= (fm |!| g) @ (fm |!| f)]
             
-    -- | Check wether the properties of a 'Diagram' are respected where the target category is infinite.
+    -- | Check wether the properties of a 'Diagram' are respected where the source or target category is infinite.
     checkDiagram :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
                            Category 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)
     checkDiagram d@Diagram{src=s,tgt=t,omap=om,mmap=fm}
         | domain om /= ob s = Just WrongDomainObjects{srcObjs = ob s, domainObjs = domain om}
-        | domain fm /= arrows s = Just WrongDomainMorphisms{srcMorphs = arrows s, domainMorphs = domain fm}
+        | not $ (genArrows s) `isIncludedIn` (domain fm) = Just WrongDomainMorphisms{srcMorphs = genArrows s, domainMorphs = domain fm}
         | not.(Set.null) $ tear = Just TornMorphism{f = anElement tear, fImage = d ->£ (anElement tear)}
         | not.(Set.null) $ imId = Just IdentityNotPreserved{originalId = identity s (anElement imId), imageId = d ->£ (identity s (anElement imId))}
-        | not.(Set.null) $ errCompo = Just CompositionNotPreserved{f = fst (anElement errCompo), g = snd (anElement errCompo), imageFG = d ->£ ((snd (anElement errCompo)) @ (fst (anElement errCompo)))}
         | otherwise = Nothing
         where
             tear = [arr | arr <- domain fm, om |!| (source arr) /= source (fm |!| arr) || om |!| (target arr) /= target (fm |!| arr)]
             imId = [a | a <- ob s, fm |!| (identity s a) /= identity t (om |!| a)]
-            errCompo = [(f,g) | f <- (arrows s), g <- (arFrom s (target f)), fm |!| (g @ f) /= (fm |!| g) @ (fm |!| f)]
     
-    -- | Smart constructor of 'Diagram'.
+    -- | Return the inverse of a finite 'Diagram' if possible, return a 'DiagramError' otherwise. Note that this function fails almost all the time if the mapping of morphisms contains generators only (it would only work if all the generators are in the image of the diagram).
+    inverseDiagram :: (FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2,
+                       FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1) => 
+        Diagram c1 m1 o1 c2 m2 o2 -> Either (DiagramError c2 m2 o2 c1 m1 o1) (Diagram c2 m2 o2 c1 m1 o1)
+    inverseDiagram diag
+        | null err = Right pseudoInverseDiag
+        | otherwise = Left $ fromJust err
+        where
+            pseudoInverseDiag = Diagram{src = tgt diag, tgt = src diag, omap = pseudoInverse (omap diag), mmap = pseudoInverse (mmap diag)}
+            err = checkFiniteDiagram pseudoInverseDiag
+            fromJust (Just x) = x
+    
+    -- | Return the inverse of a 'Diagram' without checking the structure of the returned 'Diagram'. See 'inverseDiagram' for the safe version. Note that this function fails almost all the time if the mapping of morphisms contains generators only (it would only work if all the generators are in the image of the diagram).
+    unsafeInverseDiagram :: Diagram c1 m1 o1 c2 m2 o2 -> Diagram c2 m2 o2 c1 m1 o1
+    unsafeInverseDiagram diag = Diagram{src = tgt diag, tgt = src diag, omap = pseudoInverse (omap diag), mmap = pseudoInverse (mmap diag)}
+    
+    -- | Smart constructor of a finite 'Diagram'.
+    finiteDiagram :: ( FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
+                 FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2) =>
+                 c1 -> c2 -> Map o1 o2 -> Map m1 m2 -> Either (DiagramError c1 m1 o1 c2 m2 o2) (Diagram c1 m1 o1 c2 m2 o2)
+    finiteDiagram c1 c2 om mm 
+        | null check = Right diag
+        | otherwise = Left err
+        where
+            diag = Diagram{src = c1, tgt = c2, omap = om, mmap = mm}
+            check = checkFiniteDiagram diag
+            Just err = check
+       
+    -- | Smart constructor of a 'Diagram'. See 'finiteDiagram' for constructing finite 'Diagram's.
     diagram :: ( FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
                  FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2) =>
                  c1 -> c2 -> Map o1 o2 -> Map m1 m2 -> Either (DiagramError c1 m1 o1 c2 m2 o2) (Diagram c1 m1 o1 c2 m2 o2)
@@ -212,19 +260,21 @@         | otherwise = Left err
         where
             diag = Diagram{src = c1, tgt = c2, omap = om, mmap = mm}
-            check = checkFiniteDiagram diag
+            check = checkDiagram diag
             Just err = check
     
-    -- | Complete a partial 'Diagram' by adding the mapping between identities and the mapping between composite morphisms using the decomposition of the indexing category.
+    -- | Complete a partial 'Diagram' by adding mapping on objects from mapping of arrows and mapping on identities.
     --
-    -- Does not check the structure of the resulting 'Diagram', you can use 'checkFiniteDiagram' to check afterwards.
+    -- Does not check the structure of the resulting 'Diagram', you can use 'checkFiniteDiagram' or 'checkDiagram' to check afterwards.
     completeDiagram :: (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 Diagram{src=s,tgt=t,omap=om,mmap=mm} = Diagram{src=s,tgt=t,omap=om, mmap=Map.unions [mm, mapId, mapCompo] }
+    completeDiagram Diagram{src=s,tgt=t,omap=om,mmap=mm} = Diagram{src=s,tgt=t,omap=newMapObj, mmap=Map.unions [mm, mapId] }
         where
-            mapId = weakMapFromSet [(identity s o, identity t (om |!| o)) | o <- ob s]
-            mapCompo = weakMapFromSet [(f, compose $ (mm |!|) <$> decompose s f) | f <- arrows s, isComposite s f]
+            mapId = weakMapFromSet [(identity s o, identity t (newMapObj |!| o)) | o <- ob s, o `isIn` (keys' newMapObj)]
+            mapSrc = weakMap [(source f1, source f2) | (f1,f2) <- (Map.mapToList mm)]
+            mapTgt= weakMap [(target f1, target f2) | (f1,f2) <- (Map.mapToList mm)]
+            newMapObj = Map.unions [om, mapSrc, mapTgt]
     
     
     -- | Pick one element of a list randomly.
@@ -258,23 +308,17 @@                                                             srcNT :: Diagram c1 m1 o1 c2 m2 o2, -- ^ The source functor (private, use 'source' instead).
                                                             tgtNT :: Diagram c1 m1 o1 c2 m2 o2, -- ^ The target functor (private, use 'target' instead).
                                                             components :: Map o1 m2 -- ^ The components
-                                                        } deriving (Eq)
+                                                        } deriving (Eq, Generic, PrettyPrint, Simplifiable)
     
     instance (Show c1, Show m1, Show o1, Show c2, Show m2, Show o2) => Show (NaturalTransformation c1 m1 o1 c2 m2 o2) where
         show nt = "(unsafeNaturalTransformation "++ (show.srcNT $ nt) ++ " " ++ (show.tgtNT $ nt) ++ " " ++ (show.components $ nt) ++ ")"
         
-    instance (  PrettyPrint c1, PrettyPrint m1, PrettyPrint o1, Eq m1, Eq o1,
-                PrettyPrint c2, PrettyPrint m2, PrettyPrint o2, Eq m2, Eq o2) => PrettyPrint (NaturalTransformation c1 m1 o1 c2 m2 o2) where
-        pprint nt = "NaturalTransformation(" ++ pprint (srcNT nt) ++ "->" ++ pprint (tgtNT nt) ++ "," ++ pprint (components nt) ++ ")"
-        
     instance (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
-                                       Morphism m2 o2, Eq c2, Eq m2, Eq o2) => 
+                                       Morphism m2 o2) => 
         Morphism (NaturalTransformation c1 m1 o1 c2 m2 o2) (Diagram c1 m1 o1 c2 m2 o2) where
         source = srcNT
         target = tgtNT
-        (@?) nt2 nt1
-            | target nt1 == source nt2 && (src.source $ nt1) == (src.target $ nt2) && (tgt.source $ nt1) == (tgt.target $ nt2) = Just NaturalTransformation{srcNT=source nt1, tgtNT=target nt2, components=weakMapFromSet [(o, (nt2 =>$ o) @ (nt1 =>$ o)) | o <- ob (src.source $ nt1)]}
-            | otherwise = Nothing
+        (@) nt2 nt1 = NaturalTransformation{srcNT=source nt1, tgtNT=target nt2, components=weakMapFromSet [(o, (nt2 =>$ o) @ (nt1 =>$ o)) | o <- ob (src.source $ nt1)]}
     
     
     -- | Apply a 'NaturalTransformation' on an object of the source 'Diagram'.
@@ -296,7 +340,7 @@     horizontalComposition = (<=@<=)
     
     -- | Left whiskering allows to compose a 'Diagram' with a 'NaturalTransformation'.
-    (<=@<-) :: (                        Morphism m1 o1,
+    (<=@<-) :: (     Category c1 m1 o1, Morphism m1 o1, Eq m1,
                FiniteCategory c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2,
                                         Morphism m3 o3, Eq c3, Eq m3, Eq o3) => 
                 NaturalTransformation c2 m2 o2 c3 m3 o3 -> Diagram c1 m1 o1 c2 m2 o2 -> NaturalTransformation c1 m1 o1 c3 m3 o3
@@ -307,7 +351,7 @@                                             }
     
     -- | Alias of ('<=@<-').
-    leftWhiskering :: (                          Morphism m1 o1,
+    leftWhiskering :: (       Category c1 m1 o1, Morphism m1 o1, Eq m1,
                         FiniteCategory c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2,
                                                  Morphism m3 o3, Eq c3, Eq m3, Eq o3) =>
         NaturalTransformation c2 m2 o2 c3 m3 o3 -> Diagram c1 m1 o1 c2 m2 o2 -> NaturalTransformation c1 m1 o1 c3 m3 o3
@@ -315,7 +359,8 @@     
     -- | Right whiskering allows to compose a 'NaturalTransformation' with a 'Diagram'.
     (<-@<=) :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
-                                         Morphism m2 o2, Eq c2, Eq m2, Eq o2) => 
+                      Category c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2,
+                                         Morphism m3 o3) => 
                 Diagram c2 m2 o2 c3 m3 o3 -> NaturalTransformation c1 m1 o1 c2 m2 o2 -> NaturalTransformation c1 m1 o1 c3 m3 o3
     (<-@<=) funct nt = NaturalTransformation {  
                                                 srcNT = funct <-@<- (source nt),
@@ -325,16 +370,19 @@     
     -- | Alias of ('<-@<=').
     rightWhiskering :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
-                                                 Morphism m2 o2, Eq c2, Eq m2, Eq o2) => 
+                              Category c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2,
+                                                 Morphism m3 o3) => 
         Diagram c2 m2 o2 c3 m3 o3 -> NaturalTransformation c1 m1 o1 c2 m2 o2 -> NaturalTransformation c1 m1 o1 c3 m3 o3
     rightWhiskering = (<-@<=)
     
     -- | A datatype to represent a malformation of a 'NaturalTransformation'.
     data NaturalTransformationError c1 m1 o1 c2 m2 o2 = IncompatibleFunctorsSource{sourceCat :: c1, targetCat :: c1} -- ^ The source and target functors don't have the same source category.
                                                       | IncompatibleFunctorsTarget{sourceCat2 :: c2, targetCat2 :: c2} -- ^ The source and target functors don't have the same target category.
+                                                      | WrongComponentSource{faultyComponent1 :: m2, correctSource :: o1} -- ^ The source of a component is not the image of the indexing object by the source functor. 
+                                                      | WrongComponentTarget{faultyComponent2 :: m2, correctTarget :: o1} -- ^ The target of a component is not the image of the indexing object by the target functor. 
                                                       | NotTotal{domainNat :: Set o1, objectsCat :: Set o1} -- ^ The mapping from objects to morphisms is not total.
                                                       | NaturalityFail{originalMorphism :: m1} -- ^ A morphism does not close a commutative square.
-                                                      deriving (Eq, Show)
+                                                      deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     
     -- | Check wether the structure of a 'NaturalTransformation' is respected.
@@ -345,12 +393,16 @@         | incompatibleFunctorsSource = Just IncompatibleFunctorsSource{sourceCat=(src.source $ nt), targetCat=(src.target $ nt)}
         | incompatibleFunctorsTarget = Just IncompatibleFunctorsTarget{sourceCat2=(tgt.source $ nt), targetCat2=(tgt.target $ nt)}
         | notTotal = Just NotTotal{domainNat = (domain.components $ nt), objectsCat = (ob.src.source $ nt)}
+        | (not.(Set.null)) wrongSource = Just WrongComponentSource{faultyComponent1 = fst $ anElement wrongSource, correctSource = snd $ anElement wrongSource}
+        | (not.(Set.null)) wrongTarget = Just WrongComponentTarget{faultyComponent2 = fst $ anElement wrongTarget, correctTarget = snd $ anElement wrongTarget}
         | (not.(Set.null)) naturalityFail = Just NaturalityFail{originalMorphism = anElement naturalityFail}
         | otherwise = Nothing
         where
             incompatibleFunctorsSource = (src.source $ nt) /= (src.target $ nt)
             incompatibleFunctorsTarget = (tgt.source $ nt) /= (tgt.target $ nt)  
             notTotal = (domain.components $ nt) /= (ob.src.source $ nt)
+            wrongSource = [((nt =>$ i),i) | i <- (ob.src.source $ nt), (source nt) ->$ i /= source (nt =>$ i)]
+            wrongTarget = [((nt =>$ i),i) | i <- (ob.src.source $ nt), (target nt) ->$ i /= target (nt =>$ i)]
             naturalityFail = [f | f <- (arrows.src.source $ nt), (target nt ->£ f) @ (nt =>$ (source f)) /= (nt =>$ (target f)) @ (source nt ->£ f)]
     
     -- | The smart constructor of 'NaturalTransformation'. Checks wether the structure is correct.
@@ -371,14 +423,14 @@     unsafeNaturalTransformation :: Diagram c1 m1 o1 c2 m2 o2 -> Diagram c1 m1 o1 c2 m2 o2 -> Map o1 m2 -> NaturalTransformation c1 m1 o1 c2 m2 o2
     unsafeNaturalTransformation s t c = NaturalTransformation{srcNT = s, tgtNT = t, components = c}
     
+    indexingCategory :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1, Morphism m2 o2) => NaturalTransformation c1 m1 o1 c2 m2 o2 -> c1
+    indexingCategory = src.source
+    
     -- Functor Category
     
     
     -- | A 'FunctorCategory' /D/^/C/ where /C/ is a 'FiniteCategory' and /D/ is a 'Category' has 'Diagram's @F : C -> D@ as objects and 'NaturalTransformation's between them as morphisms. 'NaturalTransformation's compose vertically in this category.
-    data FunctorCategory c1 m1 o1 c2 m2 o2 = FunctorCategory c1 c2 deriving (Eq, Show)
-    
-    instance (PrettyPrint c1, PrettyPrint c2) => PrettyPrint (FunctorCategory c1 m1 o1 c2 m2 o2) where
-        pprint (FunctorCategory c d) = "FunctorCategory(" ++ pprint c ++ "," ++ pprint d ++ ")"
+    data FunctorCategory c1 m1 o1 c2 m2 o2 = FunctorCategory c1 c2 deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
         
     instance (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
                     Category c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2) =>
@@ -408,12 +460,7 @@     -- | A 'FunctorCategory' /D/^/C/ precomposed by a functor @F : B -> C@ where /B/ and /C/ are 'FiniteCategory' and /D/ is a 'Category'.
     --
     -- It has 'Diagram's @G o F : B -> D@ as objects and 'NaturalTransformation's between them as morphisms. 'NaturalTransformation's compose vertically in this category.
-    data PrecomposedFunctorCategory c1 m1 o1 c2 m2 o2 c3 m3 o3 = PrecomposedFunctorCategory (Diagram c1 m1 o1 c2 m2 o2) c3 deriving (Eq, Show)
-    
-    instance   (PrettyPrint c1, PrettyPrint m1, PrettyPrint o1, Eq m1, Eq o1,
-                PrettyPrint c2, PrettyPrint m2, PrettyPrint o2, Eq m2, Eq o2,
-                PrettyPrint c3) => PrettyPrint (PrecomposedFunctorCategory c1 m1 o1 c2 m2 o2 c3 m3 o3) where
-        pprint (PrecomposedFunctorCategory diag d) = "PrecomposedFunctorCategory(" ++ pprint diag ++ "," ++ pprint d ++ ")"
+    data PrecomposedFunctorCategory c1 m1 o1 c2 m2 o2 c3 m3 o3 = PrecomposedFunctorCategory (Diagram c1 m1 o1 c2 m2 o2) c3 deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
         
     instance (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,
@@ -435,12 +482,7 @@     -- | A 'FunctorCategory' /D/^/C/ postcomposed by a functor @F : D -> E@ where /C/ is a 'FiniteCategory' and /D/  and /E/ are 'Category'. 
     --
     -- It has 'Diagram's @ F o G : C -> E@ as objects and 'NaturalTransformation's between them as morphisms. 'NaturalTransformation's compose vertically in this category.
-    data PostcomposedFunctorCategory c1 m1 o1 c2 m2 o2 c3 m3 o3 = PostcomposedFunctorCategory (Diagram c2 m2 o2 c3 m3 o3) c1 deriving (Eq, Show)
-    
-    instance   (PrettyPrint c1,
-                PrettyPrint c2, PrettyPrint m2, PrettyPrint o2, Eq m2, Eq o2,
-                PrettyPrint c3, PrettyPrint m3, PrettyPrint o3, Eq m3, Eq o3) => PrettyPrint (PostcomposedFunctorCategory c1 m1 o1 c2 m2 o2 c3 m3 o3) where
-        pprint (PostcomposedFunctorCategory diag d) = "PostcomposedFunctorCategory(" ++ pprint diag ++ "," ++ pprint d ++ ")"
+    data PostcomposedFunctorCategory c1 m1 o1 c2 m2 o2 c3 m3 o3 = PostcomposedFunctorCategory (Diagram c2 m2 o2 c3 m3 o3) c1 deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
         
     instance (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
                     Category c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2,
src/Math/Categories/Galaxy.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
 Description : The __'Galaxy'__ category has every objects and no morphism other than identities.
@@ -25,19 +28,20 @@     import          Math.IO.PrettyPrint
     
     import          Data.WeakSet.Safe
+    import              Data.Simplifiable
     
+    import          GHC.Generics
+    
     -- | 'StarIdentity' is the identity of a star (an object) in a 'Galaxy'.
-    data StarIdentity a = StarIdentity a deriving (Eq, Show)
+    data StarIdentity a = StarIdentity a deriving (Eq, Show, Generic, Simplifiable)
     
-    instance (Eq a) => Morphism (StarIdentity a) a where
-        (StarIdentity x) @? (StarIdentity y)
-            | x == y = Just (StarIdentity x)
-            | otherwise = Nothing
+    instance Morphism (StarIdentity a) a where
+        (StarIdentity x) @ _ = (StarIdentity x)
         source (StarIdentity x) = x
         target = source
     
     -- | The __'Galaxy'__ category has every objects and no morphism other than identities.
-    data Galaxy a = Galaxy deriving (Eq,Show)
+    data Galaxy a = Galaxy deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance (Eq a) => Category (Galaxy a) (StarIdentity a) a where
         identity _ = StarIdentity
@@ -46,7 +50,9 @@             | otherwise = set []
     
     instance (PrettyPrint a) => PrettyPrint (StarIdentity a) where
-        pprint (StarIdentity x) = "Id"++ pprint x
-    
-    instance PrettyPrint (Galaxy a) where
-        pprint = show+        pprint 0 _ = "Id"
+        pprint v (StarIdentity x) = "Id_" ++ pprint (v-1) x
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "Id\n"
+        -- pprintWithIndentations cv ov indent (StarIdentity x) = indentation (ov - cv) indent ++ "Id_" ++ pprint (cv-1) x ++ "\n"
+
src/Math/Categories/Omega.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
 Description : The category associated to the ordinal number omega is the category generated by the arrows 0 -> 1 -> 2 -> ... (See Categories for the working mathematican. Saunders Mac Lane. p.12)
src/Math/Categories/Opposite.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 {-| Module  : FiniteCategories
 Description : Each 'Category' has an opposite one where morphisms are reversed.
@@ -24,9 +28,12 @@     import          Math.IO.PrettyPrint
     
     import          Data.WeakSet.Safe
+    import          Data.Simplifiable
     
+    import          GHC.Generics
+    
     -- | An 'OpMorphism' is a morphism where source and target are reversed.
-    data OpMorphism m = OpMorphism m deriving (Eq, Show)
+    data OpMorphism m = OpMorphism m deriving (Eq, Show, Generic, Simplifiable)
     
     -- | Return the original morphism given an 'OpMorphism'.
     opOpMorphism :: OpMorphism m -> m
@@ -35,10 +42,10 @@     instance (Morphism m o) => Morphism (OpMorphism m) o where
         source (OpMorphism m) = target m
         target (OpMorphism m) = source m
-        (@?) (OpMorphism m2) (OpMorphism m1) = OpMorphism <$> m1 @? m2
+        (@) (OpMorphism m2) (OpMorphism m1) = OpMorphism $ m1 @ m2
     
     -- | The 'Op' operator gives the opposite of a 'Category'.
-    data Op c = Op c deriving (Eq, Show)
+    data Op c = Op c deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     -- | Return the original category given an 'Op' category.
     opOp :: Op c -> c
@@ -54,7 +61,8 @@         ob (Op c) = ob c
     
     instance (PrettyPrint m) => PrettyPrint (OpMorphism m) where
-        pprint (OpMorphism m) = "Op("++ pprint m ++ ")"
-    
-    instance (PrettyPrint c) => PrettyPrint (Op c) where
-        pprint (Op x) = "Op("++ pprint x ++ ")"+        pprint 0 _ = "..."
+        pprint v (OpMorphism m) = "Op("++ pprint (v-1) m ++ ")"
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        -- pprintWithIndentations cv ov indent (OpMorphism x) = indentation (ov - cv) indent ++ "Op\n" ++ pprintWithIndentations (cv - 1) ov indent x
src/Math/Categories/OrdinalCategory.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
 Description : An 'OrdinalCategory' is a 'TotalOrder' category where the total order is an order induced by ordinal numbers. 
@@ -25,18 +29,25 @@ )
 where
     import              Math.Category
+    import              Math.FiniteCategory
+    import              Math.CompleteCategory
+    import              Math.CocompleteCategory
     import              Math.Categories.FunctorCategory
     import              Math.Categories.ConeCategory
     import              Math.Categories.TotalOrder
+    import              Math.FiniteCategories.Parallel
     import              Math.IO.PrettyPrint
     
+    import qualified    Data.WeakSet          as Set
     import              Data.WeakSet.Safe
     import qualified    Data.WeakMap          as Map
     import              Data.WeakMap.Safe
+    import              Data.Simplifiable
     
+    import              GHC.Generics
     
     -- | An 'OrdinalCategory' is a 'TotalOrder' where the type /a/ follows the Enum typeclass.
-    newtype OrdinalCategory a = OrdinalCategory (TotalOrder a) deriving (Eq, Show)
+    newtype OrdinalCategory a = OrdinalCategory (TotalOrder a) deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance (Enum a, Ord a) => Category (OrdinalCategory a) (IsSmallerThan a) a where
         ar _ x y
@@ -55,6 +66,42 @@             | x == y = [IsSmallerThan x y]
             | otherwise = reverse $ (\n -> IsSmallerThan n (succ n)) <$> [x..(pred y)]
     
-    
-    instance (Show a) => PrettyPrint (OrdinalCategory a) where
-        pprint = show+    instance (Enum a, Ord a, Eq oIndex) => HasProducts (OrdinalCategory a) (IsSmallerThan a) a (OrdinalCategory a) (IsSmallerThan a) a oIndex where
+        product diag = unsafeCone apexProduct nat
+            where
+                apexProduct = Set.minimum $ Map.values $ omap diag
+                nat = unsafeNaturalTransformation (constantDiagram (src diag) (OrdinalCategory TotalOrder) apexProduct) diag $ Map.weakMapFromSet [(i,IsSmallerThan apexProduct (diag ->$ i)) | i <- ob $ src diag]
+                
+    instance (Enum a, Ord a) => HasEqualizers (OrdinalCategory a) (IsSmallerThan a) a where
+        equalize parallelDiag = unsafeCone apexEq nat
+            where
+                apexEq = parallelDiag ->$ ParallelA
+                nat = unsafeNaturalTransformation (constantDiagram Parallel (OrdinalCategory TotalOrder) apexEq) parallelDiag (weakMap [(ParallelA, IsSmallerThan apexEq apexEq),(ParallelB, IsSmallerThan (parallelDiag ->$ ParallelB) (parallelDiag ->$ ParallelB))])
+                
+    instance (Enum a, Ord a, Eq mIndex, Eq oIndex) => CompleteCategory (OrdinalCategory a) (IsSmallerThan a) a (OrdinalCategory a) (IsSmallerThan a) a cIndex mIndex oIndex where
+        limit diag = unsafeCone apexLimit nat
+            where
+                apexLimit = Set.minimum $ Map.values $ omap diag
+                nat = unsafeNaturalTransformation (constantDiagram (src diag) (OrdinalCategory TotalOrder) apexLimit) diag $ Map.weakMapFromSet [(i,IsSmallerThan apexLimit (diag ->$ i)) | i <- ob $ src diag]
+                
+        projectBase diag = Diagram{src = tgt diag, tgt = tgt diag, omap = memorizeFunction id (Map.values (omap diag)), mmap = memorizeFunction id (Map.values (mmap diag))}
+                
+    instance (Enum a, Ord a, Eq oIndex) => HasCoproducts (OrdinalCategory a) (IsSmallerThan a) a (OrdinalCategory a) (IsSmallerThan a) a oIndex where
+        coproduct diag = unsafeCocone nadirCoproduct nat
+            where
+                nadirCoproduct = Set.maximum $ Map.values $ omap diag
+                nat = unsafeNaturalTransformation diag (constantDiagram (src diag) (OrdinalCategory TotalOrder) nadirCoproduct) $ Map.weakMapFromSet [(i,IsSmallerThan (diag ->$ i) nadirCoproduct) | i <- ob $ src diag]
+                
+    instance (Enum a, Ord a) => HasCoequalizers (OrdinalCategory a) (IsSmallerThan a) a where
+        coequalize parallelDiag = unsafeCocone nadirCoeq nat
+            where
+                nadirCoeq = parallelDiag ->$ ParallelB
+                nat = unsafeNaturalTransformation parallelDiag (constantDiagram Parallel (OrdinalCategory TotalOrder) nadirCoeq) (weakMap [(ParallelA, IsSmallerThan (parallelDiag ->$ ParallelA) (parallelDiag ->$ ParallelA)),(ParallelB, IsSmallerThan nadirCoeq nadirCoeq)])
+                
+    instance (Enum a, Ord a, Eq mIndex, Eq oIndex) => CocompleteCategory (OrdinalCategory a) (IsSmallerThan a) a (OrdinalCategory a) (IsSmallerThan a) a cIndex mIndex oIndex where
+        colimit diag = unsafeCocone nadirColimit nat
+            where
+                nadirColimit = Set.maximum $ Map.values $ omap diag
+                nat = unsafeNaturalTransformation diag (constantDiagram (src diag) (OrdinalCategory TotalOrder) nadirColimit) $ Map.weakMapFromSet [(i,IsSmallerThan (diag ->$ i) nadirColimit) | i <- ob $ src diag]
+                
+        coprojectBase diag = Diagram{src = tgt diag, tgt = tgt diag, omap = memorizeFunction id (Map.values (omap diag)), mmap = memorizeFunction id (Map.values (mmap diag))}
src/Math/Categories/PresheafCategory.hs view
@@ -35,6 +35,7 @@     import              Data.WeakMap        (Map)
     import qualified    Data.WeakMap    as  Map
     import              Data.WeakMap.Safe
+    import              Data.Simplifiable
     
     -- | A 'Presheaf' on a 'Category' /C/ is a diagram from @/C/^op@ to __FinSet__.
     type Presheaf c m o = Diagram (Op c) (OpMorphism m) o (FinSet m) (Function m) (Set m)
src/Math/Categories/TotalOrder.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
 Description : Any total (or linear) order induces a preorder category where elements are objects, there is an arrow between two objects iff the relation is satisfied.
@@ -20,29 +24,35 @@     
 )
 where
+    import              Math.FiniteCategory
     import              Math.Category
     import              Math.Categories.FunctorCategory
     import              Math.Categories.ConeCategory
+    import              Math.CompleteCategory
+    import              Math.CocompleteCategory
+    import              Math.FiniteCategories.Parallel
     import              Math.IO.PrettyPrint
     
+    import qualified    Data.WeakSet          as Set
     import              Data.WeakSet.Safe
     import qualified    Data.WeakMap          as Map
     import              Data.WeakMap.Safe
+    import              Data.Simplifiable
     
+    import              GHC.Generics
+    
     -- | 'IsSmallerThan' is the type of morphisms in a linear order, it reminds the fact that there is a morphism from a source to a target iff the source is smaller than the target.
-    data IsSmallerThan a = IsSmallerThan a a deriving (Eq, Show)
+    data IsSmallerThan a = IsSmallerThan a a deriving (Eq, Show, Generic, Simplifiable)
     
     instance (Eq a) => Morphism (IsSmallerThan a) a where
-        (IsSmallerThan m1 t) @? (IsSmallerThan s m2)
-            | m1 == m2 = Just $ IsSmallerThan s t
-            | otherwise = Nothing
+        (IsSmallerThan m1 t) @ (IsSmallerThan s m2) = IsSmallerThan s t
         source (IsSmallerThan s _) = s
         target (IsSmallerThan _ t) = t
     
     -- | A 'TotalOrder' category is the category induced by a total order.
     --
     -- (See Categories for the working mathematican. Saunders Mac Lane. p.11)
-    data TotalOrder a = TotalOrder deriving (Eq,Show)
+    data TotalOrder a = TotalOrder deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance (Eq a, Ord a) => Category (TotalOrder a) (IsSmallerThan a) a where
         identity _ x = IsSmallerThan x x
@@ -51,7 +61,48 @@             | otherwise = set []
     
     instance (PrettyPrint a) => PrettyPrint (IsSmallerThan a) where
-        pprint (IsSmallerThan x y) = pprint x ++ " <= " ++ pprint y
-    
-    instance PrettyPrint (TotalOrder a) where
-        pprint = show+        pprint 0 (IsSmallerThan x y) = pprint 0 x ++ " <= " ++ pprint 0 y
+        pprint v (IsSmallerThan x y) = pprint (v-1) x ++ " <= " ++ pprint (v-1) y
+        
+        -- pprintWithIndentations 0 ov indent (IsSmallerThan x y) = indentation ov indent ++ pprint 0 x++" <= "++pprint 0 y ++ "\n"
+        -- pprintWithIndentations cv ov indent (IsSmallerThan x y) = indentation (ov - cv) indent ++ pprint (cv-1) x++" <= "++pprint (cv-1) y ++ "\n"
+        
+    instance (Ord a, Eq oIndex) => HasProducts (TotalOrder a) (IsSmallerThan a) a (TotalOrder a) (IsSmallerThan a) a oIndex where
+        product diag = unsafeCone apexProduct nat
+            where
+                apexProduct = Set.minimum $ Map.values $ omap diag
+                nat = unsafeNaturalTransformation (constantDiagram (src diag) TotalOrder apexProduct) diag $ Map.weakMapFromSet [(i,IsSmallerThan apexProduct (diag ->$ i)) | i <- ob $ src diag]
+                
+    instance (Ord a) => HasEqualizers (TotalOrder a) (IsSmallerThan a) a where
+        equalize parallelDiag = unsafeCone apexEq nat
+            where
+                apexEq = parallelDiag ->$ ParallelA
+                nat = unsafeNaturalTransformation (constantDiagram Parallel TotalOrder apexEq) parallelDiag (weakMap [(ParallelA, IsSmallerThan apexEq apexEq),(ParallelB, IsSmallerThan (parallelDiag ->$ ParallelB) (parallelDiag ->$ ParallelB))])
+                
+    instance (Ord a, Eq mIndex, Eq oIndex) => CompleteCategory (TotalOrder a) (IsSmallerThan a) a (TotalOrder a) (IsSmallerThan a) a cIndex mIndex oIndex where
+        limit diag = unsafeCone apexProduct nat
+            where
+                apexProduct = Set.minimum $ Map.values $ omap diag
+                nat = unsafeNaturalTransformation (constantDiagram (src diag) TotalOrder apexProduct) diag $ Map.weakMapFromSet [(i,IsSmallerThan apexProduct (diag ->$ i)) | i <- ob $ src diag]
+                
+        projectBase diag = Diagram{src = tgt diag, tgt = tgt diag, omap = memorizeFunction id (Map.values (omap diag)), mmap = memorizeFunction id (Map.values (mmap diag))}
+                
+    instance (Ord a, Eq oIndex) => HasCoproducts (TotalOrder a) (IsSmallerThan a) a (TotalOrder a) (IsSmallerThan a) a oIndex where
+        coproduct diag = unsafeCocone nadirCoproduct nat
+            where
+                nadirCoproduct = Set.maximum $ Map.values $ omap diag
+                nat = unsafeNaturalTransformation diag (constantDiagram (src diag) TotalOrder nadirCoproduct) $ Map.weakMapFromSet [(i,IsSmallerThan (diag ->$ i) nadirCoproduct) | i <- ob $ src diag]
+                
+    instance (Ord a) => HasCoequalizers (TotalOrder a) (IsSmallerThan a) a where
+        coequalize parallelDiag = unsafeCocone nadirCoeq nat
+            where
+                nadirCoeq = parallelDiag ->$ ParallelB
+                nat = unsafeNaturalTransformation parallelDiag (constantDiagram Parallel TotalOrder nadirCoeq) (weakMap [(ParallelA, IsSmallerThan (parallelDiag ->$ ParallelA) (parallelDiag ->$ ParallelA)),(ParallelB, IsSmallerThan nadirCoeq nadirCoeq)])
+                
+    instance (Ord a, Eq mIndex, Eq oIndex) => CocompleteCategory (TotalOrder a) (IsSmallerThan a) a (TotalOrder a) (IsSmallerThan a) a cIndex mIndex oIndex where
+        colimit diag = unsafeCocone nadirColimit nat
+            where
+                nadirColimit = Set.maximum $ Map.values $ omap diag
+                nat = unsafeNaturalTransformation diag (constantDiagram (src diag) TotalOrder nadirColimit) $ Map.weakMapFromSet [(i,IsSmallerThan (diag ->$ i) nadirColimit) | i <- ob $ src diag]
+                
+        coprojectBase diag = Diagram{src = tgt diag, tgt = tgt diag, omap = memorizeFunction id (Map.values (omap diag)), mmap = memorizeFunction id (Map.values (mmap diag))}
src/Math/Category.hs view
@@ -24,7 +24,6 @@     -- * Morphism
     Morphism(..),
     -- ** Morphism related functions
-    (@),
     compose,
     -- * Category
     Category(..),
@@ -58,29 +57,32 @@     -- 'Morphism' is a multiparametrized typeclass where /m/ is the type of the morphism and /o/ the type of the source and target objects.
     --
     -- Source and target are the same type of objects, we distinguish objects not by their type but instead by their values.
-    class Morphism m o | m -> o where
+    class Morphism m o | m -> o where        
+        -- | Unsafe version of ('@?').
+        --        
+        -- The composition @g '@' f@ may throw an error if @'source' g /= 'target' f@ although it is not garanteed that it will! This is a fast function as it is not supposed to check any compatibility of morphisms.
+        --
+        -- Composition is associative :
+        --
+        -- prop> f @ (g @ h) = (f @ g) @ h
+        (@) :: m -> m -> m
+        
         -- | The composition @g '@?' f@ should return 'Nothing' if @'source' g /= 'target' f@.
         -- This is a consequence of loosing type check at compilation time, we defer the exception handling to execution time.
         --
         -- Composition is associative :
         --
         -- prop> (fmap (f @?)) (g @? h) = fmap (@? h) (f @? g)
-        (@?) :: m -> m -> Maybe m
+        (@?) :: (Eq o) => m -> m -> Maybe m
+        (@?) g f
+            | source g == target f = Just $ g @ g
+            | otherwise = Nothing
         
         -- | Return the source object of the morphism.
         source :: m -> o
         
         -- | Return the target object of the morphism.
         target :: m -> o
-    
-    -- | Unsafe version of '(@?)'.
-    (@) :: (Morphism m o) => m -> m -> m
-    (@) m2 m1
-        | null compo = error "Math.Category.(@): incompatible morphisms"
-        | otherwise = r
-        where
-        compo = m2 @? m1
-        Just r = compo
     
     -- | Return the composition of a list of morphisms.
     --
+ src/Math/CocompleteCategory.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-| Module  : FiniteCategories
+Description : Typeclasses for 'Category' with special properties such as being cocomplete.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Typeclasses for 'Category' with special properties such as being cocomplete. 
+
+A 'Category' might have coproducts meaning that any 'discreteDiagram' on it has a colimit.
+
+A 'Category' might have coequalizers meaning that any 'parallelDiagram' on it has a colimit.
+
+If a 'Category' have both coproducts and coequalizers, it is cocomplete meaning that it has all small colimits.
+
+To compute colimits in a custom 'FiniteCategory', see 'colimits' in Math.ConeCategory.
+-}
+
+module Math.CocompleteCategory
+(
+    -- * Colimit type
+    Colimit(..),
+    uncoproject,
+    -- * Helper typeclasses to define a 'CocompleteCategory'
+    HasCoproducts(..),
+    HasCoequalizers(..),
+    colimitFromCoproductsAndCoequalizers,
+    -- * Cocomplete Category
+    CocompleteCategory(..),
+    uncoprojectBase,
+)
+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)
+    import              Data.Simplifiable
+    
+    import              Math.Category
+    import              Math.FiniteCategory
+    import              Math.Functors.DiagonalFunctor
+    import              Math.Categories.FunctorCategory
+    import              Math.Categories.ConeCategory
+    import              Math.Categories.Galaxy
+    import              Math.FiniteCategories.DiscreteCategory
+    import              Math.FiniteCategories.Parallel
+    import              Math.IO.PrettyPrint
+    
+    import              GHC.Generics
+    
+    -- | For a 'Category' parametrized over a type t, the apex of the colimit of a diagram indexed by a category parametrized over a type i will contain 'Coproduct' constructions. A given distinguished element can be constructed from a 'Coprojection' at a given index.
+    --
+    -- For example, in 'FinSet', let's consider a discrete diagram from 'DiscreteTwo' to ('FinSet' Int) which selects {1,2} and {3,4}. The nadir of the colimit is obviously {('A',1),('A',2),('B',3),('B',4)}, note that it is not an object of ('Finset' Int) but an object of ('FinSet' (DiscreteTwoOb,Int)). The 'Colimit' type allows to construct type ('FinSet' ('Colimit' 'DiscreteTwo' Int)) in which we can consider the original objects with 'Coprojection' and the new distinguished elements with 'Coproduct'. Thus, the colimit will be {Coproduct 'A' 1,Coproduct 'A' 2,Coproduct 'B' 3,Coproduct 'B' 4}. We can construct coprojections in the same category, for example along 'A', which will map ('Coprojection' 1) to 'Coproduct' 'A' 1.
+    data Colimit i t = Coprojection t -- ^ A 'Coprojection' is the parameter type of the original category to coproject them to the colimit.
+                     | CoproductElement i t  -- ^ A 'CoproductElement' is a couple containing an indexing object and an object of type t.
+                     deriving (Eq, Show, Generic, Simplifiable)
+                   
+    instance (PrettyPrint i, PrettyPrint t, Eq i) => PrettyPrint (Colimit i t) where
+        pprint v (Coprojection x) = pprint v x
+        pprint v (CoproductElement idx x) = pprint v x ++ "_" ++ pprint v idx
+        
+        pprintWithIndentations cv ov indent (Coprojection x) = indentation (ov - cv) indent ++ pprint cv x ++ "\n"
+        pprintWithIndentations cv ov indent (CoproductElement idx x) = indentation (ov - cv) indent ++ pprint cv x ++ "_" ++ pprint cv idx ++ "\n"
+    
+    -- | Remove the constructor 'Coprojection' from an original object t, throws an error if a 'CoproductElement' is given.
+    uncoproject :: Colimit oIndex t -> t
+    uncoproject (Coprojection t) = t
+    uncoproject (CoproductElement _ _) = error "Uncoproject a coproduct element."
+    
+    -- | The typeclass of categories which have all coproducts.
+    class (Category c m o, Morphism m o,
+           Category cLim mLim oLim, Morphism mLim oLim) =>
+           HasCoproducts c m o cLim mLim oLim oIndex | c -> m, m -> o, cLim -> mLim, mLim -> oLim, c oIndex -> cLim where
+        -- | Given a 'discreteDiagram' selecting objects, return the coproduct of the selected objects as a 'Cocone'.
+        coproduct :: Diagram (DiscreteCategory oIndex) (DiscreteMorphism oIndex) oIndex c m o  -> Cocone(DiscreteCategory oIndex) (DiscreteMorphism oIndex) oIndex cLim mLim oLim
+        
+    -- | The typeclass of categories which have all coequalizers.
+    class (Category c m o, Morphism m o) => HasCoequalizers c m o | c -> m, m -> o where
+        -- | Given a 'parallelDiagram' selecting arrows, return the coequalizer of the selected arrows as a 'Cocone'.  
+        coequalize :: Diagram Parallel ParallelAr ParallelOb c m o -> Cocone Parallel ParallelAr ParallelOb c m o
+        
+    -- | The typeclass of categories which have all colimits.
+    class (Category c m o, Morphism m o,
+           Category cLim mLim oLim, Morphism mLim oLim) =>
+           CocompleteCategory c m o cLim mLim oLim cIndex mIndex oIndex | c -> m, m -> o, cLim -> mLim, mLim -> oLim, c cIndex mIndex oIndex -> cLim where
+        
+        -- | Return the colimit of a 'Diagram'.
+        colimit :: (FiniteCategory cIndex mIndex oIndex, Morphism mIndex oIndex, Eq cIndex, Eq mIndex, Eq oIndex) => Diagram cIndex mIndex oIndex c m o -> Cocone cIndex mIndex oIndex cLim mLim oLim
+        
+        -- | A partial 'Diagram' to coproject objects and morphisms of a base like a call of 'colimit' would do.
+        --
+        -- (coconeBase (colimit diag)) should equal ((coprojectBase diag) <-@<- diag)
+        coprojectBase :: Diagram cIndex mIndex oIndex c m o -> Diagram c m o cLim mLim oLim
+       
+
+    -- | A partial 'Diagram' to uncoproject objects and morphisms of the base in a 'colimit' cocone.
+    --
+    -- uncoprojectBase and coprojectBase returned 'Diagram's are inverses.
+    uncoprojectBase :: (CocompleteCategory c m o cLim mLim oLim cIndex mIndex oIndex) => Diagram cIndex mIndex oIndex c m o -> Diagram cLim mLim oLim c m o
+    uncoprojectBase = unsafeInverseDiagram.coprojectBase
+        
+    
+    -- | Computes efficiently colimits thanks to coproducts and coequalizers. Can be used to instantiate 'CocompleteCategory'.
+    --
+    -- The first argument is a function to transform an object of the original category into a colimit object.
+    --
+    -- Most of the time, the original category takes one type parameter and the function uses 'Coprojection', when the category does not take any type parameter it is 'id'. 
+    --
+    -- For example, for 'FinSet', the function has to transform a function {1 -> 2} to the function {Coprojection 1 -> Coprojection 2}.
+    colimitFromCoproductsAndCoequalizers ::
+      (Category c m o, Morphism m o,
+       Category cLim mLim oLim, Morphism mLim oLim, HasCoproducts c m o cLim mLim oLim oIndex,HasCoequalizers cLim mLim oLim,
+       FiniteCategory cIndex mIndex oIndex, Morphism mIndex oIndex, Eq oIndex, Eq mIndex, Eq cIndex) => 
+       (m -> mLim) -> Diagram cIndex mIndex oIndex c m o -> Cocone cIndex mIndex oIndex cLim mLim oLim
+    colimitFromCoproductsAndCoequalizers transformMorphismIntoColimMorphism diag = colim
+            where
+                idxCat = src diag
+                discreteDiag = completeDiagram Diagram{src = discreteCategory bottomObjects, tgt = tgt diag, omap = weakMapFromSet [(o,diag ->$ o) | o <- bottomObjects], mmap = weakMap []}
+                bottomObjects = Set.filter (\o -> Set.and [not $ Set.null $ ar idxCat (target m) o | m <- arFrom idxCat o]) (ob idxCat)
+                objectToAMorphismToABottomObject o
+                    | o `Set.elem` bottomObjects = identity idxCat o
+                    | otherwise = anElement [m | m <- arFrom idxCat o, target m `Set.elem` bottomObjects]
+                coprod = coproduct discreteDiag
+                newDiag = (completeDiagram Diagram{src = src diag, tgt = (tgt (baseCocone coprod)), omap = weakMap [], mmap = transformMorphismIntoColimMorphism <$> mmap diag})
+                undiscrete = unsafeCocone (nadir coprod) (unsafeNaturalTransformation newDiag (constantDiagram (src diag) (tgt (baseCocone coprod)) (nadir coprod)) (weakMapFromSet [(o,((legsCocone coprod) =>$ (target $ objectToAMorphismToABottomObject o)) @ (newDiag ->£ (objectToAMorphismToABottomObject o))) | o <- (ob.src $ diag)]))
+                coequalizeFromMorph fIndex currColim = unsafeCocone (nadir coeq) ((diagonal (legsCocone coeq =>$ ParallelB)) @ (legsCocone currColim))
+                    where
+                        f = diag ->£ fIndex
+                        coeq = coequalize $ completeDiagram Diagram{src = Parallel, tgt = tgt (baseCocone currColim), omap = weakMap [], mmap = weakMap [(ParallelF, (legsCocone currColim) =>$ (source fIndex)),(ParallelG, ((legsCocone currColim) =>$ (target fIndex)) @ (transformMorphismIntoColimMorphism f))]}
+                        diagonal m = unsafeNaturalTransformation (constantDiagram (src diag) (tgt (baseCocone undiscrete)) (source m)) (constantDiagram (src diag) (tgt (baseCocone undiscrete)) (target m)) (memorizeFunction (const m) (ob (src diag)))
+                colim = Set.foldr coequalizeFromMorph undiscrete ((set.setToList) (genArrowsWithoutId idxCat))
+ src/Math/CompleteCategory.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-| Module  : FiniteCategories
+Description : Typeclasses for 'Category' with special properties such as being complete.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Typeclasses for 'Category' with special properties such as being complete. 
+
+A 'Category' might have products meaning that any 'discreteDiagram' on it has a limit.
+
+A 'Category' might have equalizers meaning that any 'parallelDiagram' on it has a limit.
+
+If a 'Category' have both products and equalizers, it is complete meaning that it has all small limits.
+
+To compute limits in a custom 'FiniteCategory', see 'limits' in Math.ConeCategory.
+-}
+
+module Math.CompleteCategory
+(
+    -- * Limit type
+    Limit(..),
+    unproject,
+    -- * Helper typeclasses to define a 'CompleteCategory'
+    HasProducts(..),
+    HasEqualizers(..),
+    limitFromProductsAndEqualizers,
+    -- * CompleteCategory
+    CompleteCategory(..),
+    unprojectBase,
+)
+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)
+    import              Data.Simplifiable
+    
+    import              Math.Category
+    import              Math.FiniteCategory
+    import              Math.Functors.DiagonalFunctor
+    import              Math.Categories.FunctorCategory
+    import              Math.Categories.ConeCategory
+    import              Math.Categories.Galaxy
+    import              Math.FiniteCategories.DiscreteCategory
+    import              Math.FiniteCategories.Parallel
+    import              Math.IO.PrettyPrint
+    
+    import              GHC.Generics
+    
+    -- | For a 'Category' parametrized over a type t, the apex of the limit of a diagram indexed by a category parametrized over a type i will contain 'ProductElement' constructions (a product element is a tuple). A given tuple can be projected onto a 'Projection' at a given index.
+    --
+    -- For example, in 'FinSet', let's consider a discrete diagram from 'DiscreteTwo' to ('FinSet' Int) which selects {1,2} and {3,4}. The apex of the limit is obviously {(1,3),(1,4),(2,3),(2,4)}, note that it is not an object of ('Finset' Int) but an object of ('FinSet' (Set (Int,Int))). The 'Limit' type allows to construct type ('FinSet' ('Limit' 'DiscreteTwo' Int)) in which we can consider the original objects with 'Projection' and the new tuples with 'ProductElement'. Here, instead of couples, we will consider the limit to be {ProductElement (weakMap [(A,1),(B,3)]),ProductElement (weakMap [(A,1),(B,4)]),ProductElement (weakMap [(A,2),(B,3)]),ProductElement (weakMap [(A,2),(B,4)])}. We can construct projections in the same category, for example along 'A', which will map 'ProductElement' (weakMap [(A,1),(B,3)]) to ('Projection' 1).
+    data Limit oIndex t = Projection t -- ^ A 'Projection' is the parameter type of the original category to project the limits back to them.
+                   | ProductElement (Map oIndex t) -- ^ A 'ProductElement' is a mapping from the indexing objects to objects of type t.
+                   deriving (Eq, Show, Generic, Simplifiable)
+                   
+    instance (PrettyPrint oIndex, PrettyPrint t, Eq oIndex) => PrettyPrint (Limit oIndex t) where
+        pprint v (Projection x) = pprint v x
+        pprint v (ProductElement tuple) = "(" ++ (intercalate "," (pprint v <$> Map.elems tuple)) ++ ")"
+        
+        pprintWithIndentations cv ov indent (Projection x) = indentation (ov - cv) indent ++ pprint cv x ++ "\n"
+        pprintWithIndentations cv ov indent (ProductElement tuple) = indentation (ov - cv) indent ++ "(" ++ (intercalate "," (pprint cv <$> Map.elems tuple)) ++ ")\n"
+    
+    -- | Remove the constructor 'Projection' from an original object t if possible.
+    unproject :: Limit oIndex t -> Maybe t
+    unproject (Projection t) = Just t
+    unproject (ProductElement _) = Nothing
+    
+    -- | The typeclass of categories which have all products.
+    class (Category c m o, Morphism m o,
+           Category cLim mLim oLim, Morphism mLim oLim) =>
+           HasProducts c m o cLim mLim oLim oIndex | c -> m, m -> o, cLim -> mLim, mLim -> oLim, c oIndex -> cLim where
+        
+        -- | Given a 'discreteDiagram' selecting objects, return the product of the selected objects as a 'Cone'.
+        product :: Diagram (DiscreteCategory oIndex) (DiscreteMorphism oIndex) oIndex c m o -> Cone(DiscreteCategory oIndex) (DiscreteMorphism oIndex) oIndex cLim mLim oLim
+        
+        
+        
+    -- | The typeclass of categories which have all equalizers.
+    class (Category c m o, Morphism m o) => HasEqualizers c m o | c -> m, m -> o where
+        -- | Given a 'parallelDiagram' selecting arrows, return the equalizer of the selected arrows as a 'Cone'.  
+        equalize :: Diagram Parallel ParallelAr ParallelOb c m o -> Cone Parallel ParallelAr ParallelOb c m o
+        
+    -- | The typeclass of categories which have all limits. cLim is the type of the new category in which we can compute limits and their projections. cIndex is the type of the indexing category of the diagrams.
+    class (Category c m o, Morphism m o,
+           Category cLim mLim oLim, Morphism mLim oLim) =>
+           CompleteCategory c m o cLim mLim oLim cIndex mIndex oIndex | c -> m, m -> o, cLim -> mLim, mLim -> oLim, c cIndex mIndex oIndex -> cLim where
+        
+        -- | Return the limit of a 'Diagram'.
+        limit :: (FiniteCategory cIndex mIndex oIndex, Morphism mIndex oIndex, Eq cIndex, Eq mIndex, Eq oIndex) => Diagram cIndex mIndex oIndex c m o -> Cone cIndex mIndex oIndex cLim mLim oLim
+        
+        -- | A partial 'Diagram' to project objects and morphisms of a base like a call of 'limit' would do.
+        --
+        -- (coneBase (limit diag)) should equal ((projectBase diag) <-@<- (diag))
+        projectBase :: Diagram cIndex mIndex oIndex c m o -> Diagram c m o cLim mLim oLim
+       
+
+    -- | A partial 'Diagram' to unproject object and morphism of the base in a 'limit' cone.
+    --
+    -- unprojectBase and projectBase returned 'Diagram's are inverses.
+    unprojectBase :: (CompleteCategory c m o cLim mLim oLim cIndex mIndex oIndex) => Diagram cIndex mIndex oIndex c m o -> Diagram cLim mLim oLim c m o
+    unprojectBase = unsafeInverseDiagram.projectBase
+
+    -- | Computes efficiently limits thanks to products and equalizers. Can be used to instantiate 'CompleteCategory'.
+    --
+    -- The first argument is a function to transform an object of the original category into a limit object.
+    --
+    -- Most of the time, the original category takes one type parameter and the function uses 'Projection', when the category does not take any type parameter it is 'id'. 
+    --
+    -- For example, for 'FinSet', the function has to transform a function {1 -> 2} to the function {Projection 1 -> Projection 2}.
+    limitFromProductsAndEqualizers :: 
+       (Category c m o, Morphism m o,
+        Category cLim mLim oLim, Morphism mLim oLim, Eq cLim, Eq mLim, Eq oLim, HasProducts c m o cLim mLim oLim oIndex,HasEqualizers cLim mLim oLim,
+        FiniteCategory cIndex mIndex oIndex, Morphism mIndex oIndex, Eq oIndex, Eq mIndex, Eq cIndex) => 
+        (m -> mLim) -> Diagram cIndex mIndex oIndex c m o -> Cone cIndex mIndex oIndex cLim mLim oLim
+    limitFromProductsAndEqualizers transformMorphismIntoLimMorphism diag = lim
+            where
+                idxCat = src diag
+                discreteDiag = completeDiagram Diagram{src = discreteCategory topObjects, tgt = tgt diag, omap = weakMapFromSet [(o,diag ->$ o) | o <- topObjects], mmap = weakMap[]}
+                topObjects = Set.filter (\o -> Set.and [not $ Set.null $ ar idxCat o (source m) | m <- arTo idxCat o]) (ob idxCat)
+                objectToAMorphismFromATopObject o
+                    | o `Set.elem` topObjects = identity idxCat o
+                    | otherwise = anElement [m | m <- arTo idxCat o, source m `Set.elem` topObjects]
+                prod = Math.CompleteCategory.product discreteDiag
+                newDiag = (completeDiagram Diagram{src = src diag, tgt = (tgt (baseCone prod)), omap = weakMap [], mmap = transformMorphismIntoLimMorphism <$> mmap diag})
+                undiscrete = unsafeCone (apex prod) (unsafeNaturalTransformation (constantDiagram (src diag) (tgt (baseCone prod)) (apex prod)) newDiag (weakMapFromSet [(o,(newDiag ->£ (objectToAMorphismFromATopObject o)) @ ((legsCone prod) =>$ (source $ objectToAMorphismFromATopObject o))) | o <- (ob.src $ diag)]))
+                equalizeFromMorph fIndex currLim = unsafeCone (apex eq) ((legsCone currLim) @ (diagonal (legsCone eq =>$ ParallelA)))
+                    where
+                        f = diag ->£ fIndex
+                        eq = equalize $ completeDiagram Diagram{src = Parallel, tgt = tgt (baseCone currLim), omap = weakMap [], mmap = weakMap [(ParallelF, (legsCone currLim) =>$ (target fIndex)),(ParallelG, (transformMorphismIntoLimMorphism f) @ ((legsCone currLim) =>$ (source fIndex)))]}
+                        diagonal m = unsafeNaturalTransformation (constantDiagram (src diag) (tgt (baseCone undiscrete)) (source m)) (constantDiagram (src diag) (tgt (baseCone undiscrete)) (target m)) (memorizeFunction (const m) (ob (src diag)))
+                lim = Set.foldr equalizeFromMorph undiscrete ((set.setToList) (genArrowsWithoutId (src diag)))
+
src/Math/FiniteCategories.hs view
@@ -28,6 +28,10 @@     module Math.FiniteCategories.One,
     module Math.FiniteCategories.ConeCategory,
     module Math.FiniteCategories.Subcategory,
+    module Math.FiniteCategories.DiscreteTwo,
+    module Math.FiniteCategories.LimitCategory,
+    module Math.FiniteCategories.ColimitCategory,
+    module Math.FiniteCategories.ExponentialCategory,
 ) where
     import Math.FiniteCategories.NumberCategory
     import Math.FiniteCategories.DiscreteCategory
@@ -44,4 +48,8 @@     import Math.FiniteCategories.CommaCategory 
     import Math.FiniteCategories.One
     import Math.FiniteCategories.ConeCategory
-    import Math.FiniteCategories.Subcategory+    import Math.FiniteCategories.Subcategory
+    import Math.FiniteCategories.DiscreteTwo
+    import Math.FiniteCategories.LimitCategory
+    import Math.FiniteCategories.ColimitCategory
+    import Math.FiniteCategories.ExponentialCategory
src/Math/FiniteCategories/All.hs view
@@ -14,6 +14,10 @@ module Math.FiniteCategories.All (
     module Math.Category,
     module Math.FiniteCategory,
+    module Math.CompleteCategory,
+    module Math.CocompleteCategory,
+    module Math.CartesianClosedCategory,
+    module Math.FiniteCategories.Examples,
     module Math.FiniteCategoryError,
     module Math.Categories,
     module Math.FiniteCategories,
@@ -22,6 +26,10 @@ ) where
     import Math.Category
     import Math.FiniteCategory
+    import Math.CompleteCategory
+    import Math.CocompleteCategory
+    import Math.CartesianClosedCategory
+    import Math.FiniteCategories.Examples
     import Math.FiniteCategoryError
     import Math.Categories
     import Math.Functors
+ src/Math/FiniteCategories/ColimitCategory.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE FunctionalDependencies  #-}
+{-# LANGUAGE MonadComprehensions  #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-| Module  : FiniteCategories
+Description : A 'ColimitCategory' is the colimit of a diagram in 'FinCat'.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+A 'ColimitCategory' is the colimit of a diagram in 'FinCat'. To compute colimits in a usual category, see Math.CocompleteCategory. To compute colimits in a custom 'FiniteCategory', see 'colimits' in Math.ConeCategory.
+
+Note that computing a 'ColimitCategory' is MUCH slower than computing a 'LimitCategory' as coequalizers of categories are trickier than equalizers of categories. We can only compute colimits of 'CompositionGraph's as coequalizing might create new formal morphisms when gluing two objects. Therefore 'colimit' transforms all given categories into 'CompositionGraph's. If you already have a 'CompositionGraph', consider using 'colimitOfCompositionGraphs' instead of 'colimit'.
+-}
+
+module Math.FiniteCategories.ColimitCategory
+(
+    glueObject,
+    glueObjects,
+    glueMorphism,
+    glueMorphisms,
+    colimitOfCompositionGraphs,
+    coprojectBaseCompositionGraphs
+)
+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)
+    import              Data.Simplifiable
+    
+    import              Math.Category
+    import              Math.FiniteCategory
+    import              Math.FiniteCategoryError
+    import              Math.CocompleteCategory
+    import              Math.Categories.FunctorCategory
+    import              Math.FiniteCategories.DiscreteCategory
+    import              Math.Categories.ConeCategory
+    import              Math.Categories.FinCat
+    import              Math.FiniteCategories.CompositionGraph
+    import              Math.FiniteCategories.Parallel
+    import              Math.Categories.FinGrph
+    import              Math.IO.PrettyPrint
+    
+    import              GHC.Generics
+    
+    -- | Glue two objects of a 'CompositionGraph' and return an insertion diagram into the new CompositionGraph.
+    glueObject :: (Eq a, Eq b) => CompositionGraph a b -> a -> a -> FinFunctor (CompositionGraph a b) (CGMorphism a b) a
+    glueObject cg a b = completeDiagram Diagram{src=cg,tgt=newCG, omap = omapD, mmap = mmapD}
+        where
+            glueObj obj = if obj == b then a else obj
+            omapD = memorizeFunction glueObj (nodes.support $ cg)
+            glueArr arr = Arrow{sourceArrow = glueObj.sourceArrow $ arr, targetArrow = glueObj.targetArrow $ arr, labelArrow = labelArrow arr}
+            mmapD = memorizeFunction ((unsafeArrowToCGMorphism cg).glueArr.unsafeCGMorphismToArrow) (genArrowsWithoutId cg)
+            newCG = unsafeCompositionGraph (unsafeGraph (Map.values omapD) (glueArr <$> (edges.support $ cg))) (law cg)
+    
+    -- | Glue objects of a 'CompositionGraph' and return an insertion diagram into the new CompositionGraph.
+    glueObjects :: (Eq a, Eq b) => CompositionGraph a b -> Set a -> FinFunctor (CompositionGraph a b) (CGMorphism a b) a
+    glueObjects cg objects
+        | Set.null objects = error "glue 0 object"
+        | otherwise = Set.foldr (\obj funct -> (glueObject (tgt funct) representant obj) @ funct) (identity FinCat cg) objects
+        where
+            representant = anElement objects
+
+    -- | Glue two morphisms with same source and target of a 'CompositionGraph' and return an insertion diagram into the new CompositionGraph.
+    -- The first argument should not be composite if the second is a generator.
+    glueMorphism :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b -> CGMorphism a b -> FinFunctor (CompositionGraph a b) (CGMorphism a b) a
+    glueMorphism cg m1 m2
+        | isComposite_ m1 && isGenerator_ m2 = error "Glue composite to generator."
+        | m1 == m2 = identity FinCat cg
+        | isGenerator_ m1 && isGenerator_ m2 = completeDiagram Diagram{src=cg,tgt=newCGGG,omap=omapGG,mmap=mmapGG}
+        | otherwise = completeDiagram Diagram{src=cg,tgt=newCG,omap=omapGG,mmap=mmapId}
+        where
+            isGenerator_ m = length (snd.path $ m) == 1
+            isComposite_ = not.isGenerator_
+            glueMorph m = if m == m2 then m1 else m
+            glueArr a = if a == (unsafeCGMorphismToArrow m2) then unsafeCGMorphismToArrow m1 else a
+            omapGG = memorizeFunction id (nodes.support $ cg)
+            mmapGG = memorizeFunction glueMorph (genArrowsWithoutId cg)
+            newLawGG =  weakMapFromSet $ (\(x,y) -> (glueArr <$> x, glueArr <$> y)) <$> ((Map.mapToSet).law $ cg)
+            newCGGG = unsafeCompositionGraph (unsafeGraph (nodes.support $ cg) ((edges.support $ cg) `Set.difference` (set [unsafeCGMorphismToArrow m2]))) newLawGG
+            newLaw = Map.insert (snd.path $ m2) (snd.path $ m1) (law cg)
+            mmapId = memorizeFunction (\morph -> CGMorphism{path=path morph, compositionLaw = newLaw}) (genArrowsWithoutId cg)
+            newCG = unsafeCompositionGraph (support cg) newLaw
+            
+    -- | Glue morphisms with same source and target of a 'CompositionGraph' and return an insertion diagram into the new CompositionGraph.
+    glueMorphisms :: (Eq a, Eq b) => CompositionGraph a b -> Set (CGMorphism a b) -> FinFunctor (CompositionGraph a b) (CGMorphism a b) a
+    glueMorphisms cg morphisms
+        | Set.null morphisms = error "glue 0 morphism"
+        | Set.null generators = Set.foldr (\morph funct -> (glueMorphism (tgt funct) (anElement morphisms) morph) @ funct) (identity FinCat cg) morphisms
+        | otherwise = Set.foldr (\morph funct -> (glueMorphism (tgt funct) (anElement generators) morph) @ funct) (identity FinCat cg) morphisms
+        where
+            generators = Set.filter (isGenerator cg) morphisms
+
+
+    instance (Eq e, Eq n, Eq oIndex) => 
+        HasCoproducts (FinCat (CompositionGraph n e) (CGMorphism n e) n) (FinFunctor (CompositionGraph n e) (CGMorphism n e) n) (CompositionGraph n e) (FinCat (CompositionGraph (Colimit oIndex n) (Colimit oIndex e)) (CGMorphism (Colimit oIndex n) (Colimit oIndex e)) (Colimit oIndex n)) (FinFunctor (CompositionGraph (Colimit oIndex n) (Colimit oIndex e)) (CGMorphism (Colimit oIndex n) (Colimit oIndex e)) (Colimit oIndex n)) (CompositionGraph (Colimit oIndex n) (Colimit oIndex e)) oIndex where
+        coproduct diagOfCG = unsafeCocone coproductCG natCoproduct
+            where
+                indexingCategory = src diagOfCG
+                coproductCG = unsafeCompositionGraph (nadir coproductGraphCocone) (Map.unions [weakMap $ (\(rp1,rp2) -> (transformArrowIntoArrowCoproduct i <$> rp1, transformArrowIntoArrowCoproduct i <$> rp2)) <$> (Map.mapToList (law (diagOfCG ->$ i))) | i <- (setToList (ob indexingCategory))])
+                transformObjectIntoObjectCoproduct i x = CoproductElement i x
+                transformArrowIntoArrowCoproduct i a = Arrow{sourceArrow = CoproductElement i (sourceArrow a), targetArrow = CoproductElement i (targetArrow a), labelArrow = CoproductElement i (labelArrow a)}
+                coproductGraphCocone = coproduct (completeDiagram $ Diagram{src = indexingCategory, tgt = FinGrph, omap = Map.weakMapFromSet [(i, support (diagOfCG ->$ i))| i <- ob indexingCategory], mmap = weakMap []})
+                newDiagOfCG = completeDiagram Diagram{src = indexingCategory, tgt = FinCat, omap = Map.weakMapFromSet [(i,coprojectCG cg) | (i,cg) <- Map.mapToSet (omap diagOfCG)], mmap = weakMap []}
+                natCoproduct = unsafeNaturalTransformation newDiagOfCG (constantDiagram indexingCategory FinCat coproductCG) (weakMapFromSet [(i, insertionFunctor i)| i <- ob indexingCategory])
+                coprojectArrow a = Arrow{sourceArrow = Coprojection $ sourceArrow a, targetArrow = Coprojection $ targetArrow a, labelArrow = Coprojection $ labelArrow a}
+                coprojectGraph g = unsafeGraph ((Coprojection) <$> nodes g) ((coprojectArrow) <$> edges g)
+                coprojectLaw cl = Map.weakMapFromSet [(coprojectArrow <$> rp1, coprojectArrow <$> rp2) | (rp1,rp2) <- Map.mapToSet cl]
+                coprojectCG cg = unsafeCompositionGraph (coprojectGraph $ support cg) (coprojectLaw $ law cg)
+                coprojectCGMorphism CGMorphism{path = (a, rp),compositionLaw = cl} = CGMorphism{path = (Coprojection a, coprojectArrow <$> rp), compositionLaw = coprojectLaw cl}
+                insertionFunctor i = completeDiagram Diagram{src = coprojectCG (diagOfCG ->$ i), tgt = coproductCG, omap = weakMapFromSet [(o, (nodeMap insertionGH) |!| o) | o <- ob (newDiagOfCG ->$ i)], mmap = weakMapFromSet [(coprojectCGMorphism m, (unsafeArrowToCGMorphism coproductCG (transformArrowIntoArrowCoproduct i (unsafeCGMorphismToArrow m)))) | m <- (genArrowsWithoutId (diagOfCG ->$ i))]}
+                    where
+                        insertionGH = (legsCocone coproductGraphCocone) =>$ i
+        
+
+    instance (Eq n, Eq e) => HasCoequalizers (FinCat (CompositionGraph n e) (CGMorphism n e) n) (FinFunctor (CompositionGraph n e) (CGMorphism n e) n) (CompositionGraph n e) where
+        coequalize parallelDiag = unsafeCocone coeq nat
+            where
+                selectingObjects = ob $ parallelDiag ->$ ParallelA
+                idFunct = Diagram{src = (parallelDiag ->$ ParallelB), tgt = (parallelDiag ->$ ParallelB), omap = memorizeFunction id (ob (parallelDiag ->$ ParallelB)), mmap = memorizeFunction id (genArrows (parallelDiag ->$ ParallelB))}
+                glueObjectsFunctor = Set.foldr (\obj funct -> (glueObjects (tgt funct) (set [(funct @ (parallelDiag ->£ ParallelF)) ->$ obj,(funct @ (parallelDiag ->£ ParallelG)) ->$ obj])) @ funct) idFunct selectingObjects
+                selectingArrows = genArrowsWithoutId $ parallelDiag ->$ ParallelA
+                glueArrowsFunctor = Set.foldr (\morph funct -> (glueMorphisms (tgt funct) (set [(funct @ (parallelDiag ->£ ParallelF)) ->£ morph,(funct @ (parallelDiag ->£ ParallelG)) ->£ morph])) @ funct) glueObjectsFunctor selectingArrows
+                coeq = tgt glueArrowsFunctor
+                nat = unsafeNaturalTransformation parallelDiag (constantDiagram Parallel FinCat coeq) (weakMap [(ParallelB, glueArrowsFunctor), (ParallelA, glueArrowsFunctor @ (parallelDiag ->£ ParallelF))])
+        
+    -- | Note that computing a 'ColimitCategory' is MUCH slower than computing a 'LimitCategory' as coequalizers of categories are trickier than equalizers of categories. We can only compute colimits of 'CompositionGraph's as coequalizing might create new formal morphisms when gluing two objects. Therefore 'colimit' transforms all given categories into 'CompositionGraph's. If you already have a 'CompositionGraph', consider using 'colimitOfCompositionGraphs' instead of 'colimit'.
+    instance (FiniteCategory c m o, Morphism m o, Eq c, Eq m, Eq o,
+              FiniteCategory cIndex mIndex oIndex, Morphism mIndex oIndex, Eq oIndex, Eq mIndex) => 
+        CocompleteCategory (FinCat c m o) (FinFunctor c m o) c (FinCat (CompositionGraph (Colimit oIndex o) (Colimit oIndex m)) (CGMorphism (Colimit oIndex o) (Colimit oIndex m)) (Colimit oIndex o)) (FinFunctor (CompositionGraph (Colimit oIndex o) (Colimit oIndex m)) (CGMorphism (Colimit oIndex o) (Colimit oIndex m)) (Colimit oIndex o)) (CompositionGraph (Colimit oIndex o) (Colimit oIndex m)) cIndex mIndex oIndex where
+        colimit diag = colimitFromCoproductsAndCoequalizers coprojectDiag newDiag
+            where
+                newDiag = Diagram{src = src diag, tgt = FinCat, omap = newOmap, mmap = newMmap}
+                newOmap = Map.weakMapFromSet [(k, tgt $ finiteCategoryToCompositionGraph2 (diag ->$ k)) | k <- ob (src diag)]
+                newMmap =  Map.weakMapFromSet [(a, diagramToDiagramOfCompositionGraphs2 (diag ->£ a)) | a <-  arrows (src diag)]
+                coprojectArrow a = Arrow{sourceArrow = Coprojection $ sourceArrow a, targetArrow = Coprojection $ targetArrow a, labelArrow = Coprojection $ labelArrow a}
+                coprojectGraph g = unsafeGraph ((Coprojection) <$> nodes g) ((coprojectArrow) <$> edges g)
+                coprojectLaw cl = Map.weakMapFromSet [(coprojectArrow <$> rp1, coprojectArrow <$> rp2) | (rp1,rp2) <- Map.mapToSet cl]
+                coprojectCG cg = unsafeCompositionGraph (coprojectGraph $ support cg) (coprojectLaw $ law cg)
+                coprojectCGMorphism CGMorphism{path = (a, rp),compositionLaw = cl} = CGMorphism{path = (Coprojection a, coprojectArrow <$> rp), compositionLaw = coprojectLaw cl}
+                coprojectDiag d = Diagram{src = coprojectCG $ src d, tgt = coprojectCG $ tgt d, omap = (\(x,y) -> (Coprojection x, Coprojection y)) <|$|> omap d, mmap = (\(x,y) -> (coprojectCGMorphism x, coprojectCGMorphism y)) <|$|> mmap d}
+
+        coprojectBase diag = Diagram{src = FinCat, tgt = FinCat, omap = Map.weakMapFromSet [(diag ->$ i,coprojectCG $ tgt $ finiteCategoryToCompositionGraph2 $  diag ->$ i) | i <- ob $ src diag], mmap = Map.weakMapFromSet [(diag ->£ f,coprojectDiag  $ diagramToDiagramOfCompositionGraphs2 $ diag ->£ f) | f <- arrows $ src diag] }
+            where
+                coprojectArrow a = Arrow{sourceArrow = Coprojection $ sourceArrow a, targetArrow = Coprojection $ targetArrow a, labelArrow = Coprojection $ labelArrow a}
+                coprojectGraph g = unsafeGraph ((Coprojection) <$> nodes g) ((coprojectArrow) <$> edges g)
+                coprojectLaw cl = Map.weakMapFromSet [(coprojectArrow <$> rp1, coprojectArrow <$> rp2) | (rp1,rp2) <- Map.mapToSet cl]
+                coprojectCG cg = unsafeCompositionGraph (coprojectGraph $ support cg) (coprojectLaw $ law cg)
+                coprojectCGMorphism CGMorphism{path = (a, rp),compositionLaw = cl} = CGMorphism{path = (Coprojection a, coprojectArrow <$> rp), compositionLaw = coprojectLaw cl}
+                coprojectDiag d = Diagram{src = coprojectCG $ src d, tgt = coprojectCG $ tgt d, omap = (\(x,y) -> (Coprojection x, Coprojection y)) <|$|> omap d, mmap = (\(x,y) -> (coprojectCGMorphism x, coprojectCGMorphism y)) <|$|> mmap d}
+                
+    -- | Computes the colimit of a 'Diagram' of 'CompositionGraph's, use this if you already have a 'Diagram' of 'CompositionGraph's. 
+    colimitOfCompositionGraphs :: (FiniteCategory cIndex mIndex oIndex, Morphism mIndex oIndex, Eq cIndex, Eq mIndex, Eq oIndex, Eq n, Eq e) => 
+        Diagram cIndex mIndex oIndex (FinCat (CompositionGraph n e) (CGMorphism n e) n) (FinFunctor (CompositionGraph n e) (CGMorphism n e) n) (CompositionGraph n e) -> Cocone cIndex mIndex oIndex (FinCat (CompositionGraph (Colimit oIndex n) (Colimit oIndex e)) (CGMorphism (Colimit oIndex n) (Colimit oIndex e)) (Colimit oIndex n)) (FinFunctor (CompositionGraph (Colimit oIndex n) (Colimit oIndex e)) (CGMorphism (Colimit oIndex n) (Colimit oIndex e)) (Colimit oIndex n)) (CompositionGraph (Colimit oIndex n) (Colimit oIndex e))
+    colimitOfCompositionGraphs = colimitFromCoproductsAndCoequalizers coprojectDiag
+            where
+                coprojectArrow a = Arrow{sourceArrow = Coprojection $ sourceArrow a, targetArrow = Coprojection $ targetArrow a, labelArrow = Coprojection $ labelArrow a}
+                coprojectGraph g = unsafeGraph ((Coprojection) <$> nodes g) ((coprojectArrow) <$> edges g)
+                coprojectLaw cl = Map.weakMapFromSet [(coprojectArrow <$> rp1, coprojectArrow <$> rp2) | (rp1,rp2) <- Map.mapToSet cl]
+                coprojectCG cg = unsafeCompositionGraph (coprojectGraph $ support cg) (coprojectLaw $ law cg)
+                coprojectCGMorphism CGMorphism{path = (a, rp),compositionLaw = cl} = CGMorphism{path = (Coprojection a, coprojectArrow <$> rp), compositionLaw = coprojectLaw cl}
+                coprojectDiag d = completeDiagram Diagram{src = coprojectCG $ src d, tgt = coprojectCG $ tgt d, omap = (\(x,y) -> (Coprojection x, Coprojection y)) <|$|> omap d, mmap = (\(x,y) -> (coprojectCGMorphism x, coprojectCGMorphism y)) <|$|> mmap d}
+                
+    -- | Uncoproject a base of 'CompositionGraph's.
+    coprojectBaseCompositionGraphs :: (FiniteCategory cIndex mIndex oIndex, Morphism mIndex oIndex, Eq mIndex, Eq oIndex, Eq e, Eq n) => Diagram cIndex mIndex oIndex (FinCat (CompositionGraph n e) (CGMorphism n e) n) (FinFunctor (CompositionGraph n e) (CGMorphism n e) n) (CompositionGraph n e) -> Diagram (FinCat (CompositionGraph n e) (CGMorphism n e) n) (FinFunctor (CompositionGraph n e) (CGMorphism n e) n) (CompositionGraph n e) (FinCat (CompositionGraph (Colimit oIndex n) (Colimit oIndex e)) (CGMorphism (Colimit oIndex n) (Colimit oIndex e)) (Colimit oIndex n)) (FinFunctor (CompositionGraph (Colimit oIndex n) (Colimit oIndex e)) (CGMorphism (Colimit oIndex n) (Colimit oIndex e)) (Colimit oIndex n)) (CompositionGraph (Colimit oIndex n) (Colimit oIndex e))
+    coprojectBaseCompositionGraphs diag = Diagram{src = FinCat, tgt = FinCat, omap = Map.weakMapFromSet [(diag ->$ i,coprojectCG $ diag ->$ i) | i <- ob $ src diag], mmap = Map.weakMapFromSet [(diag ->£ f,coprojectDiag $ diag ->£ f) | f <- arrows $ src diag] }
+        where
+            coprojectArrow a = Arrow{sourceArrow = Coprojection $ sourceArrow a, targetArrow = Coprojection $ targetArrow a, labelArrow = Coprojection $ labelArrow a}
+            coprojectGraph g = unsafeGraph ((Coprojection) <$> nodes g) ((coprojectArrow) <$> edges g)
+            coprojectLaw cl = Map.weakMapFromSet [(coprojectArrow <$> rp1, coprojectArrow <$> rp2) | (rp1,rp2) <- Map.mapToSet cl]
+            coprojectCG cg = unsafeCompositionGraph (coprojectGraph $ support cg) (coprojectLaw $ law cg)
+            coprojectCGMorphism CGMorphism{path = (a, rp),compositionLaw = cl} = CGMorphism{path = (Coprojection a, coprojectArrow <$> rp), compositionLaw = coprojectLaw cl}
+            coprojectDiag d = Diagram{src = coprojectCG $ src d, tgt = coprojectCG $ tgt d, omap = (\(x,y) -> (Coprojection x, Coprojection y)) <|$|> omap d, mmap = (\(x,y) -> (coprojectCGMorphism x, coprojectCGMorphism y)) <|$|> mmap d}
− src/Math/FiniteCategories/CommaCategory/Example.hs 
@@ -1,35 +0,0 @@-{-| Module  : FiniteCategories
-Description : Examples of 'CommaCategory' pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-Examples of 'CommaCategory' pretty printed.
--}
-module Math.FiniteCategories.CommaCategory.Example
-(
-    main
-)
-where
-    import qualified Data.WeakSet as Set
-    import Data.WeakSet.Safe
-    import Data.WeakMap.Safe
-    
-    import Math.FiniteCategory
-    import Math.Categories
-    import Math.FiniteCategories
-    import Math.IO.PrettyPrint
-    
-    -- | Examples of 'CommaCategory' pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.CommaCategory.Example"
-        putStrLn $ pprintFiniteCategory (numberCategory 4)
-        let Just slice = sliceCategory (numberCategory 4) 2
-        let Just coslice = cosliceCategory (numberCategory 4) 2
-        putStrLn $ pprintFiniteCategory slice
-        putStrLn $ pprintFiniteCategory coslice
-        putStrLn $ pprintFiniteCategory (arrowCategory (numberCategory 4))
-        putStrLn "End of Math.FiniteCategories.CommaCategory.Example"
+ src/Math/FiniteCategories/CommaCategory/Examples.hs view
@@ -0,0 +1,33 @@+{-| Module  : FiniteCategories
+Description : Examples of 'CommaCategory'.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'CommaCategory'.
+-}
+module Math.FiniteCategories.CommaCategory.Examples
+(
+    exampleSlice,
+    exampleCoslice,
+    exampleArrowCategory,
+)
+where
+    import Math.Categories
+    import Math.FiniteCategories
+    
+    -- | Example of slice category : (Id_4 | 2). This is the category of objects over 2 in the simplex category 4.
+    exampleSlice :: CommaCategory NumberCategory NumberCategoryMorphism NumberCategoryObject One One One NumberCategory NumberCategoryMorphism NumberCategoryObject
+    Just exampleSlice = sliceCategory (numberCategory 4) 2
+    
+    -- | Example of coslice category : (2 | Id_4). This is the category of objects under 2 in the simplex category 4.
+    exampleCoslice :: CommaCategory One One One NumberCategory NumberCategoryMorphism NumberCategoryObject NumberCategory NumberCategoryMorphism NumberCategoryObject
+    Just exampleCoslice = cosliceCategory (numberCategory 4) 2
+    
+    -- | Example of arrow category : (Id_4 | Id_4). This is the category of arrows of the simplex category 4.
+    exampleArrowCategory :: CommaCategory NumberCategory NumberCategoryMorphism NumberCategoryObject NumberCategory NumberCategoryMorphism NumberCategoryObject NumberCategory NumberCategoryMorphism NumberCategoryObject
+    exampleArrowCategory = arrowCategory (numberCategory 4)
+    
+
src/Math/FiniteCategories/CompositionGraph.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, MonadComprehensions #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
 Description : Composition graphs are the simpliest way to create simple small categories by hand. See 'readCGFile'.
@@ -17,6 +21,8 @@ 
 When taking subcategories of a composition graph, the composition law might lead to morphisms not existing anymore.
 It is not a problem because they are equivalent, it is only counterintuitive for human readability.  
+
+Note that a 'CompositionGraph' is a 'FiniteCategory' because it can implement an 'ob' function, however a loop in the graph could compose infinitely many times. We can consider that only "well formed" 'CompositionGraph's are finite. See also 'SafeCompositionGraph' to ensure there is no infinite loop in the 'compositionGraph'. 
 -}
 
 
@@ -28,6 +34,9 @@     CGMorphism(..),
     -- ** Functions for composition graph morphism
     getLabel,
+    unsafeGetLabel,
+    getMorphismFromLabel,
+    unsafeGetMorphismFromLabel,
     cgmorphismToArrow,
     arrowToCGMorphism,
     unsafeCGMorphismToArrow,
@@ -42,17 +51,18 @@     unsafeCompositionGraph,
     emptyCompositionGraph,
     finiteCategoryToCompositionGraph,
+    finiteCategoryToCompositionGraph2,
+    diagramToDiagramOfCompositionGraphs,
+    diagramToDiagramOfCompositionGraphs2,
     unsafeReadCGString,
     readCGString,
     unsafeReadCGFile,
     readCGFile,
-    coproductOfCompositionGraphs,
-    coproductOfStringCompositionGraphs,
-    coproductOfTextCompositionGraphs,
-    glueObjects,
-    glueMorphisms,
-    coequalizeCompositionGraphDiagrams,
-    colimitOfCompositionGraphs,
+    -- * Transformation
+    mapOnObjects,
+    mapOnObjects2,
+    mapOnArrows,
+    mapOnArrows2,
     -- * Serialization
     writeCGString,
     writeCGFile,
@@ -79,6 +89,7 @@     import              Data.List                   (intercalate, elemIndex, splitAt)
     import              Data.Maybe                  (fromJust, isNothing)
     import              Data.Text                   (Text, cons, singleton, unpack, pack)
+    import              Data.Simplifiable           (Simplifiable)
     
     import              Math.Categories.FinGrph
     import              Math.Categories.FunctorCategory
@@ -96,7 +107,11 @@     import              System.Random               (RandomGen, uniformR)
     
     
+    import              GHC.Base                    (maxInt)
+    import              GHC.Generics
     
+    
+    
     -- | A `RawPath` is a list of arrows, arrows should be compatible.
     type RawPath a b = [Arrow a b]
     
@@ -119,16 +134,20 @@     -- in every morphism of the graph because we need it to compose two morphisms and the morphisms compose 
     -- independently of the composition graph.
     data CGMorphism a b = CGMorphism {path :: Path a b, 
-                                      compositionLaw :: CompositionLaw a b} deriving (Show, Eq)
+                                      compositionLaw :: CompositionLaw a b} deriving (Show, Eq, Generic, Simplifiable)
     
     instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (CGMorphism a b) where
-        pprint CGMorphism {path=(s,[]),compositionLaw=cl} = "Id"++(pprint s)
-        pprint CGMorphism {path=(_,rp),compositionLaw=cl} = intercalate " o " $ (pprint.labelArrow) <$> rp
+        pprint 0 _ = "..."
+        pprint v CGMorphism{path=(s,[]),compositionLaw=cl} = "Id"++(pprint v s)
+        pprint v CGMorphism{path=(_,rp),compositionLaw=cl} = intercalate " o " $ ((pprint v).labelArrow) <$> rp
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        -- pprintWithIndentations cv ov indent CGMorphism{path=(s,[]),compositionLaw=cl} = indentation (ov - cv) indent ++ "Id"++(pprint cv s) ++ "\n"
+        -- pprintWithIndentations cv ov indent CGMorphism{path=(_,rp),compositionLaw=cl} = indentation (ov - cv) indent ++ (intercalate " o " $ ((pprint cv).labelArrow) <$> rp) ++ "\n"
 
     -- | Helper function for `simplify`. Returns a simplified raw path.
     simplifyOnce :: (Eq a, Eq b) => CompositionLaw a b -> RawPath a b -> RawPath a b
     simplifyOnce _ [] = [] 
-    simplifyOnce _ [e] = [e]
     simplifyOnce cl list 
         | new_list == [] = []
         | new_list /= list = new_list
@@ -154,6 +173,7 @@             | source m2 /= target m1 = Nothing
             | otherwise = Just CGMorphism{path=(s1,(simplify cl1 (rp2++rp1))), compositionLaw=cl1}
 
+        (@) m2@CGMorphism{path=(s2,rp2), compositionLaw=cl2} m1@CGMorphism{path=(s1,rp1), compositionLaw=cl1} = CGMorphism{path=(s1,(simplify cl1 (rp2++rp1))), compositionLaw=cl1}
                                     
         source CGMorphism{path=(s,_), compositionLaw=_} = s
         target CGMorphism{path=(s,[]), compositionLaw=_} = s
@@ -223,7 +243,33 @@         | null rp = Nothing
         | null.tail $ rp = Just (labelArrow.head $ rp)
         | otherwise = Nothing
+    
+    -- | Unsafe version of 'getLabel'. Throws an error if a problem happens. 
+    unsafeGetLabel :: CGMorphism a b -> b
+    unsafeGetLabel CGMorphism{path=(_,rp), compositionLaw=_}
+        | null rp = error "unsafeGetLabel on an identity."
+        | null.tail $ rp = (labelArrow.head $ rp)
+        | otherwise = error "unsafeGetLabel on a composite morphism."
         
+    -- | Return Just a morphism with a given label. If several morphisms share the same label, returns the first one found. O(n)
+    getMorphismFromLabel :: (Eq b) => CompositionGraph a b -> b -> Maybe (CGMorphism a b)
+    getMorphismFromLabel cg arrLabel
+        | Set.null results = Nothing
+        | otherwise = Just $ CGMorphism{path = (sourceArrow chosenOne, [chosenOne]), compositionLaw = law cg} 
+        where
+            s = support cg
+            results = Set.filter (\x -> labelArrow x == arrLabel) (edges s)
+            chosenOne = anElement results
+    
+    -- | Return a morphism with a given label. If several morphisms share the same label, returns the first one found. If no one was found throws an error. O(n)
+    unsafeGetMorphismFromLabel :: (Eq b) => CompositionGraph a b -> b -> CGMorphism a b
+    unsafeGetMorphismFromLabel cg arrLabel
+        | null maybeResult = error "unsafeGetMorphismFromLabel did not find any morphism with the given label."
+        | otherwise = r
+        where
+            maybeResult = getMorphismFromLabel cg arrLabel
+            Just r = maybeResult
+        
     -- | Return Just the 'Arrow' of a 'CompositionGraph' non identity generator, Nothing if the morphism is not a non identity generator.
     cgmorphismToArrow :: CGMorphism a b -> Maybe (Arrow a b)
     cgmorphismToArrow CGMorphism{path=(_,rp), compositionLaw=_}
@@ -231,7 +277,7 @@         | null.tail $ rp = Just (head $ rp)
         | otherwise = Nothing
         
-    -- | Given a composition graph, transform an 'Arrow' into a 'CGMorphism' if this 'CGMorphism' is in the composition graph, return Nothing otherwise. 
+    -- | Given a composition graph, transform an 'Arrow' into a 'CGMorphism' if this 'CGMorphism' is in the composition graph, return Nothing otherwise. O(e)
     arrowToCGMorphism :: (Eq a, Eq b) => CompositionGraph a b -> Arrow a b -> Maybe (CGMorphism a b)
     arrowToCGMorphism cg arr
         | arr `isIn` (edges.support $ cg) = Just $ mkCGMorphism (law cg) arr
@@ -245,7 +291,7 @@         | null.tail $ rp = head rp
         | otherwise = error "several arrows in CGMorphism"
         
-    -- | Unsafe version of 'arrowToCGMorphism'.
+    -- | Unsafe version of 'arrowToCGMorphism'. O(1)
     unsafeArrowToCGMorphism :: CompositionGraph a b -> Arrow a b -> CGMorphism a b
     unsafeArrowToCGMorphism cg arr = mkCGMorphism (law cg) arr
     
@@ -255,7 +301,7 @@     data CompositionGraph a b = CompositionGraph {
                                                     support :: Graph a b, -- ^ The generating graph (or support) of the composition graph.
                                                     law :: CompositionLaw a b -- ^ The composition law of the composition graph.
-                                                 } deriving (Eq)
+                                                 } deriving (Eq, Generic, PrettyPrint, Simplifiable)
  
     instance (Show a, Show b) => Show (CompositionGraph a b) where
         show CompositionGraph{support=g, law=l} = "(unsafeCompositionGraph "++ show g ++ " " ++ show l ++ ")"
@@ -275,10 +321,7 @@             | otherwise = mkCGMorphism l <$> rp
     
     instance (Eq a, Eq b) => FiniteCategory (CompositionGraph a b) (CGMorphism a b) a where
-        ob = (nodes.support)
-            
-    instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (CompositionGraph a b) where
-        pprint CompositionGraph{support=g,law=l} = "CompositionGraph("++pprint g++","++pprint l++")"         
+        ob = (nodes.support)       
     
     -- | Smart constructor of `CompositionGraph`.
     --
@@ -299,32 +342,53 @@     unsafeCompositionGraph g l = CompositionGraph{support = g, law = l}
             
                                                                             
+
     -- | Transforms any 'FiniteCategory' into a 'CompositionGraph'.
+    -- 
+    -- The two functions given allow to modify nodes and edges label.  The two functions given should be injective, it is your responsability to ensure it.
     --
     -- The 'CompositionGraph' will take more space in memory compared to the original category because the composition law is stored as a 'Map'.
     --
     -- Returns an isofunctor as a `Diagram` from the original category to the created 'CompositionGraph'.
     --
     -- If you only want the 'CompositionGraph', take the 'tgt' of the 'Diagram'.
-    finiteCategoryToCompositionGraph :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> Diagram c m o (CompositionGraph o m) (CGMorphism o m) o
-    finiteCategoryToCompositionGraph cat = isofunct
+    finiteCategoryToCompositionGraph :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o, Eq n, Eq e) => (m -> e) -> (o -> n) -> c -> Diagram c m o (CompositionGraph n e) (CGMorphism n e) n
+    finiteCategoryToCompositionGraph transformEdgeLabel transformObjLabel cat = isofunct
         where
-            morphToArrow f = Arrow{sourceArrow = source f, targetArrow = target f, labelArrow = f}
+            morphToArrow f = Arrow{sourceArrow = transformObjLabel $ source f, targetArrow = transformObjLabel $ target f, labelArrow = transformEdgeLabel f}
             catLaw = weakMapFromSet [
                 if isNotIdentity cat (g @ f) then
                     ((morphToArrow <$> (decompose cat g))++(morphToArrow <$> (decompose cat f)), morphToArrow <$> (decompose cat (g @ f)))
                 else
                     ((morphToArrow <$> (decompose cat g))++(morphToArrow <$> (decompose cat f)),[]) |
                 f <- (arrows cat), g <- (arFrom cat (target f)), isNotIdentity cat f, isNotIdentity cat g]
-            cg = CompositionGraph{support=(unsafeGraph (ob cat) [morphToArrow f | f <- (genArrows cat), isNotIdentity cat f])
+            cg = CompositionGraph{support=(unsafeGraph (transformObjLabel <$> (ob cat)) [morphToArrow f | f <- (genArrows cat), isNotIdentity cat f])
                                 , law=catLaw}
-            isofunct = Diagram{src=cat,tgt=cg,omap=memorizeFunction id (ob cat),mmap=memorizeFunction (\f -> if isNotIdentity cat f
+            isofunct = Diagram{src=cat,tgt=cg,omap=memorizeFunction transformObjLabel (ob cat),mmap=memorizeFunction (\f -> if isNotIdentity cat f
                                                                         then
-                                                                            CGMorphism {path=(source f,(morphToArrow <$> (decompose cat f))),compositionLaw=catLaw}
+                                                                            CGMorphism {path=(transformObjLabel $ source f,(morphToArrow <$> (decompose cat f))),compositionLaw=catLaw}
                                                                         else
-                                                                            identity cg (source f)) (arrows cat)}
-
+                                                                            identity cg (transformObjLabel (source f))) (arrows cat)}
 
+    -- | Specialized 'finiteCategoryToCompositionGraph' with two identities.
+    finiteCategoryToCompositionGraph2 :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> Diagram c m o (CompositionGraph o m) (CGMorphism o m) o
+    finiteCategoryToCompositionGraph2 = finiteCategoryToCompositionGraph id id
+    
+    -- | Transforms an arbitrary 'Diagram' into a 'Diagram' of 'CompositionGraph's. See 'finiteCategoryToCompositionGraph'.
+    diagramToDiagramOfCompositionGraphs :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1, Eq n1, Eq e1,
+                                            FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2, Eq n2, Eq e2) =>
+        (m1 -> e1) -> (o1 -> n1) -> (m2 -> e2) -> (o2 -> n2) -> Diagram c1 m1 o1 c2 m2 o2 -> Diagram (CompositionGraph n1 e1) (CGMorphism n1 e1) n1 (CompositionGraph n2 e2) (CGMorphism n2 e2) n2
+    diagramToDiagramOfCompositionGraphs transformMorph1 transformObj1 transformMorph2 transformObj2 diag = newDiag
+        where
+            diagToNewSrc = finiteCategoryToCompositionGraph transformMorph1 transformObj1 (src diag)
+            diagToNewTgt = finiteCategoryToCompositionGraph transformMorph2 transformObj2 (tgt diag)
+            newDiag = Diagram{src = tgt diagToNewSrc, tgt = tgt diagToNewTgt, omap = (diagToNewTgt ->$) <$> (Map.mapKeys (diagToNewSrc ->$) (omap diag)), mmap = (diagToNewTgt ->£) <$> (Map.mapKeys (diagToNewSrc ->£) (mmap diag))}
+            
+    -- | Specialized 'diagramToDiagramOfCompositionGraphs' with four identities.
+    diagramToDiagramOfCompositionGraphs2 :: (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 -> Diagram (CompositionGraph o1 m1) (CGMorphism o1 m1) o1 (CompositionGraph o2 m2) (CGMorphism o2 m2) o2
+    diagramToDiagramOfCompositionGraphs2 = diagramToDiagramOfCompositionGraphs id id id id
 
     -- | The empty 'CompositionGraph'.
     emptyCompositionGraph :: CompositionGraph a b
@@ -336,7 +400,7 @@ 
 
     -- | A token for a .cg file.
-    data Token = Name Text | BeginArrow | EndArrow | Equals | Identity | BeginSrc | EndSrc | BeginTgt | EndTgt | MapsTo deriving (Eq, Show)
+    data Token = Name Text | BeginArrow | EndArrow | Equals | Identity | BeginSrc | EndSrc | BeginTgt | EndTgt | MapsTo deriving (Eq, Show, Generic, Simplifiable)
     
     -- | Strip a token of unnecessary spaces.
     strip :: Token -> Token
@@ -424,7 +488,7 @@     --
     -- 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\>", " => "
+    -- 2. The following strings are reserved : " -","-> "," = ", "\<ID/\>", "\<ID\>", "\<SRC\>", "\</SRC\>", "\<TGT\>", "\</TGT\>", " => "
     --
     -- 3. To define an object, write a line containing its name.
     --
@@ -440,7 +504,7 @@     --
     -- 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.    
+    -- 5.3 You can use the tag \<ID/\> or \<ID\> in order to map a morphism to an identity.    
     readCGString :: String -> Either (FiniteCategoryError (CGMorphism Text Text) Text) CG
     readCGString str
         | null check = Right c_g
@@ -466,7 +530,7 @@     --
     -- 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\>", " => "
+    -- 2. The following strings are reserved : " -","-> "," = ", "\<ID/\>", "\<ID\>", "\<SRC\>", "\</SRC\>", "\<TGT\>", "\</TGT\>", " => "
     --
     -- 3. To define an object, write a line containing its name.
     --
@@ -482,7 +546,7 @@     --
     -- 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.
+    -- 5.3 You can use the tag \<ID/\> or \<ID\> in order to map a morphism to an identity.
     readCGFile :: String -> IO (Either (FiniteCategoryError (CGMorphism Text Text) Text) CG)
     readCGFile str = do
         cg <- unsafeReadCGFile str
@@ -493,14 +557,14 @@         
     reversedRawPathToString :: (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
     reversedRawPathToString [] = "<ID>"
-    reversedRawPathToString [Arrow{sourceArrow = s, targetArrow = t,labelArrow = l}] = pprint s ++ " -" ++ pprint l ++ "-> " ++ pprint t
-    reversedRawPathToString (Arrow{sourceArrow = s, targetArrow = t,labelArrow = l}:xs) = pprint s ++ " -" ++ pprint l ++ "-> " ++ reversedRawPathToString xs
+    reversedRawPathToString [Arrow{sourceArrow = s, targetArrow = t,labelArrow = l}] = pprint maxInt s ++ " -" ++ pprint maxInt l ++ "-> " ++ pprint maxInt t
+    reversedRawPathToString (Arrow{sourceArrow = s, targetArrow = t,labelArrow = l}:xs) = pprint maxInt s ++ " -" ++ pprint maxInt l ++ "-> " ++ reversedRawPathToString xs
     
     -- | Transform a composition graph into a string following the .cg convention.
     writeCGString :: (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => CompositionGraph a b -> String
     writeCGString cg = finalString
         where
-            obString = intercalate "\n" $ pprint <$> (setToList.ob $ cg)
+            obString = intercalate "\n" $ pprint maxInt <$> (setToList.ob $ cg)
             arNotIdentityAndNotComposite = setToList $ Set.filter (isGenerator cg) $ Set.filter (isNotIdentity cg) (genArrows cg)
             reversedRawPaths = (reverse.snd.path) <$> arNotIdentityAndNotComposite
             arString = intercalate "\n" $ reversedRawPathToString <$> reversedRawPaths
@@ -527,7 +591,7 @@     addOMapEntry otherTokens _ = error $ "addOMapEntry on invalid tokens : "++show otherTokens
     
     addMMapEntry :: [Token] -> CGD -> CGD
-    addMMapEntry tks@[Name sx, BeginArrow, Name lx, EndArrow, Name tx, MapsTo, Identity] diag = if sx `isIn` (domain (omap diag)) then Diagram{src=src diag, tgt=tgt diag, omap=omap diag, mmap=Map.insert sourceMorph (identity (tgt diag) (diag ->$ sx)) (mmap diag)} else error ("You must specify the image of the source of the morphism before mapping to an identity : "++show tks)
+    addMMapEntry tks@[Name sx, BeginArrow, Name lx, EndArrow, Name tx, MapsTo, Identity] diag = if sx `isIn` (domain (omap diag)) then Diagram{src=src diag, tgt=tgt diag, omap=omap diag, mmap=Map.insert sourceMorph (identity (tgt diag) (diag ->$ sx)) (mmap diag)} else error ("You must specify the image of the source of the morphism after mapping to an identity : "++show tks)
         where
             sourceMorphCand = Set.filter (\e -> getLabel e == Just lx) (genAr (src diag) sx tx)
             sourceMorph = if Set.null sourceMorphCand then error $ "addMMapEntry : morphism not found in source category for the following map : "++ show tks else anElement sourceMorphCand
@@ -596,12 +660,14 @@     --
     -- 2.1 Between these two lines, the target composition graph is defined as in a cg file.
     --
-    -- 3. Outside of the two previously described sections, you can declare the maps between objects and morphisms.
+    -- 3. After 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".
     --
+    -- 3.3 You can map a morphism to an identity with the following syntax : "objSrc1 -arrowSrc1-> objSrc2 => <ID>", note however that the source of the morphism objSrc1 should be mapped to an object AFTER this declaration in order to identify which identity it is mapped to. So a complete example would be "objSrc1 -arrowSrc1-> objSrc2 => <ID>\nobjSrc1 => objTgt1"
+    --
     -- 4. You don't have to (and you shouldn't) specify maps from identities, nor maps from composite arrows.
     readCGDString :: String -> Either (DiagramError CG (CGMorphism Text Text) Text CG (CGMorphism Text Text) Text) CGD
     readCGDString str
@@ -648,8 +714,8 @@         where
             srcString = "<SRC>\n"++writeCGString (src diag)++"\n</SRC>\n"
             tgtString = "<TGT>\n"++writeCGString (tgt diag)++"</TGT>\n"
-            omapString = "#Object mapping\n" ++ (intercalate "\n" $ (\o -> (pprint o) ++ " => " ++  (pprint (diag ->$ o)) )<$> (setToList.ob.src $ diag)) ++ "\n"
-            mmapString = "#Morphism mapping\n" ++ (intercalate "\n" $ (\m -> pprint (source m) ++ " -" ++ pprint m ++ "-> " ++ pprint (target m)++ " => " ++ if isIdentity (tgt diag) (diag ->£ m) then "<ID/>" else pprint (source (diag ->£ m)) ++ " -" ++ pprint (diag ->£ m) ++ "-> " ++ pprint (target (diag ->£ m)))<$> (setToList.(Set.filter (isNotIdentity (src diag))).genArrows.src $ diag)) ++ "\n"
+            omapString = "#Object mapping\n" ++ (intercalate "\n" $ (\o -> (pprint maxInt o) ++ " => " ++  (pprint maxInt (diag ->$ o)) )<$> (setToList.ob.src $ diag)) ++ "\n"
+            mmapString = "#Morphism mapping\n" ++ (intercalate "\n" $ (\m -> pprint maxInt (source m) ++ " -" ++ pprint maxInt m ++ "-> " ++ pprint maxInt (target m)++ " => " ++ if isIdentity (tgt diag) (diag ->£ m) then "<ID/>" else pprint maxInt (source (diag ->£ m)) ++ " -" ++ pprint maxInt (diag ->£ m) ++ "-> " ++ pprint maxInt (target (diag ->£ m)))<$> (setToList.(Set.filter (isNotIdentity (src diag))).genArrows.src $ diag)) ++ "\n"
         
     -- | Saves a composition graph diagram into a file located at a given path.
     writeCGDFile :: (PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1,
@@ -800,121 +866,44 @@             (nbArrows2, g5) = uniformR (1,11-nbArrows1) g4
             (nbAttempts2, g6) = uniformR (0,nbArrows2+nbArrows2) g5
             (cat2, g7) = constructRandomCompositionGraph nbArrows2 nbAttempts2 5 g6
-    
-    
-    
-    
-    
-    -- | Takes a discrete diagram of composition graphs and two functions and returns a colimit cocone object of this diagram. The two functions are used to combine an object (an arrow) of the indexing category with an object (an arrow) of a composition graph in order to distinguish an object (an arrow) with same identifier in the disjunct union constructed.
-    --
-    -- Two properties should be met and are not verified at runtime : the diagram given should be discrete and the two functions should be injective.
-    --
-    -- Moreover, the base of the diagram should not be empty. This function throws an error if this condition is not verified.
-    coproductOfCompositionGraphs :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq o1, Eq a, Eq b) => Diagram c1 m1 o1 (FinCat (CompositionGraph a b) (CGMorphism a b) a) (FinFunctor (CompositionGraph a b) (CGMorphism a b) a) (CompositionGraph a b) -> (o1 -> a -> a) -> (o1 -> b -> b) -> Cocone c1 m1 o1 (FinCat (CompositionGraph a b) (CGMorphism a b) a) (FinFunctor (CompositionGraph a b) (CGMorphism a b) a) (CompositionGraph a b)
-    coproductOfCompositionGraphs diagOfCG combObj combArr
-        | Set.null (ob indexingCategory) = error "The base should not be empty."
-        | otherwise = unsafeCommaObject One coproduct natCoproduct
-        where
-            indexingCategory = src diagOfCG
-            coproduct = unsafeCompositionGraph coproduct_graph (Map.unions [weakMap $ (\(rp1,rp2) -> (transformArrowIntoArrowCoproduct i <$> rp1, transformArrowIntoArrowCoproduct i <$> rp2)) <$> (Map.mapToList (law (diagOfCG ->$ i))) | i <- (setToList (ob indexingCategory))])
-            transformObjectIntoObjectCoproduct i x = combObj i x
-            transformArrowIntoArrowCoproduct i a = Arrow{sourceArrow = combObj i (sourceArrow a), targetArrow = combObj i (targetArrow a), labelArrow = combArr i (labelArrow a)}
-            coproduct_graph = unsafeGraph (Set.concat2 ((\i -> transformObjectIntoObjectCoproduct i <$> (ob (diagOfCG ->$ i))) <$> (ob indexingCategory))) (Set.concat2 ((\i -> (transformArrowIntoArrowCoproduct i) <$> (unsafeCGMorphismToArrow <$> genArrowsWithoutId (diagOfCG ->$ i))) <$> (ob indexingCategory)))
-            natCoproduct = unsafeNaturalTransformation diagOfCG (constantDiagram indexingCategory FinCat coproduct) (weakMapFromSet [(i, insertionFunctor i)| i <- ob indexingCategory])
-            insertionFunctor i = completeDiagram Diagram{src = diagOfCG ->$ i, tgt = coproduct, omap = weakMapFromSet [(o, transformObjectIntoObjectCoproduct i o)| o <- ob (diagOfCG ->$ i)], mmap = weakMapFromSet [(m, (unsafeArrowToCGMorphism coproduct (transformArrowIntoArrowCoproduct i (unsafeCGMorphismToArrow m)))) | m <- (genArrowsWithoutId (diagOfCG ->$ i))]}
-    
-    
-    -- | Specialized version of 'coproductOfCompositionGraphs' to CompositionGraph String String.
-    coproductOfStringCompositionGraphs :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq o1, Show o1) => Diagram c1 m1 o1 (FinCat (CompositionGraph String String) (CGMorphism String String) String) (FinFunctor (CompositionGraph String String) (CGMorphism String String) String) (CompositionGraph String String) -> Cocone c1 m1 o1 (FinCat (CompositionGraph String String) (CGMorphism String String) String) (FinFunctor (CompositionGraph String String) (CGMorphism String String) String) (CompositionGraph String String)
-    coproductOfStringCompositionGraphs diag = coproductOfCompositionGraphs diag (\x o -> (show $ x) <> "." <>o) (\x m -> (show x) <> "." <>m)
-    
-    
-    -- | Specialized version of 'coproductOfCompositionGraphs' to CompositionGraph Text Text.
-    coproductOfTextCompositionGraphs :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq o1, Show o1) => Diagram c1 m1 o1 (FinCat (CompositionGraph Text Text) (CGMorphism Text Text) Text) (FinFunctor (CompositionGraph Text Text) (CGMorphism Text Text) Text) (CompositionGraph Text Text) -> Cocone c1 m1 o1 (FinCat (CompositionGraph Text Text) (CGMorphism Text Text) Text) (FinFunctor (CompositionGraph Text Text) (CGMorphism Text Text) Text) (CompositionGraph Text Text)
-    coproductOfTextCompositionGraphs diag = coproductOfCompositionGraphs diag (\x o -> (pack.show $ x) <> (pack ".")<>o) (\x m -> (pack.show$ x) <>(pack ".")<>m)
-    
-    
-    -- | Glue two objects of a 'CompositionGraph' and return an insertion diagram into the new CompositionGraph.
-    glueObject :: (Eq a, Eq b) => CompositionGraph a b -> a -> a -> FinFunctor (CompositionGraph a b) (CGMorphism a b) a
-    glueObject cg a b = completeDiagram $ Diagram{src=cg,tgt=newCG, omap = omapD, mmap = mmapD}
-        where
-            glueObj obj = if obj == b then a else obj
-            omapD = memorizeFunction glueObj (nodes.support $ cg)
-            glueArr arr = Arrow{sourceArrow = glueObj.sourceArrow $ arr, targetArrow = glueObj.targetArrow $ arr, labelArrow = labelArrow arr}
-            mmapD = memorizeFunction ((unsafeArrowToCGMorphism cg).glueArr.unsafeCGMorphismToArrow) (genArrowsWithoutId cg)
-            newCG = unsafeCompositionGraph (unsafeGraph (Map.values omapD) (glueArr <$> (edges.support $ cg))) (law cg)
-    
-    -- | Glue objects of a 'CompositionGraph' and return an insertion diagram into the new CompositionGraph.
-    glueObjects :: (Eq a, Eq b) => CompositionGraph a b -> Set a -> FinFunctor (CompositionGraph a b) (CGMorphism a b) a
-    glueObjects cg objects
-        | Set.null objects = error "glue 0 object"
-        | otherwise = Set.foldr (\obj funct -> (glueObject (tgt funct) representant obj) @ funct) (identity FinCat cg) objects
-        where
-            representant = anElement objects
             
     
     -- | Change the law of a CGMorphism
     updateCGMorphismWithNewLaw :: CompositionLaw a b -> CGMorphism a b -> CGMorphism a b
     updateCGMorphismWithNewLaw l m = CGMorphism{path=path m, compositionLaw=l}
-    
-    -- | Glue two morphisms with same source and target of a 'Compositiongraph' and return an insertion diagram into the new CompositionGraph.
-    -- The first argument should not be composite if the second is a generator.
-    glueMorphism :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b -> CGMorphism a b -> FinFunctor (CompositionGraph a b) (CGMorphism a b) a
-    glueMorphism cg m1 m2
-        | isComposite_ m1 && isGenerator_ m2 = error "Glue composite to generator."
-        | m1 == m2 = identity FinCat cg
-        | isGenerator_ m1 && isGenerator_ m2 = completeDiagram Diagram{src=cg,tgt=newCGGG,omap=omapGG,mmap=mmapGG}
-        | otherwise = completeDiagram Diagram{src=cg,tgt=newCG,omap=omapGG,mmap=mmapId}
-        where
-            isGenerator_ m = length (snd.path $ m) == 1
-            isComposite_ = not.isGenerator_
-            glueMorph m = if m == m2 then m1 else m
-            glueArr a = if a == (unsafeCGMorphismToArrow m2) then unsafeCGMorphismToArrow m1 else a
-            omapGG = memorizeFunction id (nodes.support $ cg)
-            mmapGG = memorizeFunction glueMorph (genArrowsWithoutId cg)
-            newLawGG =  weakMapFromSet $ (\(x,y) -> (glueArr <$> x, glueArr <$> y)) <$> ((Map.mapToSet).law $ cg)
-            newCGGG = unsafeCompositionGraph (unsafeGraph (nodes.support $ cg) ((edges.support $ cg) `Set.difference` (set [unsafeCGMorphismToArrow m2]))) newLawGG
-            newLaw = Map.insert (snd.path $ m2) (snd.path $ m1) (law cg)
-            mmapId = memorizeFunction id (genArrowsWithoutId cg)
-            newCG = unsafeCompositionGraph (support cg) newLaw
+       
             
-    -- | Glue morphisms with same source and target of a 'CompositionGraph' and return an insertion diagram into the new CompositionGraph.
-    glueMorphisms :: (Eq a, Eq b) => CompositionGraph a b -> Set (CGMorphism a b) -> FinFunctor (CompositionGraph a b) (CGMorphism a b) a
-    glueMorphisms cg morphisms
-        | Set.null morphisms = error "glue 0 morphism"
-        | Set.null generators = Set.foldr (\morph funct -> (glueMorphism (tgt funct) (anElement morphisms) morph) @ funct) (identity FinCat cg) morphisms
-        | otherwise = Set.foldr (\morph funct -> (glueMorphism (tgt funct) (anElement generators) morph) @ funct) (identity FinCat cg) morphisms
+    -- | Map a function on objects of the 'CompositionGraph'.
+    mapOnObjects :: (Eq n1, Eq e) => (n1 -> n2) -> CompositionGraph n1 e -> CompositionGraph n2 e
+    mapOnObjects transformObj cg = CompositionGraph {support = mapOnNodes transformObj (support cg), law = transformLaw $ law cg}
         where
-            generators = Set.filter (isGenerator cg) morphisms
-            
+            transformLaw l = Map.weakMapFromSet [(transformRawPath k, transformRawPath v) | (k,v) <- Map.mapToSet l]
+            transformRawPath [] = []
+            transformRawPath (a:xs) = Arrow{sourceArrow = transformObj $ sourceArrow a, targetArrow = transformObj $ targetArrow a, labelArrow = labelArrow a} : (transformRawPath xs)
     
-    -- | Takes diagrams with same source and target composition graphs and returns a diagram from the target to the coequalizer of the diagrams. The set of diagrams should not be empty
-    coequalizeCompositionGraphDiagrams :: (Eq a, Eq b) => Set (FinFunctor (CompositionGraph a b) (CGMorphism a b) a) -> FinFunctor (CompositionGraph a b) (CGMorphism a b) a
-    coequalizeCompositionGraphDiagrams diags
-        | Set.null diags = error "coequalize no diagram"
-        | otherwise = glueArrowsFunctor
+    -- | Map a function on objects of the 'CompositionGraph', return the diagram from the original 'CompositionGraph' to the new one.
+    mapOnObjects2 :: (Eq n1, Eq e) => (n1 -> n2) -> CompositionGraph n1 e -> Diagram (CompositionGraph n1 e) (CGMorphism n1 e) n1 (CompositionGraph n2 e) (CGMorphism n2 e) n2
+    mapOnObjects2 transformObj cg = Diagram{src = cg, tgt = mapOnObjects transformObj cg, omap = memorizeFunction transformObj (ob cg), mmap = memorizeFunction transformGenArrow (genArrows cg)}
         where
-            aDiagram = anElement diags
-            selectingObjects = ob.src $ aDiagram
-            glueObjectsFunctor = Set.foldr (\obj funct -> (glueObjects (tgt funct) [(funct @ diag) ->$ obj | diag <- diags]) @ funct) (identity FinCat (tgt aDiagram)) selectingObjects
-            selectingArrows = genArrowsWithoutId.src $ aDiagram
-            glueArrowsFunctor = Set.foldr (\morph funct -> (glueMorphisms (tgt funct) [(funct @ diag) ->£ morph| diag <- diags]) @ funct) glueObjectsFunctor selectingArrows
-            
+            transformGenArrow CGMorphism{path = (s,rp), compositionLaw = l} = CGMorphism{path = (transformObj s,transformRawPath rp), compositionLaw = transformLaw l}
+            transformLaw l = Map.weakMapFromSet [(transformRawPath k, transformRawPath v) | (k,v) <- Map.mapToSet l]
+            transformRawPath [] = []
+            transformRawPath (a:xs) = Arrow{sourceArrow = transformObj $ sourceArrow a, targetArrow = transformObj $ targetArrow a, labelArrow = labelArrow a} : (transformRawPath xs)
     
-    -- | Takes a diagram of compositions graphs, a function to combine an object of the indexing category with an object of a composition graph, a function to combine an object of the indexing category with a morphism of a composition graph and return the colimit cocone with the constructed composition graph as nadir. Note that the functions to combine objects and morphisms should be injective. The base should not be empty.
-    colimitOfCompositionGraphs :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1, Eq a, Eq b) =>
-        Diagram c1 m1 o1 (FinCat (CompositionGraph a b) (CGMorphism a b) a) (FinFunctor (CompositionGraph a b) (CGMorphism a b) a) (CompositionGraph a b) -> (o1 -> a -> a) -> (o1 -> b -> b) -> Cocone c1 m1 o1 (FinCat (CompositionGraph a b) (CGMorphism a b) a) (FinFunctor (CompositionGraph a b) (CGMorphism a b) a) (CompositionGraph a b)
-    colimitOfCompositionGraphs diagOfCG combObj combMorph 
-        | Set.null (ob indexingCategory) = error "The base should not be empty."
-        | otherwise =  unsafeCommaObject One (tgt (coequalizedNat =>$ (anElement.ob $ indexingCategory))) coequalizedNat
+    -- | Map a function on arrows of the 'CompositionGraph'.
+    mapOnArrows :: (Eq n, Eq e1) => (e1 -> e2) -> CompositionGraph n e1 -> CompositionGraph n e2
+    mapOnArrows transformArrow cg = CompositionGraph {support = mapOnEdges transformArrow (support cg), law = transformLaw $ law cg}
         where
-            indexingCategory = src diagOfCG
-            coproductCocone = coproductOfCompositionGraphs diagOfCG combObj combMorph
-            coproductNat = legsCocone coproductCocone
-            functorToNat funct = unsafeNaturalTransformation (constantDiagram indexingCategory FinCat (src funct)) (constantDiagram indexingCategory FinCat (tgt funct)) (memorizeFunction (const funct) (ob indexingCategory))
-            composeNatWithFunctor nat funct = (functorToNat funct) @ nat
-            notBottomObjects = Set.filter (not.(Set.null).(arFromWithoutId indexingCategory)) (ob indexingCategory)
-            indexingFunctToLeg nat indexingFunct = (nat =>$ (target indexingFunct)) @ (diagOfCG ->£ indexingFunct)
-            coequalizedNat = Set.foldr (\indexingObj nat -> composeNatWithFunctor nat (coequalizeCompositionGraphDiagrams (indexingFunctToLeg nat <$> (genArFrom indexingCategory indexingObj)))) coproductNat notBottomObjects
-            
-           +            transformLaw l = Map.weakMapFromSet [(transformRawPath k, transformRawPath v) | (k,v) <- Map.mapToSet l]
+            transformRawPath [] = []
+            transformRawPath (a:xs) = Arrow{sourceArrow = sourceArrow a, targetArrow = targetArrow a, labelArrow = transformArrow $ labelArrow a} : (transformRawPath xs)
+    
+    -- | Map a function on arrows of the 'CompositionGraph', return the diagram from the original 'CompositionGraph' to the new one.
+    mapOnArrows2 :: (Eq n, Eq e1) => (e1 -> e2) -> CompositionGraph n e1 -> Diagram (CompositionGraph n e1) (CGMorphism n e1) n (CompositionGraph n e2) (CGMorphism n e2) n
+    mapOnArrows2 transformArrow cg = Diagram{src = cg, tgt = mapOnArrows transformArrow cg, omap = memorizeFunction id (ob cg), mmap = memorizeFunction transformGenArrow (genArrows cg)}
+        where
+            transformLaw l = Map.weakMapFromSet [(transformRawPath k, transformRawPath v) | (k,v) <- Map.mapToSet l]
+            transformRawPath [] = []
+            transformRawPath (a:xs) = Arrow{sourceArrow = sourceArrow a, targetArrow = targetArrow a, labelArrow = transformArrow $ labelArrow a} : (transformRawPath xs)
+            transformGenArrow CGMorphism{path = (s,rp), compositionLaw = l} = CGMorphism{path = (s,transformRawPath rp), compositionLaw = transformLaw l}
+
− src/Math/FiniteCategories/CompositionGraph/Example.hs 
@@ -1,89 +0,0 @@-{-| Module  : FiniteCategories
-Description : An example of 'CompositionGraph' pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An example of 'CompositionGraph' pretty printed.
-
-Examples of other categories transformed into 'CompositionGraph's are also pretty printed.
-
-A random example of 'CompositionGraph' is also pretty printed.
-
-A 'CompositionGraph' created from a string is also pretty printed.
--}
-module Math.FiniteCategories.CompositionGraph.Example
-(
-    main
-)
-where
-    import qualified Data.WeakSet as Set
-    import Data.WeakSet.Safe
-    import Data.WeakMap.Safe
-    
-    import Math.FiniteCategory
-    import Math.Categories
-    import Math.FiniteCategories
-    import Math.IO.PrettyPrint
-    import Math.FiniteCategories.FunctorCategory
-    import Math.Categories.FinCat
-    
-    import Data.Text (pack)
-    
-    import System.Random
-    import Numeric.Natural
-    
-    -- | An example of 'CompositionGraph' pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.CompositionGraph.Example"
-        putStrLn $ pprintFiniteCategory (unsafeCompositionGraph (unsafeGraph (set [1 :: Int,2,3]) (set [Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'},Arrow{sourceArrow=1,targetArrow=2,labelArrow='b'},Arrow{sourceArrow=2,targetArrow=3,labelArrow='c'}])) (weakMap [([Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'},Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}],[Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}])])) 
-        putStrLn $ pprint (finiteCategoryToCompositionGraph (ens.(Set.powerSet).set $ "AB"))
-        putStrLn $ pprint  (finiteCategoryToCompositionGraph (numberCategory 4)) 
-        putStrLn $ pprintFiniteCategory (fst.defaultConstructRandomCompositionGraph $ (mkStdGen 123456))
-        putStrLn $ pprint  (fst.defaultConstructRandomDiagram $ (mkStdGen 12345678))
-        let (Right cg) = readCGString "A -f-> B -g-> C = A -h-> C"
-        putStrLn $ pprintFiniteCategory cg
-        let (Right cg) = readCGString "A -f-> B\nB -g-> C\nC -h-> B\nB -g-> C -h-> B = <ID>\nC -h-> B -g-> C -h-> B -g-> C = C -h-> B -g-> C"
-        putStrLn $ pprintFiniteCategory cg
-        
-        putStrLn (take 30 (repeat '\n'))
-        
-        -- let (Right cg1) = readCGString "A -f-> B"
-        -- let (Right cg2) = readCGString "A -g-> C"
-        -- let diag = discreteDiagram FinCat [cg1,cg2]
-        -- let colimit = colimitOfCompositionGraphs diag (\x o -> (pack.show $ x) <> (pack ".")<>o) (\x m -> (pack.show$ x) <>(pack ".")<>m)
-        
-        -- putStrLn $ show $ nadir colimit
-        -- putStrLn "\n\n\n"
-        -- putStrLn $ show $ colimit
-        
-        let (Right cg1) = readCGString "A -f-> B\nB -g-> C"
-        let (Right cg2) = readCGString "1 -a-> 2\n 2 -b-> 3"
-        let (Right cg3) = readCGString "A1 -(gof)a-> C2"
-        let f = completeDiagram Diagram{src = cg3, tgt = cg1, omap = weakMap [(pack "A1", pack "A"),(pack "C2", pack "C")], mmap = weakMap [(anElement $ genAr cg3 (pack "A1") (pack "C2"), anElement $ ar cg1 (pack "A") (pack "C"))]}
-        let g = completeDiagram Diagram{src = cg3, tgt = cg2, omap = weakMap [(pack "A1", pack "1"),(pack "C2", pack "2")], mmap = weakMap [(anElement $ genAr cg3 (pack "A1") (pack "C2"), anElement $ ar cg2 (pack "1") (pack "2"))]}
-        let diag = completeDiagram Diagram{src = Hat, tgt = FinCat, omap = weakMap [(HatA,cg3) , (HatB,cg2), (HatC, cg1)], mmap = weakMap [(HatF, g), (HatG, f)]}
-        
-        let coproduct = coproductOfTextCompositionGraphs diag
-        putStrLn $ pprintFiniteCategory $ nadir coproduct
-        putStrLn $ "\n\n"
-        putStrLn $ show $ coproduct
-        putStrLn $ "\n\n"
-        
-        
-        -- let Just f_ = ((legsCocone coproduct) =>$ HatB) @? f
-        -- let Just g_ = ((legsCocone coproduct) =>$ HatC) @? g
-        -- let coequalizer = coequalizeCompositionGraphs f_ g_
-        -- putStrLn $ pprintFiniteCategory $ tgt coequalizer
-        -- putStrLn $ "\n\n"
-        -- putStrLn $ show $ coequalizer
-        -- putStrLn $ "\n\n"
-        
-        let colimit = colimitOfCompositionGraphs diag (\x o -> (pack.show $ x) <> (pack ".")<>o) (\x m -> (pack.show$ x) <>(pack ".")<>m)
-        putStrLn $ pprintFiniteCategory $ nadir colimit
-        putStrLn $ "\n\n"
-        putStrLn $ show $ colimit
-        putStrLn "End of Math.FiniteCategories.CompositionGraph.Example"
+ src/Math/FiniteCategories/CompositionGraph/Examples.hs view
@@ -0,0 +1,110 @@+{-| Module  : FiniteCategories
+Description : Examples of 'CompositionGraph's.
+Copyright   : Guillaume Sabbagh 2023
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'CompositionGraph's, other categories transformed into 'CompositionGraph's, a random example of 'CompositionGraph', a 'CompositionGraph' created from a string and a colimit of 'CompositionGraph's.
+
+See also 'exampleCgdString' in Math.FiniteCategories.FunctorCategory.Examples for constructing diagrams of 'CompositionGraph's.
+-}
+module Math.FiniteCategories.CompositionGraph.Examples
+(
+    exampleCompositionGraph,
+    exampleCompositionGraph2,
+    exampleSetTransformedIntoACompositionGraph,
+    example4TransformedIntoACompositionGraph,
+    exampleRandomCompositionGraph,
+    exampleCgString,
+    exampleCgString2,
+    exampleDiagramToCompositionGraphs,
+    exampleColimitOfCompositionGraphs,
+)
+where
+    import qualified Data.WeakSet as Set
+    import Data.WeakSet.Safe
+    import Data.WeakMap.Safe
+    
+    import Math.FiniteCategory
+    import Math.Categories
+    import Math.CocompleteCategory
+    import Math.FiniteCategories
+    import Math.FiniteCategories.FunctorCategory
+    import Math.Categories.FinCat
+    
+    import Data.Text (pack , Text)
+    
+    import System.Random
+    import Numeric.Natural
+    
+    -- | An example of 'CompositionGraph' constructed with the smart constructor 'compositionGraph'.
+    exampleCompositionGraph :: CompositionGraph Int Char
+    exampleCompositionGraph = result
+        where
+            Just underlyingGraph = graph (set [1,2,3]) (set [Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'},Arrow{sourceArrow=1,targetArrow=2,labelArrow='b'},Arrow{sourceArrow=2,targetArrow=3,labelArrow='c'}])
+            compositionLaw = weakMap [([Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'},Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}],[Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}])]
+            Right result = compositionGraph underlyingGraph compositionLaw
+            
+    -- | An example of 'CompositionGraph' constructed with the smart constructor 'unsafeCompositionGraph'.
+    exampleCompositionGraph2 :: CompositionGraph Int Char
+    exampleCompositionGraph2 = result
+        where
+            underlyingGraph = unsafeGraph (set [1,2]) (set [Arrow{sourceArrow=1,targetArrow=2,labelArrow='f'}])
+            compositionLaw = weakMap []
+            result = unsafeCompositionGraph underlyingGraph compositionLaw
+            
+    
+    -- | The insertion diagram from S (the subcategory of Set containing all subsets of the set {'A','B'} as objects)  to the same category transformed into a 'CompositionGraph'.
+    exampleSetTransformedIntoACompositionGraph :: Diagram (Ens Char) (Function Char) (Set.Set Char) (CompositionGraph (Set.Set Char) (Function Char)) (CGMorphism (Set.Set Char) (Function Char)) (Set.Set Char)
+    exampleSetTransformedIntoACompositionGraph = finiteCategoryToCompositionGraph2 s
+        where
+            s = ens.(Set.powerSet).set $ "AB"
+            
+    -- | The insertion diagram from 4 to the same category transformed into a 'CompositionGraph'.
+    example4TransformedIntoACompositionGraph :: Diagram NumberCategory NumberCategoryMorphism NumberCategoryObject (CompositionGraph NumberCategoryObject NumberCategoryMorphism) (CGMorphism NumberCategoryObject NumberCategoryMorphism) NumberCategoryObject
+    example4TransformedIntoACompositionGraph = finiteCategoryToCompositionGraph2 (numberCategory 4)
+    
+    -- | An example of random 'CompositionGraph'.
+    exampleRandomCompositionGraph :: CompositionGraph Int Int
+    exampleRandomCompositionGraph = result
+        where
+            randomGen = mkStdGen 123456
+            (result,newRandomGen) = defaultConstructRandomCompositionGraph randomGen
+            
+    -- | An example of 'CompositionGraph' read from a .cg string.
+    exampleCgString :: CompositionGraph Text Text
+    exampleCgString = cg
+        where
+            Right cg = readCGString "A -f-> B -g-> C = A -h-> C"
+            
+    -- | A second example of 'CompositionGraph' read from a .cg string.
+    exampleCgString2 :: CompositionGraph Text Text
+    exampleCgString2 = cg
+        where
+            Right cg = readCGString "A -f-> B\nB -g-> C\nC -h-> B\nB -g-> C -h-> B = <ID>\nC -h-> B -g-> C -h-> B -g-> C = C -h-> B -g-> C"
+            
+    -- | An example of 'Diagram' from 'Hat' to 'FinCat' of 'CompositionGraph's.  
+    exampleDiagramToCompositionGraphs :: Diagram Hat HatAr HatOb (FinCat (CompositionGraph Text Text) (CGMorphism Text Text) Text) (FinFunctor (CompositionGraph Text Text) (CGMorphism Text Text) Text) (CompositionGraph Text Text)
+    exampleDiagramToCompositionGraphs = completeDiagram diag
+        where
+            (Right cg1) = readCGString "A"
+            (Right cg2) = readCGString "A\nB"
+            (Right cg3) = readCGString "A\nC"
+            f = completeDiagram Diagram{src = cg1, tgt = cg2, omap = weakMap [(pack "A", pack "A")], mmap = weakMap []}
+            g = completeDiagram Diagram{src = cg1, tgt = cg3, omap = weakMap [(pack "A", pack "A")], mmap = weakMap []}
+            diag = Diagram{src = Hat, tgt = FinCat, omap = weakMap [(HatA,cg1) , (HatB,cg2), (HatC, cg3)], mmap = weakMap [(HatF, f), (HatG, g)]}
+            
+    -- | An example of colimit of 'CompositionGraph's.
+    exampleColimitOfCompositionGraphs = result
+        where
+            (Right cg1) = readCGString "A -f-> B\nB -g-> C"
+            (Right cg2) = readCGString "1 -a-> 2\n 2 -b-> 3"
+            (Right cg3) = readCGString "A1 -(gof)a-> C2"
+            f = completeDiagram Diagram{src = cg3, tgt = cg1, omap = weakMap [(pack "A1", pack "A"),(pack "C2", pack "C")], mmap = weakMap [(anElement $ genAr cg3 (pack "A1") (pack "C2"), anElement $ ar cg1 (pack "A") (pack "C"))]}
+            g = completeDiagram Diagram{src = cg3, tgt = cg2, omap = weakMap [(pack "A1", pack "1"),(pack "C2", pack "2")], mmap = weakMap [(anElement $ genAr cg3 (pack "A1") (pack "C2"), anElement $ ar cg2 (pack "1") (pack "2"))]}
+            diag = completeDiagram Diagram{src = Hat, tgt = FinCat, omap = weakMap [(HatA,cg3) , (HatB,cg2), (HatC, cg1)], mmap = weakMap [(HatF, g), (HatG, f)]}
+            result = colimitOfCompositionGraphs diag
+    
+
− src/Math/FiniteCategories/ConeCategory/Example.hs 
@@ -1,47 +0,0 @@-{-| Module  : FiniteCategories
-Description : An exemple of 'ConeCategory' pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An exemple of 'ConeCategory' pretty printed.
-
-Pretty print the 'ConeCategory' of a 'V' 'Diagram'.
--}
-module Math.FiniteCategories.ConeCategory.Example
-(
-    main
-)
-where
-    import              Math.Category  
-    import              Math.Categories.FinGrph   
-    import              Math.FiniteCategories.ConeCategory
-    import              Math.FiniteCategories.FunctorCategory
-    import              Math.FiniteCategories.V
-    import              Math.FiniteCategories.Hat
-    import              Math.FiniteCategories.SafeCompositionGraph
-    import              Math.IO.PrettyPrint
-    import              Math.FiniteCategory
-    
-    
-    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
-    
-    -- | An exemple of 'ConeCategory' pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.ConeCategory.Example"
-        let Right scg = safeCompositionGraph (unsafeGraph (set "ABCD") (set [Arrow{sourceArrow = 'A', targetArrow = 'B', labelArrow='f'}, Arrow{sourceArrow = 'A', targetArrow = 'C', labelArrow='g'}, Arrow{sourceArrow = 'B', targetArrow = 'D', labelArrow='h'}, Arrow{sourceArrow = 'C', targetArrow = 'D', labelArrow='I'}])) (weakMap [([Arrow{sourceArrow = 'C', targetArrow = 'D', labelArrow='I'}, Arrow{sourceArrow = 'A', targetArrow = 'C', labelArrow='g'}],[Arrow{sourceArrow = 'B', targetArrow = 'D', labelArrow='h'}, Arrow{sourceArrow = 'A', targetArrow = 'B', labelArrow='f'}])]) 3
-        let diag = completeDiagram Diagram{src=V,tgt=scg,omap=weakMap [(VA,'D'),(VB,'B'),(VC,'C')], mmap=weakMap [(VF,anElement (genAr scg 'B' 'D')),(VG,anElement (genAr scg 'C' 'D'))]}
-        putStrLn $ pprint  diag 
-        putStrLn $ pprintFiniteCategory  (coneCategory diag) 
-        let diag2 = completeDiagram Diagram{src=Hat,tgt=scg,omap=weakMap [(HatA,'A'),(HatB,'B'),(HatC,'C')], mmap=weakMap [(HatF,anElement (genAr scg 'A' 'B')),(HatG,anElement (genAr scg 'A' 'C'))]}
-        putStrLn $ pprint  diag2 
-        putStrLn $ pprintFiniteCategory  (coconeCategory diag2) 
-        putStrLn "End of Math.FiniteCategories.ConeCategory.Example"
+ src/Math/FiniteCategories/ConeCategory/Examples.hs view
@@ -0,0 +1,49 @@+{-| Module  : FiniteCategories
+Description : Examples of 'ConeCategory'.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'ConeCategory' and example of (co)limits computation.
+-}
+module Math.FiniteCategories.ConeCategory.Examples
+(
+    exampleConeCategory,
+    exampleLimit,
+    exampleCoconeCategory,
+    exampleColimit,
+)
+where
+    import              Math.Category
+    import              Math.FiniteCategories.ConeCategory
+    import              Math.FiniteCategories.FunctorCategory
+    import              Math.FiniteCategories
+    import              Math.FiniteCategories.FunctorCategory.Examples
+    
+    
+    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
+    
+    
+    -- | Example of 'ConeCategory'. Here, there are no cone as 'Square.FH' is different from 'Square.GI'.
+    exampleConeCategory :: ConeCategory V VAr VOb Square SquareAr SquareOb
+    exampleConeCategory = coneCategory exampleDiagramVToSquare
+    
+    -- | Example of limit computation. Here, there are no limit as 'Square.FH' is different from 'Square.GI'.
+    exampleLimit :: Set (Cone V VAr VOb Square SquareAr SquareOb)
+    exampleLimit = limits exampleDiagramVToSquare
+    
+    -- | Example of 'CoconeCategory'. Here, there are no cocone as 'Square.FH' is different from 'Square.GI'.
+    exampleCoconeCategory :: CoconeCategory Hat HatAr HatOb Square SquareAr SquareOb
+    exampleCoconeCategory = coconeCategory exampleDiagramHatToSquare
+    
+    -- | Example of colimit computation. Here, there are no colimit as 'Square.FH' is different from 'Square.GI'.
+    exampleColimit :: Set (Cocone Hat HatAr HatOb Square SquareAr SquareOb)
+    exampleColimit = colimits exampleDiagramHatToSquare
+
− src/Math/FiniteCategories/DiscreteCategory/Example.hs 
@@ -1,31 +0,0 @@-{-| Module  : FiniteCategories
-Description : Six examples of 'DiscreteCategory' pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-Six examples of 'DiscreteCategory' pretty printed.
-
-Pretty print categories __0__ up to __5__ .
--}
-module Math.FiniteCategories.DiscreteCategory.Example
-(
-    main
-)
-where
-    import Data.WeakSet.Safe
-    
-    import Math.FiniteCategories.DiscreteCategory
-    import Math.IO.PrettyPrint
-    import Math.FiniteCategory
-    
-    -- | Six examples of 'DiscreteCategory' pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.DiscreteCategory.Example"
-        let cats = discreteCategory <$> (\n -> set (take n ['A'..])) <$> [0..5]
-        let ps = (putStrLn.pprintFiniteCategory) <$> cats
-        sequence ps
-        putStrLn "End of Math.FiniteCategories.DiscreteCategory.Example"
+ src/Math/FiniteCategories/DiscreteCategory/Examples.hs view
@@ -0,0 +1,49 @@+{-| Module  : FiniteCategories
+Description : Six examples of 'DiscreteCategory'.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Six examples of 'DiscreteCategory'.
+
+Categories __0__ up to __5__ .
+-}
+module Math.FiniteCategories.DiscreteCategory.Examples
+(
+    exampleDiscreteCategory0,
+    exampleDiscreteCategory1,
+    exampleDiscreteCategory2,
+    exampleDiscreteCategory3,
+    exampleDiscreteCategory4,
+    exampleDiscreteCategory5,
+)
+where
+    import Data.WeakSet.Safe
+    
+    import Math.FiniteCategories.DiscreteCategory
+    
+    -- | An example of 'DiscreteCategory' with 0 object.
+    exampleDiscreteCategory0 :: DiscreteCategory Int
+    exampleDiscreteCategory0 = discreteCategory (set [])
+    
+    -- | An example of 'DiscreteCategory' with 1 object.
+    exampleDiscreteCategory1 :: DiscreteCategory Int
+    exampleDiscreteCategory1 = discreteCategory (set [1])
+    
+    -- | An example of 'DiscreteCategory' with 2 objects.
+    exampleDiscreteCategory2 :: DiscreteCategory Int
+    exampleDiscreteCategory2 = discreteCategory (set [1..2])
+    
+    -- | An example of 'DiscreteCategory' with 3 objects.
+    exampleDiscreteCategory3 :: DiscreteCategory Int
+    exampleDiscreteCategory3 = discreteCategory (set [1..3])
+    
+    -- | An example of 'DiscreteCategory' with 4 objects.
+    exampleDiscreteCategory4 :: DiscreteCategory Int
+    exampleDiscreteCategory4 = discreteCategory (set [1..4])
+    
+    -- | An example of 'DiscreteCategory' with 5 objects.
+    exampleDiscreteCategory5 :: DiscreteCategory Int
+    exampleDiscreteCategory5 = discreteCategory (set [1..5])
+ src/Math/FiniteCategories/DiscreteTwo.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-| Module  : FiniteCategories
+Description : The 'DiscreteTwo' category contains two objects and their identities.
+Copyright   : Guillaume Sabbagh 2023
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+The 'DiscreteTwo' category contains two objects and their identities.
+
+You can construct it using 'DiscreteCategory', it is defined as a standalone category because it is often used unlike other discrete categories.
+-}
+
+module Math.FiniteCategories.DiscreteTwo
+(
+    DiscreteTwoOb(..),
+    DiscreteTwoAr(..),
+    DiscreteTwo(..),
+    twoDiagram,
+    insertionDiscreteTwoInDiscreteCategory,
+)
+where
+    import          Math.FiniteCategory
+    import          Math.Categories.FunctorCategory
+    import          Math.FiniteCategories.DiscreteCategory
+    import          Math.IO.PrettyPrint
+    
+    import          Data.WeakSet.Safe
+    import          Data.WeakMap.Safe
+    import          Data.Simplifiable
+    
+    import          GHC.Generics
+    
+    -- | 'DiscreteTwoOb' is a datatype used as the object type and the morphism type.
+    --
+    -- It has two constructors 'A' and 'B'.
+    data DiscreteTwoOb = A | B  deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
+    
+    -- | There are two identities corresponding to 'A' and 'B'.
+    type DiscreteTwoAr = DiscreteTwoOb
+    
+    instance Morphism DiscreteTwoOb DiscreteTwoOb where
+        source A = A
+        source B = B
+        target A = A
+        target B = B
+        (@) A A = A
+        (@) B B = B
+        (@) _ _ = error "Incompatible composition of DiscreteTwo morphisms."
+    
+    -- | 'DiscreteTwo' is a datatype used as category type.
+    data DiscreteTwo = DiscreteTwo deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
+    
+    instance Category DiscreteTwo DiscreteTwoOb DiscreteTwoOb where
+        identity DiscreteTwo A = A
+        identity DiscreteTwo B = B
+        ar DiscreteTwo A A = set [A]
+        ar DiscreteTwo A B = set []
+        ar DiscreteTwo B A = set []
+        ar DiscreteTwo B B = set [B]
+    
+    instance FiniteCategory DiscreteTwo DiscreteTwoOb DiscreteTwoOb where
+        ob DiscreteTwo = set [A,B]
+    
+    -- | Constructs a diagram from 'DiscreteTwo' to another category.
+    twoDiagram :: (Category c m o, Morphism m o) => c -> o -> o -> Diagram DiscreteTwo DiscreteTwoAr DiscreteTwoOb c m o
+    twoDiagram c a b = Diagram{src = DiscreteTwo, tgt = c, omap = weakMap [(A,a),(B,b)], mmap = weakMap [(A,identity c a),(B, identity c b)]}
+    
+    -- | Return an insertion functor from 'DiscreteTwo' to a 'DiscreteCategory' given a 'DiscreteCategory' and the image of 'A' and 'B'.
+    insertionDiscreteTwoInDiscreteCategory :: (Eq t) => (DiscreteCategory t) -> t -> t -> Diagram DiscreteTwo DiscreteTwoAr DiscreteTwoOb (DiscreteCategory t) (DiscreteMorphism t) t
+    insertionDiscreteTwoInDiscreteCategory dc imA imB = completeDiagram $ Diagram{src = DiscreteTwo, tgt = dc, omap = weakMap [(A,imA),(B,imB)], mmap = weakMap []}
− src/Math/FiniteCategories/Ens/Example.hs 
@@ -1,28 +0,0 @@-{-| Module  : FiniteCategories
-Description : An example of  __'Ens'__ pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An example of  __'Ens'__ pretty printed.
--}
-module Math.FiniteCategories.Ens.Example
-(
-    main
-)
-where
-    import Data.WeakSet         (powerSet, Set)
-    import Data.WeakSet.Safe
-    
-    import Math.FiniteCategories
-    import Math.IO.PrettyPrint
-    import Math.FiniteCategory
-    
-    -- | __'Ens'__ pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.Ens.Example"
-        putStrLn $ pprintFiniteCategory (ens.powerSet.set $ "ABC")
-        putStrLn "End of Math.FiniteCategories.Ens.Example"
+ src/Math/FiniteCategories/Ens/Examples.hs view
@@ -0,0 +1,98 @@+{-| Module  : FiniteCategories
+Description : Examples of  __'Ens'__.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of  __'Ens'__.
+-}
+module Math.FiniteCategories.Ens.Examples
+(
+    exampleEns,
+    exampleEns2,
+    exampleDiscreteDiagToSet,
+    exampleProductSet,
+    exampleCoproductSet,
+    exampleParallelDiagramToSet,
+    exampleEqualizerSet,
+    exampleCoequalizerSet,
+    exampleDiagramVToFinSet,
+    exampleLimitSet,
+    exampleColimitSet,
+    exampleExponentialObjectInSet,
+)
+where
+    import Data.WeakSet         (powerSet, Set)
+    import Data.WeakSet.Safe
+    import Data.WeakMap
+    
+    import Math.FiniteCategories
+    import Math.Categories
+    import Math.IO.PrettyPrint
+    import Math.FiniteCategory
+    import Math.CompleteCategory
+    import Math.CocompleteCategory
+    import Math.CartesianClosedCategory
+    
+    -- | An example of 'Ens' containing all subsets of {'A', 'B', 'C'}.
+    exampleEns :: Ens Char
+    exampleEns = ens.powerSet.set $ "ABC"
+    
+    -- | An example of 'Ens' containing sets {{},{'A'},{'A','B'},{'A','B','C'}}.
+    exampleEns2 :: Ens Char
+    exampleEns2 = ens.set $ [set "", set "A", set "AB", set "ABC"]
+    
+    -- | An example of 'discreteDiagram' to 'FinSet'.
+    exampleDiscreteDiagToSet :: Diagram (DiscreteCategory Char) (DiscreteMorphism Char) Char (FinSet Int) (Function Int) (Set Int)
+    exampleDiscreteDiagToSet = completeDiagram Diagram{src=discreteCategory (set ['a','b']), tgt=FinSet, omap= (weakMap [('a',set [1,2]),('b',set [3,4,5])]), mmap = weakMap []}
+
+    -- | An example of product computed in 'FinSet' thanks to the fact that 'FinSet' is complete. Computes {1,2} x {3,4,5}.
+    exampleProductSet :: Cone (DiscreteCategory Char) (DiscreteMorphism Char) Char (FinSet (Limit Char Int)) (Function (Limit Char Int)) (Set (Limit Char Int))
+    exampleProductSet = Math.CompleteCategory.product exampleDiscreteDiagToSet
+    
+    -- | An example of coproduct computed in 'FinSet' thanks to the fact that 'FinSet' is cocomplete. Computes {1,2} + {3,4,5}.
+    exampleCoproductSet :: Cocone (DiscreteCategory Char) (DiscreteMorphism Char) Char (FinSet (Colimit Char Int)) (Function (Colimit Char Int)) (Set (Colimit Char Int))
+    exampleCoproductSet = coproduct exampleDiscreteDiagToSet
+            
+    -- | An example of 'parallelDiagram' to 'FinSet', the first function selected is x%2 on {0,1,2,3,4} and the second is (const 0).
+    exampleParallelDiagramToSet :: Diagram Parallel ParallelAr ParallelOb (FinSet Int) (Function Int) (Set Int)
+    exampleParallelDiagramToSet = completeDiagram Diagram{src = Parallel, tgt = FinSet, omap = weakMap [], mmap = weakMap [(ParallelF,Function{function = weakMap [(0,0),(1,1),(2,0),(3,1),(4,0)], codomain = set [0,1]}),(ParallelG,Function{function = weakMap [(0,0),(1,0),(2,0),(3,0),(4,0)], codomain = set [0,1]})]}
+    
+    -- | An example of equalizer of a 'parallelDiagram' to 'FinSet' thanks to the fact that 'FinSet' is complete.
+    --
+    -- It equalizes 'exampleParallelDiagramToSet', therefore the apex of the equalizer is {0,2,4}.
+    exampleEqualizerSet :: Cone Parallel ParallelAr ParallelOb (FinSet Int) (Function Int) (Set Int)
+    exampleEqualizerSet = equalize exampleParallelDiagramToSet
+    
+    -- | An example of coequalizer of a 'parallelDiagram' to 'FinSet' thanks to the fact that 'FinSet' is cocomplete.
+    --
+    -- It equalizes 'exampleParallelDiagramToSet', therefore the nadir of the coequalizer is {0}.
+    exampleCoequalizerSet :: Cocone Parallel ParallelAr ParallelOb (FinSet Int) (Function Int) (Set Int)
+    exampleCoequalizerSet = coequalize exampleParallelDiagramToSet
+    
+    
+    -- | An example of a diagram from 'V' to 'FinSet'. The two functions selected are identities, the first from {1,2,3,4} to {1,2,3,4,5,6,7,8,9,10} and the second from {3,4,5,6} to {1,2,3,4,5,6,7,8,9,10}.
+    exampleDiagramVToFinSet :: Diagram V VAr VOb (FinSet Int) (Function Int) (Set Int)
+    exampleDiagramVToFinSet = completeDiagram Diagram{src = V, tgt = FinSet, omap = weakMap [], mmap = weakMap [(VF,Function{function = weakMap [(1,1),(2,2),(3,3),(4,4)], codomain = set [1..10]}),(VG,Function{function = weakMap [(3,3),(4,4),(5,5),(6,6)], codomain = set [1..10]})]}
+    
+    -- | An example of limit computation of a 'Diagram' to 'FinSet' thanks to the fact that 'FinSet' is complete.
+    exampleLimitSet :: Cone V VAr VOb (FinSet (Limit VOb Int)) (Function (Limit VOb Int)) (Set (Limit VOb Int))
+    exampleLimitSet = limit exampleDiagramVToFinSet
+    
+    
+    
+    -- | An example of a diagram from 'Hat' to 'FinSet'. The two functions selected are identities, the first from {3,4} to {1,2,3,4} and the second from {3,4} to {3,4,5,6}.
+    exampleDiagramHatToFinSet :: Diagram Hat HatAr HatOb (FinSet Int) (Function Int) (Set Int)
+    exampleDiagramHatToFinSet = completeDiagram Diagram{src = Hat, tgt = FinSet, omap = weakMap [], mmap = weakMap [(HatF,Function{function = weakMap [(3,3),(4,4)], codomain = set [1..4]}),(HatG,Function{function = weakMap [(3,3),(4,4)], codomain = set [3..6]})]}
+    
+    -- | An example of colimit computation of a 'Diagram' to 'FinSet' thanks to the fact that 'FinSet' is cocomplete.
+    --
+    -- It is the colimit of 'exampleDiagramHatToFinSet' which computes the union of {1,2,3,4} and {3,4,5,6} where 3 and 4 are identified.
+    exampleColimitSet :: Cocone Hat HatAr HatOb (FinSet (Colimit HatOb Int)) (Function (Colimit HatOb Int)) (Set (Colimit HatOb Int))
+    exampleColimitSet = colimit exampleDiagramHatToFinSet
+    
+    -- | An example of exponential object. Computes the internal hom of 'exampleDiscreteDiagToSet', meaning all functions from {1,2} to {3,4,5}.
+    exampleExponentialObjectInSet :: Tripod (FinSet (Cartesian Int)) (Function (Cartesian Int)) (Set (Cartesian Int))
+    exampleExponentialObjectInSet = internalHom $ exampleDiscreteDiagToSet <-@<- (insertionDiscreteTwoInDiscreteCategory (src exampleDiscreteDiagToSet) 'a' 'b')
src/Math/FiniteCategories/Examples.hs view
@@ -1,51 +1,41 @@ {-| Module  : FiniteCategories
-Description : Run all finite categories examples.
+Description : Export all finite category examples.
 Copyright   : Guillaume Sabbagh 2022
 License     : GPL-3
 Maintainer  : guillaumesabbagh@protonmail.com
 Stability   : experimental
 Portability : portable
 
-Run all finite categories examples. See results in the folder 
+Export all finite category examples. 
 -}
 
 module Math.FiniteCategories.Examples
 (
-    main
+    module Math.FiniteCategories.CommaCategory.Examples,
+    module Math.FiniteCategories.CompositionGraph.Examples,
+    module Math.FiniteCategories.ConeCategory.Examples,
+    module Math.FiniteCategories.DiscreteCategory.Examples,
+    module Math.FiniteCategories.Ens.Examples,
+    module Math.FiniteCategories.FinCat.Examples,
+    module Math.FiniteCategories.FinGrph.Examples,
+    module Math.FiniteCategories.FinSketch.Examples,
+    module Math.FiniteCategories.FunctorCategory.Examples,
+    module Math.FiniteCategories.LimitCategory.Examples,
+    module Math.FiniteCategories.NumberCategory.Examples,
+    module Math.FiniteCategories.Opposite.Examples,
+    module Math.FiniteCategories.SafeCompositionGraph.Examples,
 )
 where
-    import qualified Math.FiniteCategories.NumberCategory.Example       as NumberCategory
-    import qualified Math.FiniteCategories.DiscreteCategory.Example     as DiscreteCategory
-    import qualified Math.FiniteCategories.Hat.Example                  as Hat
-    import qualified Math.FiniteCategories.V.Example                    as V
-    import qualified Math.FiniteCategories.Parallel.Example             as Parallel
-    import qualified Math.FiniteCategories.Square.Example               as Square
-    import qualified Math.FiniteCategories.Ens.Example                  as Ens
-    import qualified Math.FiniteCategories.FinGrph.Example              as FinGrph
-    import qualified Math.FiniteCategories.Opposite.Example             as Opposite
-    import qualified Math.FiniteCategories.FinCat.Example               as FinCat
-    import qualified Math.FiniteCategories.FunctorCategory.Example      as FunctorCategory
-    import qualified Math.FiniteCategories.CompositionGraph.Example     as CompositionGraph
-    import qualified Math.FiniteCategories.SafeCompositionGraph.Example as SafeCompositionGraph
-    import qualified Math.FiniteCategories.CommaCategory.Example        as CommaCategory
-    import qualified Math.FiniteCategories.One.Example                  as One
-    import qualified Math.FiniteCategories.ConeCategory.Example         as ConeCategory
-    
-    -- | Run all examples of the project. See results in the folder OutputGraphViz.
-    main = do
-        NumberCategory.main
-        DiscreteCategory.main
-        Hat.main
-        V.main
-        Parallel.main
-        Square.main
-        Ens.main
-        FinGrph.main
-        Opposite.main
-        FinCat.main
-        FunctorCategory.main
-        CompositionGraph.main
-        SafeCompositionGraph.main
-        CommaCategory.main
-        One.main
-        ConeCategory.main+    import Math.FiniteCategories.CommaCategory.Examples
+    import Math.FiniteCategories.CompositionGraph.Examples
+    import Math.FiniteCategories.ConeCategory.Examples
+    import Math.FiniteCategories.DiscreteCategory.Examples
+    import Math.FiniteCategories.Ens.Examples
+    import Math.FiniteCategories.FinCat.Examples
+    import Math.FiniteCategories.FinGrph.Examples
+    import Math.FiniteCategories.FinSketch.Examples
+    import Math.FiniteCategories.FunctorCategory.Examples
+    import Math.FiniteCategories.LimitCategory.Examples
+    import Math.FiniteCategories.NumberCategory.Examples
+    import Math.FiniteCategories.Opposite.Examples
+    import Math.FiniteCategories.SafeCompositionGraph.Examples
+ src/Math/FiniteCategories/ExponentialCategory.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE FunctionalDependencies  #-}
+{-# LANGUAGE MonadComprehensions  #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{-| Module  : FiniteCategories
+Description : ('FinCat' 'ExponentialCategory') is the category in which live the exponential objects of 'FinCat' with the original categories.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+('FinCat' 'ExponentialCategory') is the category in which live the exponential objects of 'FinCat' with the original categories. To compute exponential objects in a usual category, see Math.CartesianClosedCategory. To compute exponential objects in a custom 'FiniteCategory', see 'exponentialObjects' in Math.CartesianClosedCategory.
+-}
+
+module Math.FiniteCategories.ExponentialCategory
+(
+    -- * Exponential category
+    -- ** Object
+    ExponentialCategoryObject(..),
+    -- ** Morphism
+    ExponentialCategoryMorphism(..),
+    -- ** Category
+    ExponentialCategory(..),
+    -- * Cartesian category type
+    -- ** Object
+    CartesianObject(..),
+    -- ** Morphism
+    CartesianMorphism(..),
+    -- ** Category
+    CartesianCategory(..),
+)
+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)
+    import              Data.Simplifiable
+    
+    import              Math.Category
+    import              Math.FiniteCategory
+    import              Math.FiniteCategories.DiscreteTwo
+    import              Math.FiniteCategories.LimitCategory
+    import              Math.CompleteCategory
+    import              Math.CartesianClosedCategory
+    import              Math.Categories.FunctorCategory
+    import              Math.Categories.ConeCategory
+    import              Math.Categories.FinCat
+    import              Math.IO.PrettyPrint
+    
+    import              GHC.Generics
+    
+    -- | An object in an 'ExponentialCategory'. It is either a 'ExprojectedObject' in an original category or a 'ExponentialElementObject'.
+    data ExponentialCategoryObject c m o = ExprojectedObject o -- ^ An 'ExprojectedObject' is an object o.
+                                         | ExponentialElementObject (FinFunctor c m o) -- ^ The exponential elemets in Cat are functors.
+        deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)
+       
+       
+    -- | A morphism in an 'ExponentialCategory'. It is either a 'ExprojectedMorphism' in an original category or an 'ExponentialElementMorphism'.
+    data ExponentialCategoryMorphism c m o = ExprojectedMorphism m -- ^ An 'ExprojectedMorphism' is a morphism m.
+                                           | ExponentialElementMorphism (NaturalTransformation c m o c m o) -- ^ A 'NaturalTransformation' is a morphism in the 'ExponentialCategory'.
+        deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)        
+        
+    instance (FiniteCategory c m o, Morphism m o, Eq c, Eq m, Eq o) => Morphism (ExponentialCategoryMorphism c m o) (ExponentialCategoryObject c m o) where
+        source (ExprojectedMorphism m) = ExprojectedObject (source m)
+        source (ExponentialElementMorphism nat) = ExponentialElementObject (source nat)
+        target (ExprojectedMorphism m) = ExprojectedObject (target m)
+        target (ExponentialElementMorphism nat) = ExponentialElementObject (target nat)
+        (ExprojectedMorphism m2) @ (ExprojectedMorphism m1) = ExprojectedMorphism $ m2 @ m1
+        (ExponentialElementMorphism nat2) @ (ExponentialElementMorphism nat1) = ExponentialElementMorphism $ nat2 @ nat1
+        _ @ _ = error "Incompatible composition of ExponentialCategory morphisms."
+    
+    
+    
+    -- | An 'ExponentialCategory' is either an 'ExprojectedCategory' (an original category) or an 'ExponentialCategory'.
+    data ExponentialCategory c m o = ExprojectedCategory c -- ^ An original category in 'FinCat'.
+                                   | ExponentialCategory (FunctorCategory c m o c m o)     -- ^ The exponential category of a given 2-base is a 'FunctorCategory'.
+        deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)
+    
+    instance (FiniteCategory c m o, Morphism m o, Eq c, Eq m, Eq o) => Category (ExponentialCategory c m o) (ExponentialCategoryMorphism c m o) (ExponentialCategoryObject c m o) where
+        identity (ExprojectedCategory c) (ExprojectedObject o) = ExprojectedMorphism $ identity c o
+        identity (ExponentialCategory _) (ExprojectedObject _) = error "Identity in an exponential category on an exprojected object."
+        identity (ExprojectedCategory _) (ExponentialElementObject _) = error "Identity in an exprojected category on a exponential element."
+        identity (ExponentialCategory functCat) (ExponentialElementObject funct) = ExponentialElementMorphism $ identity functCat funct
+        ar (ExprojectedCategory functCat) (ExprojectedObject s) (ExprojectedObject t) = ExprojectedMorphism <$> ar functCat s t
+        ar (ExprojectedCategory _) (ExprojectedObject _) (ExponentialElementObject _) = error "Ar in an exprojected category where the target is an exponential element."
+        ar (ExprojectedCategory _) (ExponentialElementObject _) (ExprojectedObject _) = error "Ar in an exprojected category where the source is an exponential element."
+        ar (ExprojectedCategory _) (ExponentialElementObject _) (ExponentialElementObject _) = error "Ar in an exprojected category where the source and the target are exponential elements."
+        ar (ExponentialCategory _) (ExprojectedObject _) (ExprojectedObject _) = error "Ar in an exponential category where the source and target are exprojected objects."
+        ar (ExponentialCategory _) (ExprojectedObject _) (ExponentialElementObject _) = error "Ar in an exponential category where the source is an exprojected object."
+        ar (ExponentialCategory _) (ExponentialElementObject _) (ExprojectedObject _) = error "Ar in an exponential category where the target is an exprojected object."
+        ar (ExponentialCategory functCat) (ExponentialElementObject s) (ExponentialElementObject t) = ExponentialElementMorphism <$> ar functCat s t
+            
+            
+    instance (FiniteCategory c m o, Morphism m o, Eq c, Eq m, Eq o) => FiniteCategory (ExponentialCategory c m o) (ExponentialCategoryMorphism c m o) (ExponentialCategoryObject c m o) where
+        ob (ExprojectedCategory cat) = ExprojectedObject <$> ob cat
+        ob (ExponentialCategory functCat) = ExponentialElementObject <$> ob functCat
+    
+    type TwoProductOfCategories c m o = FinCat (LimitCategory DiscreteTwo DiscreteTwoAr DiscreteTwoOb c m o) (Limit DiscreteTwoOb m) (Limit DiscreteTwoOb o)
+    type TwoProductOfCategoriesMorphism c m o = FinFunctor (LimitCategory DiscreteTwo DiscreteTwoAr DiscreteTwoOb c m o) (Limit DiscreteTwoOb m) (Limit DiscreteTwoOb o)
+    type TwoProductOfCategoriesObject c m o = LimitCategory DiscreteTwo DiscreteTwoAr DiscreteTwoOb c m o
+    
+    -- | The type of the category containing categories and their exponential objects.
+    type CartesianCategory c m o = TwoProductOfCategories (ExponentialCategory c m o) (ExponentialCategoryMorphism c m o) (ExponentialCategoryObject c m o)
+    
+    -- | A morphism in 'CartesianCategory'.
+    type CartesianMorphism c m o = TwoProductOfCategoriesMorphism (ExponentialCategory c m o) (ExponentialCategoryMorphism c m o) (ExponentialCategoryObject c m o)
+    
+    -- | An object in 'CartesianCategory'.
+    type CartesianObject c m o = TwoProductOfCategoriesObject (ExponentialCategory c m o) (ExponentialCategoryMorphism c m o) (ExponentialCategoryObject c m o)
+    
+    instance (FiniteCategory c m o, Morphism m o, Eq c, Eq m, Eq o) => CartesianClosedCategory (FinCat c m o) (FinFunctor c m o) c (TwoProductOfCategories c m o) (TwoProductOfCategoriesMorphism c m o) (TwoProductOfCategoriesObject c m o) (CartesianCategory c m o) (CartesianMorphism c m o) (CartesianObject c m o) where
+        internalHom twoBase = unsafeTripod twoLimit evalMap_
+            where
+                powerObject = ExponentialCategory (FunctorCategory (twoBase ->$ A) (twoBase ->$ B))
+                baseTwoCone = twoDiagram FinCat powerObject (ExprojectedCategory (twoBase ->$ A))
+                twoLimit = limit baseTwoCone
+                evalOb (ProductElement tuple) = Projection (ExprojectedObject $ funct ->$ x)
+                    where
+                        (ExponentialElementObject funct) = tuple |!| A
+                        (ExprojectedObject x)  = tuple |!| B
+                evalAr (ProductElement tuple) = Projection (ExprojectedMorphism $ ((target nat) ->£ f) @ (nat =>$ (source f)))
+                    where
+                        (ExponentialElementMorphism nat) = tuple |!| A
+                        (ExprojectedMorphism f)  = tuple |!| B
+                finalInternalCodomain = Projection $ (Exprojection $ twoBase ->$ A)
+                newInternalCodomain = ProjectedCategory $ ExprojectedCategory $ (twoBase ->$ B)
+                evalMap_ = Diagram{src = apex twoLimit, tgt = newInternalCodomain, omap = memorizeFunction evalOb (ob $ apex twoLimit), mmap = memorizeFunction evalAr (arrows $ apex twoLimit)}
− src/Math/FiniteCategories/FinCat/Example.hs 
@@ -1,30 +0,0 @@-{-| Module  : FiniteCategories
-Description : An example of 'FullSubcategory' of __'FinCat'__ pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An example of 'FullSubcategory' of __'FinCat'__ pretty printed.
--}
-module Math.FiniteCategories.FinCat.Example
-(
-    main
-)
-where
-    import Data.WeakSet.Safe
-    
-    import Math.Categories
-    import Math.FiniteCategories
-    import Math.IO.PrettyPrint
-    import Math.FiniteCategory
-    
-    import Numeric.Natural
-    
-    -- | An example of 'FullSubcategory' of __'FinCat'__ pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.FinCat.Example"
-        putStrLn $ pprintFiniteCategory (FullSubcategory FinCat (numberCategory <$> (set [0..2])) :: FullSubcategory (FinCat NumberCategory NumberCategoryMorphism Natural) (FinFunctor NumberCategory NumberCategoryMorphism Natural) NumberCategory)
-        putStrLn "End of Math.FiniteCategories.FinCat.Example"
+ src/Math/FiniteCategories/FinCat/Examples.hs view
@@ -0,0 +1,26 @@+{-| Module  : FiniteCategories
+Description : An example of 'FullSubcategory' of __'FinCat'__.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+An example of 'FullSubcategory' of __'FinCat'__.
+-}
+module Math.FiniteCategories.FinCat.Examples
+(
+    exampleFinCatNumbers,
+)
+where
+    import Data.WeakSet.Safe
+    
+    import Math.Categories
+    import Math.FiniteCategories
+    import Math.FiniteCategory
+    
+    
+    -- | The 'FullSubcategory' of __'FinCat'__ containing the number categories 0,1, and 2.
+    exampleFinCatNumbers :: FullSubcategory (FinCat NumberCategory NumberCategoryMorphism numberCategoryObject) (FinFunctor NumberCategory NumberCategoryMorphism numberCategoryObject) NumberCategory
+    exampleFinCatNumbers  = FullSubcategory FinCat (numberCategory <$> (set [0..2]))
+
− src/Math/FiniteCategories/FinGrph/Example.hs 
@@ -1,41 +0,0 @@-{-| Module  : FiniteCategories
-Description : An example of 'FullSubcategory' of __'FinGrph'__ pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An example of 'FullSubcategory' of __'FinGrph'__ pretty printed.
-
-
--}
-module Math.FiniteCategories.FinGrph.Example
-(
-    main
-)
-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.Text           (Text, pack)
-    
-    import              Math.Categories  
-    import              Math.FiniteCategories
-    import              Math.IO.PrettyPrint
-    import              Math.FiniteCategory
-    
-    
-    import              Numeric.Natural
-    
-    
-    -- | A 'FullSubcategory' __'FinGrph'__ pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.FinGrph.Example"
-        let c = FullSubcategory FinGrph $ (underlyingGraphFormat id (const.pack $ "")).numberCategory <$> set [0..2] :: FullSubcategory (FinGrph Natural Text) (GraphHomomorphism Natural Text) (Graph Natural Text)
-        putStrLn $ pprintFiniteCategory c 
-        putStrLn "End of Math.FiniteCategories.FinGrph.Example"
+ src/Math/FiniteCategories/FinGrph/Examples.hs view
@@ -0,0 +1,98 @@+{-| Module  : FiniteCategories
+Description : An example of 'FullSubcategory' of __'FinGrph'__ and an example of 'Graph'.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+An example of 'FullSubcategory' of __'FinGrph'__ and an example of 'Graph'.
+
+
+-}
+module Math.FiniteCategories.FinGrph.Examples
+(
+    divisibilityGraph,
+    exampleGraph,
+    exampleFinGrph,
+    exampleDiscreteDiagramToFinGrph,
+    exampleProductGaphs,
+    exampleParallelDiagramToFinGrph,
+    exampleEqualizerInFinGrph,
+    exampleDiagramHatToFinGrph,
+    exampleColimitOfGraphs,
+)
+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.Text           (Text, pack)
+    
+    import              Math.Categories  
+    import              Math.FiniteCategories
+    import              Math.IO.PrettyPrint
+    import              Math.FiniteCategory
+    import              Math.CompleteCategory
+    import              Math.CocompleteCategory
+    
+    -- | Return the divisibility graph of number lesser or equal than a given n.
+    divisibilityGraph :: Int -> Graph Int Int
+    divisibilityGraph n = result
+        where
+            Just result = graph (set [1..n]) (set [Arrow{sourceArrow = a, targetArrow = b, labelArrow = b `div` a} | a <- [1..n], b <- [1..n], b `mod` a == 0])
+    
+    
+    -- | Example of graph : divisibility graph of numbers lesser or equal than 10.
+    exampleGraph :: Graph Int Int
+    exampleGraph = divisibilityGraph 10
+            
+    -- | Example of a 'FullSubcategory' of 'FinGrph'.
+    exampleFinGrph :: FullSubcategory (FinGrph Int Int) (GraphHomomorphism Int Int) (Graph Int Int)
+    exampleFinGrph = FullSubcategory FinGrph (set (divisibilityGraph <$> [1..3]))
+    
+    -- | Example of a discrete diagram selecting two graphs.
+    exampleDiscreteDiagramToFinGrph :: Diagram (DiscreteCategory Int) (DiscreteMorphism Int) Int (FinGrph Text Text) (GraphHomomorphism Text Text) (Graph Text Text)
+    exampleDiscreteDiagramToFinGrph = discreteDiagram FinGrph [g1,g2]
+        where
+            Right cg1 = readCGString "A -f-> B"
+            g1 = support cg1
+            Right cg2 = readCGString "C -g-> D"
+            g2 = support cg2
+            
+    -- | Product of 'exampleDiscreteDiagramToFinGrph'.
+    exampleProductGaphs :: Cone (DiscreteCategory Int) (DiscreteMorphism Int) Int (FinGrph (Limit Int Text) (Limit Int Text)) (GraphHomomorphism (Limit Int Text) (Limit Int Text)) (Graph (Limit Int Text) (Limit Int Text))
+    exampleProductGaphs = Math.CompleteCategory.product exampleDiscreteDiagramToFinGrph 
+    
+    -- | Example of a parallel diagram selecting two graphs.
+    exampleParallelDiagramToFinGrph :: Diagram Parallel ParallelAr ParallelOb (FinGrph Char Char) (GraphHomomorphism Char Char) (Graph Char Char)
+    exampleParallelDiagramToFinGrph = parallelDiagram FinGrph gh1 gh2
+        where
+            x = Arrow{sourceArrow = 'A', targetArrow = 'B', labelArrow = 'x'}
+            y = Arrow{sourceArrow = 'C', targetArrow = 'D', labelArrow = 'y'}
+            Just g = graph (set "ABCD") (set [x,y])
+            Just gh1 = graphHomomorphism (weakMap [('A','A'),('B','B'),('C','A'),('D','B')]) (weakMap [(x,x),(y,x)]) g
+            Just gh2 = graphHomomorphism (weakMap [('A','A'),('B','B'),('C','C'),('D','D')]) (weakMap [(x,x),(y,y)]) g
+            
+    -- | Limit of 'exampleParallelDiagramToFinGrph'.
+    exampleEqualizerInFinGrph :: Cone Parallel ParallelAr ParallelOb (FinGrph (Limit ParallelOb Char) (Limit ParallelOb Char)) (GraphHomomorphism (Limit ParallelOb Char) (Limit ParallelOb Char)) (Graph (Limit ParallelOb Char) (Limit ParallelOb Char))
+    exampleEqualizerInFinGrph = limit exampleParallelDiagramToFinGrph
+    
+    -- | Example of a 'Diagram' from 'Hat' to 'FinGrph'.
+    exampleDiagramHatToFinGrph :: Diagram Hat HatAr HatOb (FinGrph Char Char) (GraphHomomorphism Char Char) (Graph Char Char)
+    exampleDiagramHatToFinGrph = diag
+        where
+            f = Arrow{sourceArrow = 'A', targetArrow = 'B', labelArrow = 'f'}
+            g = Arrow{sourceArrow = 'B', targetArrow = 'C', labelArrow = 'g'}
+            Just g1 = graph (set "AB") (set [f])
+            Just g2 = graph (set "BC") (set [g])
+            Just g3 = graph (set "B") (set [])
+            Just gh1 = graphHomomorphism (weakMap [('B','B')]) (weakMap []) g1
+            Just gh2 = graphHomomorphism (weakMap [('B','B')]) (weakMap []) g2
+            diag = completeDiagram Diagram{src = Hat, tgt = FinGrph, omap = weakMap [(HatA,g3),(HatB,g1),(HatC,g2)], mmap = weakMap [(HatF,gh1),(HatG,gh2)]}
+            
+    -- | Example of a colimit of graphs.
+    exampleColimitOfGraphs :: Cocone Hat HatAr HatOb (FinGrph (Colimit HatOb Char) (Colimit HatOb Char)) (GraphHomomorphism (Colimit HatOb Char) (Colimit HatOb Char)) (Graph (Colimit HatOb Char) (Colimit HatOb Char))
+    exampleColimitOfGraphs = colimit exampleDiagramHatToFinGrph
+ src/Math/FiniteCategories/FinSketch/Examples.hs view
@@ -0,0 +1,356 @@+{-| Module  : FiniteCategories
+Description : Examples of 'Sketch'es.
+Copyright   : Guillaume Sabbagh 2023
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'Sketch'es.
+-}
+module Math.FiniteCategories.FinSketch.Examples
+(
+    exampleSketchMagma,
+    exampleSketchUnitalMagma,
+    exampleSketchMorphismMagmaToUnitalMagma,
+    exampleSketchGraph,
+    exampleSketchPointedSet,
+    exampleSketchAtomic,
+    exampleDiagramOfSketches,
+    exampleSketchLoop,
+    exampleDiagramOfSketches2,
+    exampleLantern,
+    exampleSpotlight,
+    exampleCrescentMoon,
+    exampleColantern,
+    exampleCospotlight,
+    exampleCocrescentMoon,
+    exampleNoCrescentMoon,
+    exampleSketchToRealize,
+    exampleSketchSAT1,
+    exampleSketchSAT2,
+    exampleSketchSAT3,
+    exampleSketchSAT4,
+    exampleSketchSAT5,
+    exampleSketchSAT6, 
+ 
+)
+where
+    import qualified Data.WeakSet as Set
+    import Data.WeakSet.Safe
+    import Data.WeakMap.Safe
+    import Data.Simplifiable
+    
+    import Math.FiniteCategory
+    import Math.Categories
+    import Math.CocompleteCategory
+    import Math.FiniteCategories
+    import Math.FiniteCategories.FunctorCategory
+    import Math.Categories.FinCat
+    import Math.Categories.FinSketch
+    
+    import Data.Text (pack , Text)
+    
+    import System.Random
+    import Numeric.Natural
+    
+    -- | The 'Sketch' of the magma structure.
+    exampleSketchMagma :: Sketch Text Text
+    exampleSketchMagma = result
+        where
+            Right cg = readCGString "ExE -p_1-> E\nExE -p_2-> E\nExE -+-> E\n"
+            Right indx = readCGString "A\nB\n"
+            Right base = readCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nExE -p_1-> E\nExE -p_2-> E\nExE -+-> E\n</TGT>\nA => E\nB => E\n"
+            Just c = cone (pack "ExE") (unsafeNaturalTransformation (constantDiagram indx cg (pack "ExE")) base (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p_1")), (pack "B", unsafeGetMorphismFromLabel cg (pack "p_2"))]))
+            Right result = sketchText cg (set [c]) (set []) (set [])
+            
+    -- | The 'Sketch' of the unital magma structure. A unital magma is a magma with an identity.
+    exampleSketchUnitalMagma :: Sketch Text Text
+    exampleSketchUnitalMagma = simplify result
+        where
+            cg = unsafeReadCGString "ExE -p_1-> E\nExE -p_2-> E\nExE -+-> E\nE -(e,_)-> ExE -p_1-> E = E -T-> 1 -e-> E\nE -(e,_)-> ExE -+-> E = <ID>\nE -(_,e)-> ExE -p_2-> E = E -T-> 1 -e-> E\nE -(_,e)-> ExE -+-> E = <ID>\n"
+            indx1 = unsafeReadCGString "A\nB\n"
+            base1 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nExE -p_1-> E\nExE -p_2-> E\nExE -+-> E\nE -(e,_)-> ExE -p_1-> E = E -T-> 1 -e-> E\nE -(e,_)-> ExE -+-> E = <ID>\nE -(_,e)-> ExE -p_2-> E = E -T-> 1 -e-> E\nE -(_,e)-> ExE -+-> E = <ID>\n</TGT>\nA => E\nB => E\n"
+            c1 = unsafeCone (pack "ExE") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "ExE")) base1 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p_1")), (pack "B", unsafeGetMorphismFromLabel cg (pack "p_2"))]))
+            indx2 = unsafeReadCGString ""
+            base2 = unsafeReadCGDString "<SRC>\n</SRC>\n<TGT>\nExE -p_1-> E\nExE -p_2-> E\nExE -+-> E\nE -(e,_)-> ExE -p_1-> E = E -T-> 1 -e-> E\nE -(e,_)-> ExE -+-> E = <ID>\nE -(_,e)-> ExE -p_2-> E = E -T-> 1 -e-> E\nE -(_,e)-> ExE -+-> E = <ID>\n</TGT>"
+            c2 = unsafeCone (pack "1") (unsafeNaturalTransformation base2 base2 (weakMap []))
+            result = unsafeSketch cg (set [c1,c2]) (set []) (set [])
+            
+    -- | The inclusion sketch morphism from the sketch of magmas to the sketch of unital magmas.
+    exampleSketchMorphismMagmaToUnitalMagma :: SketchMorphism Text Text
+    exampleSketchMorphismMagmaToUnitalMagma = simplify result
+        where
+            f = unsafeReadCGDString "<SRC>\nExE -p_1-> E\nExE -p_2-> E\nExE -+-> E\n</SRC>\n<TGT>\nExE -p_1-> E\nExE -p_2-> E\nExE -+-> E\nE -(e,_)-> ExE -p_1-> E = E -T-> 1 -e-> E\nE -(e,_)-> ExE -+-> E = <ID>\nE -(_,e)-> ExE -p_2-> E = E -T-> 1 -e-> E\nE -(_,e)-> ExE -+-> E = <ID>\n</TGT>\nExE -p_1-> E => ExE -p_1-> E\nExE -p_2-> E => ExE -p_2-> E\nExE -+-> E => ExE -+-> E\n"
+            Right result = sketchMorphism exampleSketchMagma exampleSketchUnitalMagma f
+            
+    -- | The sketch of graphs.
+    exampleSketchGraph :: Sketch Text Text
+    exampleSketchGraph = simplify result
+        where
+            cg = unsafeReadCGString "E -s-> V\nE -t-> V\n"
+            Right result = sketchText cg (set []) (set []) (set [])
+            
+    -- | The sketch of pointed sets.
+    exampleSketchPointedSet :: Sketch Text Text
+    exampleSketchPointedSet = simplify result
+        where
+            cg = unsafeReadCGString "1 -p-> E\n"
+            indx1 = unsafeReadCGString ""
+            base1 = unsafeReadCGDString "<SRC>\n</SRC>\n<TGT>\n1 -p-> E\n</TGT>\n"
+            c1 = unsafeCone (pack "1") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "1")) base1 (weakMap []))
+            Right result = sketchText cg (set [c1]) (set []) (set [])
+   
+    -- |  A sketch with just one object and no (co)cone.     
+    exampleSketchAtomic :: Sketch Text Text
+    exampleSketchAtomic = simplify result
+        where
+            cg = unsafeReadCGString "E\n"
+            Right result = sketchText cg (set []) (set []) (set [])
+            
+    -- | A diagram selecting 'exampleSketchAtomic', 'exampleSketchPointedSet' and 'exampleSketchGraph' so that its colimit is the sketch of graphs with a distinguished edge.
+    exampleDiagramOfSketches :: Diagram Hat HatAr HatOb (FinSketch Text Text) (SketchMorphism Text Text) (Sketch Text Text)
+    exampleDiagramOfSketches = simplify result
+        where
+            Right f = readCGDString "<SRC>\nE\n</SRC>\n<TGT>\n1 -p-> E\n</TGT>\nE => E\n"
+            Right sm1 = sketchMorphism exampleSketchAtomic exampleSketchPointedSet f
+            Right g = readCGDString "<SRC>\nE\n</SRC>\n<TGT>\nE -s-> V\nE -t-> V\n</TGT>\nE => E\n"
+            Right sm2 = sketchMorphism exampleSketchAtomic exampleSketchGraph g
+            result = completeDiagram Diagram{src = Hat, tgt = FinSketch, omap = weakMap [], mmap = weakMap [(HatF,sm1), (HatG, sm2)]}
+    
+    
+    -- | A sketch with a single object and a loop. This sketch is infinite because of the loop.
+    exampleSketchLoop :: Sketch Text Text
+    exampleSketchLoop = simplify result
+        where
+            cg = unsafeReadCGString "N -s-> N\n"
+            result = unsafeSketch cg (set []) (set []) (set [])
+            
+    -- | A diagram selecting 'exampleSketchAtomic', 'exampleSketchPointedSet' and 'exampleSketchLoop' so that its colimit is the sketch of discrete systems.
+    exampleDiagramOfSketches2 :: Diagram Hat HatAr HatOb (FinSketch Text Text) (SketchMorphism Text Text) (Sketch Text Text)
+    exampleDiagramOfSketches2 = simplify result
+        where
+            Right f = readCGDString "<SRC>\nE\n</SRC>\n<TGT>\n1 -p-> E\n</TGT>\nE => E\n"
+            Right sm1 = sketchMorphism exampleSketchAtomic exampleSketchPointedSet f
+            g = completeDiagram Diagram{src = underlyingCategory exampleSketchAtomic, tgt = underlyingCategory exampleSketchLoop, omap = weakMap [(pack "E",pack "N")],mmap = weakMap []}
+            Right sm2 = sketchMorphism exampleSketchAtomic exampleSketchLoop g
+            result = completeDiagram Diagram{src = Hat, tgt = FinSketch, omap = weakMap [(HatA, source sm1),(HatB, target sm1),(HatC, target sm2)], mmap = weakMap [(HatF,sm1), (HatG, sm2)]}
+            
+            
+    -- | An example of 'Sketch' containing a 'Lantern'.        
+    exampleLantern :: Sketch Text Text
+    exampleLantern = simplify result
+        where
+            cg = unsafeReadCGString "C -f-> A x B -p1-> A = C -g-> A x B -p1-> A\nC -f-> A x B -p2-> B = C -g-> A x B -p2-> B\n"
+            indx1 = unsafeReadCGString "A\nB\n"
+            base1 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nC -f-> A x B -p1-> A = C -g-> A x B -p1-> A\nC -f-> A x B -p2-> B = C -g-> A x B -p2-> B\n</TGT>\nA => A\nB => B\n"
+            c1 = unsafeCone (pack "A x B") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "A x B")) base1 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1")), (pack "B", unsafeGetMorphismFromLabel cg (pack "p2"))]))
+            result = unsafeSketch cg (set [c1]) (set []) (set [])
+    
+    -- | An example of 'Sketch' containing a 'Spotlight'.     
+    exampleSpotlight :: Sketch Text Text
+    exampleSpotlight = simplify result
+        where
+            cg = unsafeReadCGString "A -f-> B\nA -g-> B\n"
+            indx1 = unsafeReadCGString "A\nB\n"
+            base1 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nA -f-> B\nA -g-> B\n</TGT>\nA => B\nB => B\n"
+            c1 = unsafeCone (pack "A") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "A")) base1 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "f")), (pack "B", unsafeGetMorphismFromLabel cg (pack "f"))]))
+            result = unsafeSketch cg (set [c1]) (set []) (set [])
+            
+    -- | An example of 'Sketch' containing a 'CrescentMoon'. 
+    exampleCrescentMoon :: Sketch Text Text
+    exampleCrescentMoon = simplify result
+        where
+            cg = unsafeReadCGString "A -f-> B\nA -g-> C\nX -h-> B\nX -i-> C\nX -j-> C\n"
+            indx1 = unsafeReadCGString "A\nB\n"
+            base1 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nA -f-> B\nA -g-> C\nX -h-> B\nX -i-> C\nX -j-> C\n</TGT>\nA => B\nB => C\n"
+            c1 = unsafeCone (pack "A") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "A")) base1 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "f")), (pack "B", unsafeGetMorphismFromLabel cg (pack "g"))]))
+            indx2 = unsafeReadCGString "*\n"
+            base2 = unsafeReadCGDString "<SRC>\n*\n</SRC>\n<TGT>\nA -f-> B\nA -g-> C\nX -h-> B\nX -i-> C\nX -j-> C\n</TGT>\n* => B\n"
+            c2 = unsafeCone (pack "A") (unsafeNaturalTransformation (constantDiagram indx2 cg (pack "A")) base2 (weakMap [(pack "*", unsafeGetMorphismFromLabel cg (pack "f"))]))
+            result = unsafeSketch cg (set [c1,c2]) (set []) (set [])
+            
+    -- | An example of 'Sketch' containing no 'CrescentMoon' but in a tricky way. 
+    exampleNoCrescentMoon :: Sketch Text Text
+    exampleNoCrescentMoon = simplify result
+        where
+            cg = unsafeReadCGString "D -p1-> A -f-> C = D -p3-> C\nD -p2-> B\nX -c-> A\nX -a-> C\nX -b-> C\n"
+            indx1 = unsafeReadCGString "A -f-> C\nB\n"
+            base1 = unsafeReadCGDString "<SRC>\nA -f-> C\nB\n</SRC>\n<TGT>\nD -p1-> A -f-> C = D -p3-> C\nD -p2-> B\nX -c-> A\nX -a-> C\nX -b-> C\n</TGT>\nA -f-> C => A -f-> C\nB => B\n"
+            c1 = unsafeCone (pack "D") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "D")) base1 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1")), (pack "B", unsafeGetMorphismFromLabel cg (pack "p2")), (pack "C", unsafeGetMorphismFromLabel cg (pack "p3"))]))
+            indx2 = unsafeReadCGString "*\n"
+            base2 = unsafeReadCGDString "<SRC>\n*\n</SRC>\n<TGT>\nD -p1-> A -f-> C = D -p3-> C\nD -p2-> B\nX -c-> A\nX -a-> C\nX -b-> C\n</TGT>\n* => A\n"
+            c2 = unsafeCone (pack "D") (unsafeNaturalTransformation (constantDiagram indx2 cg (pack "D")) base2 (weakMap [(pack "*", unsafeGetMorphismFromLabel cg (pack "p1"))]))
+            result = unsafeSketch cg (set [c1,c2]) (set []) (set [])
+    
+
+    -- | An example of 'Sketch' containing a 'Colantern'. 
+    exampleColantern :: Sketch Text Text
+    exampleColantern = simplify result
+        where
+            cg = unsafeReadCGString "A -q1-> A + B -f-> C = A -q1-> A + B -g-> C\nB -q2-> A + B -f-> C = B -q2-> A + B -g-> C\n"
+            indx1 = unsafeReadCGString "A\nB\n"
+            base1 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nA -q1-> A + B -f-> C = A -q1-> A + B -g-> C\nB -q2-> A + B -f-> C = B -q2-> A + B -g-> C\n</TGT>\nA => A\nB => B\n"
+            cc1 = unsafeCocone (pack "A + B") (unsafeNaturalTransformation base1 (constantDiagram indx1 cg (pack "A + B")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q1")), (pack "B", unsafeGetMorphismFromLabel cg (pack "q2"))]))
+            result = unsafeSketch cg (set []) (set [cc1]) (set [])
+    
+    -- | An example of 'Sketch' containing a 'Cospotlight'. 
+    exampleCospotlight :: Sketch Text Text
+    exampleCospotlight = simplify result
+        where
+            cg = unsafeReadCGString "A -f-> B\nA -g-> B\n"
+            indx1 = unsafeReadCGString "A\nB\n"
+            base1 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nA -f-> B\nA -g-> B\n</TGT>\nA => A\nB => A\n"
+            cc1 = unsafeCocone (pack "B") (unsafeNaturalTransformation base1 (constantDiagram indx1 cg (pack "B")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "f")), (pack "B", unsafeGetMorphismFromLabel cg (pack "f"))]))
+            result = unsafeSketch cg (set []) (set [cc1]) (set [])
+        
+    -- | An example of 'Sketch' containing a 'CocrescentMoon'. 
+    exampleCocrescentMoon :: Sketch Text Text
+    exampleCocrescentMoon = simplify result
+        where
+            cg = unsafeReadCGString "B -f-> A\nC -g-> A\nB -h-> X\nC -i-> X\nC -j-> X\n"
+            indx1 = unsafeReadCGString "A\nB\n"
+            base1 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nB -f-> A\nC -g-> A\nB -h-> X\nC -i-> X\nC -j-> X\n</TGT>\nA => B\nB => C\n"
+            cc1 = unsafeCocone (pack "A") (unsafeNaturalTransformation base1 (constantDiagram indx1 cg (pack "A")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "f")), (pack "B", unsafeGetMorphismFromLabel cg (pack "g"))]))
+            indx2 = unsafeReadCGString "*\n"
+            base2 = unsafeReadCGDString "<SRC>\n*\n</SRC>\n<TGT>\nB -f-> A\nC -g-> A\nB -h-> X\nC -i-> X\nC -j-> X\n</TGT>\n* => B\n"
+            cc2 = unsafeCocone (pack "A") (unsafeNaturalTransformation base2 (constantDiagram indx2 cg (pack "A")) (weakMap [(pack "*", unsafeGetMorphismFromLabel cg (pack "f"))]))
+            result = unsafeSketch cg (set []) (set [cc1,cc2]) (set [])
+            
+    
+    -- | An example of 'Sketch' to realize.
+    exampleSketchToRealize :: Sketch Text Text
+    exampleSketchToRealize = simplify result
+        where
+            cg = unsafeReadCGString "A -f-> B\nA -g-> C\nX -h-> B\nX -i-> C\n"
+            indx1 = unsafeReadCGString "A\nB\n"
+            base1 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nA -f-> B\nA -g-> C\nX -h-> B\nX -i-> C\n</TGT>\nA => B\nB => C\n"
+            c1 = unsafeCone (pack "A") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "A")) base1 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "f")), (pack "B", unsafeGetMorphismFromLabel cg (pack "g"))]))
+            result = unsafeSketch cg (set [c1]) (set []) (set [])
+            
+
+    exampleSketchSAT1 :: Sketch Text Text
+    exampleSketchSAT1 = simplify result
+        where
+            cg = unsafeReadCGString "1 -V-> B\n1 -F-> B\n1 -P-> B\n1 -Q-> B\nBxB -p1-> B\nBxB -p2-> B\nBxB -et-> B\n1 -(F,F)-> BxB -p1-> B = 1 -F-> B\n1 -(F,F)-> BxB -p2-> B = 1 -F-> B\n1 -(F,V)-> BxB -p1-> B = 1 -F-> B\n1 -(F,V)-> BxB -p2-> B = 1 -V-> B\n1 -(V,F)-> BxB -p1-> B = 1 -V-> B\n1 -(V,F)-> BxB -p2-> B = 1 -F-> B\n1 -(V,V)-> BxB -p1-> B = 1 -V-> B\n1 -(V,V)-> BxB -p2-> B = 1 -V-> B\n1 -(F,F)-> BxB -et-> B = 1 -F-> B\n1 -(F,V)-> BxB -et-> B = 1 -F-> B\n1 -(V,F)-> BxB -et-> B = 1 -F-> B\n1 -(V,V)-> BxB -et-> B = 1 -V-> B\n1 -(P,Q)-> BxB -p1-> B = 1 -P-> B\n1 -(P,Q)-> BxB -p2-> B = 1 -Q-> B\n1 -(P,Q)-> BxB -et-> B = 1 -V-> B\n"
+            indx1 = unsafeReadCGString ""
+            base1 = unsafeReadCGDString "<SRC>\n</SRC>\n<TGT>\n1 -V-> B\n1 -F-> B\n1 -P-> B\n1 -Q-> B\nBxB -p1-> B\nBxB -p2-> B\nBxB -et-> B\n1 -(F,F)-> BxB -p1-> B = 1 -F-> B\n1 -(F,F)-> BxB -p2-> B = 1 -F-> B\n1 -(F,V)-> BxB -p1-> B = 1 -F-> B\n1 -(F,V)-> BxB -p2-> B = 1 -V-> B\n1 -(V,F)-> BxB -p1-> B = 1 -V-> B\n1 -(V,F)-> BxB -p2-> B = 1 -F-> B\n1 -(V,V)-> BxB -p1-> B = 1 -V-> B\n1 -(V,V)-> BxB -p2-> B = 1 -V-> B\n1 -(F,F)-> BxB -et-> B = 1 -F-> B\n1 -(F,V)-> BxB -et-> B = 1 -F-> B\n1 -(V,F)-> BxB -et-> B = 1 -F-> B\n1 -(V,V)-> BxB -et-> B = 1 -V-> B\n1 -(P,Q)-> BxB -p1-> B = 1 -P-> B\n1 -(P,Q)-> BxB -p2-> B = 1 -Q-> B\n1 -(P,Q)-> BxB -et-> B = 1 -V-> B\n</TGT>\n"
+            c1 = unsafeCone (pack "1") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "1")) base1 (weakMap []))
+            indx2 = unsafeReadCGString "A\nB\n"
+            base2 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n1 -V-> B\n1 -F-> B\n1 -P-> B\n1 -Q-> B\nBxB -p1-> B\nBxB -p2-> B\nBxB -et-> B\n1 -(F,F)-> BxB -p1-> B = 1 -F-> B\n1 -(F,F)-> BxB -p2-> B = 1 -F-> B\n1 -(F,V)-> BxB -p1-> B = 1 -F-> B\n1 -(F,V)-> BxB -p2-> B = 1 -V-> B\n1 -(V,F)-> BxB -p1-> B = 1 -V-> B\n1 -(V,F)-> BxB -p2-> B = 1 -F-> B\n1 -(V,V)-> BxB -p1-> B = 1 -V-> B\n1 -(V,V)-> BxB -p2-> B = 1 -V-> B\n1 -(F,F)-> BxB -et-> B = 1 -F-> B\n1 -(F,V)-> BxB -et-> B = 1 -F-> B\n1 -(V,F)-> BxB -et-> B = 1 -F-> B\n1 -(V,V)-> BxB -et-> B = 1 -V-> B\n1 -(P,Q)-> BxB -p1-> B = 1 -P-> B\n1 -(P,Q)-> BxB -p2-> B = 1 -Q-> B\n1 -(P,Q)-> BxB -et-> B = 1 -V-> B\n</TGT>\nA => 1\nB => 1\n"
+            cc2 = unsafeCocone (pack "B") (unsafeNaturalTransformation base2 (constantDiagram indx2 cg (pack "B")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "V")),(pack "B", unsafeGetMorphismFromLabel cg (pack "F"))]))
+            indx3 = unsafeReadCGString "A\nB\n"
+            base3 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n1 -V-> B\n1 -F-> B\n1 -P-> B\n1 -Q-> B\nBxB -p1-> B\nBxB -p2-> B\nBxB -et-> B\n1 -(F,F)-> BxB -p1-> B = 1 -F-> B\n1 -(F,F)-> BxB -p2-> B = 1 -F-> B\n1 -(F,V)-> BxB -p1-> B = 1 -F-> B\n1 -(F,V)-> BxB -p2-> B = 1 -V-> B\n1 -(V,F)-> BxB -p1-> B = 1 -V-> B\n1 -(V,F)-> BxB -p2-> B = 1 -F-> B\n1 -(V,V)-> BxB -p1-> B = 1 -V-> B\n1 -(V,V)-> BxB -p2-> B = 1 -V-> B\n1 -(F,F)-> BxB -et-> B = 1 -F-> B\n1 -(F,V)-> BxB -et-> B = 1 -F-> B\n1 -(V,F)-> BxB -et-> B = 1 -F-> B\n1 -(V,V)-> BxB -et-> B = 1 -V-> B\n1 -(P,Q)-> BxB -p1-> B = 1 -P-> B\n1 -(P,Q)-> BxB -p2-> B = 1 -Q-> B\n1 -(P,Q)-> BxB -et-> B = 1 -V-> B\n</TGT>\nA => B\nB => B\n"
+            c3 = unsafeCone (pack "BxB") (unsafeNaturalTransformation (constantDiagram indx3 cg (pack "BxB")) base3 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2"))]))
+            result = unsafeSketch cg (set [c1,c3]) (set [cc2]) (set [])
+            
+    exampleSketchSAT2 :: Sketch Text Text
+    exampleSketchSAT2 = simplify result
+        where
+            cg = unsafeReadCGString "1 -V-> B\n1 -F-> B\n1 -P-> B\n1 -Q-> B\nBxB -p1-> B\nBxB -p2-> B\nBxB -ou-> B\n1 -(F,F)-> BxB -p1-> B = 1 -F-> B\n1 -(F,F)-> BxB -p2-> B = 1 -F-> B\n1 -(F,V)-> BxB -p1-> B = 1 -F-> B\n1 -(F,V)-> BxB -p2-> B = 1 -V-> B\n1 -(V,F)-> BxB -p1-> B = 1 -V-> B\n1 -(V,F)-> BxB -p2-> B = 1 -F-> B\n1 -(V,V)-> BxB -p1-> B = 1 -V-> B\n1 -(V,V)-> BxB -p2-> B = 1 -V-> B\n1 -(F,F)-> BxB -ou-> B = 1 -F-> B\n1 -(F,V)-> BxB -ou-> B = 1 -V-> B\n1 -(V,F)-> BxB -ou-> B = 1 -V-> B\n1 -(V,V)-> BxB -ou-> B = 1 -V-> B\n1 -(V,V)-> BxB -ou-> B = 1 -V-> B\n1 -(P,Q)-> BxB -p1-> B = 1 -P-> B\n1 -(P,Q)-> BxB -p2-> B = 1 -Q-> B\n1 -(P,Q)-> BxB -ou-> B = 1 -V-> B\n"
+            indx1 = unsafeReadCGString ""
+            base1 = unsafeReadCGDString "<SRC>\n</SRC>\n<TGT>\n1 -V-> B\n1 -F-> B\n1 -P-> B\n1 -Q-> B\nBxB -p1-> B\nBxB -p2-> B\nBxB -ou-> B\n1 -(F,F)-> BxB -p1-> B = 1 -F-> B\n1 -(F,F)-> BxB -p2-> B = 1 -F-> B\n1 -(F,V)-> BxB -p1-> B = 1 -F-> B\n1 -(F,V)-> BxB -p2-> B = 1 -V-> B\n1 -(V,F)-> BxB -p1-> B = 1 -V-> B\n1 -(V,F)-> BxB -p2-> B = 1 -F-> B\n1 -(V,V)-> BxB -p1-> B = 1 -V-> B\n1 -(V,V)-> BxB -p2-> B = 1 -V-> B\n1 -(F,F)-> BxB -ou-> B = 1 -F-> B\n1 -(F,V)-> BxB -ou-> B = 1 -V-> B\n1 -(V,F)-> BxB -ou-> B = 1 -V-> B\n1 -(V,V)-> BxB -ou-> B = 1 -V-> B\n1 -(V,V)-> BxB -ou-> B = 1 -V-> B\n1 -(P,Q)-> BxB -p1-> B = 1 -P-> B\n1 -(P,Q)-> BxB -p2-> B = 1 -Q-> B\n1 -(P,Q)-> BxB -ou-> B = 1 -V-> B\n</TGT>\n"
+            c1 = unsafeCone (pack "1") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "1")) base1 (weakMap []))
+            indx2 = unsafeReadCGString "A\nB\n"
+            base2 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n1 -V-> B\n1 -F-> B\n1 -P-> B\n1 -Q-> B\nBxB -p1-> B\nBxB -p2-> B\nBxB -ou-> B\n1 -(F,F)-> BxB -p1-> B = 1 -F-> B\n1 -(F,F)-> BxB -p2-> B = 1 -F-> B\n1 -(F,V)-> BxB -p1-> B = 1 -F-> B\n1 -(F,V)-> BxB -p2-> B = 1 -V-> B\n1 -(V,F)-> BxB -p1-> B = 1 -V-> B\n1 -(V,F)-> BxB -p2-> B = 1 -F-> B\n1 -(V,V)-> BxB -p1-> B = 1 -V-> B\n1 -(V,V)-> BxB -p2-> B = 1 -V-> B\n1 -(F,F)-> BxB -ou-> B = 1 -F-> B\n1 -(F,V)-> BxB -ou-> B = 1 -V-> B\n1 -(V,F)-> BxB -ou-> B = 1 -V-> B\n1 -(V,V)-> BxB -ou-> B = 1 -V-> B\n1 -(V,V)-> BxB -ou-> B = 1 -V-> B\n1 -(P,Q)-> BxB -p1-> B = 1 -P-> B\n1 -(P,Q)-> BxB -p2-> B = 1 -Q-> B\n1 -(P,Q)-> BxB -ou-> B = 1 -V-> B\n</TGT>\nA => 1\nB => 1\n"
+            cc2 = unsafeCocone (pack "B") (unsafeNaturalTransformation base2 (constantDiagram indx2 cg (pack "B")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "V")),(pack "B", unsafeGetMorphismFromLabel cg (pack "F"))]))
+            indx3 = unsafeReadCGString "A\nB\n"
+            base3 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n1 -V-> B\n1 -F-> B\n1 -P-> B\n1 -Q-> B\nBxB -p1-> B\nBxB -p2-> B\nBxB -ou-> B\n1 -(F,F)-> BxB -p1-> B = 1 -F-> B\n1 -(F,F)-> BxB -p2-> B = 1 -F-> B\n1 -(F,V)-> BxB -p1-> B = 1 -F-> B\n1 -(F,V)-> BxB -p2-> B = 1 -V-> B\n1 -(V,F)-> BxB -p1-> B = 1 -V-> B\n1 -(V,F)-> BxB -p2-> B = 1 -F-> B\n1 -(V,V)-> BxB -p1-> B = 1 -V-> B\n1 -(V,V)-> BxB -p2-> B = 1 -V-> B\n1 -(F,F)-> BxB -ou-> B = 1 -F-> B\n1 -(F,V)-> BxB -ou-> B = 1 -V-> B\n1 -(V,F)-> BxB -ou-> B = 1 -V-> B\n1 -(V,V)-> BxB -ou-> B = 1 -V-> B\n1 -(V,V)-> BxB -ou-> B = 1 -V-> B\n1 -(P,Q)-> BxB -p1-> B = 1 -P-> B\n1 -(P,Q)-> BxB -p2-> B = 1 -Q-> B\n1 -(P,Q)-> BxB -ou-> B = 1 -V-> B\n</TGT>\nA => B\nB => B\n"
+            c3 = unsafeCone (pack "BxB") (unsafeNaturalTransformation (constantDiagram indx3 cg (pack "BxB")) base3 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2"))]))
+            result = unsafeSketch cg (set [c1,c3]) (set [cc2]) (set [])
+            
+    exampleSketchSAT3 :: Sketch Text Text
+    exampleSketchSAT3 = simplify result
+        where
+            cg = unsafeReadCGString "P&Q -p1-> P\nP&Q -p2-> Q\nX -f-> Q\nX -g-> Q\n"
+            indx1 = unsafeReadCGString ""
+            base1 = unsafeReadCGDString "<SRC>\n</SRC>\n<TGT>\nP&Q -p1-> P\nP&Q -p2-> Q\nX -f-> Q\nX -g-> Q\n</TGT>\n"
+            c1 = unsafeCone (pack "P&Q") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "P&Q")) base1 (weakMap []))
+            indx2 = unsafeReadCGString "A\nB\n"
+            base2 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nP&Q -p1-> P\nP&Q -p2-> Q\nX -f-> Q\nX -g-> Q\n</TGT>\nA => P\nB => Q\n"
+            c2 = unsafeCone (pack "P&Q") (unsafeNaturalTransformation (constantDiagram indx2 cg (pack "P&Q")) base2 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2"))]))
+            result = unsafeSketch cg (set [c1,c2]) (set []) (set [])
+            
+    exampleSketchSAT4 :: Sketch Text Text
+    exampleSketchSAT4 = simplify result
+        where
+            cg = unsafeReadCGString "P -q1-> P|Q\nQ -q2-> P|Q\nQ -f-> X\nQ -g-> X\n"
+            indx1 = unsafeReadCGString ""
+            base1 = unsafeReadCGDString "<SRC>\n</SRC>\n<TGT>\nP -q1-> P|Q\nQ -q2-> P|Q\nQ -f-> X\nQ -g-> X\n</TGT>\n"
+            cc1 = unsafeCocone (pack "P|Q") (unsafeNaturalTransformation base1 (constantDiagram indx1 cg (pack "P|Q")) (weakMap []))
+            indx2 = unsafeReadCGString "A\nB\n"
+            base2 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nP -q1-> P|Q\nQ -q2-> P|Q\nQ -f-> X\nQ -g-> X\n</TGT>\nA => P\nB => Q\n"
+            cc2 = unsafeCocone (pack "P|Q") (unsafeNaturalTransformation base2 (constantDiagram indx2 cg (pack "P|Q")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q1")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q2"))]))
+            result = unsafeSketch cg (set []) (set [cc1,cc2]) (set [])
+            
+    exampleSketchSAT5 :: Sketch Text Text
+    exampleSketchSAT5 = simplify result
+        where
+            cg = unsafeReadCGString "A&-A -p3-> A\nA&-A -p4-> -A\nA&-A -f-> X\nA&-A -g-> X\n"
+            indx1 = unsafeReadCGString ""
+            base1 = unsafeReadCGDString "<SRC>\n</SRC>\n<TGT>\nA&-A -p3-> A\nA&-A -p4-> -A\nA&-A -f-> X\nA&-A -g-> X\n</TGT>\n"
+            cc1 = unsafeCocone (pack "A&-A") (unsafeNaturalTransformation base1 (constantDiagram indx1 cg (pack "A&-A")) (weakMap []))
+            indx2 = unsafeReadCGString "A\nB\n"
+            base2 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nA&-A -p3-> A\nA&-A -p4-> -A\nA&-A -f-> X\nA&-A -g-> X\n</TGT>\nA => A\nB => -A\n"
+            c3 = unsafeCone (pack "A&-A") (unsafeNaturalTransformation (constantDiagram indx2 cg (pack "A&-A")) base2 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p3")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p4"))]))
+            result = unsafeSketch cg (set [c3]) (set [cc1]) (set [])
+            
+    exampleSketchSAT6 :: Sketch Text Text
+    exampleSketchSAT6 = simplify result
+        where
+            cg = unsafeReadCGString "0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n"
+            indx1 = unsafeReadCGString ""
+            base1 = unsafeReadCGDString "<SRC>\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\n"
+            cc1 = unsafeCocone (pack "0") (unsafeNaturalTransformation base1 (constantDiagram indx1 cg (pack "0")) (weakMap []))
+            indx2 = unsafeReadCGString "A\nB\n"
+            base2 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => A\nB => -A\n"
+            c2 = unsafeCone (pack "0") (unsafeNaturalTransformation (constantDiagram indx2 cg (pack "0")) base2 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1A")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2A"))]))
+            base3 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => B\nB => -B\n"
+            c3 = unsafeCone (pack "0") (unsafeNaturalTransformation (constantDiagram indx2 cg (pack "0")) base3 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1B")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2B"))]))
+            base4 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => C\nB => -C\n"
+            c4 = unsafeCone (pack "0") (unsafeNaturalTransformation (constantDiagram indx2 cg (pack "0")) base4 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1C")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2C"))]))
+            base5 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => -A\nB => B\n"
+            cc5 = unsafeCocone (pack "-A|B") (unsafeNaturalTransformation base5 (constantDiagram indx2 cg (pack "-A|B")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q1")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q2"))]))
+            base6 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => -B\nB => C\n"
+            cc6 = unsafeCocone (pack "-B|C") (unsafeNaturalTransformation base6 (constantDiagram indx2 cg (pack "-B|C")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q3")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q4"))]))
+            indx7 = unsafeReadCGString "A\nB\nC\nD\n"
+            base7 = unsafeReadCGDString "<SRC>\nA\nB\nC\nD\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => -A|B\nB => -B|C\nC => A\nD => -C\n"
+            c7 = unsafeCone (pack "(-A|B)&(-B|C)&A&-C") (unsafeNaturalTransformation (constantDiagram indx7 cg (pack "(-A|B)&(-B|C)&A&-C")) base7 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2")),(pack "C", unsafeGetMorphismFromLabel cg (pack "p3")),(pack "D", unsafeGetMorphismFromLabel cg (pack "p4"))]))
+            base8 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => A\nB => -A\n"
+            cc8 = unsafeCocone (pack "1") (unsafeNaturalTransformation base8 (constantDiagram indx2 cg (pack "1")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q1A")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q2A"))]))
+            base9 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => B\nB => -B\n"
+            cc9 = unsafeCocone (pack "1") (unsafeNaturalTransformation base9 (constantDiagram indx2 cg (pack "1")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q1B")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q2B"))]))
+            base10 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => C\nB => -C\n"
+            cc10 = unsafeCocone (pack "1") (unsafeNaturalTransformation base10 (constantDiagram indx2 cg (pack "1")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q1C")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q2C"))]))
+            c11 = unsafeCone (pack "1") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "1")) base1 (weakMap []))
+            result = unsafeSketch cg (set [c2,c3,c4,c7,c11]) (set [cc1,cc5,cc6,cc8,cc9,cc10]) (set [])
+            
+    exampleSketchSAT7 :: Sketch Text Text
+    exampleSketchSAT7 = simplify result
+        where
+            cg = unsafeReadCGString "0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n"
+            indx1 = unsafeReadCGString ""
+            base1 = unsafeReadCGDString "<SRC>\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\n"
+            cc1 = unsafeCocone (pack "0") (unsafeNaturalTransformation base1 (constantDiagram indx1 cg (pack "0")) (weakMap []))
+            indx2 = unsafeReadCGString "A\nB\n"
+            base2 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => A\nB => -A\n"
+            c2 = unsafeCone (pack "0") (unsafeNaturalTransformation (constantDiagram indx2 cg (pack "0")) base2 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1A")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2A"))]))
+            base3 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => B\nB => -B\n"
+            c3 = unsafeCone (pack "0") (unsafeNaturalTransformation (constantDiagram indx2 cg (pack "0")) base3 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1B")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2B"))]))
+            base4 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => C\nB => -C\n"
+            c4 = unsafeCone (pack "0") (unsafeNaturalTransformation (constantDiagram indx2 cg (pack "0")) base4 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1C")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2C"))]))
+            base5 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => -A\nB => B\n"
+            cc5 = unsafeCocone (pack "-A|B") (unsafeNaturalTransformation base5 (constantDiagram indx2 cg (pack "-A|B")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q1")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q2"))]))
+            base6 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => -B\nB => C\n"
+            cc6 = unsafeCocone (pack "-B|C") (unsafeNaturalTransformation base6 (constantDiagram indx2 cg (pack "-B|C")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q3")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q4"))]))
+            indx7 = unsafeReadCGString "A\nB\nC\nD\n"
+            base7 = unsafeReadCGDString "<SRC>\nA\nB\nC\nD\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => -A|B\nB => -B|C\nC => A\nD => -C\n"
+            c7 = unsafeCone (pack "(-A|B)&(-B|C)&A&-C") (unsafeNaturalTransformation (constantDiagram indx7 cg (pack "(-A|B)&(-B|C)&A&-C")) base7 (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "p1")),(pack "B", unsafeGetMorphismFromLabel cg (pack "p2")),(pack "C", unsafeGetMorphismFromLabel cg (pack "p3")),(pack "D", unsafeGetMorphismFromLabel cg (pack "p4"))]))
+            base8 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => A\nB => -A\n"
+            cc8 = unsafeCocone (pack "1") (unsafeNaturalTransformation base8 (constantDiagram indx2 cg (pack "1")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q1A")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q2A"))]))
+            base9 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => B\nB => -B\n"
+            cc9 = unsafeCocone (pack "1") (unsafeNaturalTransformation base9 (constantDiagram indx2 cg (pack "1")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q1B")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q2B"))]))
+            base10 = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -p1A-> A\nA -q1A-> 1\n0 -p2A-> -A -q2A-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1B-> B -q1B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2B-> -B -q2B-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p1C-> C -q1C-> 1 = 0 -p1A-> A -q1A-> 1\n0 -p2C-> -C -q2C-> 1 = 0 -p1A-> A -q1A-> 1\n-A -q1-> -A|B\nB -q2-> -A|B\n-B -q3-> -B|C\nC -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p1-> -A|B\n(-A|B)&(-B|C)&A&-C -p2-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A\n(-A|B)&(-B|C)&A&-C -p4-> -C\n(-A|B)&(-B|C)&A&-C -f-> X\n(-A|B)&(-B|C)&A&-C -g-> X\n0 -p2A-> -A -q1-> -A|B = 0 -p1B-> B -q2-> -A|B\n0 -p2B-> -B -q3-> -B|C = 0 -p1C-> C -q4-> -B|C\n(-A|B)&(-B|C)&A&-C -p3-> A -q1A-> 1 = (-A|B)&(-B|C)&A&-C -p4-> -C -q2C-> 1\n</TGT>\nA => C\nB => -C\n"
+            cc10 = unsafeCocone (pack "1") (unsafeNaturalTransformation base10 (constantDiagram indx2 cg (pack "1")) (weakMap [(pack "A", unsafeGetMorphismFromLabel cg (pack "q1C")),(pack "B", unsafeGetMorphismFromLabel cg (pack "q2C"))]))
+            c11 = unsafeCone (pack "1") (unsafeNaturalTransformation (constantDiagram indx1 cg (pack "1")) base1 (weakMap []))
+            result = unsafeSketch cg (set [c2,c3,c4,c7,c11]) (set [cc1,cc5,cc6,cc8,cc9,cc10]) (set [])
src/Math/FiniteCategories/FullSubcategory.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 {-| Module  : FiniteCategories
 Description : Selecting a full subcategory yields a finite category.
@@ -27,11 +31,14 @@     import              Data.WeakSet            (Set)
     import qualified    Data.WeakSet        as  Set
     import              Data.WeakSet.Safe
+    import              Data.Simplifiable
     
+    import              GHC.Generics
+    
     -- | A 'FullSubcategory' needs an original category and a set of objects to select in the category.
     --
     -- The generators are forgotten, use 'InheritedFullSubcategory' if the generators are inheritable.
-    data FullSubcategory c m o = FullSubcategory c (Set o) deriving (Eq, Show)
+    data FullSubcategory c m o = FullSubcategory c (Set o) deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance (Category c m o, Eq o) => Category (FullSubcategory c m o) m o where
         identity (FullSubcategory c objs) o
@@ -43,13 +50,10 @@     
     instance (Category c m o, Eq o) => FiniteCategory (FullSubcategory c m o) m o where
         ob (FullSubcategory _ s) = s
-    
-    instance (PrettyPrint c, PrettyPrint m, PrettyPrint o, Eq o) => PrettyPrint (FullSubcategory c m o)  where
-        pprint (FullSubcategory c s) = "FullSubcategory("++ pprint c ++ ","++ pprint s ++")"
 
         
     -- | An 'InheritedFullSubcategory' is a 'FullSubcategory' where the generators are the same as in the original 'Category'.
-    data InheritedFullSubcategory c m o = InheritedFullSubcategory c (Set o) deriving (Eq, Show)
+    data InheritedFullSubcategory c m o = InheritedFullSubcategory c (Set o) deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance (Category c m o, Eq o) => Category (InheritedFullSubcategory c m o) m o where
         identity (InheritedFullSubcategory c objs) o
@@ -67,7 +71,3 @@         
     instance (Category c m o, Eq o) => FiniteCategory (InheritedFullSubcategory c m o) m o where
         ob (InheritedFullSubcategory _ s) = s
-        
-    instance (PrettyPrint c, PrettyPrint m, PrettyPrint o, Eq o) => PrettyPrint (InheritedFullSubcategory c m o)  where
-        pprint (InheritedFullSubcategory c s) = "InheritedFullSubcategory("++ pprint c ++ ","++ pprint s ++")"
-
src/Math/FiniteCategories/FunctorCategory.hs view
@@ -1,14 +1,13 @@ {-| Module  : FiniteCategories
-Description : A 'FunctorCategory' where the target category is finite is a 'FiniteCategory'.
+Description : A 'FunctorCategory' where the source and target category are finite is a 'FiniteCategory'.
 Copyright   : Guillaume Sabbagh 2022
 License     : GPL-3
 Maintainer  : guillaumesabbagh@protonmail.com
 Stability   : experimental
 Portability : portable
 
-The __'Hat'__ category contains two arrows coming from the same object.
+A 'FunctorCategory' where the source and target category are finite is a 'FiniteCategory'.
 
-The shape of __'Hat'__ is the following : @`B` <-`F`- `A` -`G`-> `C`@
 -}
 
 module Math.FiniteCategories.FunctorCategory
− src/Math/FiniteCategories/FunctorCategory/Example.hs 
@@ -1,42 +0,0 @@-{-| Module  : FiniteCategories
-Description : An example of 'FunctorCategory' pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An example of 'FunctorCategory' pretty printed.
-
-
--}
-module Math.FiniteCategories.FunctorCategory.Example
-(
-    main
-)
-where
-    import Data.WeakSet.Safe
-    import Data.WeakMap.Safe
-    
-    import Math.FiniteCategory
-    import Math.Categories
-    import Math.FiniteCategories
-    
-    import Math.IO.PrettyPrint
-    
-    import Numeric.Natural
-    
-    -- | An example of 'FunctorCategory' pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.FunctorCategory.Example"
-        putStrLn $  pprintFiniteCategory (FunctorCategory (numberCategory 2) (numberCategory 3)) 
-        sequence $ (putStrLn.pprint) <$> (setToList (ob (FunctorCategory (numberCategory 2) (numberCategory 3))))
-        sequence $ (putStrLn.pprint) <$> (setToList (ob (FunctorCategory (numberCategory 2) (numberCategory 3))))
-        sequence $ (putStrLn.pprint) <$> (setToList (arrows (FunctorCategory (numberCategory 2) (numberCategory 3))))
-        let diag = completeDiagram Diagram{src=discreteCategory (set [1,2]), tgt = (numberCategory 2), omap=memorizeFunction id (set [1,2]), mmap = weakMap []}
-        (putStrLn.pprint) $ diag 
-        putStrLn $  pprintFiniteCategory (PrecomposedFunctorCategory diag (numberCategory 3)) 
-        sequence $ (putStrLn.pprint) <$> (setToList (ob (PrecomposedFunctorCategory diag (numberCategory 3))))
-        sequence $ (putStrLn.pprint) <$> (setToList (arrows (PrecomposedFunctorCategory diag (numberCategory 3))))
-        putStrLn "End of Math.FiniteCategories.FunctorCategory.Example"
+ src/Math/FiniteCategories/FunctorCategory/Examples.hs view
@@ -0,0 +1,58 @@+{-| Module  : FiniteCategories
+Description : Examples of 'FunctorCategory'. Examples of 'Diagram's.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'FunctorCategory'. Examples of 'Diagram's.
+-}
+module Math.FiniteCategories.FunctorCategory.Examples
+(
+    exampleFunctorCategory,
+    exampleDiagramVToSquare,
+    exampleDiagramHatToSquare,
+    examplePrecomposedFunctorCategory,
+    examplePostcomposedFunctorCategory,
+    exampleCgdString,
+)
+where
+    import Data.WeakSet.Safe
+    import Data.WeakMap.Safe
+    
+    import Math.FiniteCategory
+    import Math.Categories
+    import Math.FiniteCategories
+    
+    import Math.IO.PrettyPrint
+    
+    import Data.Text (Text)
+    
+    -- | The 'FunctorCategory' 3^2.
+    exampleFunctorCategory :: FunctorCategory NumberCategory NumberCategoryMorphism NumberCategoryObject NumberCategory NumberCategoryMorphism NumberCategoryObject
+    exampleFunctorCategory = FunctorCategory (numberCategory 2) (numberCategory 3)
+    
+    -- | Example of a 'Diagram' from V to Square.
+    exampleDiagramVToSquare :: Diagram V VAr VOb Square SquareAr SquareOb
+    exampleDiagramVToSquare = completeDiagram Diagram{src=V, tgt=Square, omap=weakMap [], mmap = weakMap [(VF,SquareH),(VG,SquareI)]}
+    
+    -- | Example of a 'Diagram' from Hat to Square.
+    exampleDiagramHatToSquare :: Diagram Hat HatAr HatOb Square SquareAr SquareOb
+    exampleDiagramHatToSquare = completeDiagram Diagram{src=Hat, tgt=Square, omap=weakMap [], mmap = weakMap [(HatF,SquareF),(HatG,SquareG)]}
+    
+    -- | Example of a 'PrecomposedFunctorCategory'.
+    examplePrecomposedFunctorCategory :: PrecomposedFunctorCategory V VAr VOb Square SquareAr SquareOb Square SquareAr SquareOb
+    examplePrecomposedFunctorCategory = PrecomposedFunctorCategory exampleDiagramVToSquare Square
+    
+    
+    -- | Example of a 'PostcomposedFunctorCategory'.
+    examplePostcomposedFunctorCategory :: PostcomposedFunctorCategory Square SquareAr SquareOb V VAr VOb Square SquareAr SquareOb
+    examplePostcomposedFunctorCategory = PostcomposedFunctorCategory exampleDiagramVToSquare Square
+    
+    -- | Example of a 'Diagram' of 'CompositionGraph's constructed by reading a .cgd string.
+    exampleCgdString :: Diagram (CompositionGraph Text Text) (CGMorphism Text Text) Text (CompositionGraph Text Text) (CGMorphism Text Text) Text
+    Right exampleCgdString = readCGDString $ sourceCG++targetCG++"A -f-> B => 1 -a-> 2\n"
+        where
+            sourceCG = "<SRC>\nA -f-> B\n</SRC>\n"
+            targetCG = "<TGT>\n1 -a-> 2\n1 -b-> 3\n</TGT>\n"
src/Math/FiniteCategories/Hat.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
@@ -24,15 +26,18 @@     import          Math.IO.PrettyPrint
     
     import          Data.WeakSet.Safe
+    import          Data.Simplifiable
     
+    import          GHC.Generics
+    
     -- | Objects of the __'Hat'__ category.
-    data HatOb = HatA | HatB | HatC deriving (Eq, Show)
+    data HatOb = HatA | HatB | HatC deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     -- | Morphisms of the __'Hat'__ category.
-    data HatAr = HatIdA | HatIdB | HatIdC | HatF | HatG deriving (Eq, Show)
+    data HatAr = HatIdA | HatIdB | HatIdC | HatF | HatG deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     -- | The Hat category.
-    data Hat = Hat deriving (Eq, Show)
+    data Hat = Hat deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance Morphism HatAr HatOb where
         source HatIdA = HatA
@@ -44,14 +49,14 @@         target HatIdC = HatC
         target HatF = HatB
         target HatG = HatC
-        (@?) HatIdA HatIdA = Just HatIdA
-        (@?) HatF HatIdA = Just HatF
-        (@?) HatG HatIdA = Just HatG
-        (@?) HatIdB HatIdB = Just HatIdB
-        (@?) HatIdC HatIdC = Just HatIdC
-        (@?) HatIdB HatF = Just HatF
-        (@?) HatIdC HatG = Just HatG
-        (@?) _ _ = Nothing
+        (@) HatIdA HatIdA = HatIdA
+        (@) HatF HatIdA = HatF
+        (@) HatG HatIdA = HatG
+        (@) HatIdB HatIdB = HatIdB
+        (@) HatIdC HatIdC = HatIdC
+        (@) HatIdB HatF = HatF
+        (@) HatIdC HatG = HatG
+        (@) _ _ = error "Incompatible composition of Hat morphisms."
     
     instance Category Hat HatAr HatOb where
         identity _ HatA = HatIdA
@@ -65,20 +70,4 @@         ar _ _ _ = set []
     
     instance FiniteCategory Hat HatAr HatOb where
-        ob _ = set [HatA, HatB, HatC]
-    
-    instance PrettyPrint HatOb where
-        pprint HatA = "A"
-        pprint HatB = "B"
-        pprint HatC = "C"
-        
-    
-    instance PrettyPrint HatAr where
-        pprint HatIdA = "IdA"
-        pprint HatIdB = "IdB"
-        pprint HatIdC = "IdC"
-        pprint HatF = "f"
-        pprint HatG = "g"
-        
-    instance PrettyPrint Hat where
-        pprint = show+        ob _ = set [HatA, HatB, HatC]
− src/Math/FiniteCategories/Hat/Example.hs 
@@ -1,29 +0,0 @@-{-| Module  : FiniteCategories
-Description : __'Hat'__ pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-__'Hat'__ pretty printed.
-
--}
-module Math.FiniteCategories.Hat.Example
-(
-    main
-)
-where
-    import Data.WeakSet.Safe
-    
-    import Math.FiniteCategories.Hat
-    import Math.IO.PrettyPrint
-    import Math.FiniteCategory
-    
-    
-    -- | __'Hat'__ pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.Hat.Example"
-        putStrLn $ pprintFiniteCategory Hat 
-        putStrLn "End of Math.FiniteCategories.Hat.Example"
+ src/Math/FiniteCategories/LimitCategory.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE FunctionalDependencies  #-}
+{-# LANGUAGE MonadComprehensions  #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{-| Module  : FiniteCategories
+Description : A 'LimitCategory' is the category in which lives the limit of a diagram in 'FinCat'.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+A 'LimitCategory' is the category in which the limit of a diagram in 'FinCat' lives. To compute limits in a usual category, see Math.CompleteCategory. To compute limits in a custom 'FiniteCategory', see 'limits' in Math.ConeCategory.
+-}
+
+module Math.FiniteCategories.LimitCategory
+(
+    -- * Limit category
+    LimitCategory(..),
+    
+)
+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)
+    import              Data.Simplifiable
+    
+    import              Math.Category
+    import              Math.FiniteCategory
+    import              Math.FiniteCategories.DiscreteTwo
+    import              Math.CompleteCategory
+    import              Math.CartesianClosedCategory
+    import              Math.Categories.FunctorCategory
+    import              Math.Categories.ConeCategory
+    import              Math.Categories.FinCat
+    import              Math.IO.PrettyPrint
+    
+    import              GHC.Generics
+    
+    
+        
+    instance (Morphism m o, Eq m, Eq oIndex) => Morphism (Limit oIndex m) (Limit oIndex o) where
+        source (Projection m) = Projection (source m)
+        source (ProductElement tuple) = ProductElement (source <$> tuple)
+        target (Projection m) = Projection (target m)
+        target (ProductElement tuple) = ProductElement (target <$> tuple)
+        (Projection m2) @ (Projection m1) = Projection $ m2 @ m1
+        (ProductElement tuple2) @ (ProductElement tuple1) = ProductElement $ weakMapFromSet [(k1,(tuple2 |!| k1) @ v1) | (k1,v1) <- Map.mapToSet tuple1]
+        _ @ _ = error "Incompatible composition of Limit morphisms."
+    
+    -- | A 'LimitCategory' is either a 'ProjectedCategory' (an original category) or a 'LimitCategory'.
+    data LimitCategory cIndex mIndex oIndex c m o = ProjectedCategory c -- ^ An original category in 'FinCat' with the indexing object of the category.
+                                                  | LimitCategory (Diagram cIndex mIndex oIndex (FinCat c m o) (FinFunctor c m o) c)     -- ^ The limit category of a given 'Diagram'.
+        deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)    
+
+    
+    instance (FiniteCategory cIndex mIndex oIndex, Morphism mIndex oIndex, Eq mIndex, Eq oIndex,
+              Category c m o, Morphism m o, Eq m, Eq o) => Category (LimitCategory cIndex mIndex oIndex c m o) (Limit oIndex m) (Limit oIndex o) where
+        identity (ProjectedCategory c) (Projection o) = Projection $ identity c o
+        identity (LimitCategory _) (Projection _) = error "Identity in a limit category on a projected object."
+        identity (ProjectedCategory _) (ProductElement _) = error "Identity in a projected category on a limit object."
+        identity (LimitCategory diag) (ProductElement tupleObj) 
+            | topObjects /= domain tupleObj = error "Identity in a limit category on a limit object with different indexing objects."
+            | otherwise = ProductElement $ weakMapFromSet [(k,identity (diag ->$ k) (tupleObj |!| k)) | k <- topObjects]
+            where
+                idxCat = (src diag)
+                topObjects = Set.filter (\o -> Set.and [not $ Set.null $ ar idxCat o (source m) | m <- arTo idxCat o]) (ob idxCat)
+         
+        ar (ProjectedCategory c) (Projection s) (Projection t) = Projection <$> ar c s t
+        ar (ProjectedCategory _) (Projection _) (ProductElement _) = error "Ar in a projected category where the target is a limit object."
+        ar (ProjectedCategory _) (ProductElement _) (Projection _) = error "Ar in a projected category where the source is a limit object."
+        ar (ProjectedCategory _) (ProductElement _) (ProductElement _) = error "Ar in a projected category where the source and the target are limit objects."
+        ar (LimitCategory _) (Projection _) (Projection _) = error "Ar in a limit category where the source and target are projected objects."
+        ar (LimitCategory _) (Projection _) (ProductElement _) = error "Ar in a limit category where the source is a projected object."
+        ar (LimitCategory _) (ProductElement _) (Projection _) = error "Ar in a limit category where the target is a projected object."
+        ar (LimitCategory diag) (ProductElement tupleSource) (ProductElement tupleTarget)
+            | topObjects /= domain tupleSource || topObjects /= domain tupleTarget = error "Ar in a limit category where the source and target limit objects don't have the same indexing objects."
+            | otherwise = Set.filter filterProduct products
+            where
+                products = ProductElement <$> weakMap <$> cartesianProductOfSets [(\x -> (k,x)) <$> ar (diag ->$ k) (tupleSource |!| k) (tupleTarget |!| k) | k <- Set.setToList topObjects]
+                idxCat = (src diag)
+                topObjects = Set.filter (\o -> Set.and [not $ Set.null $ ar idxCat o (source m) | m <- arTo idxCat o]) (ob idxCat)
+                objectToAMorphismFromATopObject o
+                    | o `Set.elem` topObjects = identity idxCat o
+                    | otherwise = anElement [m | m <- arTo idxCat o, source m `Set.elem` topObjects]
+                filterProduct (ProductElement tupleMorph) = Set.and [(diag ->£ (objectToAMorphismFromATopObject i)) ->£ (tupleMorph |!| (source $ objectToAMorphismFromATopObject i)) == (diag ->£ m) ->£ (tupleMorph |!| (source $ m)) | i <- (ob idxCat), s <- topObjects, m <- arWithoutId idxCat s (target $ objectToAMorphismFromATopObject i)]
+            
+            
+    instance (FiniteCategory cIndex mIndex oIndex, Morphism mIndex oIndex, Eq mIndex, Eq oIndex,
+              FiniteCategory c m o, Morphism m o, Eq m, Eq o) => FiniteCategory (LimitCategory cIndex mIndex oIndex c m o) (Limit oIndex m) (Limit oIndex o) where
+        ob (ProjectedCategory cat) = Projection <$> ob cat
+        ob (LimitCategory diag) = Set.filter filterProduct products
+            where
+                products = ProductElement <$> weakMap <$> cartesianProductOfSets (Set.setToList [(\x -> (k,x)) <$> ob (diag ->$ k) | k <- topObjects])
+                idxCat = (src diag)
+                topObjects = Set.filter (\o -> Set.and [not $ Set.null $ ar idxCat o (source m) | m <- arTo idxCat o]) (ob idxCat)
+                objectToAMorphismFromATopObject o
+                    | o `Set.elem` topObjects = identity idxCat o
+                    | otherwise = anElement [m | m <- arTo idxCat o, source m `Set.elem` topObjects]
+                filterProduct (ProductElement tupleObj) = Set.and [(diag ->£ (objectToAMorphismFromATopObject i)) ->$ (tupleObj |!| (source $ objectToAMorphismFromATopObject i)) == (diag ->£ m) ->$ (tupleObj |!| (source $ m)) | i <- (ob idxCat), s <- topObjects, m <- arWithoutId idxCat s (target $ objectToAMorphismFromATopObject i)]
+    
+    instance (FiniteCategory c m o, Morphism m o, Eq c, Eq m, Eq o,
+              FiniteCategory cIndex mIndex oIndex, Morphism mIndex oIndex, Eq cIndex, Eq mIndex, Eq oIndex) => 
+        CompleteCategory (FinCat c m o) (FinFunctor c m o) c (FinCat (LimitCategory cIndex mIndex oIndex c m o) (Limit oIndex m) (Limit oIndex o)) (FinFunctor (LimitCategory cIndex mIndex oIndex c m o) (Limit oIndex m) (Limit oIndex o)) (LimitCategory cIndex mIndex oIndex c m o) cIndex mIndex oIndex where
+        
+        limit diag = unsafeCone apex nat
+            where
+                apex = LimitCategory diag
+                newDiag = Diagram {src = src diag, tgt = FinCat, omap = newOmap, mmap = newMmap}
+                newOmap = Map.weakMapFromSet [(k, ProjectedCategory v) | (k,v) <- (Map.mapToSet $ omap diag)]
+                newMmap = Map.weakMapFromSet [(k, transformDiagramToProjectedDiagram v) | (k,v) <- (Map.mapToSet $ mmap diag)]
+                transformDiagramToProjectedDiagram diag_ = Diagram{src = ProjectedCategory (src diag_), tgt = ProjectedCategory (tgt diag_), omap = transformOmapToProjectedOmap (omap diag_), mmap = transformMmapToProjectedMmap (mmap diag_)}
+                transformOmapToProjectedOmap om = Map.weakMapFromSet [(Projection o1, Projection o2) | (o1,o2) <- (Map.mapToSet om)]
+                transformMmapToProjectedMmap mm = Map.weakMapFromSet [(Projection m1, Projection m2) | (m1,m2) <- (Map.mapToSet mm)]
+                nat = unsafeNaturalTransformation (constantDiagram (src diag) FinCat apex) newDiag components_
+                components_ = Map.weakMapFromSet [(oIndex, leg oIndex) | oIndex <- (ob.src $ diag)]
+                idxCat = (src diag)
+                topObjects = Set.filter (\o -> Set.and [not $ Set.null $ ar idxCat o (source m) | m <- arTo idxCat o]) (ob idxCat)
+                objectToAMorphismFromATopObject o
+                    | o `Set.elem` topObjects = identity idxCat o
+                    | otherwise = anElement [m | m <- arTo idxCat o, source m `Set.elem` topObjects]
+                leg oIndex = Diagram{src = apex, tgt = ProjectedCategory (diag ->$ oIndex), omap = Map.weakMapFromSet [(tuple, (Projection ((diag ->£ (objectToAMorphismFromATopObject oIndex)) ->$ ((extractProductObj tuple) |!| (source (objectToAMorphismFromATopObject oIndex)))))) | tuple <- ob apex], mmap = Map.weakMapFromSet [(tuple, (Projection ((diag ->£ (objectToAMorphismFromATopObject oIndex)) ->£ ((extractProductMorph tuple) |!| (source (objectToAMorphismFromATopObject oIndex)))))) | tuple <- arrows apex]}
+                extractProductObj (ProductElement m) = m  
+                extractProductMorph (ProductElement m) = m
+
+        projectBase diag = newDiag
+            where
+                newDiag = Diagram {src = FinCat, tgt = FinCat, omap = newOmap, mmap = newMmap}
+                newOmap = Map.weakMapFromSet [(v, ProjectedCategory v) | (k,v) <- (Map.mapToSet $ omap diag)]
+                newMmap = Map.weakMapFromSet [(v, transformDiagramToProjectedDiagram v) | (k,v) <- (Map.mapToSet $ mmap diag)]
+                transformDiagramToProjectedDiagram diag_ = Diagram{src = ProjectedCategory (src diag_), tgt = ProjectedCategory (tgt diag_), omap = transformOmapToProjectedOmap (omap diag_), mmap = transformMmapToProjectedMmap (mmap diag_)}
+                transformOmapToProjectedOmap om = Map.weakMapFromSet [(Projection o1, Projection o2) | (o1,o2) <- (Map.mapToSet om)]
+                transformMmapToProjectedMmap mm = Map.weakMapFromSet [(Projection m1, Projection m2) | (m1,m2) <- (Map.mapToSet mm)]
+ src/Math/FiniteCategories/LimitCategory/Examples.hs view
@@ -0,0 +1,61 @@+{-| Module  : FiniteCategories
+Description : Examples of 'LimitCategory'.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'LimitCategory'.
+-}
+module Math.FiniteCategories.LimitCategory.Examples
+(
+    exampleDiagramVToFinCat,
+    exampleLimitCategoryOfCompositionGraphs,
+    exampleLimitOfCompositionGraphs,
+)
+where
+    import Data.WeakSet.Safe
+    import Data.WeakMap.Safe
+    import Data.Text (pack, Text)
+    
+    import Math.CompleteCategory
+    import Math.Categories.FunctorCategory
+    import Math.Categories.ConeCategory
+    import Math.Categories.FinCat
+    import Math.FiniteCategories.LimitCategory
+    import Math.FiniteCategories.V
+    import Math.FiniteCategories.CompositionGraph
+    
+    -- | An example of 'Diagram' from 'V' to 'FinCat'.
+    exampleDiagramVToFinCat :: Diagram V VAr VOb (FinCat (CompositionGraph Text Text) (CGMorphism Text Text) Text) (FinFunctor (CompositionGraph Text Text) (CGMorphism Text Text) Text) (CompositionGraph Text Text)
+    exampleDiagramVToFinCat = completeDiagram diag
+        where
+            Right cg1 = readCGString "A -f-> B\nB -i-> D\nA -g-> C\nC -h-> D"
+            Right cg2 = readCGString "F -j-> G"
+            Right cg3 = readCGString "H -k-> I\nH -l-> I"
+            Right diag1 = readCGDString "<SRC>\nA -f-> B\nB -i-> D\nA -g-> C\nC -h-> D\n</SRC>\n<TGT>\nH -k-> I\nH -l-> I\n</TGT>\nB => H\nC => H\nA -f-> B => <ID>\nA -g-> C => <ID>\nB -i-> D => H -k-> I\nC -h-> D => H -l-> I\nA => H\n"
+            Right diag2 = readCGDString "<SRC>\nF -j-> G\n</SRC>\n<TGT>\nH -k-> I\nH -l-> I\n</TGT>\nF -j-> G => H -k-> I\n"
+            diag = Diagram {src = V, tgt = FinCat, omap = weakMap [(VA,cg3),(VB,cg1),(VC,cg2)], mmap = weakMap [(VF, diag1),(VG, diag2)]}
+    
+    -- | An example of 'LimitCategory' of 'CompositionGraph's.
+    exampleLimitCategoryOfCompositionGraphs :: LimitCategory V VAr VOb (CompositionGraph Text Text) (CGMorphism Text Text) Text
+    exampleLimitCategoryOfCompositionGraphs = LimitCategory $ completeDiagram diag
+        where
+            Right cg1 = readCGString "A -f-> B\nB -i-> D\nA -g-> C\nC -h-> D"
+            Right cg2 = readCGString "F -j-> G"
+            Right cg3 = readCGString "H -k-> I\nH -l-> I"
+            Right diag1 = readCGDString "<SRC>\nA -f-> B\nB -i-> D\nA -g-> C\nC -h-> D\n</SRC>\n<TGT>\nH -k-> I\nH -l-> I\n</TGT>\nB => H\nC => H\nA -f-> B => <ID>\nA -g-> C => <ID>\nB -i-> D => H -k-> I\nC -h-> D => H -l-> I\nA => H\n"
+            Right diag2 = readCGDString "<SRC>\nF -j-> G\n</SRC>\n<TGT>\nH -k-> I\nH -l-> I\n</TGT>\nF -j-> G => H -k-> I\n"
+            diag = Diagram {src = V, tgt = FinCat, omap = weakMap [(VA,cg3),(VB,cg1),(VC,cg2)], mmap = weakMap [(VF, diag1),(VG, diag2)]}
+            
+    -- | Same example as 'exampleLimitCategoryOfCompositionGraphs' but the complete 'Cone'.
+    exampleLimitOfCompositionGraphs :: Cone V VAr VOb (FinCat (LimitCategory V VAr VOb (CompositionGraph Text Text) (CGMorphism Text Text) Text) (Limit VOb (CGMorphism Text Text)) (Limit VOb Text)) (FinFunctor (LimitCategory V VAr VOb (CompositionGraph Text Text) (CGMorphism Text Text) Text) (Limit VOb (CGMorphism Text Text)) (Limit VOb Text)) (LimitCategory V VAr VOb (CompositionGraph Text Text) (CGMorphism Text Text) Text)
+    exampleLimitOfCompositionGraphs = limit $ completeDiagram diag
+        where
+            Right cg1 = readCGString "A -f-> B\nB -i-> D\nA -g-> C\nC -h-> D"
+            Right cg2 = readCGString "F -j-> G"
+            Right cg3 = readCGString "H -k-> I\nH -l-> I"
+            Right diag1 = readCGDString "<SRC>\nA -f-> B\nB -i-> D\nA -g-> C\nC -h-> D\n</SRC>\n<TGT>\nH -k-> I\nH -l-> I\n</TGT>\nB => H\nC => H\nA -f-> B => <ID>\nA -g-> C => <ID>\nB -i-> D => H -k-> I\nC -h-> D => H -l-> I\nA => H\n"
+            Right diag2 = readCGDString "<SRC>\nF -j-> G\n</SRC>\n<TGT>\nH -k-> I\nH -l-> I\n</TGT>\nF -j-> G => H -k-> I\n"
+            diag = Diagram {src = V, tgt = FinCat, omap = weakMap [(VA,cg3),(VB,cg1),(VC,cg2)], mmap = weakMap [(VF, diag1),(VG, diag2)]}
src/Math/FiniteCategories/NumberCategory.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
 Description : By regarding each natural number as the linearly ordered set of all preceding natural number, it yields a category. __0__, __1__, __2__, __3__, ... are all number categories.
− src/Math/FiniteCategories/NumberCategory/Example.hs 
@@ -1,28 +0,0 @@-{-| Module  : FiniteCategories
-Description : Six examples of 'NumberCategory' pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-Six examples of 'NumberCategory' pretty printed. 
--}
-module Math.FiniteCategories.NumberCategory.Example
-(
-    main
-)
-where
-    import Math.FiniteCategories.NumberCategory
-    import Math.IO.PrettyPrint
-    import Math.FiniteCategory
-    
-    
-    -- | Six examples of 'NumberCategory' pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.NumberCategory.Example"
-        let cats = numberCategory <$> [0..5]
-        let p = (putStrLn.pprintFiniteCategory) <$> cats
-        sequence p
-        putStrLn "End of Math.FiniteCategories.NumberCategory.Example"
+ src/Math/FiniteCategories/NumberCategory/Examples.hs view
@@ -0,0 +1,62 @@+{-| Module  : FiniteCategories
+Description : Six examples of 'NumberCategory'.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Six examples of 'NumberCategory'. 
+-}
+module Math.FiniteCategories.NumberCategory.Examples
+(
+    exampleNumberCategory0,
+    exampleNumberCategory1,
+    exampleNumberCategory2,
+    exampleNumberCategory3,
+    exampleNumberCategory4,
+    exampleNumberCategory5,
+    exampleDiagramOfNumberCategory,
+)
+where
+    import Math.FiniteCategories.NumberCategory
+    import Math.FiniteCategory
+    import Math.Categories.FunctorCategory
+    import Math.Categories.Omega
+    
+    import Data.WeakSet
+    import Data.WeakMap
+    
+    import Numeric.Natural
+    
+    -- | The category 0
+    exampleNumberCategory0 :: NumberCategory
+    exampleNumberCategory0 = numberCategory 0
+    
+    -- | The category 1
+    exampleNumberCategory1 :: NumberCategory
+    exampleNumberCategory1 = numberCategory 1
+    
+    -- | The category 2
+    exampleNumberCategory2 :: NumberCategory
+    exampleNumberCategory2 = numberCategory 2
+    
+    -- | The category 3
+    exampleNumberCategory3 :: NumberCategory
+    exampleNumberCategory3 = numberCategory 3
+    
+    
+    -- | The category 4
+    exampleNumberCategory4 :: NumberCategory
+    exampleNumberCategory4 = numberCategory 4
+    
+    
+    -- | The category 5
+    exampleNumberCategory5:: NumberCategory
+    exampleNumberCategory5 = numberCategory 5
+    
+    -- | An example of 'Diagram' from 3 to 'Omega'.
+    exampleDiagramOfNumberCategory :: Diagram NumberCategory (IsSmallerThan Natural) Natural Omega (IsSmallerThan Natural) Natural
+    exampleDiagramOfNumberCategory = diag
+        where
+            diag = Diagram{src = numberCategory 3, tgt = omega, omap = memorizeFunction id (ob $ numberCategory 3), mmap = memorizeFunction id (arrows $ numberCategory 3)}
src/Math/FiniteCategories/One.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
@@ -22,14 +24,17 @@     import          Math.IO.PrettyPrint
     
     import          Data.WeakSet.Safe
+    import          Data.Simplifiable
     
+    import          GHC.Generics
+    
     -- | 'One' is a datatype used as the object type, the morphism type and the category type of __1__.
-    data One = One deriving (Eq, Show)
+    data One = One deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance Morphism One One where
         source One = One
         target One = One
-        (@?) One One = Just One
+        (@) One One = One
     
     instance Category One One One where
         identity One One = One
@@ -37,7 +42,4 @@     
     instance FiniteCategory One One One where
         ob One = set [One]
-    
-    instance PrettyPrint One where
-        pprint = show
− src/Math/FiniteCategories/One/Example.hs 
@@ -1,26 +0,0 @@-{-| Module  : FiniteCategories
-Description : __1__ pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-__1__ pretty printed.
--}
-module Math.FiniteCategories.One.Example
-(
-    main
-)
-where
-    import Math.FiniteCategories.One
-    import Math.FiniteCategory
-    import Math.IO.PrettyPrint
-    
-    
-    -- | __'One'__ pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.One.Example"
-        putStrLn $  pprintFiniteCategory One 
-        putStrLn "End of Math.FiniteCategories.One.Example"
− src/Math/FiniteCategories/Opposite/Example.hs 
@@ -1,35 +0,0 @@-{-| Module  : FiniteCategories
-Description : An example of opposite category pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An example of opposite category pretty printed.
-
-
--}
-module Math.FiniteCategories.Opposite.Example
-(
-    main
-)
-where
-    import Data.WeakSet         (powerSet, Set)
-    import Data.WeakSet.Safe
-    
-    import Math.Categories
-    import Math.FiniteCategories
-    import Math.FiniteCategory
-    import Math.IO.PrettyPrint
-    
-    
-    -- | An example of opposite category pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.Opposite.Example"
-        putStrLn $  pprintFiniteCategory (ens.powerSet.set $ "AB") 
-        putStrLn $  pprintFiniteCategory (Op (ens.powerSet.set $ "AB")) 
-        putStrLn $  pprintFiniteCategory (numberCategory 4) 
-        putStrLn $  pprintFiniteCategory (Op (numberCategory 4)) 
-        putStrLn "End of Math.FiniteCategories.Opposite.Example"
+ src/Math/FiniteCategories/Opposite/Examples.hs view
@@ -0,0 +1,30 @@+{-| Module  : FiniteCategories
+Description : Examples of opposite categories.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of opposite categories.
+-}
+module Math.FiniteCategories.Opposite.Examples
+(
+    exampleOppositeEns,
+    exampleOppositeNumberCategory,
+)
+where
+    import Data.WeakSet         (powerSet, Set)
+    import Data.WeakSet.Safe
+    
+    import Math.Categories
+    import Math.FiniteCategories
+    import Math.FiniteCategory
+    
+    -- | The opposite of an 'Ens' category.
+    exampleOppositeEns :: Op (Ens Char)
+    exampleOppositeEns = Op (ens.powerSet.set $ "AB")
+    
+    -- | The opposite of the 'NumberCategory' 4.
+    exampleOppositeNumberCategory :: Op NumberCategory
+    exampleOppositeNumberCategory = Op (numberCategory 4)
src/Math/FiniteCategories/Parallel.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
@@ -22,15 +24,18 @@     import          Math.IO.PrettyPrint
     
     import          Data.WeakSet.Safe
+    import          Data.Simplifiable
     
+    import          GHC.Generics
+    
     -- | Objects of the __'Parallel'__ category.
-    data ParallelOb = ParallelA | ParallelB deriving (Eq, Show)
+    data ParallelOb = ParallelA | ParallelB deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     -- | Morphisms of the __'Parallel'__ category.
-    data ParallelAr = ParallelIdA | ParallelIdB | ParallelF | ParallelG deriving (Eq, Show)
+    data ParallelAr = ParallelIdA | ParallelIdB | ParallelF | ParallelG deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     -- | The __'Parallel'__ category.
-    data Parallel = Parallel deriving (Eq, Show)
+    data Parallel = Parallel deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance Morphism ParallelAr ParallelOb where
         source ParallelIdA = ParallelA
@@ -39,13 +44,13 @@         target ParallelIdA = ParallelA
         target ParallelIdB = ParallelB
         target _ = ParallelB
-        (@?) ParallelIdA ParallelIdA = Just ParallelIdA
-        (@?) ParallelF ParallelIdA = Just ParallelF
-        (@?) ParallelG ParallelIdA = Just ParallelG
-        (@?) ParallelIdB ParallelIdB = Just ParallelIdB
-        (@?) ParallelIdB ParallelF = Just ParallelF
-        (@?) ParallelIdB ParallelG = Just ParallelG
-        (@?) _ _ = Nothing
+        (@) ParallelIdA ParallelIdA = ParallelIdA
+        (@) ParallelF ParallelIdA = ParallelF
+        (@) ParallelG ParallelIdA =  ParallelG
+        (@) ParallelIdB ParallelIdB =  ParallelIdB
+        (@) ParallelIdB ParallelF =  ParallelF
+        (@) ParallelIdB ParallelG =  ParallelG
+        (@) _ _ = error "Incompatible composition of Parallel morphisms."
         
     instance Category Parallel ParallelAr ParallelOb where
         identity _ ParallelA = ParallelIdA
@@ -58,16 +63,4 @@     
     instance FiniteCategory Parallel ParallelAr ParallelOb where
         ob _ = set [ParallelA,ParallelB]
-        
-    instance PrettyPrint ParallelOb where
-        pprint ParallelA = "A"
-        pprint ParallelB = "B"
-        
-    instance PrettyPrint ParallelAr where
-        pprint ParallelIdA = "IdA"
-        pprint ParallelIdB = "IdB"
-        pprint ParallelF = "f"
-        pprint ParallelG = "g"
-        
-    instance PrettyPrint Parallel where
-        pprint Parallel = "Parallel"+
− src/Math/FiniteCategories/Parallel/Example.hs 
@@ -1,28 +0,0 @@-{-| Module  : FiniteCategories
-Description : __'Parallel'__ pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-__'Parallel'__ pretty printed.
--}
-module Math.FiniteCategories.Parallel.Example
-(
-    main
-)
-where
-    import Data.WeakSet.Safe
-    
-    import Math.FiniteCategories.Parallel
-    import Math.IO.PrettyPrint
-    import Math.FiniteCategory
-    
-    
-    -- | __'Parallel'__ pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.Parallel.Example"
-        putStrLn $  pprintFiniteCategory Parallel 
-        putStrLn "End of Math.FiniteCategories.Parallel.Example"
src/Math/FiniteCategories/SafeCompositionGraph.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, MonadComprehensions #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-| Module  : FiniteCategories
 Description : A 'SafeCompositionGraph' is a 'CompositionGraph' where infinite loops are prevented.
 Copyright   : Guillaume Sabbagh 2022
@@ -58,6 +62,7 @@     import              Data.WeakMap.Safe
     import              Data.List           (intercalate, elemIndex, splitAt)
     import              Data.Text           (Text, singleton, cons, unpack, pack)
+    import              Data.Simplifiable   (Simplifiable)
     
     import              Math.Category
     import              Math.FiniteCategory
@@ -71,17 +76,25 @@     import              System.FilePath.Posix       (takeDirectory)
     import              System.Random               (RandomGen, uniformR)
     
+    import              GHC.Generics
+    import              GHC.Base                    (maxInt)
+    
     -- | The type `SCGMorphism` is the type of 'SafeCompositionGraph's morphisms.
     --
     -- It is just like a 'CGMorphism', we also store the maximum number of cycles.
     data SCGMorphism a b = SCGMorphism {pathS :: Path a b 
                                        ,compositionLawS :: CompositionLaw a b
-                                       ,maxNbCycles :: Int} deriving (Show, Eq)
+                                       ,maxNbCycles :: Int} deriving (Show, Eq, Generic, Simplifiable)
     
     instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (SCGMorphism a b) where
-        pprint SCGMorphism {pathS=(s,[]),compositionLawS=cl} = "Id"++(pprint s)
-        pprint SCGMorphism {pathS=(_,rp),compositionLawS=cl} = intercalate " o " $ (pprint.labelArrow) <$> rp
+        pprint 0 _ = "..."
+        pprint v SCGMorphism{pathS=(s,[]),compositionLawS=cl} = "Id"++(pprint v s)
+        pprint v SCGMorphism{pathS=(_,rp),compositionLawS=cl} = intercalate " o " $ ((pprint v).labelArrow) <$> rp
         
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        -- pprintWithIndentations cv ov indent SCGMorphism{pathS=(s,[]),compositionLawS=cl} = indentation (ov - cv) indent ++ "Id"++(pprint cv s) ++ "\n"
+        -- pprintWithIndentations cv ov indent SCGMorphism{pathS=(_,rp),compositionLawS=cl} = indentation (ov - cv) indent ++ (intercalate " o " $ ((pprint cv).labelArrow) <$> rp) ++ "\n"
+        
     -- | Return the label of a 'SafeCompositionGraph' generator.
     getLabelS :: SCGMorphism a b -> Maybe b
     getLabelS SCGMorphism{pathS=(s,rp), compositionLawS=_, maxNbCycles=_}
@@ -126,6 +139,8 @@             | cl1 /= cl2 = Nothing
             | source m2 /= target m1 = Nothing
             | otherwise = Just SCGMorphism{pathS=(s1,(simplify cl1 nb1 (rp2++rp1))), compositionLawS=cl1, maxNbCycles=nb1}
+        
+        (@) m2@SCGMorphism{pathS=(s2,rp2), compositionLawS=cl2, maxNbCycles=nb2} m1@SCGMorphism{pathS=(s1,rp1), compositionLawS=cl1, maxNbCycles=nb1} = SCGMorphism{pathS=(s1,(simplify cl1 nb1 (rp2++rp1))), compositionLawS=cl1, maxNbCycles=nb1}
             
         source SCGMorphism{pathS=(s,_), compositionLawS=_, maxNbCycles=_} = s
         target SCGMorphism{pathS=(s,[]), compositionLawS=_, maxNbCycles=_} = s
@@ -193,7 +208,7 @@                                                             supportS :: Graph a b, -- ^ The generating graph of the safe composition graph.
                                                             lawS :: CompositionLaw a b, -- ^ The composition law of the safe composition graph.
                                                             maxCycles :: Int -- ^ The maximum number of times a cycle can be composed with itself.
-                                                         } deriving (Eq)
+                                                         } deriving (Eq, Generic, PrettyPrint, Simplifiable)
  
     instance (Show a, Show b) => Show (SafeCompositionGraph a b) where
         show scg = "(unsafeSafeCompositionGraph "++ show (supportS scg) ++ " " ++ show (lawS scg) ++ " " ++ show (maxCycles scg) ++ ")"
@@ -213,10 +228,7 @@             | otherwise = mkSCGMorphism l nb <$> rp
     
     instance (Eq a, Eq b) => FiniteCategory (SafeCompositionGraph a b) (SCGMorphism a b) a where
-        ob = (nodes.supportS)
-            
-    instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (SafeCompositionGraph a b) where
-        pprint SafeCompositionGraph{supportS=g,lawS=l,maxCycles=nb} = "SafeCompositionGraph("++pprint g++","++pprint l++","++pprint nb++")"         
+        ob = (nodes.supportS)      
         
     -- | Smart constructor of `SafeCompositionGraph`.
     --
@@ -238,7 +250,7 @@     
     
     -- | A token for a .scg file.
-    data Token = Name Text | BeginArrow | EndArrow | Equals | Identity | BeginSrc | EndSrc | BeginTgt | EndTgt | MapsTo deriving (Eq, Show)
+    data Token = Name Text | BeginArrow | EndArrow | Equals | Identity | BeginSrc | EndSrc | BeginTgt | EndTgt | MapsTo deriving (Eq, Show, Generic, Simplifiable)
     
     -- | Strip a token of unnecessary spaces.
     strip :: Token -> Token
@@ -364,14 +376,14 @@     
     reversedRawPathToString :: (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
     reversedRawPathToString [] = "<ID>"
-    reversedRawPathToString [Arrow{sourceArrow = s, targetArrow = t,labelArrow = l}] = pprint s ++ " -" ++ pprint l ++ "-> " ++ pprint t
-    reversedRawPathToString (Arrow{sourceArrow = s, targetArrow = t,labelArrow = l}:xs) = pprint s ++ " -" ++ pprint l ++ "-> " ++ reversedRawPathToString xs
+    reversedRawPathToString [Arrow{sourceArrow = s, targetArrow = t,labelArrow = l}] = pprint maxInt s ++ " -" ++ pprint maxInt l ++ "-> " ++ pprint maxInt t
+    reversedRawPathToString (Arrow{sourceArrow = s, targetArrow = t,labelArrow = l}:xs) = pprint maxInt s ++ " -" ++ pprint maxInt l ++ "-> " ++ reversedRawPathToString xs
     
     -- | Transform a composition graph into a string following the .scg convention.
     writeSCGString :: (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => SafeCompositionGraph a b -> String
     writeSCGString cg = finalString
         where
-            obString = intercalate "\n" $ pprint <$> (setToList.ob $ cg)
+            obString = intercalate "\n" $ pprint maxInt <$> (setToList.ob $ cg)
             arNotIdentityAndNotComposite = setToList $ Set.filter (isGenerator cg) $ Set.filter (isNotIdentity cg) (genArrows cg)
             reversedRawPaths = (reverse.snd.pathS) <$> arNotIdentityAndNotComposite
             arString = intercalate "\n" $ reversedRawPathToString <$> reversedRawPaths
@@ -523,8 +535,8 @@         where
             srcString = "<SRC>\n"++writeSCGString (src diag)++"\n</SRC>\n"
             tgtString = "<TGT>\n"++writeSCGString (tgt diag)++"</TGT>\n"
-            omapString = "#Object mapping\n" ++ (intercalate "\n" $ (\o -> (pprint o) ++ " => " ++  (pprint (diag ->$ o)) )<$> (setToList.ob.src $ diag)) ++ "\n"
-            mmapString = "#Morphism mapping\n" ++ (intercalate "\n" $ (\m -> pprint (source m) ++ " -" ++ pprint m ++ "-> " ++ pprint (target m)++ " => " ++ if isIdentity (tgt diag) (diag ->£ m) then "<ID/>" else pprint (source (diag ->£ m)) ++ " -" ++ pprint (diag ->£ m) ++ "-> " ++ pprint (target (diag ->£ m)))<$> (setToList.(Set.filter (isNotIdentity (src diag))).genArrows.src $ diag)) ++ "\n"
+            omapString = "#Object mapping\n" ++ (intercalate "\n" $ (\o -> (pprint maxInt o) ++ " => " ++  (pprint maxInt (diag ->$ o)) )<$> (setToList.ob.src $ diag)) ++ "\n"
+            mmapString = "#Morphism mapping\n" ++ (intercalate "\n" $ (\m -> pprint maxInt (source m) ++ " -" ++ pprint maxInt m ++ "-> " ++ pprint maxInt (target m)++ " => " ++ if isIdentity (tgt diag) (diag ->£ m) then "<ID/>" else pprint maxInt (source (diag ->£ m)) ++ " -" ++ pprint maxInt (diag ->£ m) ++ "-> " ++ pprint maxInt (target (diag ->£ m)))<$> (setToList.(Set.filter (isNotIdentity (src diag))).genArrows.src $ diag)) ++ "\n"
         
     -- | Saves a safe composition graph diagram into a file located at a given path.
     writeSCGDFile :: (PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1,
− src/Math/FiniteCategories/SafeCompositionGraph/Example.hs 
@@ -1,44 +0,0 @@-{-| Module  : FiniteCategories
-Description : An example of 'SafeCompositionGraph' pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An example of 'SafeCompositionGraph' pretty printed.
-
-A 'SafeCompositionGraph' created from a string is also pretty printed.
-
-A random 'SafeCompositionGraph' is also pretty printed.
--}
-module Math.FiniteCategories.SafeCompositionGraph.Example
-(
-    main
-)
-where
-    import qualified Data.WeakSet as Set
-    import Data.WeakSet.Safe
-    import Data.WeakMap.Safe
-    
-    import Math.FiniteCategory
-    import Math.Categories
-    import Math.FiniteCategories
-    
-    import Math.IO.PrettyPrint
-    
-    import Numeric.Natural
-    import System.Random
-    
-    -- | An example of 'SafeCompositionGraph' pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.SafeCompositionGraph.Example"
-        putStrLn $  pprintFiniteCategory (unsafeSafeCompositionGraph (unsafeGraph (set [1 :: Int,2,3]) (set [Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'},Arrow{sourceArrow=1,targetArrow=2,labelArrow='b'},Arrow{sourceArrow=2,targetArrow=3,labelArrow='c'}])) (weakMap [([Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'},Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}],[Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}])]) 3) 
-        putStrLn $  pprintFiniteCategory (unsafeSafeCompositionGraph (unsafeGraph (set [1 :: Int]) (set [Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}])) (weakMap []) 3) 
-        
-        putStrLn $  pprintFiniteCategory (fst.defaultConstructRandomSafeCompositionGraph $ (mkStdGen 123456)) 
-        
-        let (Right scg) = readSCGString "2\nA -f-> B -g-> C = A -h-> C"
-        putStrLn $  pprintFiniteCategory scg 
-        putStrLn "End of Math.FiniteCategories.SafeCompositionGraph.Example"
+ src/Math/FiniteCategories/SafeCompositionGraph/Examples.hs view
@@ -0,0 +1,55 @@+{-| Module  : FiniteCategories
+Description : Examples of 'SafeCompositionGraph', some are constructed using the smart constructors, others are random and others are read in a .scg file.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'SafeCompositionGraph', some are constructed using the smart constructors, others are random and others are read in a .scg file
+-}
+module Math.FiniteCategories.SafeCompositionGraph.Examples
+(
+    exampleSafeCompositionGraph,
+    exampleLoopingSafeCompositionGraph,
+    exampleScgString,
+    exampleRandomSafeCompositionGraph,
+)
+where
+    import qualified Data.WeakSet as Set
+    import Data.WeakSet.Safe
+    import Data.WeakMap.Safe
+    
+    import Math.FiniteCategory
+    import Math.Categories
+    import Math.FiniteCategories
+
+    import Data.Text (Text)
+
+    import System.Random
+    
+    
+    -- | A 'SafeCompositionGraph' constructed using the smart constructor 'safeCompositionGraph'.
+    exampleSafeCompositionGraph :: SafeCompositionGraph Int Char
+    exampleSafeCompositionGraph = result
+        where
+            Right result = safeCompositionGraph underlyingGraph compositionLaw 3
+            Just underlyingGraph = graph (set [1 :: Int,2,3]) (set [Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'},Arrow{sourceArrow=1,targetArrow=2,labelArrow='b'},Arrow{sourceArrow=2,targetArrow=3,labelArrow='c'}])
+            compositionLaw = weakMap [([Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'},Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}],[Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}])]
+    
+    -- | A 'SafeCompositionGraph' containing a loop which would go infinite with a 'CompositionGraph'.
+    exampleLoopingSafeCompositionGraph :: SafeCompositionGraph Int Char
+    exampleLoopingSafeCompositionGraph = result
+        where
+            Right result = safeCompositionGraph (unsafeGraph (set [1 :: Int]) (set [Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}])) (weakMap []) 3
+            
+    -- | A 'SafeCompositionGraph' read using a .scg string.
+    exampleScgString :: SafeCompositionGraph Text Text
+    Right exampleScgString = readSCGString "2\nA -f-> B -g-> C = A -h-> C"
+    
+    -- | A random 'SafeCompositionGraph'.
+    exampleRandomSafeCompositionGraph :: SafeCompositionGraph Int Int
+    exampleRandomSafeCompositionGraph = result 
+        where
+            randomGen = mkStdGen 123456
+            (result,newGen) = defaultConstructRandomSafeCompositionGraph randomGen
src/Math/FiniteCategories/Square.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
@@ -22,15 +24,18 @@     import          Math.IO.PrettyPrint
     
     import          Data.WeakSet.Safe
+    import          Data.Simplifiable
     
+    import          GHC.Generics
+    
     -- | Objects of the __'Square'__ category.
-    data SquareOb = SquareA | SquareB | SquareC | SquareD deriving (Eq, Show)
+    data SquareOb = SquareA | SquareB | SquareC | SquareD deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     -- | Morphisms of the __'Square'__ category.
-    data SquareAr = SquareIdA | SquareIdB | SquareIdC | SquareIdD | SquareF | SquareG | SquareH | SquareI | SquareFH | SquareGI deriving (Eq, Show)
+    data SquareAr = SquareIdA | SquareIdB | SquareIdC | SquareIdD | SquareF | SquareG | SquareH | SquareI | SquareFH | SquareGI deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     -- | The __'Square'__ category.
-    data Square = Square deriving (Eq, Show)
+    data Square = Square deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance Morphism SquareAr SquareOb where
         source SquareIdA = SquareA
@@ -55,25 +60,25 @@         target SquareFH = SquareD
         target SquareGI = SquareD
         
-        (@?) SquareIdA SquareIdA = Just SquareIdA
-        (@?) SquareF SquareIdA = Just SquareF
-        (@?) SquareG SquareIdA = Just SquareG
-        (@?) SquareFH SquareIdA = Just SquareFH
-        (@?) SquareGI SquareIdA = Just SquareGI
-        (@?) SquareIdB SquareIdB = Just SquareIdB
-        (@?) SquareH SquareIdB = Just SquareH
-        (@?) SquareIdC SquareIdC = Just SquareIdC
-        (@?) SquareI SquareIdC = Just SquareI
-        (@?) SquareIdD SquareIdD = Just SquareIdD
-        (@?) SquareIdB SquareF = Just SquareF
-        (@?) SquareH SquareF = Just SquareFH
-        (@?) SquareIdC SquareG = Just SquareG
-        (@?) SquareI SquareG = Just SquareGI
-        (@?) SquareIdD SquareH = Just SquareH
-        (@?) SquareIdD SquareI = Just SquareI
-        (@?) SquareIdD SquareFH = Just SquareFH
-        (@?) SquareIdD SquareGI = Just SquareGI
-        (@?) _ _ = Nothing
+        (@) SquareIdA SquareIdA = SquareIdA
+        (@) SquareF SquareIdA = SquareF
+        (@) SquareG SquareIdA = SquareG
+        (@) SquareFH SquareIdA = SquareFH
+        (@) SquareGI SquareIdA = SquareGI
+        (@) SquareIdB SquareIdB = SquareIdB
+        (@) SquareH SquareIdB = SquareH
+        (@) SquareIdC SquareIdC = SquareIdC
+        (@) SquareI SquareIdC = SquareI
+        (@) SquareIdD SquareIdD = SquareIdD
+        (@) SquareIdB SquareF = SquareF
+        (@) SquareH SquareF = SquareFH
+        (@) SquareIdC SquareG = SquareG
+        (@) SquareI SquareG = SquareGI
+        (@) SquareIdD SquareH = SquareH
+        (@) SquareIdD SquareI = SquareI
+        (@) SquareIdD SquareFH = SquareFH
+        (@) SquareIdD SquareGI = SquareGI
+        (@) _ _ = error "Incompatible composition of Square morphisms."
         
     instance Category Square SquareAr SquareOb where
         identity _ SquareA = SquareIdA
@@ -107,25 +112,4 @@         decompose _ x = [x]
         
     instance FiniteCategory Square SquareAr SquareOb where
-        ob _ = set [SquareA, SquareB, SquareC, SquareD]
-    
-    instance PrettyPrint SquareOb where
-        pprint SquareA = "A"
-        pprint SquareB = "B"
-        pprint SquareC = "C"
-        pprint SquareD = "D"
-    
-    instance PrettyPrint SquareAr where
-        pprint SquareIdA = "IdA"
-        pprint SquareIdB = "IdB"
-        pprint SquareIdC = "IdC"
-        pprint SquareIdD = "IdD"
-        pprint SquareF = "f"
-        pprint SquareG = "g"
-        pprint SquareH = "h"
-        pprint SquareI = "i"
-        pprint SquareFH = "h o f"
-        pprint SquareGI = "i o g"
-    
-    instance PrettyPrint Square where
-        pprint = show+        ob _ = set [SquareA, SquareB, SquareC, SquareD]
− src/Math/FiniteCategories/Square/Example.hs 
@@ -1,28 +0,0 @@-{-| Module  : FiniteCategories
-Description : __'Square'__ pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-__'Square'__ pretty printed.
--}
-module Math.FiniteCategories.Square.Example
-(
-    main
-)
-where
-    import Data.WeakSet.Safe
-    
-    import Math.FiniteCategories.Square
-    import Math.IO.PrettyPrint
-    import Math.FiniteCategory
-    
-    
-    -- | __'Square'__ pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.Square.Example"
-        putStrLn $  pprintFiniteCategory Square 
-        putStrLn "End of Math.FiniteCategories.Square.Example"
src/Math/FiniteCategories/Subcategory.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE UndecidableInstances, FlexibleInstances, MultiParamTypeClasses  #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE UndecidableInstances  #-}
 
 {-| Module  : FiniteCategories
 Description : A 'Subcategory' of a category /C/ is a category /D/ whose objects are objects in /C/ and whose morphisms are morphisms in /C/ with the same identities and composition of morphisms.
@@ -52,7 +56,10 @@     import              Data.WeakMap            (Map)
     import qualified    Data.WeakMap        as  Map
     import              Data.WeakMap.Safe
+    import              Data.Simplifiable
     
+    import              GHC.Generics
+    
     -- | A 'Subcategory' needs an original category, a set of objects and a set of morphisms selected in the category.
     --
     -- The generators are forgotten, use 'InheritedSubcategory' if the generators are inheritable.
@@ -60,7 +67,7 @@     -- 'Subcategory' is private because the subset of morphisms might not yield a valid 'FiniteCategory' if a composite morphism does not belong in the subset.
     --
     -- Use the smart constructor 'subcategory' instead.
-    data Subcategory c m o = Subcategory c (Set o) (Set m) deriving (Eq)
+    data Subcategory c m o = Subcategory c (Set o) (Set m) deriving (Eq, Generic, PrettyPrint, Simplifiable)
     
     instance (Show c, Show m, Show o) => Show (Subcategory c m o) where
         show (Subcategory c os ms) = "(unsafeSubcategory "++show c++" "++show os++" "++show ms++")"
@@ -95,9 +102,6 @@     
     instance (Category c m o, Eq o, Eq m) => FiniteCategory (Subcategory c m o) m o where
         ob (Subcategory _ o _) = o
-    
-    instance (PrettyPrint c, PrettyPrint m, PrettyPrint o, Eq o, Eq m) => PrettyPrint (Subcategory c m o) where
-        pprint (Subcategory c o m) = "FullSubcategory("++ pprint c ++ ","++ pprint o ++ "," ++ pprint m ++")"
         
         
         
@@ -108,7 +112,7 @@     -- 'InheritedSubcategory' is private because the subset of morphisms might not yield a valid 'FiniteCategory' if a composite morphism does not belong in the subset.
     --
     -- Use the smart constructor 'inheritedSubcategory' instead.
-    data InheritedSubcategory c m o = InheritedSubcategory c (Set o) (Set m) deriving (Eq)
+    data InheritedSubcategory c m o = InheritedSubcategory c (Set o) (Set m) deriving (Eq, Generic, PrettyPrint, Simplifiable)
     
     instance (Show c, Show m, Show o) => Show (InheritedSubcategory c m o) where
         show (InheritedSubcategory c os ms) = "(unsafeInheritedSubcategory "++show c++" "++show os++" "++show ms++")"
@@ -149,9 +153,6 @@     
     instance (Category c m o, Eq o, Eq m) => FiniteCategory (InheritedSubcategory c m o) m o where
         ob (InheritedSubcategory _ o _) = o
-    
-    instance (PrettyPrint c, PrettyPrint m, PrettyPrint o, Eq o, Eq m) => PrettyPrint (InheritedSubcategory c m o) where
-        pprint (InheritedSubcategory c o m) = "InheritedFullSubcategory("++ pprint c ++ ","++ pprint o ++ "," ++ pprint m ++")"
             
     
     -- | Return the image 'Subcategory' of an embedding.
src/Math/FiniteCategories/V.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 {-| Module  : FiniteCategories
@@ -24,15 +26,17 @@     import          Math.IO.PrettyPrint
     
     import          Data.WeakSet.Safe
-    
+    import          Data.Simplifiable
+        
+    import          GHC.Generics
     -- | Objects of the __'V'__ category.
-    data VOb = VA | VB | VC deriving (Eq, Show)
+    data VOb = VA | VB | VC deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     -- | Morphisms of the __'V'__ category.
-    data VAr =  VIdA | VIdB | VIdC | VF | VG deriving (Eq, Show)
+    data VAr =  VIdA | VIdB | VIdC | VF | VG deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     -- | The __'V'__ category.
-    data V = V deriving (Eq, Show)
+    data V = V deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance Morphism VAr VOb where
         source VIdA = VA
@@ -44,14 +48,14 @@         target VIdB = VB
         target VIdC = VC
         target _ = VA
-        (@?) VIdA VIdA = Just VIdA
-        (@?) VIdB VIdB = Just VIdB
-        (@?) VF VIdB = Just VF
-        (@?) VG VIdC = Just VG
-        (@?) VIdC VIdC = Just VIdC
-        (@?) VIdA VF = Just VF
-        (@?) VIdA VG = Just VG
-        (@?) _ _ = Nothing
+        (@) VIdA VIdA = VIdA
+        (@) VIdB VIdB = VIdB
+        (@) VF VIdB = VF
+        (@) VG VIdC = VG
+        (@) VIdC VIdC = VIdC
+        (@) VIdA VF = VF
+        (@) VIdA VG = VG
+        (@) _ _ = error "Incompatible composition of V morphisms."
     
     instance Category V VAr VOb where
         identity _ VA = VIdA
@@ -66,18 +70,3 @@     
     instance FiniteCategory V VAr VOb where
         ob _ = set [VA, VB, VC]
-
-    instance PrettyPrint VOb where
-        pprint VA = "A"
-        pprint VB = "B"
-        pprint VC = "C"
-        
-    instance PrettyPrint VAr where
-        pprint VIdA = "IdA"
-        pprint VIdB = "IdB"
-        pprint VIdC = "IdC"
-        pprint VF = "f"
-        pprint VG = "g"
-        
-    instance PrettyPrint V where
-        pprint = show
− src/Math/FiniteCategories/V/Example.hs 
@@ -1,28 +0,0 @@-{-| Module  : FiniteCategories
-Description : __'V'__ pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-__'V'__ pretty printed.
--}
-module Math.FiniteCategories.V.Example
-(
-    main
-)
-where
-    import Data.WeakSet.Safe
-    
-    import Math.FiniteCategories.V
-    import Math.IO.PrettyPrint
-    import Math.FiniteCategory
-    
-    
-    -- | __'V'__ pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.V.Example"
-        putStrLn $  pprintFiniteCategory V 
-        putStrLn "End of Math.FiniteCategories.V.Example"
src/Math/FiniteCategory.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies  #-}
+{-# LANGUAGE FunctionalDependencies  #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
 
 {-| Module  : FiniteCategories
 Description : A 'FiniteCategory' is a 'Category' where the objects can be enumerated.
@@ -166,8 +167,8 @@     -- | Return wether an object is initial in the category.
     isInitial :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> o -> Bool
     isInitial cat obj = let
-                            morphisms t = setToList $ ar cat obj t
-                            condition t = (not.null $ morphisms t) && (null.tail $ morphisms t) -- we avoid the usage of cardinal to test that the size of (ar cat obj t) is 1 for speed purposes
+                            morphisms t = ar cat obj t
+                            condition t = (not $ Set.null $ morphisms t) && (Set.and ((anElement (morphisms t) ==) <$> morphisms t)) -- we avoid the usage of cardinal to test that the size of (ar cat obj t) is 1 for speed purposes
                         in
                             Set.and $ condition <$> ob cat 
     
@@ -178,8 +179,8 @@     -- | Return wether an object is terminal in the category.
     isTerminal :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> o -> Bool
     isTerminal cat obj = let
-                            morphisms s = setToList $ ar cat s obj
-                            condition s = (not.null $ morphisms s) && (null.tail $ morphisms s) -- we avoid the usage of cardinal to test that the size of (ar cat s obj) is 1 for speed purposes
+                            morphisms s = ar cat s obj
+                            condition s = (not $ Set.null $ morphisms s) && (Set.and ((anElement (morphisms s) ==) <$> morphisms s)) -- we avoid the usage of cardinal to test that the size of (ar cat s obj) is 1 for speed purposes
                         in
                             Set.and $ condition <$> ob cat 
         
@@ -210,6 +211,6 @@     bruteForceDecompose c m = bruteForce c m ((:[]) <$> (setToList $ genArFrom c (source m))) 
     
     
-    -- | Pretty print a category by enumerating all objects, and then all arrows.
-    pprintFiniteCategory :: (FiniteCategory c m o, Morphism m o, PrettyPrint c, PrettyPrint m, PrettyPrint o, Eq m, Eq o) => c -> String
-    pprintFiniteCategory c = "Category : " ++ pprint c ++ "\nObjects :\n"++ (intercalate "\n" (setToList $ pprint <$> ob c)) ++ "\nArrows :\n"++ (intercalate "\n" (setToList $ pprint <$> arrows c)) +    -- | Pretty print a category by enumerating all objects, and then all arrows. The first argument is the verbosity of the pretty print.
+    pprintFiniteCategory :: (FiniteCategory c m o, Morphism m o, PrettyPrint c, PrettyPrint m, PrettyPrint o, Eq m, Eq o) => Int -> c -> String
+    pprintFiniteCategory v c = "Category : " ++ pprint v c ++ "\n\nObjects :\n\n"++ (intercalate "\n" (setToList $ pprint v <$> ob c)) ++ "\n\nArrows :\n\n"++ (intercalate "\n" (setToList $ pprint v <$> arrows c))
src/Math/FiniteCategoryError.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE MultiParamTypeClasses  #-}
 
 {-| Module  : FiniteCategories
@@ -21,9 +23,13 @@     import              Data.WeakSet               (Set)
     import qualified    Data.WeakSet           as  Set
     import              Data.WeakSet.Safe
+    import              Data.Simplifiable
     
     import              Math.FiniteCategory
+    import              Math.IO.PrettyPrint
 
+    import              GHC.Generics
+
     -- | A data type to represent an incoherence inside a finite category.
     data FiniteCategoryError m o =
          CompositionNotAssociative {f :: m, g :: m, h :: m, fg_h :: m, f_gh :: m} -- ^ @(h\@g)\@f /= h\@(g\@f)@
@@ -36,7 +42,7 @@        | GeneratorIsNotAMorphism {f :: m} -- ^ `f` is a generator but not a morphism.
        | MorphismDoesntDecomposesIntoGenerators {f :: m, decomp :: [m], notGen :: m} -- ^ The morphism `f` decomposes into `decomp` where `notGen` is a non generating morphism.
        | WrongDecomposition {f :: m, decomp :: [m], comp :: m} -- ^ @compose (decompose c f) /= f@.
-       deriving (Eq, Show)
+       deriving (Eq, Show, Generic, Simplifiable, PrettyPrint)
 
     -- | Checks the category axioms for a 'FiniteCategory'.
     --
src/Math/Functors/Adjunction.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MonadComprehensions, MultiParamTypeClasses  #-}
+{-# LANGUAGE MonadComprehensions  #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
 {-| Module  : FiniteCategories
 Description : Adjoint functors.
 Copyright   : Guillaume Sabbagh 2022
@@ -7,7 +8,7 @@ Stability   : experimental
 Portability : portable
 
-Adjunctions are all over the place in mathematics.
+Adjunctions are all over the place in mathematics. Note that 'leftAdjoint' and 'rightAdjoint' are slow because we enumerate a lot of morphisms to find the universal morphisms. Prefer using your own construction of an adjoint if known.
 -}
 
 module Math.Functors.Adjunction 
@@ -28,6 +29,8 @@     import              Math.Categories.CommaCategory
     
     -- | Returns the left adjoint of a functor, if the left adjoint does not exist, returns a partial Diagram being the best ajoint we could construct.
+    --
+    -- Note that 'leftAdjoint' and 'rightAdjoint' are slow because we enumerate a lot of morphisms to find the universal morphisms. Prefer using your own construction of an adjoint if known.
     leftAdjoint :: (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 -> Diagram c2 m2 o2 c1 m1 o1
@@ -45,6 +48,8 @@             binding m = [a | a <- ar (src g) (om |!| (source m)) (om |!| (target m)), ((yToEta |!| target m) @ m) == (g ->£ a) @ (yToEta |!| source m)]
     
     -- | Returns the right adjoint of a functor, if the right adjoint does not exist, returns a partial Diagram being the best ajoint we could construct.
+    --
+    -- Note that 'leftAdjoint' and 'rightAdjoint' are slow because we enumerate a lot of morphisms to find the universal morphisms. Prefer using your own construction of an adjoint if known.
     rightAdjoint :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
                      FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2) =>
                      Diagram c2 m2 o2 c1 m1 o1 -> Diagram c1 m1 o1 c2 m2 o2
− src/Math/Functors/Adjunction/Example.hs 
@@ -1,48 +0,0 @@-{-| Module  : FiniteCategories
-Description : An exemple of 'leftAdjoint' and 'rightAdjoint' use pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An exemple of 'leftAdjoint' and 'rightAdjoint' use pretty printed.
-
-
--}
-module Math.Functors.Adjunction.Example
-(
-    main
-)
-where
-    import              Math.FiniteCategory  
-    import              Math.FiniteCategories.Ens   
-    import              Math.FiniteCategories.DiscreteCategory   
-    import              Math.Categories.FunctorCategory   
-    import              Math.Functors.Adjunction
-    import              Math.Functors.DiagonalFunctor
-    import              Math.IO.PrettyPrint
-    import              Math.FiniteCategory
-
-    
-    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
-    
-    -- | An exemple of 'leftAdjoint' and 'rightAdjoint' use pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.Functors.Adjunction.Example"
-        let universe = ens $ set [set [1 :: Int], set [3,4]]
-        let indexing = discreteCategory $ set [0 :: Int,1]
-        let diagFunct = diagonalFunctor indexing universe
-        let leftAdj = leftAdjoint diagFunct
-        let rightAdj = rightAdjoint diagFunct
-        putStrLn $ pprintFiniteCategory universe 
-        putStrLn $ pprintFiniteCategory indexing 
-        putStrLn $ pprint (fst.anElement.(Map.mapToSet).omap $ leftAdj) 
-        putStrLn $ pprint (selectObject universe (snd.anElement.(Map.mapToSet).omap $ leftAdj)) 
-        putStrLn "End of Math.Functors.Adjunction.Example"
+ src/Math/Functors/Adjunction/Examples.hs view
@@ -0,0 +1,42 @@+{-| Module  : FiniteCategories
+Description : An exemple of 'leftAdjoint' and 'rightAdjoint' use.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+An exemple of 'leftAdjoint' and 'rightAdjoint' use.
+
+
+-}
+module Math.Functors.Adjunction.Examples
+(
+    exampleLeftAdjoint,
+    exampleRightAdjoint,
+)
+where
+    import              Math.FiniteCategory  
+    import              Math.Categories   
+    import              Math.FiniteCategories 
+    import              Math.Functors.DiagonalFunctor.Examples
+    import              Math.Functors.Adjunction
+    import              Math.Functors.DiagonalFunctor
+
+    
+    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
+    
+
+    -- | The 'leftAdjoint' of a diagonal functor allows to compute colimits.
+    exampleLeftAdjoint :: Diagram (FunctorCategory (DiscreteCategory Int) (DiscreteMorphism Int) Int (Ens Int) (Function Int) (Set Int)) (NaturalTransformation (DiscreteCategory Int) (DiscreteMorphism Int) Int (Ens Int) (Function Int) (Set Int)) (Diagram (DiscreteCategory Int) (DiscreteMorphism Int) Int (Ens Int) (Function Int) (Set Int)) (Ens Int) (Function Int) (Set Int)
+    exampleLeftAdjoint = leftAdjoint exampleDiagonalFunctor
+    
+    -- | The 'rightAdjoint' of a diagonal functor allows to compute limits.
+    exampleRightAdjoint :: Diagram (FunctorCategory (DiscreteCategory Int) (DiscreteMorphism Int) Int (Ens Int) (Function Int) (Set Int)) (NaturalTransformation (DiscreteCategory Int) (DiscreteMorphism Int) Int (Ens Int) (Function Int) (Set Int)) (Diagram (DiscreteCategory Int) (DiscreteMorphism Int) Int (Ens Int) (Function Int) (Set Int)) (Ens Int) (Function Int) (Set Int)
+    exampleRightAdjoint = rightAdjoint exampleDiagonalFunctor
+
src/Math/Functors/DataMigration.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MonadComprehensions, MultiParamTypeClasses  #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
 {-| Module  : FiniteCategories
 Description : Data migration functors as defined by David Spivak in FQL.
 Copyright   : Guillaume Sabbagh 2022
@@ -29,7 +29,7 @@     import              Math.Functors.Adjunction
     
     -- | Precomposition functor.
-    deltaFunctor :: (FiniteCategory c1 m1 o1, Morphism m1 o1,
+    deltaFunctor :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1,
                      FiniteCategory c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2,
                      FiniteCategory c3 m3 o3, Morphism m3 o3, Eq c3, Eq m3, Eq o3) =>
                      c3 -> Diagram c1 m1 o1 c2 m2 o2 -> Diagram (FunctorCategory c2 m2 o2 c3 m3 o3) (NaturalTransformation c2 m2 o2 c3 m3 o3) (Diagram c2 m2 o2 c3 m3 o3) (FunctorCategory c1 m1 o1 c3 m3 o3) (NaturalTransformation c1 m1 o1 c3 m3 o3) (Diagram c1 m1 o1 c3 m3 o3)
− src/Math/Functors/DataMigration/Example.hs 
@@ -1,81 +0,0 @@-{-| Module  : FiniteCategories
-Description : An exemple of a 'dataMigration' pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An exemple of 'dataMigration' pretty printed.
-
-
--}
-module Math.Functors.DataMigration.Example
-(
-    main
-)
-where
-    import              Math.FiniteCategory
-    import              Math.FiniteCategories.SafeCompositionGraph
-    import              Math.FiniteCategories
-    import              Math.Functors.DataMigration
-    import              Math.Categories.FinSet
-    import              Math.IO.PrettyPrint
-    import              Math.FiniteCategory
-
-    
-    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
-    
-    -- | An exemple of 'DataMigration' pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.Functors.DataMigration.Example"
-        -- let Right graphSketch = readSCGString "3\nE -s-> V\nE -t-> V"
-        -- let Right autographSketch = readSCGString "3\nA -s-> A -s-> A = A -t-> A\nA -s-> A -t-> A = <ID>\nA -t-> A -s-> A = <ID>\n A -t-> A -t-> A = A -s-> A"
-        -- let f = (setToList $ ob (FunctorCategory graphSketch autographSketch)) !! 7
-        -- --Diagram{src=graphSketch, tgt=autographSketch, omap=memorizeFunction (const.anElement.ob $ autographSketch) (ob graphSketch), mmap = weakMap (zip (setToList (arrows graphSketch)) (setToList (arrows autographSketch)))}
-        -- putStrLn $ pprintFiniteCategory graphSketch 
-        -- putStrLn $ pprintFiniteCategory autographSketch 
-        -- putStrLn $ pprint f 
-        -- putStrLn (show f)
-        -- let universe = ens $ set [set [1 :: Int,2]]
-        -- let delta = (deltaFunctor universe f)
-        -- let anInstance = anElement (ob.source $ delta)
-        -- putStrLn $ pprint anInstance 
-        -- putStrLn $ pprint (delta ->$ anInstance) 
-        
-        -- let universe = ens $ set [set[], set[1], set[1 :: Int,2]]
-        -- let pii = (piFunctor universe f)
-        -- let anInstance = (setToList.ob.source $ delta) !! 0
-        -- putStrLn $ pprint anInstance 
-        -- putStrLn $ pprint (pii ->$ anInstance) 
-        
-        -- let c = V
-        -- let d = numberCategory 2
-        -- let f = completeDiagram Diagram{src=c,tgt=d,omap=weakMap [(VA,2),(VB,1),(VC,1)],mmap=weakMap [(VF,IsSmallerThan 1 2),(VG,IsSmallerThan 1 2)]}
-        let c = Parallel
-        let d = discreteCategory (set "A")
-        let f = completeDiagram Diagram{src=d,tgt=c,omap=weakMap [('A',ParallelA)],mmap = Map.empty}
-        putStrLn $ pprint f 
-        
-        let universe = ens $ set [set[], set [1 :: Int,2], set [1]]
-        let anInstance = completeDiagram Diagram{src=d,tgt=universe,omap=weakMap [('A',set [1])],mmap=Map.empty}
-        putStrLn $ pprint anInstance 
-        putStrLn $ pprint anInstance 
-        
-        let pii = (piFunctor universe f)
-        putStrLn $ pprint (pii ->$ anInstance) 
-        putStrLn $ pprint (pii ->$ anInstance) 
-        putStrLn $ show (pii ->$ anInstance)
-        
-        let sigmaa = (sigmaFunctor universe f)
-        putStrLn $ pprint (sigmaa ->$ anInstance) 
-        putStrLn $ pprint (sigmaa ->$ anInstance) 
-        putStrLn $ show (sigmaa ->$ anInstance)
-        
-        putStrLn "End of Math.Functors.DataMigration.Example"
+ src/Math/Functors/DataMigration/Examples.hs view
@@ -0,0 +1,54 @@+{-| Module  : FiniteCategories
+Description : Examples of data migration.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of data migration.
+-}
+module Math.Functors.DataMigration.Examples
+(
+    exampleDeltaFunctor,
+    examplePiFunctor,
+    exampleSigmaFunctor,
+)
+where
+    import              Math.FiniteCategory
+    import              Math.FiniteCategories
+    import              Math.Categories
+    import              Math.Functors.DataMigration
+
+    
+    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
+    
+    -- | An example of 'deltaFunctor', you can see it as a cast operation on models of a given linear sketch.
+    --
+    -- Here we consider a sketch morphism from the sketch of graphs ('Parellel') to the sketch of sets ('One').
+    exampleDeltaFunctor :: Diagram (FunctorCategory One One One (Ens Int) (Function Int) (Set Int)) (NaturalTransformation One One One (Ens Int) (Function Int) (Set Int)) (Diagram One One One (Ens Int) (Function Int) (Set Int)) (FunctorCategory Parallel ParallelAr ParallelOb (Ens Int) (Function Int) (Set Int)) (NaturalTransformation Parallel ParallelAr ParallelOb (Ens Int) (Function Int) (Set Int)) (Diagram Parallel ParallelAr ParallelOb (Ens Int) (Function Int) (Set Int))
+    exampleDeltaFunctor = deltaFunctor universe functor
+        where
+            universe = ens $ set [set[], set [1], set [1,2]]
+            functor = anElement.ob $ FunctorCategory Parallel One
+    
+    
+    -- | An example of 'piFunctor', it is the right adjoint of 'exampleDeltaFunctor'.
+    examplePiFunctor :: Diagram (FunctorCategory Parallel ParallelAr ParallelOb (Ens Int) (Function Int) (Set Int)) (NaturalTransformation Parallel ParallelAr ParallelOb (Ens Int) (Function Int) (Set Int)) (Diagram Parallel ParallelAr ParallelOb (Ens Int) (Function Int) (Set Int)) (FunctorCategory One One One (Ens Int) (Function Int) (Set Int)) (NaturalTransformation One One One (Ens Int) (Function Int) (Set Int)) (Diagram One One One (Ens Int) (Function Int) (Set Int)) 
+    examplePiFunctor = piFunctor universe functor
+        where
+            universe = ens $ set [set[], set [1], set [1,2]]
+            functor = anElement.ob $ FunctorCategory Parallel One
+    
+    -- | An example of 'piFunctor', it is the left adjoint of 'exampleDeltaFunctor'.
+    exampleSigmaFunctor :: Diagram (FunctorCategory Parallel ParallelAr ParallelOb (Ens Int) (Function Int) (Set Int)) (NaturalTransformation Parallel ParallelAr ParallelOb (Ens Int) (Function Int) (Set Int)) (Diagram Parallel ParallelAr ParallelOb (Ens Int) (Function Int) (Set Int)) (FunctorCategory One One One (Ens Int) (Function Int) (Set Int)) (NaturalTransformation One One One (Ens Int) (Function Int) (Set Int)) (Diagram One One One (Ens Int) (Function Int) (Set Int)) 
+    exampleSigmaFunctor = sigmaFunctor universe functor
+        where
+            universe = ens $ set [set[], set [1], set [1,2]]
+            functor = anElement.ob $ FunctorCategory Parallel One
+
src/Math/Functors/DiagonalFunctor.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MonadComprehensions, MultiParamTypeClasses  #-}
+{-# LANGUAGE MonadComprehensions  #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
 {-| Module  : FiniteCategories
 Description : Diagonal functor.
 Copyright   : Guillaume Sabbagh 2022
− src/Math/Functors/DiagonalFunctor/Example.hs 
@@ -1,40 +0,0 @@-{-| Module  : FiniteCategories
-Description : An exemple of a 'diagonalFunctor' pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An exemple of 'diagonalFunctor' pretty printed.
-
-
--}
-module Math.Functors.DiagonalFunctor.Example
-(
-    main
-)
-where
-    import              Math.FiniteCategory  
-    import              Math.FiniteCategories.DiscreteCategory
-    import              Math.FiniteCategories.V
-    import              Math.Functors.DiagonalFunctor
-    import              Math.IO.PrettyPrint
-    import              Math.FiniteCategory
-
-    
-    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
-    
-    -- | An exemple of 'diagonalFunctor' pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.Functors.DiagonalFunctor.Example"
-        putStrLn $ pprintFiniteCategory (discreteCategory (set [1 :: Int,2])) 
-        putStrLn $ pprintFiniteCategory V 
-        putStrLn $ pprint (diagonalFunctor (discreteCategory (set [1 :: Int,2])) V) 
-        putStrLn "End of Math.Functors.DiagonalFunctor.Example"
+ src/Math/Functors/DiagonalFunctor/Examples.hs view
@@ -0,0 +1,36 @@+{-| Module  : FiniteCategories
+Description : An example of a 'diagonalFunctor'.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+An example of 'diagonalFunctor'.
+
+
+-}
+module Math.Functors.DiagonalFunctor.Examples
+(
+    exampleDiagonalFunctor,
+)
+where
+    import              Math.FiniteCategory
+    import              Math.FiniteCategories
+    import              Math.Categories
+    import              Math.Functors.DiagonalFunctor
+
+    
+    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 
+    
+    -- | An example of 'diagonalFunctor'.
+    exampleDiagonalFunctor :: Diagram (Ens Int) (Function Int) (Set Int) (FunctorCategory (DiscreteCategory Int) (DiscreteMorphism Int) Int (Ens Int) (Function Int) (Set Int)) (NaturalTransformation (DiscreteCategory Int) (DiscreteMorphism Int) Int (Ens Int) (Function Int) (Set Int)) (Diagram (DiscreteCategory Int) (DiscreteMorphism Int) Int (Ens Int) (Function Int) (Set Int))
+    exampleDiagonalFunctor = diagonalFunctor indexing universe
+        where
+            universe = ens $ set [set [1], set [3,4]]
+            indexing = discreteCategory $ set [0,1]
src/Math/Functors/Examples.hs view
@@ -1,31 +1,27 @@ {-| Module  : FiniteCategories
-Description : Run all functors examples.
+Description : This file exports all Functors examples.
 Copyright   : Guillaume Sabbagh 2022
 License     : GPL-3
 Maintainer  : guillaumesabbagh@protonmail.com
 Stability   : experimental
 Portability : portable
 
-Run all functors examples. See results in the folder 
+This file exports all Functors examples.
 -}
 
 module Math.Functors.Examples
 (
-    main
+    module Math.Functors.Adjunction.Examples,
+    module Math.Functors.DataMigration.Examples,
+    module Math.Functors.DiagonalFunctor.Examples,
+    module Math.Functors.KanExtension.Examples,
+    module Math.Functors.SetValued.Examples,
+    module Math.Functors.YonedaEmbedding.Examples,
 )
 where
-    import qualified Math.Functors.SetValued.Example        as SetValued
-    import qualified Math.Functors.Adjunction.Example       as Adjunction
-    import qualified Math.Functors.DiagonalFunctor.Example  as DiagonalFunctor
-    import qualified Math.Functors.DataMigration.Example    as DataMigration
-    import qualified Math.Functors.KanExtension.Example     as KanExtension
-    import qualified Math.Functors.YonedaEmbedding.Example  as Yoneda
-    
-    -- | Run all examples of the project. See results in the folder OutputGraphViz.
-    main = do
-        SetValued.main
-        KanExtension.main
-        DataMigration.main
-        Adjunction.main
-        DiagonalFunctor.main
-        Yoneda.main+    import Math.Functors.Adjunction.Examples
+    import Math.Functors.DataMigration.Examples
+    import Math.Functors.DiagonalFunctor.Examples
+    import Math.Functors.KanExtension.Examples
+    import Math.Functors.SetValued.Examples
+    import Math.Functors.YonedaEmbedding.Examples
src/Math/Functors/KanExtension.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE MonadComprehensions, MultiParamTypeClasses  #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE MonadComprehensions  #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
 {-| Module  : FiniteCategories
 Description : Kan extensions for arbitrary functors.
 Copyright   : Guillaume Sabbagh 2023
@@ -22,28 +25,30 @@     import              Data.WeakMap        (Map)
     import qualified    Data.WeakMap    as  Map
     import              Data.WeakMap.Safe
+    import              Data.Simplifiable
 
     import              Math.FiniteCategory
     import              Math.Categories.FunctorCategory
     import              Math.Categories.CommaCategory
+    import              Math.IO.PrettyPrint
     
+    import              GHC.Generics
     
+    
     -- | KanObject is either a functor X : A -> C or a functor to be precomposed called RL : B -> C (R or L).
-    data KanObject c1 m1 o1 c2 m2 o2 c3 m3 o3 = X (Diagram c1 m1 o1 c3 m3 o3) | RL (Diagram c2 m2 o2 c3 m3 o3) deriving (Eq, Show)
+    data KanObject c1 m1 o1 c2 m2 o2 c3 m3 o3 = X (Diagram c1 m1 o1 c3 m3 o3) | RL (Diagram c2 m2 o2 c3 m3 o3) deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     -- | RightKanMorphism is a natural transformation Delta between functors to be precomposed or a natural transformation Mu to X.
-    data RightKanMorphism c1 m1 o1 c2 m2 o2 c3 m3 o3 = Delta (NaturalTransformation c2 m2 o2 c3 m3 o3) (Diagram c1 m1 o1 c2 m2 o2) | Mu (NaturalTransformation c1 m1 o1 c3 m3 o3) deriving (Eq, Show)
+    data RightKanMorphism c1 m1 o1 c2 m2 o2 c3 m3 o3 = Delta (NaturalTransformation c2 m2 o2 c3 m3 o3) (Diagram c1 m1 o1 c2 m2 o2) | Mu (NaturalTransformation c1 m1 o1 c3 m3 o3) deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance (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,
                     Category c3 m3 o3, Morphism m3 o3, Eq c3, Eq m3, Eq o3) =>
               Morphism (RightKanMorphism c1 m1 o1 c2 m2 o2 c3 m3 o3) (KanObject c1 m1 o1 c2 m2 o2 c3 m3 o3) where
-        (@?) (Delta nat1 diag1) (Delta nat2 diag2)
-            | diag1 == diag2 = (\x -> Delta x diag1) <$> (nat1 @? nat2)
-            | otherwise = Nothing
-        (@?) (Mu nat2) (Delta nat1 diag) = Mu <$> (nat2 @? (nat1 <=@<- diag))
-        (@?) (Mu nat1) (Mu nat2) = Mu <$> (nat1 @? nat2)
-        (@?) _ _ = Nothing
+        (@) (Delta nat1 diag1) (Delta nat2 diag2) = Delta (nat1 @ nat2) diag1
+        (@) (Mu nat2) (Delta nat1 diag) = Mu $ (nat2 @ (nat1 <=@<- diag))
+        (@) (Mu nat1) (Mu nat2) = Mu $ (nat1 @ nat2)
+        (@) _ _ = error "Incompatible composition of RightKanMorphisms."
     
         source (Delta nat _) = RL (source nat)
         source (Mu nat) = X (source nat)
@@ -52,7 +57,7 @@         target (Mu nat) = X (target nat)
         
     -- | RightKanCategory is the category in which we want to take a comma category to find the terminal object.
-    data RightKanCategory c1 m1 o1 c2 m2 o2 c3 m3 o3 = RightKanCategory (Diagram c1 m1 o1 c2 m2 o2) (Diagram c1 m1 o1 c3 m3 o3) deriving (Eq, Show)
+    data RightKanCategory c1 m1 o1 c2 m2 o2 c3 m3 o3 = RightKanCategory (Diagram c1 m1 o1 c2 m2 o2) (Diagram c1 m1 o1 c3 m3 o3) deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance (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,
@@ -99,18 +104,16 @@     
     
     -- | LeftKanMorphism is a natural transformation Sigma between functors to be precomposed or a natural transformation Alpha from X.
-    data LeftKanMorphism c1 m1 o1 c2 m2 o2 c3 m3 o3 = Sigma (NaturalTransformation c2 m2 o2 c3 m3 o3) (Diagram c1 m1 o1 c2 m2 o2) | Alpha (NaturalTransformation c1 m1 o1 c3 m3 o3) deriving (Eq, Show)
+    data LeftKanMorphism c1 m1 o1 c2 m2 o2 c3 m3 o3 = Sigma (NaturalTransformation c2 m2 o2 c3 m3 o3) (Diagram c1 m1 o1 c2 m2 o2) | Alpha (NaturalTransformation c1 m1 o1 c3 m3 o3) deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance (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,
                     Category c3 m3 o3, Morphism m3 o3, Eq c3, Eq m3, Eq o3) =>
               Morphism (LeftKanMorphism c1 m1 o1 c2 m2 o2 c3 m3 o3) (KanObject c1 m1 o1 c2 m2 o2 c3 m3 o3) where
-        (@?) (Sigma nat1 diag1) (Sigma nat2 diag2)
-            | diag1 == diag2 = (\x -> Sigma x diag1) <$> (nat1 @? nat2)
-            | otherwise = Nothing
-        (@?) (Sigma nat1 diag) (Alpha nat2) = Alpha <$> ((nat1 <=@<- diag) @? nat2)
-        (@?) (Alpha nat1) (Alpha nat2) = Alpha <$> (nat1 @? nat2)
-        (@?) _ _ = Nothing
+        (@) (Sigma nat1 diag1) (Sigma nat2 diag2) = Sigma (nat1 @ nat2) diag1 
+        (@) (Sigma nat1 diag) (Alpha nat2) = Alpha $ ((nat1 <=@<- diag) @ nat2)
+        (@) (Alpha nat1) (Alpha nat2) = Alpha $ (nat1 @ nat2)
+        (@) _ _ = error "Incompatible composition of LeftKanMorphisms."
     
         source (Sigma nat _) = RL (source nat)
         source (Alpha nat) = X (source nat)
@@ -119,7 +122,7 @@         target (Alpha nat) = X (target nat)
         
     -- | LeftKanCategory is the category in which we want to take a comma category to find the initial object.
-    data LeftKanCategory c1 m1 o1 c2 m2 o2 c3 m3 o3 = LeftKanCategory (Diagram c1 m1 o1 c2 m2 o2) (Diagram c1 m1 o1 c3 m3 o3) deriving (Eq, Show)
+    data LeftKanCategory c1 m1 o1 c2 m2 o2 c3 m3 o3 = LeftKanCategory (Diagram c1 m1 o1 c2 m2 o2) (Diagram c1 m1 o1 c3 m3 o3) deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
     
     instance (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,
− src/Math/Functors/KanExtension/Example.hs 
@@ -1,145 +0,0 @@-{-| Module  : FiniteCategories
-Description : Examples of Kan extensions pretty printed.
-Copyright   : Guillaume Sabbagh 2023
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-Examples of Kan extensions pretty printed.
-
-
--}
-module Math.Functors.KanExtension.Example
-(
-    main
-)
-where
-    import              Math.FiniteCategory
-    import              Math.FiniteCategories
-    import              Math.Functors.KanExtension
-    import              Math.IO.PrettyPrint
-    import              Math.FiniteCategory
-
-    
-    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
-    
-    -- | Examples of Kan extensions pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.Functors.KanExtension.Example"
-        let d1 = (setToList $ ob (FunctorCategory (numberCategory 2) (numberCategory 4)))!! 3
-        let d2 = (setToList $ ob (FunctorCategory (numberCategory 2) (numberCategory 3)))!! 2
-        putStrLn $ pprint d1 
-        putStrLn $ pprint d2 
-        let Just (lk,lknat) = (leftKan d1 d2)
-        putStrLn $ pprint lk 
-        putStrLn $ pprint lknat 
-        let Just (rk,rknat) = (rightKan d1 d2)
-        putStrLn $ pprint rk 
-        putStrLn $ pprint rknat 
-        
-        let a = unsafeReadSCGString "2\nA\n"
-        putStrLn $ pprintFiniteCategory a 
-        let b = unsafeReadSCGString "2\nA -f-> B\n"
-        putStrLn $ pprintFiniteCategory b 
-        let c = unsafeReadSCGString "2\nA -f-> B -g-> A = <ID>\nB -g-> A -f-> B = <ID>\n"
-        putStrLn $ pprintFiniteCategory c 
-        let f = unsafeReadSCGDString "<SRC>\n2\nA\n</SRC>\n<TGT>\n2\nA -f-> B -g-> A = <ID>\nB -g-> A -f-> B = <ID>\n</TGT>\nA => A"
-        putStrLn $ pprint f 
-        let g = unsafeReadSCGDString "<SRC>\n2\nA\n</SRC>\n<TGT>\n2\nA -f-> B\n</TGT>\nA => A"
-        putStrLn $ pprint g 
-        
-        let Just (lk,lknat) = (leftKan f g)
-        putStrLn $ pprint lk 
-        putStrLn $ pprint lknat 
-        
-        let Just (rk,rknat) = (rightKan f g)
-        putStrLn $ pprint rk 
-        putStrLn $ pprint rknat 
-        
-        
-        let a = unsafeReadSCGString "2\nA\nB\n"
-        putStrLn $ pprintFiniteCategory a 
-        let b = unsafeReadSCGString "2\nC -p1-> A\nC -p2-> B\n"
-        putStrLn $ pprintFiniteCategory b 
-        let c = unsafeReadSCGString "2\n0 -abs-> 1\n"
-        putStrLn $ pprintFiniteCategory c 
-        let f = unsafeReadSCGDString "<SRC>\n2\nA\nB\n</SRC>\n<TGT>\n2\nC -p1-> A\nC -p2-> B\n</TGT>\nA => A\nB => B\n"
-        putStrLn $ pprint f 
-        let x = unsafeReadSCGDString "<SRC>\n2\nA\nB\n</SRC>\n<TGT>\n2\n0 -abs-> 1\n</TGT>\nA => 1\nB => 1"
-        putStrLn $ pprint x 
-        
-        -- let Just (lk,lknat) = (leftKan f x)
-        -- putStrLn $ pprint lk 
-        -- putStrLn $ pprint lknat 
-        
-        let Just (rk,rknat) = (rightKan f x)
-        putStrLn $ pprint rk 
-        putStrLn $ pprint rknat 
-        
-        
-        let a = unsafeReadSCGString "2\nA\nB\n"
-        putStrLn $ pprintFiniteCategory a 
-        let b = unsafeReadSCGString "2\nA -q1-> C\nB -q2-> C\n"
-        putStrLn $ pprintFiniteCategory b 
-        let c = unsafeReadSCGString "2\n0 -abs-> 1\n"
-        putStrLn $ pprintFiniteCategory c 
-        let f = unsafeReadSCGDString "<SRC>\n2\nA\nB\n</SRC>\n<TGT>\n2\nA -q1-> C\nB -q2-> C\n</TGT>\nA => A\nB => B\n"
-        putStrLn $ pprint f 
-        let x = unsafeReadSCGDString "<SRC>\n2\nA\nB\n</SRC>\n<TGT>\n2\n0 -abs-> 1\n</TGT>\nA => 1\nB => 1"
-        putStrLn $ pprint x 
-        
-        let Just (lk,lknat) = (leftKan f x)
-        putStrLn $ pprint lk 
-        putStrLn $ pprint lknat 
-        
-        -- let Just (rk,rknat) = (rightKan f x)
-        -- putStrLn $ pprint rk 
-        -- putStrLn $ pprint rknat 
-        
-        
-        let a = unsafeReadSCGString "2\nA\nB\n"
-        putStrLn $ pprintFiniteCategory a 
-        let b = unsafeReadSCGString "2\nA -f-> C\nB -g-> C\n"
-        putStrLn $ pprintFiniteCategory b 
-        let c = unsafeReadSCGString "2\n0 -f-> 1\n1 -g-> 2\n"
-        putStrLn $ pprintFiniteCategory c 
-        let f = unsafeReadSCGDString "<SRC>\n2\nA\nB\n</SRC>\n<TGT>\n2\nA -f-> C\nB -g-> C\n</TGT>\nA => A\nB => B\n"
-        putStrLn $ pprint f 
-        let x = unsafeReadSCGDString "<SRC>\n2\nA\nB\n</SRC>\n<TGT>\n2\n0 -f-> 1\n1 -g-> 2\n</TGT>\nA => 1\nB => 1"
-        putStrLn $ pprint x 
-        
-        let Just (lk,lknat) = (leftKan f x)
-        putStrLn $ pprint lk 
-        putStrLn $ pprint lknat 
-        
-        let Just (rk,rknat) = (rightKan f x)
-        putStrLn $ pprint rk 
-        putStrLn $ pprint rknat 
-        
-        -- let a = unsafeReadSCGString "2\nA\nB\n"
-        -- putStrLn $ pprintFiniteCategory a 
-        -- let b = unsafeReadSCGString "2\nA -q1-> C\nB -q2-> C\n"
-        -- putStrLn $ pprintFiniteCategory b 
-        -- let c = unsafeReadSCGString "2\n0 -abs-> 1\n"
-        -- putStrLn $ pprintFiniteCategory c 
-        -- let f = unsafeReadSCGDString "<SRC>\n2\nA\nB\n</SRC>\n<TGT>\n2\nA -q1-> C\nB -q2-> C\n</TGT>\nA => A\nB => B\n"
-        -- putStrLn $ pprint f 
-        -- let x = unsafeReadSCGDString "<SRC>\n2\nA\nB\n</SRC>\n<TGT>\n2\n0 -abs-> 1\n</TGT>\nA => 0\nB => 1"
-        -- putStrLn $ pprint x 
-        
-        -- let Just (lk,lknat) = (leftKan f x)
-        -- putStrLn $ pprint lk 
-        -- putStrLn $ pprint lknat 
-        
-        -- let Just (rk,rknat) = (rightKan f x)
-        -- putStrLn $ pprint rk 
-        -- putStrLn $ pprint rknat 
-        
-        putStrLn "End of Math.Functors.KanExtension.Example"
+ src/Math/Functors/KanExtension/Examples.hs view
@@ -0,0 +1,53 @@+{-| Module  : FiniteCategories
+Description : Examples of Kan extensions.
+Copyright   : Guillaume Sabbagh 2023
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of Kan extensions.
+
+
+-}
+module Math.Functors.KanExtension.Examples
+(
+    exampleLeftKanExtension,
+    exampleRightKanExtension,
+)
+where
+    import              Math.FiniteCategory
+    import              Math.FiniteCategories
+    import              Math.Functors.KanExtension
+
+    import              Data.Text                (Text)
+    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
+    
+
+    -- | An example of left Kan Extension which computes the sum (disjunction) of two booleans variables.
+    exampleLeftKanExtension :: Diagram (CompositionGraph Text Text) (CGMorphism Text Text) Text (CompositionGraph Text Text) (CGMorphism Text Text) Text
+    exampleLeftKanExtension = lk
+        where
+            a = unsafeReadCGString "A\nB\n"
+            b = unsafeReadCGString "A -q1-> C\nB -q2-> C\n"
+            c = unsafeReadCGString "0 -abs-> 1\n"
+            f = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nA -q1-> C\nB -q2-> C\n</TGT>\nA => A\nB => B\n"
+            x = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -abs-> 1\n</TGT>\nA => 0\nB => 1"
+            Just (lk,lknat) = (leftKan f x)
+        
+    -- | An example of right Kan Extension which computes the product (conjonction) of two booleans variables.
+    exampleRightKanExtension :: Diagram (CompositionGraph Text Text) (CGMorphism Text Text) Text (CompositionGraph Text Text) (CGMorphism Text Text) Text
+    exampleRightKanExtension = rk
+        where
+            a = unsafeReadCGString "A\nB\n"
+            b = unsafeReadCGString "C -p1-> A\nC -p2-> B\n"
+            c = unsafeReadCGString "0 -abs-> 1\n"
+            f = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\nC -p1-> A\nC -p2-> B\n</TGT>\nA => A\nB => B\n"
+            x = unsafeReadCGDString "<SRC>\nA\nB\n</SRC>\n<TGT>\n0 -abs-> 1\n</TGT>\nA => 0\nB => 1"
+            Just (rk,rknat) = (rightKan f x)
+
src/Math/Functors/SetValued.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MonadComprehensions, MultiParamTypeClasses  #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE MonadComprehensions  #-}
 {-| Module  : FiniteCategories
 Description : Utility functions for set-valued functors.
 Copyright   : Guillaume Sabbagh 2023
@@ -43,12 +44,14 @@     import              Math.FiniteCategories.One
     import              Math.IO.PrettyPrint
     
+    import              GHC.Base            (maxInt)
+    
     -- | A 'LimitObject' is a map from a comma object to an element a, the maps should be seen as elements of the cartesian products indexed by comma objects.
     type LimitObject o1 m2 a = Map (CommaObject One o1 m2) a
     
     -- | Format a 'LimitObject' to be readable.
     formatLimitObject :: (Eq o1, Eq m2, Eq a, PrettyPrint a) => LimitObject o1 m2 a -> String
-    formatLimitObject mapping = "(" ++ intercalate "," [ (pprint v) | (k,v) <- Map.mapToList mapping] ++ ")"
+    formatLimitObject mapping = "(" ++ intercalate "," [ (pprint maxInt v) | (k,v) <- Map.mapToList mapping] ++ ")"
     
     -- | Format a set of 'LimitObject's to be readable.
     formatSetOfLimitObjects :: (Eq o1, Eq m2, Eq a, PrettyPrint a) => Set (LimitObject o1 m2 a) -> String
@@ -121,7 +124,7 @@     
     -- | Format a 'ColimitObject' to be readable.
     formatColimitObject :: (PrettyPrint a) => ColimitObject o1 m2 a -> String
-    formatColimitObject = pprint.snd.anElement
+    formatColimitObject = (pprint maxInt).snd.anElement
     
     -- | Format a set of 'ColimitObject's to be readable.
     formatSetOfColimitObjects :: (Eq o1, Eq m2, Eq a, PrettyPrint a) => Set (ColimitObject o1 m2 a) -> String
− src/Math/Functors/SetValued/Example.hs 
@@ -1,56 +0,0 @@-{-| Module  : FiniteCategories
-Description : Examples of Kan extensions of set-valued functors pretty printed.
-Copyright   : Guillaume Sabbagh 2023
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-Examples of Kan extensions of set-valued functors pretty printed.
-
-
--}
-module Math.Functors.SetValued.Example
-(
-    main
-)
-where
-    import              Math.FiniteCategory
-    import              Math.IO.PrettyPrint
-    import              Math.FiniteCategories
-    import              Math.Categories.FinSet
-    import              Math.Functors.SetValued
-
-    
-    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.Text                (pack)
-    
-
-    
-    -- | Examples of Kan extensions of set-valued functors pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.Functors.SetValued.Example"
-        let Right c1 = readSCGString "2\nA -f-> B\nC -g-> B\n"
-        putStrLn $ pprintFiniteCategory c1 
-        let Right c2 = readSCGString "2\nA -f-> B\nC -g-> B\nB -h-> C\nA -i-> C\nC -g-> B -h-> C = <ID>\nB -h-> C -g-> B = <ID>\nA -i-> C -g-> B = A -f-> B\nA -f-> B -h-> C = A -i-> C\n"
-        putStrLn $ pprintFiniteCategory c2 
-        let Right f = readSCGDString "<SRC>\n2\nA -f-> B\nC -g-> B\n</SRC>\n<TGT>\n2\nA -f-> B\nC -g-> B\nB -h-> C\nA -i-> C\nC -g-> B -h-> C = <ID>\nB -h-> C -g-> B = <ID>\nA -i-> C -g-> B = A -f-> B\nA -f-> B -h-> C = A -i-> C\n</TGT>\nA -f-> B => A -f-> B\nC -g-> B => C -g-> B\n"
-        putStrLn $ pprint f 
-        let x = completeDiagram Diagram{src=c1,tgt=FinSet,omap=weakMap [(pack "A",set [1 :: Int]),(pack "B",set [2,3]),(pack "C",set [4,5])], mmap= weakMap [(anElement (genAr c1 (pack "A") (pack "B")),Function{function=weakMap [(1,2)], codomain = set [2,3]}),(anElement (genAr c1 (pack "C") (pack "B")),Function{function=weakMap [(4,2),(5,3)], codomain = set [2,3]})]}
-        putStrLn $ pprint (fullDiagram2 x) 
-        let (ran, epsilon) = rightKanSetValued f x
-        putStrLn $ pprint (fullDiagram2 ran) 
-        putStrLn $ pprint (fullDiagram2 ran)
-        putStrLn $ pprint (fullNaturalTransformation2 epsilon)
-        let (lan, eta) = leftKanSetValued f x
-        putStrLn $ pprint (fullDiagram2 lan) 
-        putStrLn $ pprint (fullDiagram2 lan)
-        putStrLn $ pprint (fullNaturalTransformation2 eta) 
-        putStrLn "End of Math.Functors.SetValued.Example"
+ src/Math/Functors/SetValued/Examples.hs view
@@ -0,0 +1,54 @@+{-| Module  : FiniteCategories
+Description : Examples of Kan extensions of set-valued functors.
+Copyright   : Guillaume Sabbagh 2023
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of Kan extensions of set-valued functors.
+
+Kan extensions of set-valued functors are useful for the study of models of linear sketches.
+-}
+module Math.Functors.SetValued.Examples
+(
+    exampleSetValuedLeftKanExtension,
+    exampleSetValuedRightKanExtension,
+)
+where
+    import              Math.FiniteCategory
+    import              Math.IO.PrettyPrint
+    import              Math.FiniteCategories
+    import              Math.Categories.FinSet
+    import              Math.Functors.SetValued
+
+    
+    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.Text                (Text, pack)
+    
+
+    -- | Computes the left Kan extension of a set-valued model to compute the pseudo-inverse of a function.
+    exampleSetValuedLeftKanExtension :: (Diagram (CompositionGraph Text Text) (CGMorphism Text Text) Text (FinSet (ColimitObject Text (CGMorphism Text Text) Int)) (Function (ColimitObject Text (CGMorphism Text Text) Int)) (Set (ColimitObject Text (CGMorphism Text Text) Int)), NaturalTransformation (CompositionGraph Text Text) (CGMorphism Text Text) Text (FinSet (ColimitObject Text (CGMorphism Text Text) Int)) (Function (ColimitObject Text (CGMorphism Text Text) Int)) (Set (ColimitObject Text (CGMorphism Text Text) Int))) 
+    exampleSetValuedLeftKanExtension = (lan,eta)
+        where
+            Right a = readCGString "A -f-> B\n"
+            Right b = readCGString "A -f-> B -g-> A = <ID>\nB -g-> A -f-> B = <ID>\n"
+            Right f = readCGDString "<SRC>\nA -f-> B\n</SRC>\n<TGT>\nA -f-> B -g-> A = <ID>\nB -g-> A -f-> B = <ID>\n</TGT>\nA -f-> B => A -f-> B\n"
+            x = completeDiagram Diagram{src = a, tgt = FinSet, omap = weakMap [], mmap = weakMap [(anElement (ar a (pack "A") (pack "B")),Function{function=weakMap [(1,3),(2,3)], codomain = set [3,4]})]}
+            (lan,eta) = leftKanSetValued f x
+    
+    -- | Computes the right Kan extension of a set-valued model to compute the pseudo-inverse of a function.
+    exampleSetValuedRightKanExtension :: (Diagram (CompositionGraph Text Text) (CGMorphism Text Text) Text (FinSet (LimitObject Text (CGMorphism Text Text) Int)) (Function (LimitObject Text (CGMorphism Text Text) Int)) (Set (LimitObject Text (CGMorphism Text Text) Int)), NaturalTransformation (CompositionGraph Text Text) (CGMorphism Text Text) Text (FinSet (LimitObject Text (CGMorphism Text Text) Int)) (Function (LimitObject Text (CGMorphism Text Text) Int)) (Set (LimitObject Text (CGMorphism Text Text) Int))) 
+    exampleSetValuedRightKanExtension = (ran,epsilon)
+        where
+            Right a = readCGString "A -f-> B\n"
+            Right b = readCGString "A -f-> B -g-> A = <ID>\nB -g-> A -f-> B = <ID>\n"
+            Right f = readCGDString "<SRC>\nA -f-> B\n</SRC>\n<TGT>\nA -f-> B -g-> A = <ID>\nB -g-> A -f-> B = <ID>\n</TGT>\nA -f-> B => A -f-> B\n"
+            x = completeDiagram Diagram{src = a, tgt = FinSet, omap = weakMap [], mmap = weakMap [(anElement (ar a (pack "A") (pack "B")),Function{function=weakMap [(1,3),(2,3)], codomain = set [3,4]})]}
+            (ran,epsilon) = rightKanSetValued f x
− src/Math/Functors/YonedaEmbedding/Example.hs 
@@ -1,32 +0,0 @@-{-| Module  : FiniteCategories
-Description : An example of 'yonedaEmbedding' pretty printed.
-Copyright   : Guillaume Sabbagh 2022
-License     : GPL-3
-Maintainer  : guillaumesabbagh@protonmail.com
-Stability   : experimental
-Portability : portable
-
-An example of  'yonedaEmbedding' pretty printed.
-
-
--}
-module Math.Functors.YonedaEmbedding.Example
-(
-    main
-)
-where
-    import Data.WeakSet         (Set)
-    import Data.WeakSet.Safe
-    
-    import Math.FiniteCategories
-    import Math.Categories
-    import              Math.FiniteCategory
-    import              Math.IO.PrettyPrint
-    
-    -- | 'yonedaEmbedding' pretty printed.
-    main :: IO ()
-    main = do
-        putStrLn "Start of Math.FiniteCategories.YonedaEmbedding.Example"
-        putStrLn $ pprint (fullDiagram.yonedaEmbedding $ Hat) 
-        putStrLn $ pprint (fullDiagram.yonedaEmbedding $ Square) 
-        putStrLn "End of Math.FiniteCategories.YonedaEmbedding.Example"
+ src/Math/Functors/YonedaEmbedding/Examples.hs view
@@ -0,0 +1,29 @@+{-| Module  : FiniteCategories
+Description : Examples of 'yonedaEmbedding'.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of  'yonedaEmbedding'.
+
+
+-}
+module Math.Functors.YonedaEmbedding.Examples
+(
+    exampleYonedaEmbeddingOfHat,
+    exampleYonedaEmbeddingOfSquare,
+)
+where
+    import              Math.FiniteCategories
+    import              Math.Categories
+    
+    
+    -- | The full and faithfull part of the 'yonedaEmbedding' of 'Hat'.
+    exampleYonedaEmbeddingOfHat :: Diagram Hat HatAr HatOb (Subcategory (PresheafCategory Hat HatAr HatOb) (PresheafMorphism Hat HatAr HatOb) (Presheaf Hat HatAr HatOb)) (PresheafMorphism Hat HatAr HatOb) (Presheaf Hat HatAr HatOb)
+    exampleYonedaEmbeddingOfHat = fullDiagram.yonedaEmbedding $ Hat
+    
+    -- | The full and faithfull part of the 'yonedaEmbedding' of 'Square'.
+    exampleYonedaEmbeddingOfSquare :: Diagram Square SquareAr SquareOb (Subcategory (PresheafCategory Square SquareAr SquareOb) (PresheafMorphism Square SquareAr SquareOb) (Presheaf Square SquareAr SquareOb)) (PresheafMorphism Square SquareAr SquareOb) (Presheaf Square SquareAr SquareOb)
+    exampleYonedaEmbeddingOfSquare = fullDiagram.yonedaEmbedding $ Square
src/Math/IO/PrettyPrint.hs view
@@ -1,3 +1,12 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DefaultSignatures#-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+
 {-| Module  : FiniteCategories
 Description : A simple typeclass for things to be pretty printed.
 Copyright   : Guillaume Sabbagh 2022
@@ -6,12 +15,15 @@ Stability   : experimental
 Portability : portable
 
-A simple typeclass for things to be pretty printed. Things should be pretty printable to be exported with graphviz.
+A simple typeclass for things to be pretty printed. Categories objects and arrows should be pretty printable to be exported with graphviz.
 Different objects should be pretty printed into different strings or the graphviz export might be wrong.
 -}
 module Math.IO.PrettyPrint
 (
     PrettyPrint(..),
+    pp,
+    ppi,
+    indentation,
     pprintFunction
 )
 where
@@ -19,53 +31,331 @@     import qualified    Data.Set                                            as Set
     import qualified    Data.WeakSet                                        as WSet
     import qualified    Data.WeakMap                                        as WMap
-    import qualified    Math.PureSet                                        as PSet
     import qualified    Data.Text                                           as Text
+    import              Data.Int
+    import              Data.Word
+    import              Data.Simplifiable
     
+    import              GHC.Generics
+    
     import              Numeric.Natural
     
     -- | The typeclass of things that can be pretty printed.
+    --
+    -- 'pprint' takes a level of verbosity as its first argument from the less verbose 'pprint 0' to the most verbose 'pprint n'.
     class PrettyPrint a where
-        pprint :: a -> String
+        -- | Pretty print an element of type 'a' with a given verbosity level. 0 is the less verbose possible.
+        pprint :: Int -> a -> String
         
-    instance (PrettyPrint a) => PrettyPrint [a] where
-        pprint xs = "[" ++ intercalate "," (pprint <$> xs) ++ "]"
+        -- | Pretty print with a given level of indentation an element of type 'a' with a given verbosity level. See 'pprintIndent' for usage.
+        pprintWithIndentations :: Int -- ^ The current verbosity level
+                     -> Int -- ^ Original verbosity level
+                     -> String -- ^ The indentation used
+                     -> a -- ^ The object to pretty print
+                     -> String
         
+        -- | Pretty print with indentation an element of type 'a' with a given verbosity level.
+        pprintIndent :: Int -> a -> String
+        pprintIndent v a = pprintWithIndentations v v "| " a
+        
+        default pprint :: (Generic a, GPrettyPrint (Rep a)) => Int -> a -> String
+        pprint v a = gpprint v (from a)
+        
+        default pprintWithIndentations :: (Generic a, GPrettyPrint (Rep a)) => Int -> Int -> String -> a -> String
+        pprintWithIndentations cv ov indent a = gpprintWithIndentations cv ov indent (from a)
     
+    -- | PutStrLn composed with pprint. Takes a verbosity level as its first argument.
+    pp :: (PrettyPrint a) => Int -> a -> IO ()
+    pp v a = putStrLn $ pprint v a
+        
+    -- | PutStrLn composed with pprintIndent. Takes a verbosity level as its first argument.
+    ppi :: (PrettyPrint a) => Int -> a -> IO ()
+    ppi v a = putStrLn $ pprintIndent v a
+        
+    -- | Add indentation at the begining of a string.
+    indentation :: Int -> String -> String
+    indentation i s = concat $ replicate i s
+        
+    class GPrettyPrint f where
+        gpprint :: Int -> f a -> String
+        gpprintWithIndentations :: Int -> Int -> String -> f a -> String
+        
+    instance GPrettyPrint U1 where
+        gpprint _ U1 = []
+        gpprintWithIndentations _ _ _ U1 = []
+        
+    instance (GPrettyPrint a, GPrettyPrint b) => GPrettyPrint (a :*: b) where
+        -- gpprint 0 _ = "..."
+        gpprint v (a :*: b) = gpprint v a ++ ", " ++ gpprint v b
+        
+        -- gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        gpprintWithIndentations cv ov indent (a :*: b) = gpprintWithIndentations cv ov indent a ++ gpprintWithIndentations cv ov indent b
+        
+    instance (GPrettyPrint a, GPrettyPrint b) => GPrettyPrint (a :+: b) where
+        -- gpprint 0 _ = "..."
+        gpprint v (L1 a) = gpprint v a
+        gpprint v (R1 b) = gpprint v b
+        
+        -- gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        gpprintWithIndentations cv ov indent (L1 a) = gpprintWithIndentations cv ov indent a
+        gpprintWithIndentations cv ov indent (R1 b) = gpprintWithIndentations cv ov indent b
+        
+        
+    instance (GPrettyPrint a) => GPrettyPrint (S1 c a) where
+        -- gpprint 0 _ = "..."
+        gpprint v (M1 x) = gpprint v x
+        
+        -- gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        gpprintWithIndentations cv ov indent (M1 x) = gpprintWithIndentations cv ov indent x
+        
+    instance (GPrettyPrint a) => GPrettyPrint (D1 c a) where
+        -- gpprint 0 _ = "..."
+        gpprint v (M1 x) = gpprint v x
+        
+        -- gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        gpprintWithIndentations cv ov indent (M1 x) = gpprintWithIndentations cv ov indent x
+    
+    instance (Constructor c, GPrettyPrint a) => GPrettyPrint (C1 c a) where
+        gpprint v c@(M1 x) 
+            | null innerString = conName c
+            | otherwise = conName c ++ "("++ innerString ++")"
+            where
+                innerString = gpprint v x
+        
+        gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        gpprintWithIndentations cv ov indent c@(M1 x)
+            | null innerString = indentation (ov - cv) indent ++ conName c ++ "\n"
+            | otherwise = indentation (ov - cv) indent ++ conName c ++ "\n" ++ innerString
+            where
+                innerString = gpprintWithIndentations cv ov indent x
+
+    instance (PrettyPrint a) => GPrettyPrint (K1 i a) where
+        gpprint 0 _ = "..."
+        gpprint v (K1 x) = pprint (v - 1) x
+        
+        gpprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        gpprintWithIndentations cv ov indent (K1 x) = pprintWithIndentations (cv-1) ov indent x
+        
+        
+        
+        
+        
+        
+    instance (PrettyPrint a) => PrettyPrint [a] where
+        -- pprint 0 _ = "..."
+        pprint v xs = "[" ++ intercalate "," (pprint (v) <$> xs) ++ "]"
+        
+        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent xs = indentation (ov - cv) indent ++ "[\n" ++ intercalate ",\n" (init <$> pprintWithIndentations (cv-1) ov indent  <$> xs) ++ "\n" ++ indentation (ov - cv) indent ++ "]\n"
+        
+    instance (PrettyPrint a) => PrettyPrint (Maybe a) where
+        -- pprint 0 _ = "..."
+        pprint _ Nothing = "Nothing"
+        pprint v (Just x) = pprint v x
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent Nothing = indentation (ov - cv) indent ++ "Nothing\n"
+        pprintWithIndentations cv ov indent (Just x) = pprintWithIndentations cv ov indent x ++ "\n"
+        
+    instance (PrettyPrint a, PrettyPrint b) => PrettyPrint (Either a b) where
+        pprint 0 _ = "..."
+        pprint v (Left a) = pprint v a
+        pprint v (Right a) = pprint v a
+        
+        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent (Left a) = pprintWithIndentations cv ov indent a ++"\n"
+        pprintWithIndentations cv ov indent (Right a) = pprintWithIndentations cv ov indent a ++"\n"
+        
     instance (PrettyPrint a, PrettyPrint b) => PrettyPrint (a,b) where
-        pprint (a,b) = "(" ++ pprint a ++ "," ++ pprint b ++ ")"
+        pprint 0 _ = "..."
+        pprint v (a,b) = "(" ++ pprint (v-1) a ++ "," ++ pprint (v-1) b ++ ")"
+        
+        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent (a,b) = indentation (ov - cv) indent ++ "(\n" ++ init (pprintWithIndentations (cv-1) ov indent a) ++ ",\n" ++ pprintWithIndentations (cv-1) ov indent b ++ indentation (ov - cv) indent ++ ")\n"
     
     instance (PrettyPrint a, PrettyPrint b, PrettyPrint c) => PrettyPrint (a,b,c) where
-        pprint (a,b,c) = "(" ++ pprint a ++ "," ++ pprint b ++ "," ++ pprint c ++ ")"
+        pprint 0 _ = "..."
+        pprint v (a,b,c) = "(" ++ pprint (v-1) a ++ "," ++ pprint (v-1) b ++ "," ++ pprint (v-1) c ++ ")"
         
+        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent (a,b,c) = indentation (ov - cv) indent ++ "(\n" ++ init (pprintWithIndentations (cv-1) ov indent a) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent b) ++ ",\n" ++ pprintWithIndentations (cv-1) ov indent c ++ indentation (ov - cv) indent ++ ")\n"
+        
+    instance (PrettyPrint a, PrettyPrint b, PrettyPrint c, PrettyPrint d) => PrettyPrint (a,b,c,d) where
+        pprint 0 _ = "..."
+        pprint v (a,b,c,d) = "(" ++ pprint (v-1) a ++ "," ++ pprint (v-1) b ++ "," ++ pprint (v-1) c ++ "," ++ pprint (v-1) d ++ ")"
+        
+        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent (a,b,c,d) = indentation (ov - cv) indent ++ "(\n" ++ init (pprintWithIndentations (cv-1) ov indent a) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent b) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent c) ++ ",\n" ++ pprintWithIndentations (cv-1) ov indent d ++ indentation (ov - cv) indent ++ ")\n"
+        
+    instance (PrettyPrint a, PrettyPrint b, PrettyPrint c, PrettyPrint d, PrettyPrint e) => PrettyPrint (a,b,c,d,e) where
+        pprint 0 _ = "..."
+        pprint v (a,b,c,d,e) = "(" ++ pprint (v-1) a ++ "," ++ pprint (v-1) b ++ "," ++ pprint (v-1) c ++","++ pprint (v-1) d ++ "," ++ pprint (v-1) e ++ ")"
+        
+        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent (a,b,c,d,e) = indentation (ov - cv) indent ++ "(\n" ++ init (pprintWithIndentations (cv-1) ov indent a) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent b) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent c) ++ ",\n" ++ init (pprintWithIndentations (cv-1) ov indent d) ++ ",\n" ++ pprintWithIndentations (cv-1) ov indent e ++ indentation (ov - cv) indent ++ ")\n"
+        
     instance (PrettyPrint a) => PrettyPrint (Set.Set a) where
-        pprint xs = "{" ++ intercalate "," (pprint <$> (Set.toList xs)) ++ "}"
+        -- pprint 0 _ = "..."
+        pprint v xs = "{" ++ intercalate "," (pprint (v) <$> (Set.toList xs)) ++ "}"
         
+        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent xs = indentation (ov - cv) indent ++ "{\n" ++ intercalate ",\n" (init <$> pprintWithIndentations (cv-1) ov indent  <$> (Set.toList xs)) ++ "\n" ++ indentation (ov - cv) indent ++ "}\n"
+        
+        
     instance (PrettyPrint a, Eq a) => PrettyPrint (WSet.Set a) where
-        pprint xs = "{" ++ intercalate "," (pprint <$> (WSet.setToList xs)) ++ "}"
+        -- pprint 0 _ = "..."
+        pprint v xs = "{" ++ intercalate "," (pprint (v) <$> (WSet.setToList xs)) ++ "}"
         
+        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent xs = indentation (ov - cv) indent ++ "{\n" ++ intercalate ",\n" (init <$> pprintWithIndentations (cv-1) ov indent  <$> (WSet.setToList xs)) ++ "\n" ++ indentation (ov - cv) indent ++ "}\n"
+        
     instance (PrettyPrint a, Eq a, PrettyPrint b, Eq b) => PrettyPrint (WMap.Map a b) where
-        pprint m = "{" ++ intercalate "," ((\(k,v) -> (pprint k) ++ "->" ++ (pprint v)) <$> (WMap.mapToList m)) ++ "}"
+        -- pprint 0 _ = "..."
+        pprint verbosity m = "{" ++ intercalate "," ((\(k,v) -> (pprint (verbosity) k) ++ "->" ++ (pprint (verbosity) v)) <$> (WMap.mapToList m)) ++ "}"
         
-    instance PrettyPrint PSet.PureSet where
-        pprint = PSet.formatPureSet
+        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent xs = indentation (ov - cv) indent ++ "{\n" ++ intercalate ",\n" (init <$> pprintWithIndentations (cv-1) ov indent  <$> (WMap.mapToList xs)) ++ "\n" ++ indentation (ov - cv) indent ++ "}\n"
         
-    instance PrettyPrint Int where
-        pprint = show
+    instance PrettyPrint Bool where
+        -- pprint 0 = (const "...")
+        pprint _ = show
         
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n"
+        
+    instance PrettyPrint Char where
+        -- pprint 0 = (const "...")
+        pprint _ = (:[])
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ [x] ++ "\n"
+        
     instance PrettyPrint Double where
-        pprint = show
+        -- pprint 0 = (const "...")
+        pprint _ = show
         
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+        
+    instance PrettyPrint Float where
+        -- pprint 0 = (const "...")
+        pprint _ = show
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+        
+    instance PrettyPrint Int where
+        -- pprint 0 = (const "...")
+        pprint _ = show
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+        
+    instance PrettyPrint Int8 where
+        -- pprint 0 = (const "...")
+        pprint _ = show  
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+        
+    instance PrettyPrint Int16 where
+        -- pprint 0 = (const "...")
+        pprint _ = show  
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+        
+    instance PrettyPrint Int32 where
+        -- pprint 0 = (const "...")
+        pprint _ = show  
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+        
+    instance PrettyPrint Int64 where
+        -- pprint 0 = (const "...")
+        pprint _ = show  
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+        
+    instance PrettyPrint Integer where
+        -- pprint 0 = (const "...")
+        pprint _ = show  
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+        
     instance PrettyPrint Natural where
-        pprint = show
+        -- pprint 0 = (const "...")
+        pprint _ = show
         
-    instance PrettyPrint Char where
-        pprint = (:[])
-    
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+            
+    instance PrettyPrint Ordering where
+        -- pprint 0 = (const "...")
+        pprint _ = show
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+            
+    instance PrettyPrint Word where
+        -- pprint 0 = (const "...")
+        pprint _ = show
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+            
+    instance PrettyPrint Word8 where
+        -- pprint 0 = (const "...")
+        pprint _ = show
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+            
+    instance PrettyPrint Word16 where
+        -- pprint 0 = (const "...")
+        pprint _ = show
+        
+        pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+            
+    instance PrettyPrint Word32 where
+        -- pprint 0 = (const "...")
+        pprint _ = show
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+            
+    instance PrettyPrint Word64 where
+        -- pprint 0 = (const "...")
+        pprint _ = show
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+            
+    instance PrettyPrint () where
+        -- pprint 0 = (const "...")
+        pprint _ = show
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+               
     instance PrettyPrint Text.Text where
-        pprint = Text.unpack
+        -- pprint 0 = (const "...")
+        pprint _ = Text.unpack
+        
+        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "...\n"
+        pprintWithIndentations cv ov indent x = indentation (ov - cv) indent ++ show x ++ "\n" 
+        
     
     -- | Pretty print a function on a specific domain.
     pprintFunction :: (PrettyPrint a, PrettyPrint b) =>
-                   (a -> b) -> [a] -> String
-    pprintFunction f xs = intercalate "\n" [pprint x ++" -> " ++ pprint (f x) | x <- xs]
+                   Int -> (a -> b) -> [a] -> String
+    pprintFunction 0 _ _ = "..."
+    pprintFunction v f xs = intercalate "\n" [pprint (v-1) x ++" -> " ++ pprint (v-1) (f x) | x <- xs]
+    
+    
+    instance Simplifiable Text.Text where
+        simplify = id
test/CheckAllFiniteCategories.hs view
@@ -10,13 +10,14 @@ -}
 module CheckAllFiniteCategories
 (
-    main
+    test
 )
 where
     import              Math.FiniteCategory
     import              Math.FiniteCategoryError
     import              Math.Categories
     import              Math.FiniteCategories
+    import              Math.FiniteCategories.Examples
     
     import              Data.WeakSet            (Set)    
     import qualified    Data.WeakSet        as  Set    
@@ -24,7 +25,6 @@     import              Data.WeakMap           (Map)    
     import qualified    Data.WeakMap        as  Map    
     import              Data.WeakMap.Safe
-    import              Math.PureSet
     import              Data.Text               (Text, pack)
     import              Data.Maybe              (fromJust)
     
@@ -41,29 +41,50 @@             Just err = check
     
     -- | Check the structure of every finite categories defined in this package.
-    main = do
+    test = do
             putStrLn "Start of CheckAllFiniteCategories"
-            assert $ V
-            assert $ Hat
-            assert $ Parallel
-            assert $ discreteCategory $ set [1,2,3,4 :: Int]
-            assert $ numberCategory 5
-            assert $ Square
-            assert $ ens.(Set.powerSet).set $ "ABC"
-            assert $ (FullSubcategory FinGrph $ (underlyingGraphFormat id (const.pack $ "")).numberCategory <$> set [0..2] :: FullSubcategory (FinGrph Natural Text) (GraphHomomorphism Natural Text) (Graph Natural Text))
-            assert $ (Op (ens.(Set.powerSet).set $ "ABC"))
-            assert $ (FullSubcategory FinCat (numberCategory <$> (set [0..3])) :: FullSubcategory (FinCat NumberCategory NumberCategoryMorphism Natural) (FinFunctor NumberCategory NumberCategoryMorphism Natural) NumberCategory)
-            assert $ FunctorCategory (numberCategory 2) (numberCategory 4)
-            assert $ (unsafeCompositionGraph (unsafeGraph (set [1 :: Int,2,3]) (set [Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'},Arrow{sourceArrow=1,targetArrow=2,labelArrow='b'},Arrow{sourceArrow=2,targetArrow=3,labelArrow='c'}])) (weakMap [([Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'},Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}],[Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}])]))
-            assert $ (tgt (finiteCategoryToCompositionGraph (ens.(Set.powerSet).set $ "AB")))
-            assert $ (unsafeSafeCompositionGraph (unsafeGraph (set [1 :: Int]) (set [Arrow{sourceArrow=1,targetArrow=1,labelArrow='a'}])) (weakMap []) 3)
-            assert $ fromJust $ sliceCategory (numberCategory 4) 2
-            assert $ fromJust $ cosliceCategory (numberCategory 4) 2
-            assert $ arrowCategory (numberCategory 4)
-            assert $ One
-            let diag = completeDiagram Diagram{src=V,tgt=Square,omap=weakMap [(VA,SquareD),(VB,SquareB),(VC,SquareC)], mmap=weakMap [(VF,SquareH),(VG,SquareI)]}
-            assert $ coneCategory diag
-            let diag2 = completeDiagram Diagram{src=Hat,tgt=Square,omap=weakMap [(HatA,SquareA),(HatB,SquareB),(HatC,SquareC)], mmap=weakMap [(HatF,SquareF),(HatG,SquareG)]}
-            assert $ coconeCategory diag2
-            assert $ (embeddingToSubcategory.yonedaEmbedding $ Square)
+            assert V
+            assert Hat
+            assert Parallel
+            assert Square
+            assert One
+            assert DiscreteTwo
+            assert exampleSlice
+            assert exampleCoslice
+            assert exampleArrowCategory
+            assert exampleCompositionGraph
+            assert $ tgt exampleSetTransformedIntoACompositionGraph
+            assert $ tgt example4TransformedIntoACompositionGraph
+            assert exampleRandomCompositionGraph
+            assert exampleCgString
+            assert exampleCgString2
+            assert exampleConeCategory
+            assert exampleCoconeCategory
+            assert exampleDiscreteCategory0
+            assert exampleDiscreteCategory1
+            assert exampleDiscreteCategory2
+            assert exampleDiscreteCategory3
+            assert exampleDiscreteCategory4
+            assert exampleDiscreteCategory5
+            assert exampleEns
+            assert exampleEns2
+            assert exampleFinCatNumbers
+            assert exampleFinGrph
+            assert exampleFunctorCategory
+            assert examplePrecomposedFunctorCategory
+            assert examplePostcomposedFunctorCategory
+            assert exampleNumberCategory0
+            assert exampleNumberCategory1
+            assert exampleNumberCategory2
+            assert exampleNumberCategory3
+            assert exampleNumberCategory4
+            assert exampleNumberCategory5
+            assert exampleOppositeEns
+            assert exampleOppositeNumberCategory
+            assert exampleSafeCompositionGraph
+            assert exampleLoopingSafeCompositionGraph
+            assert exampleScgString
+            assert exampleRandomSafeCompositionGraph
+            assert exampleLimitCategoryOfCompositionGraphs
+            -- assert $ (embeddingToSubcategory.yonedaEmbedding $ Square)
             putStrLn "End of CheckAllFiniteCategories"
+ test/FiniteCategoryExamples/CommaCategory.hs view
@@ -0,0 +1,27 @@+{-| Module  : FiniteCategories
+Description : Examples of 'CommaCategory' pretty printed.
+Copyright   : Guillaume Sabbagh 2023
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'CommaCategory' pretty printed.
+-}
+module FiniteCategoryExamples.CommaCategory
+(
+    test
+)
+where
+    import Math.FiniteCategory
+    import Math.FiniteCategories.CommaCategory.Examples
+    import Math.IO.PrettyPrint
+    
+    -- | Examples of 'CommaCategory' pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.CommaCategory"
+        putStrLn $ pprintFiniteCategory 2 exampleSlice
+        putStrLn $ pprintFiniteCategory 2 exampleCoslice
+        putStrLn $ pprintFiniteCategory 2 exampleArrowCategory
+        putStrLn "End of FiniteCategoryExamples.CommaCategory"
+ test/FiniteCategoryExamples/CompositionGraph.hs view
@@ -0,0 +1,33 @@+{-| Module  : FiniteCategories
+Description : Examples of 'CompositionGraph' pretty printed.
+Copyright   : Guillaume Sabbagh 2023
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'CompositionGraph's pretty printed.
+-}
+module FiniteCategoryExamples.CompositionGraph
+(
+    test
+)
+where
+    import Math.FiniteCategories.CompositionGraph.Examples
+    import Math.FiniteCategory
+    import Math.FiniteCategories.ConeCategory
+    import Math.IO.PrettyPrint
+    
+    
+    -- | Examples of 'CompositionGraph' pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.CompositionGraph"
+        putStrLn $ pprintFiniteCategory 2 $ exampleCompositionGraph
+        pp 2 exampleSetTransformedIntoACompositionGraph
+        pp 3 example4TransformedIntoACompositionGraph
+        putStrLn $ pprintFiniteCategory 2 $ exampleRandomCompositionGraph
+        putStrLn $ pprintFiniteCategory 2 $ exampleCgString
+        putStrLn $ pprintFiniteCategory 2 $ exampleCgString2
+        putStrLn $ pprintFiniteCategory 2 $ nadir $ exampleColimitOfCompositionGraphs
+        putStrLn "End of FiniteCategoryExamples.CompositionGraph"
+ test/FiniteCategoryExamples/ConeCategory.hs view
@@ -0,0 +1,28 @@+{-| Module  : FiniteCategories
+Description : Examples of 'ConeCategory' pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'ConeCategory' pretty printed.
+-}
+module FiniteCategoryExamples.ConeCategory
+(
+    test
+)
+where
+    import              Math.FiniteCategories.ConeCategory.Examples
+    import              Math.FiniteCategory
+    import              Math.IO.PrettyPrint
+    
+    -- | Examples of 'ConeCategory' pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.ConeCategory"
+        putStrLn $ pprintFiniteCategory 3 exampleConeCategory
+        putStrLn $ pprintFiniteCategory 3 exampleCoconeCategory
+        putStrLn.show $ pprint 2 <$> exampleLimit
+        putStrLn.show $ pprint 2 <$> exampleColimit
+        putStrLn "End of FiniteCategoryExamples.ConeCategory"
+ test/FiniteCategoryExamples/DiscreteCategory.hs view
@@ -0,0 +1,32 @@+{-| Module  : FiniteCategories
+Description : Six examples of 'DiscreteCategory' pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Six examples of 'DiscreteCategory' pretty printed.
+
+Pretty print categories __0__ up to __5__ .
+-}
+module FiniteCategoryExamples.DiscreteCategory
+(
+    test
+)
+where
+    import Math.FiniteCategories.DiscreteCategory.Examples
+    import Math.IO.PrettyPrint
+    import Math.FiniteCategory
+    
+    -- | Six examples of 'DiscreteCategory' pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.DiscreteCategory"
+        putStrLn $ pprintFiniteCategory 1 exampleDiscreteCategory0
+        putStrLn $ pprintFiniteCategory 1 exampleDiscreteCategory1
+        putStrLn $ pprintFiniteCategory 1 exampleDiscreteCategory2
+        putStrLn $ pprintFiniteCategory 1 exampleDiscreteCategory3
+        putStrLn $ pprintFiniteCategory 1 exampleDiscreteCategory4
+        putStrLn $ pprintFiniteCategory 1 exampleDiscreteCategory5
+        putStrLn "End of FiniteCategoryExamples.DiscreteCategory"
+ test/FiniteCategoryExamples/Ens.hs view
@@ -0,0 +1,29 @@+{-| Module  : FiniteCategories
+Description : Examples of  __'Ens'__ pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of  __'Ens'__ pretty printed.
+-}
+module FiniteCategoryExamples.Ens
+(
+    test
+)
+where
+    import Math.FiniteCategories.Ens.Examples
+    import Math.IO.PrettyPrint
+    import Math.FiniteCategory
+    import Math.Categories.ConeCategory
+    
+    -- | __'Ens'__ pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of Math.FiniteCategoryExamples.Ens"
+        putStrLn $ pprintFiniteCategory 2 exampleEns
+        putStrLn $ pprintFiniteCategory 2 exampleEns2
+        pp 2 $ apex $ exampleLimitSet
+        pp 2 $ nadir $ exampleColimitSet
+        putStrLn "End of Math.FiniteCategoryExamples.Ens"
+ test/FiniteCategoryExamples/FinCat.hs view
@@ -0,0 +1,29 @@+{-| Module  : FiniteCategories
+Description : An example of 'FullSubcategory' of __'FinCat'__ pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+An example of 'FullSubcategory' of __'FinCat'__ pretty printed.
+-}
+module FiniteCategoryExamples.FinCat
+(
+    test
+)
+where
+    import Data.WeakSet.Safe
+    
+    import Math.Categories
+    import Math.FiniteCategories.Examples
+    import Math.IO.PrettyPrint
+    import Math.FiniteCategory
+
+    
+    -- | An example of 'FullSubcategory' of __'FinCat'__ pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.FinCat"
+        putStrLn $ pprintFiniteCategory 1 exampleFinCatNumbers
+        putStrLn "End of FiniteCategoryExamples.FinCat"
+ test/FiniteCategoryExamples/FinGrph.hs view
@@ -0,0 +1,29 @@+{-| Module  : FiniteCategories
+Description : An example of 'FullSubcategory' of __'FinGrph'__  and a 'Graph' pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+An example of 'FullSubcategory' of __'FinGrph'__ and a 'Graph' pretty printed.
+
+
+-}
+module FiniteCategoryExamples.FinGrph
+(
+    test
+)
+where
+    import              Math.FiniteCategories.Examples
+    import              Math.IO.PrettyPrint
+    import              Math.FiniteCategory
+    
+    
+    -- | An example of 'FullSubcategory' of __'FinGrph'__ and a 'Graph' pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.FinGrph"
+        pp 1 exampleGraph
+        putStrLn $ pprintFiniteCategory 2 exampleFinGrph
+        putStrLn "End of FiniteCategoryExamples.FinGrph"
+ test/FiniteCategoryExamples/FunctorCategory.hs view
@@ -0,0 +1,32 @@+{-| Module  : FiniteCategories
+Description : Examples of 'FunctorCategory' pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'FunctorCategory' pretty printed.
+
+
+-}
+module FiniteCategoryExamples.FunctorCategory
+(
+    test
+)
+where
+    import Math.FiniteCategories.FunctorCategory.Examples
+    import Math.FiniteCategory
+    import Math.IO.PrettyPrint
+    
+    -- | Examples of 'FunctorCategory' pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.FunctorCategory"
+        putStrLn $  pprintFiniteCategory 2 exampleFunctorCategory
+        putStrLn $  pprint 2 exampleDiagramVToSquare
+        putStrLn $  pprint 2 exampleDiagramHatToSquare
+        putStrLn $  pprintFiniteCategory 2 examplePrecomposedFunctorCategory
+        putStrLn $  pprintFiniteCategory 2 examplePostcomposedFunctorCategory
+        putStrLn $  pprint 2 exampleCgdString
+        putStrLn "End of FiniteCategoryExamples.FunctorCategory"
+ test/FiniteCategoryExamples/LimitCategory.hs view
@@ -0,0 +1,28 @@+{-| Module  : FiniteCategories
+Description : Examples of 'LimitCategory' pretty printed.
+Copyright   : Guillaume Sabbagh 2023
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'LimitCategory' pretty printed.
+-}
+module FiniteCategoryExamples.LimitCategory
+(
+    test
+)
+where
+    import Math.FiniteCategories.LimitCategory.Examples
+    import Math.FiniteCategory
+    import Math.FiniteCategories.ConeCategory
+    import Math.IO.PrettyPrint
+    
+    
+    -- | Examples of 'LimitCategory' pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.LimitCategory"
+        putStrLn $ pprintFiniteCategory 2 $ exampleLimitCategoryOfCompositionGraphs
+        putStrLn $ pprintFiniteCategory 2 $ apex $ exampleLimitOfCompositionGraphs
+        putStrLn "End of FiniteCategoryExamples.LimitCategory"
+ test/FiniteCategoryExamples/NumberCategory.hs view
@@ -0,0 +1,31 @@+{-| Module  : FiniteCategories
+Description : Six examples of 'NumberCategory' pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Six examples of 'NumberCategory' pretty printed. 
+-}
+module FiniteCategoryExamples.NumberCategory
+(
+    test
+)
+where
+    import Math.FiniteCategories.Examples
+    import Math.IO.PrettyPrint
+    import Math.FiniteCategory
+    
+    
+    -- | Six examples of 'NumberCategory' pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.NumberCategory"
+        putStrLn $ pprintFiniteCategory 2 $ exampleNumberCategory0
+        putStrLn $ pprintFiniteCategory 2 $ exampleNumberCategory1
+        putStrLn $ pprintFiniteCategory 2 $ exampleNumberCategory2
+        putStrLn $ pprintFiniteCategory 2 $ exampleNumberCategory3
+        putStrLn $ pprintFiniteCategory 2 $ exampleNumberCategory4
+        putStrLn $ pprintFiniteCategory 2 $ exampleNumberCategory5
+        putStrLn "End of FiniteCategoryExamples.NumberCategory"
+ test/FiniteCategoryExamples/Opposite.hs view
@@ -0,0 +1,29 @@+{-| Module  : FiniteCategories
+Description : Examples of opposite categories pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of opposite categories pretty printed.
+
+
+-}
+module FiniteCategoryExamples.Opposite
+(
+    test
+)
+where
+    import Math.FiniteCategories.Examples
+    import Math.FiniteCategory
+    import Math.IO.PrettyPrint
+    
+    
+    -- | Examples of opposite categories pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.Opposite"
+        putStrLn $  pprintFiniteCategory 2 exampleOppositeEns 
+        putStrLn $  pprintFiniteCategory 3 exampleOppositeNumberCategory 
+        putStrLn "End of FiniteCategoryExamples.Opposite"
+ test/FiniteCategoryExamples/SafeCompositionGraph.hs view
@@ -0,0 +1,30 @@+{-| Module  : FiniteCategories
+Description : Examples of 'SafeCompositionGraph', some are constructed using the smart constructors, others are random and others are read in a .scg file are pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of 'SafeCompositionGraph', some are constructed using the smart constructors, others are random and others are read in a .scg file are pretty printed.
+-}
+module FiniteCategoryExamples.SafeCompositionGraph
+(
+    test
+)
+where
+    import Math.FiniteCategory
+    import Math.Categories
+    import Math.FiniteCategories.Examples
+    
+    import Math.IO.PrettyPrint
+    
+    -- | Examples of 'SafeCompositionGraph', some are constructed using the smart constructors, others are random and others are read in a .scg file are pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FiniteCategoryExamples.SafeCompositionGraph"
+        putStrLn $  pprintFiniteCategory 2 exampleSafeCompositionGraph
+        putStrLn $  pprintFiniteCategory 2 exampleLoopingSafeCompositionGraph
+        putStrLn $  pprintFiniteCategory 2 exampleScgString
+        putStrLn $  pprintFiniteCategory 2 exampleRandomSafeCompositionGraph
+        putStrLn "End of FiniteCategoryExamples.SafeCompositionGraph"
+ test/FunctorExamples/Adjunction.hs view
@@ -0,0 +1,28 @@+{-| Module  : FiniteCategories
+Description : An exemple of 'leftAdjoint' and 'rightAdjoint' use pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+An exemple of 'leftAdjoint' and 'rightAdjoint' use pretty printed.
+
+
+-}
+module FunctorExamples.Adjunction
+(
+    test
+)
+where
+    import              Math.Functors.Examples
+    import              Math.IO.PrettyPrint
+    import              Math.FiniteCategory
+    
+    -- | An exemple of 'leftAdjoint' and 'rightAdjoint' use pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FunctorExamples.Adjunction"
+        pp 5 exampleLeftAdjoint
+        pp 5 exampleRightAdjoint
+        putStrLn "End of FunctorExamples.Adjunction"
+ test/FunctorExamples/DataMigration.hs view
@@ -0,0 +1,27 @@+{-| Module  : FiniteCategories
+Description : Examples of data migration functors pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of data migration functors pretty printed.
+-}
+module FunctorExamples.DataMigration
+(
+    test
+)
+where
+    import              Math.Functors.Examples
+    import              Math.IO.PrettyPrint
+    import              Math.FiniteCategory
+    
+    -- | Examples of data migration functors pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FunctorExamples.DataMigration"
+        pp 3 exampleDeltaFunctor
+        pp 3 examplePiFunctor
+        pp 3 exampleSigmaFunctor
+        putStrLn "End of FunctorExamples.DataMigration"
+ test/FunctorExamples/DiagonalFunctor.hs view
@@ -0,0 +1,27 @@+{-| Module  : FiniteCategories
+Description : An example of a 'diagonalFunctor' pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+An example of 'diagonalFunctor' pretty printed.
+
+
+-}
+module FunctorExamples.DiagonalFunctor
+(
+    test
+)
+where
+    import              Math.Functors.Examples
+    import              Math.IO.PrettyPrint
+    import              Math.FiniteCategory
+    
+    -- | An example of 'diagonalFunctor' pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FunctorExamples.DiagonalFunctor"
+        pp 2 exampleDiagonalFunctor
+        putStrLn "End of FunctorExamples.DiagonalFunctor"
+ test/FunctorExamples/KanExtension.hs view
@@ -0,0 +1,28 @@+{-| Module  : FiniteCategories
+Description : Examples of Kan extensions pretty printed.
+Copyright   : Guillaume Sabbagh 2023
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of Kan extensions pretty printed.
+
+
+-}
+module FunctorExamples.KanExtension
+(
+    test
+)
+where
+    import              Math.FiniteCategory
+    import              Math.Functors.Examples
+    import              Math.IO.PrettyPrint
+    
+    -- | Examples of Kan extensions pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FunctorExamples.KanExtension"
+        pp 2 exampleLeftKanExtension
+        pp 2 exampleRightKanExtension
+        putStrLn "End of FunctorExamples.KanExtension"
+ test/FunctorExamples/SetValued.hs view
@@ -0,0 +1,30 @@+{-| Module  : FiniteCategories
+Description : Examples of Kan extensions of set-valued functors pretty printed.
+Copyright   : Guillaume Sabbagh 2023
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of Kan extensions of set-valued functors pretty printed.
+
+
+-}
+module FunctorExamples.SetValued
+(
+    test
+)
+where
+    import              Math.FiniteCategory
+    import              Math.IO.PrettyPrint
+    import              Math.Functors.Examples
+    
+
+    
+    -- | Examples of Kan extensions of set-valued functors pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FunctorExamples.SetValued"
+        pp 2 exampleSetValuedLeftKanExtension
+        pp 2 exampleSetValuedRightKanExtension
+        putStrLn "End of FunctorExamples.SetValued"
+ test/FunctorExamples/YonedaEmbedding.hs view
@@ -0,0 +1,29 @@+{-| Module  : FiniteCategories
+Description : Examples of 'yonedaEmbedding' pretty printed.
+Copyright   : Guillaume Sabbagh 2022
+License     : GPL-3
+Maintainer  : guillaumesabbagh@protonmail.com
+Stability   : experimental
+Portability : portable
+
+Examples of  'yonedaEmbedding' pretty printed.
+
+
+-}
+module FunctorExamples.YonedaEmbedding
+(
+    test
+)
+where
+    
+    import              Math.FiniteCategory
+    import              Math.Functors.Examples
+    import              Math.IO.PrettyPrint
+    
+    -- | 'yonedaEmbedding's pretty printed.
+    test :: IO ()
+    test = do
+        putStrLn "Start of FunctorExamples.YonedaEmbedding"
+        pp 2 exampleYonedaEmbeddingOfHat
+        pp 2 exampleYonedaEmbeddingOfSquare
+        putStrLn "End of FunctorExamples.YonedaEmbedding"
test/RunAllExamples.hs view
@@ -14,12 +14,64 @@     main
 )
 where
-    import qualified Math.FiniteCategories.Examples     as  FINCAT
-    import qualified Math.Functors.Examples             as  FUNCTORS
-    import qualified CheckAllFiniteCategories           as  CHECK
+    import qualified FiniteCategoryExamples.CommaCategory           as  CommaCategory
+    import qualified FiniteCategoryExamples.CompositionGraph        as  CompositionGraph
+    import qualified FiniteCategoryExamples.ConeCategory            as  ConeCategory
+    import qualified FiniteCategoryExamples.DiscreteCategory        as  DiscreteCategory
+    import qualified FiniteCategoryExamples.Ens                     as  Ens
+    import qualified FiniteCategoryExamples.FinCat                  as  FinCat
+    import qualified FiniteCategoryExamples.FinGrph                 as  FinGrph
+    import qualified FiniteCategoryExamples.FunctorCategory         as  FunctorCategory
+    import qualified FiniteCategoryExamples.LimitCategory           as  LimitCategory
+    import qualified FiniteCategoryExamples.NumberCategory          as  NumberCategory
+    import qualified FiniteCategoryExamples.Opposite                as  Opposite
+    import qualified FiniteCategoryExamples.SafeCompositionGraph    as  SafeCompositionGraph
+    import qualified FunctorExamples.Adjunction                     as  Adjunction
+    import qualified FunctorExamples.DataMigration                  as  DataMigration
+    import qualified FunctorExamples.DiagonalFunctor                as  DiagonalFunctor
+    import qualified FunctorExamples.KanExtension                   as  KanExtension
+    import qualified FunctorExamples.SetValued                      as  SetValued
+    import qualified FunctorExamples.YonedaEmbedding                as  YonedaEmbedding
+    import qualified CheckAllFiniteCategories                       as  CHECK
     
     -- | Run all examples of the project. See results in the folder OutputGraphViz.
     main = do
-        FUNCTORS.main
-        FINCAT.main
-        CHECK.main+        let spacing = 5
+        let printSpacing = putStrLn $ take spacing (repeat '\n')
+        CommaCategory.test
+        printSpacing
+        CompositionGraph.test
+        printSpacing
+        ConeCategory.test
+        printSpacing
+        DiscreteCategory.test
+        printSpacing
+        Ens.test
+        printSpacing
+        FinCat.test
+        printSpacing
+        FunctorCategory.test
+        printSpacing
+        FinGrph.test
+        printSpacing
+        LimitCategory.test
+        printSpacing
+        NumberCategory.test
+        printSpacing
+        Opposite.test
+        printSpacing
+        SafeCompositionGraph.test
+        printSpacing
+        Adjunction.test
+        printSpacing
+        DataMigration.test
+        printSpacing
+        DiagonalFunctor.test
+        printSpacing
+        KanExtension.test
+        printSpacing
+        SetValued.test
+        printSpacing
+        YonedaEmbedding.test
+        printSpacing
+        CHECK.test