Three.hs

{-# 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 (Eq, Show)
    
    -- | Morphism of the __3__ category.
    data ThreeAr = IdA | IdB | IdC | F | G | GF deriving (Eq,Show)
    
    -- | The __3__ category.
    data Three = Three deriving (Eq,Show)
    
    instance Morphism ThreeAr ThreeOb where
        source IdA = A
        source IdB = B
        source IdC = C
        source F = A
        source G = B
        source GF = A
        target IdA = A
        target IdB = B
        target IdC = C
        target F = B
        target G = C
        target GF = C
        (@) IdA IdA = IdA
        (@) F IdA = F
        (@) GF IdA = GF
        (@) IdB IdB = IdB
        (@) G IdB = G
        (@) IdC IdC = IdC
        (@) IdB F = F
        (@) G F = GF
        (@) IdC G = G
        (@) IdC GF = GF
        (@) x y = error ("Invalid composition of ThreeMorph : "++show x++" * "++show y)
    
    instance FiniteCategory Three ThreeAr ThreeOb where
        ob = const [A,B,C]
        identity _ A = IdA
        identity _ B = IdB
        identity _ C = IdC
        ar _ A A = [IdA]
        ar _ A B = [F]
        ar _ A C = [GF]
        ar _ B B = [IdB]
        ar _ B C = [G]
        ar _ C C = [IdC]
        ar _ _ _ = []
        
    instance GeneratedFiniteCategory Three ThreeAr ThreeOb where
        genAr _ A C = []
        genAr c x y = defaultGenAr c x y
        decompose _ GF = [G,F]
        decompose c m = defaultDecompose c m
        
    instance PrettyPrintable ThreeOb where
        pprint = show
        
    instance PrettyPrintable ThreeAr where
        pprint = show
    
    instance PrettyPrintable Three where
        pprint = show