{-# LANGUAGE MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : The Hat category contains two arrows coming from the same object.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The Hat category contains two arrows coming from the same object.
-}

module UsualCategories.Hat
(
    HatOb(..),
    HatAr(..),
    Hat(..)
)
where
    import          FiniteCategory.FiniteCategory
    import          IO.PrettyPrint
    
    -- | Object of the Hat category.

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

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

    data Hat = Hat deriving (Hat -> Hat -> Bool
(Hat -> Hat -> Bool) -> (Hat -> Hat -> Bool) -> Eq Hat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hat -> Hat -> Bool
$c/= :: Hat -> Hat -> Bool
== :: Hat -> Hat -> Bool
$c== :: Hat -> Hat -> Bool
Eq, Int -> Hat -> ShowS
[Hat] -> ShowS
Hat -> String
(Int -> Hat -> ShowS)
-> (Hat -> String) -> ([Hat] -> ShowS) -> Show Hat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hat] -> ShowS
$cshowList :: [Hat] -> ShowS
show :: Hat -> String
$cshow :: Hat -> String
showsPrec :: Int -> Hat -> ShowS
$cshowsPrec :: Int -> Hat -> ShowS
Show)
    
    instance Morphism HatAr HatOb where
        source :: HatAr -> HatOb
source HatAr
IdA = HatOb
A
        source HatAr
IdB = HatOb
B
        source HatAr
IdC = HatOb
C
        source HatAr
_ = HatOb
A
        target :: HatAr -> HatOb
target HatAr
IdA = HatOb
A
        target HatAr
IdB = HatOb
B
        target HatAr
IdC = HatOb
C
        target HatAr
F = HatOb
B
        target HatAr
G = HatOb
C
        @ :: HatAr -> HatAr -> HatAr
(@) HatAr
IdA HatAr
IdA = HatAr
IdA
        (@) HatAr
F HatAr
IdA = HatAr
F
        (@) HatAr
G HatAr
IdA = HatAr
G
        (@) HatAr
IdB HatAr
IdB = HatAr
IdB
        (@) HatAr
IdC HatAr
IdC = HatAr
IdC
        (@) HatAr
IdB HatAr
F = HatAr
F
        (@) HatAr
IdC HatAr
G = HatAr
G
    
    instance FiniteCategory Hat HatAr HatOb where
        ob :: Hat -> [HatOb]
ob = [HatOb] -> Hat -> [HatOb]
forall a b. a -> b -> a
const [HatOb
A,HatOb
B,HatOb
C]
        identity :: Morphism HatAr HatOb => Hat -> HatOb -> HatAr
identity Hat
_ HatOb
A = HatAr
IdA
        identity Hat
_ HatOb
B = HatAr
IdB
        identity Hat
_ HatOb
C = HatAr
IdC
        ar :: Morphism HatAr HatOb => Hat -> HatOb -> HatOb -> [HatAr]
ar Hat
_ HatOb
A HatOb
A = [HatAr
IdA]
        ar Hat
_ HatOb
B HatOb
B = [HatAr
IdB]
        ar Hat
_ HatOb
C HatOb
C = [HatAr
IdC]
        ar Hat
_ HatOb
A HatOb
B = [HatAr
F]
        ar Hat
_ HatOb
A HatOb
C = [HatAr
G]
        ar Hat
_ HatOb
_ HatOb
_ = []
        
    instance GeneratedFiniteCategory Hat HatAr HatOb where
        genAr :: Morphism HatAr HatOb => Hat -> HatOb -> HatOb -> [HatAr]
genAr = Hat -> HatOb -> HatOb -> [HatAr]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
defaultGenAr
        decompose :: Morphism HatAr HatOb => Hat -> HatAr -> [HatAr]
decompose = Hat -> HatAr -> [HatAr]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> m -> [m]
defaultDecompose
        
    instance PrettyPrintable HatOb where
        pprint :: HatOb -> String
pprint = HatOb -> String
forall a. Show a => a -> String
show
        
    instance PrettyPrintable HatAr where
        pprint :: HatAr -> String
pprint = HatAr -> String
forall a. Show a => a -> String
show
    
    instance PrettyPrintable Hat where
        pprint :: Hat -> String
pprint = Hat -> String
forall a. Show a => a -> String
show