{-# LANGUAGE MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : The __'Square'__ category contains 4 generating arrows forming a square. It has 6 non identity arrows.
Copyright   : Guillaume Sabbagh 2022
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The __'Square'__ category contains 4 generating arrows forming a square. It has 6 non identity arrows.
-}

module Math.FiniteCategories.Square
(
    SquareOb(..),
    SquareAr(..),
    Square(..)
)
where
    import          Math.FiniteCategory
    import          Math.IO.PrettyPrint
    
    import          Data.WeakSet.Safe
    
    -- | Objects of the __'Square'__ category.
    data SquareOb = SquareA | SquareB | SquareC | SquareD deriving (Eq, Show)
    
    -- | Morphisms of the __'Square'__ category.
    data SquareAr = SquareIdA | SquareIdB | SquareIdC | SquareIdD | SquareF | SquareG | SquareH | SquareI | SquareFH | SquareGI deriving (Eq, Show)
    
    -- | The __'Square'__ category.
    data Square = Square deriving (Eq, Show)
    
    instance Morphism SquareAr SquareOb where
        source SquareIdA = SquareA
        source SquareIdB = SquareB
        source SquareIdC = SquareC
        source SquareIdD = SquareD
        source SquareF = SquareA
        source SquareG = SquareA
        source SquareH = SquareB
        source SquareI = SquareC
        source SquareFH = SquareA
        source SquareGI = SquareA
        
        target SquareIdA = SquareA
        target SquareIdB = SquareB
        target SquareIdC = SquareC
        target SquareIdD = SquareD
        target SquareF = SquareB
        target SquareG = SquareC
        target SquareH = SquareD
        target SquareI = SquareD
        target SquareFH = SquareD
        target SquareGI = SquareD
        
        (@?) SquareIdA SquareIdA = Just SquareIdA
        (@?) SquareF SquareIdA = Just SquareF
        (@?) SquareG SquareIdA = Just SquareG
        (@?) SquareFH SquareIdA = Just SquareFH
        (@?) SquareGI SquareIdA = Just SquareGI
        (@?) SquareIdB SquareIdB = Just SquareIdB
        (@?) SquareH SquareIdB = Just SquareH
        (@?) SquareIdC SquareIdC = Just SquareIdC
        (@?) SquareI SquareIdC = Just SquareI
        (@?) SquareIdD SquareIdD = Just SquareIdD
        (@?) SquareIdB SquareF = Just SquareF
        (@?) SquareH SquareF = Just SquareFH
        (@?) SquareIdC SquareG = Just SquareG
        (@?) SquareI SquareG = Just SquareGI
        (@?) SquareIdD SquareH = Just SquareH
        (@?) SquareIdD SquareI = Just SquareI
        (@?) SquareIdD SquareFH = Just SquareFH
        (@?) SquareIdD SquareGI = Just SquareGI
        (@?) _ _ = Nothing
        
    instance Category Square SquareAr SquareOb where
        identity _ SquareA = SquareIdA
        identity _ SquareB = SquareIdB
        identity _ SquareC = SquareIdC
        identity _ SquareD = SquareIdD
        
        ar _ SquareA SquareA = set [SquareIdA]
        ar _ SquareA SquareB = set [SquareF]
        ar _ SquareA SquareC = set [SquareG]
        ar _ SquareA SquareD = set [SquareFH,SquareGI]
        ar _ SquareB SquareB = set [SquareIdB]
        ar _ SquareB SquareD = set [SquareH]
        ar _ SquareC SquareC = set [SquareIdC]
        ar _ SquareC SquareD = set [SquareI]
        ar _ SquareD SquareD = set [SquareIdD]
        ar _ _ _ = set []
        
        genAr _ SquareA SquareA = set [SquareIdA]
        genAr _ SquareA SquareB = set [SquareF]
        genAr _ SquareA SquareC = set [SquareG]
        genAr _ SquareB SquareB = set [SquareIdB]
        genAr _ SquareB SquareD = set [SquareH]
        genAr _ SquareC SquareC = set [SquareIdC]
        genAr _ SquareC SquareD = set [SquareI]
        genAr _ SquareD SquareD = set [SquareIdD]
        genAr _ _ _ = set []
        
        decompose _ SquareFH = [SquareH, SquareF]
        decompose _ SquareGI = [SquareI, SquareG]
        decompose _ x = [x]
        
    instance FiniteCategory Square SquareAr SquareOb where
        ob _ = set [SquareA, SquareB, SquareC, SquareD]
    
    instance PrettyPrint SquareOb where
        pprint SquareA = "A"
        pprint SquareB = "B"
        pprint SquareC = "C"
        pprint SquareD = "D"
    
    instance PrettyPrint SquareAr where
        pprint SquareIdA = "IdA"
        pprint SquareIdB = "IdB"
        pprint SquareIdC = "IdC"
        pprint SquareIdD = "IdD"
        pprint SquareF = "f"
        pprint SquareG = "g"
        pprint SquareH = "h"
        pprint SquareI = "i"
        pprint SquareFH = "h o f"
        pprint SquareGI = "i o g"
    
    instance PrettyPrint Square where
        pprint = show