{-# LANGUAGE MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : The __'V'__ category contains two arrows pointing to the same object. It is the opposite of __'Hat'__.
Copyright   : Guillaume Sabbagh 2022
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The __'V'__ category contains two arrows pointing to the same object.

The shape of the __'V'__ category is the following : @`B` -`F`-> `A` <-`G`- `C`@
-}

module Math.FiniteCategories.V 
(
    VOb(..),
    VAr(..),
    V(..)
)
where
    import          Math.FiniteCategory
    import          Math.IO.PrettyPrint
    
    import          Data.WeakSet.Safe
    
    -- | Objects of the __'V'__ category.

    data VOb = VA | VB | VC deriving (VOb -> VOb -> Bool
(VOb -> VOb -> Bool) -> (VOb -> VOb -> Bool) -> Eq VOb
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VOb -> VOb -> Bool
$c/= :: VOb -> VOb -> Bool
== :: VOb -> VOb -> Bool
$c== :: VOb -> VOb -> Bool
Eq, Int -> VOb -> ShowS
[VOb] -> ShowS
VOb -> String
(Int -> VOb -> ShowS)
-> (VOb -> String) -> ([VOb] -> ShowS) -> Show VOb
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VOb] -> ShowS
$cshowList :: [VOb] -> ShowS
show :: VOb -> String
$cshow :: VOb -> String
showsPrec :: Int -> VOb -> ShowS
$cshowsPrec :: Int -> VOb -> ShowS
Show)
    
    -- | Morphisms of the __'V'__ category.

    data VAr =  VIdA | VIdB | VIdC | VF | VG deriving (VAr -> VAr -> Bool
(VAr -> VAr -> Bool) -> (VAr -> VAr -> Bool) -> Eq VAr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VAr -> VAr -> Bool
$c/= :: VAr -> VAr -> Bool
== :: VAr -> VAr -> Bool
$c== :: VAr -> VAr -> Bool
Eq, Int -> VAr -> ShowS
[VAr] -> ShowS
VAr -> String
(Int -> VAr -> ShowS)
-> (VAr -> String) -> ([VAr] -> ShowS) -> Show VAr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VAr] -> ShowS
$cshowList :: [VAr] -> ShowS
show :: VAr -> String
$cshow :: VAr -> String
showsPrec :: Int -> VAr -> ShowS
$cshowsPrec :: Int -> VAr -> ShowS
Show)
    
    -- | The __'V'__ category.

    data V = V deriving (V -> V -> Bool
(V -> V -> Bool) -> (V -> V -> Bool) -> Eq V
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V -> V -> Bool
$c/= :: V -> V -> Bool
== :: V -> V -> Bool
$c== :: V -> V -> Bool
Eq, Int -> V -> ShowS
[V] -> ShowS
V -> String
(Int -> V -> ShowS) -> (V -> String) -> ([V] -> ShowS) -> Show V
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V] -> ShowS
$cshowList :: [V] -> ShowS
show :: V -> String
$cshow :: V -> String
showsPrec :: Int -> V -> ShowS
$cshowsPrec :: Int -> V -> ShowS
Show)
    
    instance Morphism VAr VOb where
        source :: VAr -> VOb
source VAr
VIdA = VOb
VA
        source VAr
VIdB = VOb
VB
        source VAr
VIdC = VOb
VC
        source VAr
VF = VOb
VB
        source VAr
VG = VOb
VC
        target :: VAr -> VOb
target VAr
VIdA = VOb
VA
        target VAr
VIdB = VOb
VB
        target VAr
VIdC = VOb
VC
        target VAr
_ = VOb
VA
        @? :: VAr -> VAr -> Maybe VAr
(@?) VAr
VIdA VAr
VIdA = VAr -> Maybe VAr
forall a. a -> Maybe a
Just VAr
VIdA
        (@?) VAr
VIdB VAr
VIdB = VAr -> Maybe VAr
forall a. a -> Maybe a
Just VAr
VIdB
        (@?) VAr
VF VAr
VIdB = VAr -> Maybe VAr
forall a. a -> Maybe a
Just VAr
VF
        (@?) VAr
VG VAr
VIdC = VAr -> Maybe VAr
forall a. a -> Maybe a
Just VAr
VG
        (@?) VAr
VIdC VAr
VIdC = VAr -> Maybe VAr
forall a. a -> Maybe a
Just VAr
VIdC
        (@?) VAr
VIdA VAr
VF = VAr -> Maybe VAr
forall a. a -> Maybe a
Just VAr
VF
        (@?) VAr
VIdA VAr
VG = VAr -> Maybe VAr
forall a. a -> Maybe a
Just VAr
VG
        (@?) VAr
_ VAr
_ = Maybe VAr
forall a. Maybe a
Nothing
    
    instance Category V VAr VOb where
        identity :: Morphism VAr VOb => V -> VOb -> VAr
identity V
_ VOb
VA = VAr
VIdA
        identity V
_ VOb
VB = VAr
VIdB
        identity V
_ VOb
VC = VAr
VIdC
        ar :: Morphism VAr VOb => V -> VOb -> VOb -> Set VAr
ar V
_ VOb
VA VOb
VA = [VAr] -> Set VAr
forall a. [a] -> Set a
set [VAr
VIdA]
        ar V
_ VOb
VB VOb
VA = [VAr] -> Set VAr
forall a. [a] -> Set a
set [VAr
VF]
        ar V
_ VOb
VB VOb
VB = [VAr] -> Set VAr
forall a. [a] -> Set a
set [VAr
VIdB]
        ar V
_ VOb
VC VOb
VA = [VAr] -> Set VAr
forall a. [a] -> Set a
set [VAr
VG]
        ar V
_ VOb
VC VOb
VC = [VAr] -> Set VAr
forall a. [a] -> Set a
set [VAr
VIdC]
        ar V
_ VOb
_ VOb
_ = [VAr] -> Set VAr
forall a. [a] -> Set a
set []
    
    instance FiniteCategory V VAr VOb where
        ob :: V -> Set VOb
ob V
_ = [VOb] -> Set VOb
forall a. [a] -> Set a
set [VOb
VA, VOb
VB, VOb
VC]

    instance PrettyPrint VOb where
        pprint :: VOb -> String
pprint VOb
VA = String
"A"
        pprint VOb
VB = String
"B"
        pprint VOb
VC = String
"C"
        
    instance PrettyPrint VAr where
        pprint :: VAr -> String
pprint VAr
VIdA = String
"IdA"
        pprint VAr
VIdB = String
"IdB"
        pprint VAr
VIdC = String
"IdC"
        pprint VAr
VF = String
"f"
        pprint VAr
VG = String
"g"
        
    instance PrettyPrint V where
        pprint :: V -> String
pprint = V -> String
forall a. Show a => a -> String
show