{-# LANGUAGE MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : The __3__ category contains three object `A`, `B` and `C` and three morphisms @`F` : `A` -> `B`@, @`G` : `B` -> `C`@, @`G`*`F` : `A` -> `C`@.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The __3__ category contains three object `A`, `B` and `C` and three morphisms @`F` : `A` -> `B`@, @`G` : `B` -> `C`@, @`G`*`F` : `A` -> `C`@ (and of course three identities).
-}

module UsualCategories.Three 
(
    ThreeOb(..),
    ThreeAr(..),
    Three(..)
)
where
    import          FiniteCategory.FiniteCategory
    import          IO.PrettyPrint
    
    -- | Object of the __3__ category.

    data ThreeOb = A | B | C deriving (ThreeOb -> ThreeOb -> Bool
(ThreeOb -> ThreeOb -> Bool)
-> (ThreeOb -> ThreeOb -> Bool) -> Eq ThreeOb
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreeOb -> ThreeOb -> Bool
$c/= :: ThreeOb -> ThreeOb -> Bool
== :: ThreeOb -> ThreeOb -> Bool
$c== :: ThreeOb -> ThreeOb -> Bool
Eq, Int -> ThreeOb -> ShowS
[ThreeOb] -> ShowS
ThreeOb -> String
(Int -> ThreeOb -> ShowS)
-> (ThreeOb -> String) -> ([ThreeOb] -> ShowS) -> Show ThreeOb
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreeOb] -> ShowS
$cshowList :: [ThreeOb] -> ShowS
show :: ThreeOb -> String
$cshow :: ThreeOb -> String
showsPrec :: Int -> ThreeOb -> ShowS
$cshowsPrec :: Int -> ThreeOb -> ShowS
Show)
    
    -- | Morphism of the __3__ category.

    data ThreeAr = IdA | IdB | IdC | F | G | GF deriving (ThreeAr -> ThreeAr -> Bool
(ThreeAr -> ThreeAr -> Bool)
-> (ThreeAr -> ThreeAr -> Bool) -> Eq ThreeAr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreeAr -> ThreeAr -> Bool
$c/= :: ThreeAr -> ThreeAr -> Bool
== :: ThreeAr -> ThreeAr -> Bool
$c== :: ThreeAr -> ThreeAr -> Bool
Eq,Int -> ThreeAr -> ShowS
[ThreeAr] -> ShowS
ThreeAr -> String
(Int -> ThreeAr -> ShowS)
-> (ThreeAr -> String) -> ([ThreeAr] -> ShowS) -> Show ThreeAr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreeAr] -> ShowS
$cshowList :: [ThreeAr] -> ShowS
show :: ThreeAr -> String
$cshow :: ThreeAr -> String
showsPrec :: Int -> ThreeAr -> ShowS
$cshowsPrec :: Int -> ThreeAr -> ShowS
Show)
    
    -- | The __3__ category.

    data Three = Three deriving (Three -> Three -> Bool
(Three -> Three -> Bool) -> (Three -> Three -> Bool) -> Eq Three
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Three -> Three -> Bool
$c/= :: Three -> Three -> Bool
== :: Three -> Three -> Bool
$c== :: Three -> Three -> Bool
Eq,Int -> Three -> ShowS
[Three] -> ShowS
Three -> String
(Int -> Three -> ShowS)
-> (Three -> String) -> ([Three] -> ShowS) -> Show Three
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Three] -> ShowS
$cshowList :: [Three] -> ShowS
show :: Three -> String
$cshow :: Three -> String
showsPrec :: Int -> Three -> ShowS
$cshowsPrec :: Int -> Three -> ShowS
Show)
    
    instance Morphism ThreeAr ThreeOb where
        source :: ThreeAr -> ThreeOb
source ThreeAr
IdA = ThreeOb
A
        source ThreeAr
IdB = ThreeOb
B
        source ThreeAr
IdC = ThreeOb
C
        source ThreeAr
F = ThreeOb
A
        source ThreeAr
G = ThreeOb
B
        source ThreeAr
GF = ThreeOb
A
        target :: ThreeAr -> ThreeOb
target ThreeAr
IdA = ThreeOb
A
        target ThreeAr
IdB = ThreeOb
B
        target ThreeAr
IdC = ThreeOb
C
        target ThreeAr
F = ThreeOb
B
        target ThreeAr
G = ThreeOb
C
        target ThreeAr
GF = ThreeOb
C
        @ :: ThreeAr -> ThreeAr -> ThreeAr
(@) ThreeAr
IdA ThreeAr
IdA = ThreeAr
IdA
        (@) ThreeAr
F ThreeAr
IdA = ThreeAr
F
        (@) ThreeAr
GF ThreeAr
IdA = ThreeAr
GF
        (@) ThreeAr
IdB ThreeAr
IdB = ThreeAr
IdB
        (@) ThreeAr
G ThreeAr
IdB = ThreeAr
G
        (@) ThreeAr
IdC ThreeAr
IdC = ThreeAr
IdC
        (@) ThreeAr
IdB ThreeAr
F = ThreeAr
F
        (@) ThreeAr
G ThreeAr
F = ThreeAr
GF
        (@) ThreeAr
IdC ThreeAr
G = ThreeAr
G
        (@) ThreeAr
IdC ThreeAr
GF = ThreeAr
GF
        (@) ThreeAr
x ThreeAr
y = String -> ThreeAr
forall a. HasCallStack => String -> a
error (String
"Invalid composition of ThreeMorph : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ThreeAr -> String
forall a. Show a => a -> String
show ThreeAr
xString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" * "String -> ShowS
forall a. [a] -> [a] -> [a]
++ThreeAr -> String
forall a. Show a => a -> String
show ThreeAr
y)
    
    instance FiniteCategory Three ThreeAr ThreeOb where
        ob :: Three -> [ThreeOb]
ob = [ThreeOb] -> Three -> [ThreeOb]
forall a b. a -> b -> a
const [ThreeOb
A,ThreeOb
B,ThreeOb
C]
        identity :: Morphism ThreeAr ThreeOb => Three -> ThreeOb -> ThreeAr
identity Three
_ ThreeOb
A = ThreeAr
IdA
        identity Three
_ ThreeOb
B = ThreeAr
IdB
        identity Three
_ ThreeOb
C = ThreeAr
IdC
        ar :: Morphism ThreeAr ThreeOb =>
Three -> ThreeOb -> ThreeOb -> [ThreeAr]
ar Three
_ ThreeOb
A ThreeOb
A = [ThreeAr
IdA]
        ar Three
_ ThreeOb
A ThreeOb
B = [ThreeAr
F]
        ar Three
_ ThreeOb
A ThreeOb
C = [ThreeAr
GF]
        ar Three
_ ThreeOb
B ThreeOb
B = [ThreeAr
IdB]
        ar Three
_ ThreeOb
B ThreeOb
C = [ThreeAr
G]
        ar Three
_ ThreeOb
C ThreeOb
C = [ThreeAr
IdC]
        ar Three
_ ThreeOb
_ ThreeOb
_ = []
        
    instance GeneratedFiniteCategory Three ThreeAr ThreeOb where
        genAr :: Morphism ThreeAr ThreeOb =>
Three -> ThreeOb -> ThreeOb -> [ThreeAr]
genAr Three
_ ThreeOb
A ThreeOb
C = []
        genAr Three
c ThreeOb
x ThreeOb
y = Three -> ThreeOb -> ThreeOb -> [ThreeAr]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
defaultGenAr Three
c ThreeOb
x ThreeOb
y
        decompose :: Morphism ThreeAr ThreeOb => Three -> ThreeAr -> [ThreeAr]
decompose Three
_ ThreeAr
GF = [ThreeAr
G,ThreeAr
F]
        decompose Three
c ThreeAr
m = Three -> ThreeAr -> [ThreeAr]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> m -> [m]
defaultDecompose Three
c ThreeAr
m
        
    instance PrettyPrintable ThreeOb where
        pprint :: ThreeOb -> String
pprint = ThreeOb -> String
forall a. Show a => a -> String
show
        
    instance PrettyPrintable ThreeAr where
        pprint :: ThreeAr -> String
pprint = ThreeAr -> String
forall a. Show a => a -> String
show
    
    instance PrettyPrintable Three where
        pprint :: Three -> String
pprint = Three -> String
forall a. Show a => a -> String
show