Parallel.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : The __'Parallel'__ category contains two parallel arrows.
Copyright   : Guillaume Sabbagh 2022
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The __'Parallel'__ category contains two objects `A` and `B` and two morphisms @`F` : `A` -> `B`@ and @`G` : `A` -> `B`@.
-}

module Math.FiniteCategories.Parallel 
(
    ParallelOb(..),
    ParallelAr(..),
    Parallel(..)
)
where
    import          Math.FiniteCategory
    import          Math.IO.PrettyPrint
    
    import          Data.WeakSet.Safe
    import          Data.Simplifiable
    
    import          GHC.Generics
    
    -- | Objects of the __'Parallel'__ category.
    data ParallelOb = ParallelA | ParallelB deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
    
    -- | Morphisms of the __'Parallel'__ category.
    data ParallelAr = ParallelIdA | ParallelIdB | ParallelF | ParallelG deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
    
    -- | The __'Parallel'__ category.
    data Parallel = Parallel deriving (Eq, Show, Generic, PrettyPrint, Simplifiable)
    
    instance Morphism ParallelAr ParallelOb where
        source ParallelIdA = ParallelA
        source ParallelIdB = ParallelB
        source _ = ParallelA
        target ParallelIdA = ParallelA
        target ParallelIdB = ParallelB
        target _ = ParallelB
        (@) ParallelIdA ParallelIdA = ParallelIdA
        (@) ParallelF ParallelIdA = ParallelF
        (@) ParallelG ParallelIdA =  ParallelG
        (@) ParallelIdB ParallelIdB =  ParallelIdB
        (@) ParallelIdB ParallelF =  ParallelF
        (@) ParallelIdB ParallelG =  ParallelG
        (@) _ _ = error "Incompatible composition of Parallel morphisms."
        
    instance Category Parallel ParallelAr ParallelOb where
        identity _ ParallelA = ParallelIdA
        identity _ ParallelB = ParallelIdB
        ar _ ParallelA ParallelA = set [ParallelIdA]
        ar _ ParallelA ParallelB = set [ParallelF,ParallelG]
        ar _ ParallelB ParallelB = set [ParallelIdB]
        ar _ _ _ = set []
        
    
    instance FiniteCategory Parallel ParallelAr ParallelOb where
        ob _ = set [ParallelA,ParallelB]