{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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
    import          Data.Simplifiable
    
    import          GHC.Generics
    
    -- | Objects of the __'Square'__ category.
    data SquareOb = SquareA | SquareB | SquareC | SquareD deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
    
    -- | Morphisms of the __'Square'__ category.
    data SquareAr = SquareIdA | SquareIdB | SquareIdC | SquareIdD | SquareF | SquareG | SquareH | SquareI | SquareFH | SquareGI deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
    
    -- | The __'Square'__ category.
    data Square = Square deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
    
    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 = SquareIdA
        (@) SquareF SquareIdA = SquareF
        (@) SquareG SquareIdA = SquareG
        (@) SquareFH SquareIdA = SquareFH
        (@) SquareGI SquareIdA = SquareGI
        (@) SquareIdB SquareIdB = SquareIdB
        (@) SquareH SquareIdB = SquareH
        (@) SquareIdC SquareIdC = SquareIdC
        (@) SquareI SquareIdC = SquareI
        (@) SquareIdD SquareIdD = SquareIdD
        (@) SquareIdB SquareF = SquareF
        (@) SquareH SquareF = SquareFH
        (@) SquareIdC SquareG = SquareG
        (@) SquareI SquareG = SquareGI
        (@) SquareIdD SquareH = SquareH
        (@) SquareIdD SquareI = SquareI
        (@) SquareIdD SquareFH = SquareFH
        (@) SquareIdD SquareGI = SquareGI
        (@) _ _ = error "Incompatible composition of Square morphisms."
        
    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]