{-# 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'__.
Copyright   : Guillaume Sabbagh 2022
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The __FinCat__ category has as objects finite categories and as morphisms homogeneous functors between them.

Functors must be homogeneous because otherwise we would not be able to compose them with the 'Morphism' typeclass.

The 'FinCat' datatype should not be confused with the `FiniteCategory` typeclass. The `FiniteCategory` typeclass describes axioms a structure should follow to be considered a finite category. The 'FinCat' type is itself a 'Category'.

A 'FinFunctor' is a 'Diagram' where the source and target category are the same. The source category of a 'FinFunctor' should be finite.
-}

module Math.Categories.FinCat
(
    -- * Homogeneous functor

    FinFunctor(..),
    -- * __FinCat__

    FinCat(..)
)
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.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)

    -- prop> funct ->$ (target f) == target (funct ->£ f)

    -- prop> funct ->£ (f @ g) = (funct ->£ f) @ (funct ->£ g)

    -- prop> funct ->£ (identity a) = identity (funct ->$ a)

    --

    -- A 'FinFunctor' is a type of 'Diagram'.

    --

    -- It is meant to be a morphism between categories within __`FinCat`__, it is homogeneous, the type of the source category must be the same as the type of the target category.

    --

    -- See 'Diagram' in Math.Categories.FunctorCategory for heterogeneous ones.

    type FinFunctor c m o = Diagram c m o c m o
    
    instance (Category c m o, Morphism m o, Eq m, Eq o) => Morphism (FinFunctor c m o) c where
        @ :: FinFunctor c m o -> FinFunctor c m o -> FinFunctor c m o
(@) FinFunctor c m o
d2 FinFunctor c m o
d1 = FinFunctor c m o
d2 FinFunctor c m o -> FinFunctor c m o -> FinFunctor c m o
forall c1 m1 o1 c2 m2 o2 m3 o3 c3.
(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
<-@<- FinFunctor c m o
d1
        source :: FinFunctor c m o -> c
source = FinFunctor c m o -> c
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src
        target :: FinFunctor c m o -> c
target = FinFunctor c m o -> c
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt
          
    -- | The __'FinCat'__ category has as objects finite categories and as morphisms homogeneous functors between them.

    data FinCat c m o = FinCat deriving (FinCat c m o -> FinCat c m o -> Bool
(FinCat c m o -> FinCat c m o -> Bool)
-> (FinCat c m o -> FinCat c m o -> Bool) -> Eq (FinCat c m o)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c m o. FinCat c m o -> FinCat c m o -> Bool
$c== :: forall c m o. FinCat c m o -> FinCat c m o -> Bool
== :: FinCat c m o -> FinCat c m o -> Bool
$c/= :: forall c m o. FinCat c m o -> FinCat c m o -> Bool
/= :: FinCat c m o -> FinCat c m o -> Bool
Eq, Int -> FinCat c m o -> ShowS
[FinCat c m o] -> ShowS
FinCat c m o -> String
(Int -> FinCat c m o -> ShowS)
-> (FinCat c m o -> String)
-> ([FinCat c m o] -> ShowS)
-> Show (FinCat c m o)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c m o. Int -> FinCat c m o -> ShowS
forall c m o. [FinCat c m o] -> ShowS
forall c m o. FinCat c m o -> String
$cshowsPrec :: forall c m o. Int -> FinCat c m o -> ShowS
showsPrec :: Int -> FinCat c m o -> ShowS
$cshow :: forall c m o. FinCat c m o -> String
show :: FinCat c m o -> String
$cshowList :: forall c m o. [FinCat c m o] -> ShowS
showList :: [FinCat c m o] -> ShowS
Show, (forall x. FinCat c m o -> Rep (FinCat c m o) x)
-> (forall x. Rep (FinCat c m o) x -> FinCat c m o)
-> Generic (FinCat c m o)
forall x. Rep (FinCat c m o) x -> FinCat c m o
forall x. FinCat c m o -> Rep (FinCat c m o) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c m o x. Rep (FinCat c m o) x -> FinCat c m o
forall c m o x. FinCat c m o -> Rep (FinCat c m o) x
$cfrom :: forall c m o x. FinCat c m o -> Rep (FinCat c m o) x
from :: forall x. FinCat c m o -> Rep (FinCat c m o) x
$cto :: forall c m o x. Rep (FinCat c m o) x -> FinCat c m o
to :: forall x. Rep (FinCat c m o) x -> FinCat c m o
Generic, Int -> Int -> String -> FinCat c m o -> String
Int -> FinCat c m o -> String
(Int -> FinCat c m o -> String)
-> (Int -> Int -> String -> FinCat c m o -> String)
-> (Int -> FinCat c m o -> String)
-> PrettyPrint (FinCat c m o)
forall a.
(Int -> a -> String)
-> (Int -> Int -> String -> a -> String)
-> (Int -> a -> String)
-> PrettyPrint a
forall c m o. Int -> Int -> String -> FinCat c m o -> String
forall c m o. Int -> FinCat c m o -> String
$cpprint :: forall c m o. Int -> FinCat c m o -> String
pprint :: Int -> FinCat c m o -> String
$cpprintWithIndentations :: forall c m o. Int -> Int -> String -> FinCat c m o -> String
pprintWithIndentations :: Int -> Int -> String -> FinCat c m o -> String
$cpprintIndent :: forall c m o. Int -> FinCat c m o -> String
pprintIndent :: Int -> FinCat c m o -> String
PrettyPrint, FinCat c m o -> FinCat c m o
(FinCat c m o -> FinCat c m o) -> Simplifiable (FinCat c m o)
forall a. (a -> a) -> Simplifiable a
forall c m o. FinCat c m o -> FinCat c m o
$csimplify :: forall c m o. FinCat c m o -> FinCat c m o
simplify :: FinCat c m o -> FinCat c m o
Simplifiable)
    
    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 :: Morphism (FinFunctor c m o) c =>
FinCat c m o -> c -> FinFunctor c m o
identity FinCat c m o
_ c
cat = Diagram{src :: c
src=c
cat,tgt :: c
tgt=c
cat,omap :: Map o o
omap=(o -> o) -> Set o -> Map o o
forall k v. (k -> v) -> Set k -> Map k v
memorizeFunction o -> o
forall a. a -> a
id (c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
cat),mmap :: Map m m
mmap=(m -> m) -> Set m -> Map m m
forall k v. (k -> v) -> Set k -> Map k v
memorizeFunction m -> m
forall a. a -> a
id (c -> Set m
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
genArrows c
cat)}
        ar :: Morphism (FinFunctor c m o) c =>
FinCat c m o -> c -> c -> Set (FinFunctor c m o)
ar FinCat c m o
_ c
s c
t = (Set (DiagramError c m o c m o), Set (FinFunctor c m o))
-> Set (FinFunctor c m o)
forall a b. (a, b) -> b
snd((Set (DiagramError c m o c m o), Set (FinFunctor c m o))
 -> Set (FinFunctor c m o))
-> (Set (Either (DiagramError c m o c m o) (FinFunctor c m o))
    -> (Set (DiagramError c m o c m o), Set (FinFunctor c m o)))
-> Set (Either (DiagramError c m o c m o) (FinFunctor c m o))
-> Set (FinFunctor c m o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set (Either (DiagramError c m o c m o) (FinFunctor c m o))
-> (Set (DiagramError c m o c m o), Set (FinFunctor c m o))
forall a b. Set (Either a b) -> (Set a, Set b)
Set.catEither) (Set (Either (DiagramError c m o c m o) (FinFunctor c m o))
 -> Set (FinFunctor c m o))
-> Set (Either (DiagramError c m o c m o) (FinFunctor c m o))
-> Set (FinFunctor c m o)
forall a b. (a -> b) -> a -> b
$ [c
-> c
-> Map o o
-> Map m m
-> Either (DiagramError c m o c m o) (FinFunctor c m o)
forall c1 m1 o1 c2 m2 o2.
(FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
 FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2) =>
c1
-> c2
-> Map o1 o2
-> Map m1 m2
-> Either
     (DiagramError c1 m1 o1 c2 m2 o2) (Diagram c1 m1 o1 c2 m2 o2)
diagram c
s c
t Map o o
appO Map m m
appF | Map o o
appO <- Set (Map o o)
appObj, Map m m
appF <- ((([Map m m] -> Map m m) -> Set [Map m m] -> Set (Map m m)
forall a b. (a -> b) -> Set a -> Set b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Map m m] -> Map m m) -> Set [Map m m] -> Set (Map m m))
-> ([Map m m] -> Map m m) -> Set [Map m m] -> Set (Map m m)
forall a b. (a -> b) -> a -> b
$ ([Map m m] -> Map m m
forall k a. Eq k => [Map k a] -> Map k a
Map.unions))(Set [Map m m] -> Set (Map m m))
-> ([Set (Map m m)] -> Set [Map m m])
-> [Set (Map m m)]
-> Set (Map m m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Set (Map m m)] -> Set [Map m m]
forall (m :: * -> *) a.
(Monoid (m a), Monad m, Foldable m, Eq a) =>
m (Set a) -> Set (m a)
cartesianProductOfSets) [o -> o -> Map o o -> Set (Map m m)
twoObjToMaps o
a o
b Map o o
appO| o
a <- (Set o -> [o]
forall a. Eq a => Set a -> [a]
setToList (Set o -> [o]) -> Set o -> [o]
forall a b. (a -> b) -> a -> b
$ c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
s), o
b <- (Set o -> [o]
forall a. Eq a => Set a -> [a]
setToList (Set o -> [o]) -> Set o -> [o]
forall a b. (a -> b) -> a -> b
$ c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
s)]]
            where
                appObj :: Set (Map o o)
appObj = Set o -> Set o -> Set (Map o o)
forall a b. (Eq a, Eq b) => Set a -> Set b -> Set (Map a b)
Map.enumerateMaps (c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
s) (c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
t)
                twoObjToMaps :: o -> o -> Map o o -> Set (Map m m)
twoObjToMaps o
a o
b Map o o
appO = Set m -> Set m -> Set (Map m m)
forall a b. (Eq a, Eq b) => Set a -> Set b -> Set (Map a b)
Map.enumerateMaps (c -> o -> o -> Set m
forall c m o.
(Category c m o, Morphism m o) =>
c -> o -> o -> Set m
ar c
s o
a o
b) (c -> o -> o -> Set m
forall c m o.
(Category c m o, Morphism m o) =>
c -> o -> o -> Set m
ar c
t (Map o o
appO Map o o -> o -> o
forall k v. Eq k => Map k v -> k -> v
|!| o
a) (Map o o
appO Map o o -> o -> o
forall k v. Eq k => Map k v -> k -> v
|!| o
b))