Hat.hs

{-# 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 (Eq, Show)
    
    -- | Morphism of the Hat category.
    data HatAr = IdA | IdB | IdC | F | G deriving (Eq, Show)
    
    -- | The Hat category.
    data Hat = Hat deriving (Eq, Show)
    
    instance Morphism HatAr HatOb where
        source IdA = A
        source IdB = B
        source IdC = C
        source _ = A
        target IdA = A
        target IdB = B
        target IdC = C
        target F = B
        target G = C
        (@) IdA IdA = IdA
        (@) F IdA = F
        (@) G IdA = G
        (@) IdB IdB = IdB
        (@) IdC IdC = IdC
        (@) IdB F = F
        (@) IdC G = G
    
    instance FiniteCategory Hat HatAr HatOb where
        ob = const [A,B,C]
        identity _ A = IdA
        identity _ B = IdB
        identity _ C = IdC
        ar _ A A = [IdA]
        ar _ B B = [IdB]
        ar _ C C = [IdC]
        ar _ A B = [F]
        ar _ A C = [G]
        ar _ _ _ = []
        
    instance GeneratedFiniteCategory Hat HatAr HatOb where
        genAr = defaultGenAr
        decompose = defaultDecompose
        
    instance PrettyPrintable HatOb where
        pprint = show
        
    instance PrettyPrintable HatAr where
        pprint = show
    
    instance PrettyPrintable Hat where
        pprint = show