Square.hs

{-# LANGUAGE MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : The square category contains 4 generating arrows forming a square.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The square category contains 4 generating arrows forming a square.
-}

module UsualCategories.Square
(
    SquareOb(..),
    SquareAr(..),
    Square(..)
)
where
    import          FiniteCategory.FiniteCategory
    import          IO.PrettyPrint
    
    -- | Object of the Square category.
    data SquareOb = A | B | C | D deriving (Eq, Show)
    
    -- | Morphism of the Square category.
    data SquareAr = IdA | IdB | IdC | IdD | F | G | H | I | FH | GI deriving (Eq, Show)
    
    -- | The Square category.
    data Square = Square deriving (Eq, Show)
    
    instance Morphism SquareAr SquareOb where
        source IdA = A
        source IdB = B
        source IdC = C
        source IdD = D
        source F = A
        source G = A
        source H = B
        source I = C
        source FH = A
        source GI = A
        target IdA = A
        target IdB = B
        target IdC = C
        target IdD = D
        target F = B
        target G = C
        target H = D
        target I = D
        target FH = D
        target GI = D
        (@) IdA IdA = IdA
        (@) F IdA = F
        (@) G IdA = G
        (@) FH IdA = FH
        (@) GI IdA = GI
        (@) IdB IdB = IdB
        (@) H IdB = H
        (@) IdC IdC = IdC
        (@) I IdC = I
        (@) IdD IdD = IdD
        (@) IdB F = F
        (@) H F = FH
        (@) IdC G = G
        (@) I G = GI
        (@) IdD H = H
        (@) IdD I = I
        (@) IdD FH = FH
        (@) IdD GI = GI
        
    instance FiniteCategory Square SquareAr SquareOb where
        ob = const [A,B,C,D]
        identity _ A = IdA
        identity _ B = IdB
        identity _ C = IdC
        identity _ D = IdD
        ar _ A A = [IdA]
        ar _ A B = [F]
        ar _ A C = [G]
        ar _ A D = [FH,GI]
        ar _ B B = [IdB]
        ar _ B D = [H]
        ar _ C C = [IdC]
        ar _ C D = [I]
        ar _ D D = [IdD]
        ar _ _ _ = []
        
    instance GeneratedFiniteCategory Square SquareAr SquareOb where
        genAr = defaultGenAr
        decompose = defaultDecompose
        
    instance PrettyPrintable SquareOb where
        pprint = show
        
    instance PrettyPrintable SquareAr where
        pprint = show
    
    instance PrettyPrintable Square where
        pprint = show