{-# LANGUAGE MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : The __2__ category contains two object `A` and `B` and a morphism @`F` : `A` -> `B`@.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The __2__ category contains two object `A` and `B` and a morphism @f : `A` -> `B`@ (and of course two identities).
-}

module UsualCategories.Two 
(
    TwoOb(..),
    TwoAr(..),
    Two(..)
)
where
    import          FiniteCategory.FiniteCategory
    import          IO.PrettyPrint
    
    -- | Object of the __2__ category.

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

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

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