{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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
    import          Data.Simplifiable
        
    import          GHC.Generics
    -- | 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
$c== :: VOb -> VOb -> Bool
== :: VOb -> VOb -> Bool
$c/= :: VOb -> VOb -> Bool
/= :: 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
$cshowsPrec :: Int -> VOb -> ShowS
showsPrec :: Int -> VOb -> ShowS
$cshow :: VOb -> String
show :: VOb -> String
$cshowList :: [VOb] -> ShowS
showList :: [VOb] -> ShowS
Show, (forall x. VOb -> Rep VOb x)
-> (forall x. Rep VOb x -> VOb) -> Generic VOb
forall x. Rep VOb x -> VOb
forall x. VOb -> Rep VOb x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VOb -> Rep VOb x
from :: forall x. VOb -> Rep VOb x
$cto :: forall x. Rep VOb x -> VOb
to :: forall x. Rep VOb x -> VOb
Generic, Int -> Int -> String -> VOb -> String
Int -> VOb -> String
(Int -> VOb -> String)
-> (Int -> Int -> String -> VOb -> String)
-> (Int -> VOb -> String)
-> PrettyPrint VOb
forall a.
(Int -> a -> String)
-> (Int -> Int -> String -> a -> String)
-> (Int -> a -> String)
-> PrettyPrint a
$cpprint :: Int -> VOb -> String
pprint :: Int -> VOb -> String
$cpprintWithIndentations :: Int -> Int -> String -> VOb -> String
pprintWithIndentations :: Int -> Int -> String -> VOb -> String
$cpprintIndent :: Int -> VOb -> String
pprintIndent :: Int -> VOb -> String
PrettyPrint, VOb -> VOb
(VOb -> VOb) -> Simplifiable VOb
forall a. (a -> a) -> Simplifiable a
$csimplify :: VOb -> VOb
simplify :: VOb -> VOb
Simplifiable)
    
    -- | 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
$c== :: VAr -> VAr -> Bool
== :: VAr -> VAr -> Bool
$c/= :: VAr -> VAr -> Bool
/= :: 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
$cshowsPrec :: Int -> VAr -> ShowS
showsPrec :: Int -> VAr -> ShowS
$cshow :: VAr -> String
show :: VAr -> String
$cshowList :: [VAr] -> ShowS
showList :: [VAr] -> ShowS
Show, (forall x. VAr -> Rep VAr x)
-> (forall x. Rep VAr x -> VAr) -> Generic VAr
forall x. Rep VAr x -> VAr
forall x. VAr -> Rep VAr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VAr -> Rep VAr x
from :: forall x. VAr -> Rep VAr x
$cto :: forall x. Rep VAr x -> VAr
to :: forall x. Rep VAr x -> VAr
Generic, Int -> Int -> String -> VAr -> String
Int -> VAr -> String
(Int -> VAr -> String)
-> (Int -> Int -> String -> VAr -> String)
-> (Int -> VAr -> String)
-> PrettyPrint VAr
forall a.
(Int -> a -> String)
-> (Int -> Int -> String -> a -> String)
-> (Int -> a -> String)
-> PrettyPrint a
$cpprint :: Int -> VAr -> String
pprint :: Int -> VAr -> String
$cpprintWithIndentations :: Int -> Int -> String -> VAr -> String
pprintWithIndentations :: Int -> Int -> String -> VAr -> String
$cpprintIndent :: Int -> VAr -> String
pprintIndent :: Int -> VAr -> String
PrettyPrint, VAr -> VAr
(VAr -> VAr) -> Simplifiable VAr
forall a. (a -> a) -> Simplifiable a
$csimplify :: VAr -> VAr
simplify :: VAr -> VAr
Simplifiable)
    
    -- | 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
$c== :: V -> V -> Bool
== :: V -> V -> Bool
$c/= :: V -> V -> Bool
/= :: 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
$cshowsPrec :: Int -> V -> ShowS
showsPrec :: Int -> V -> ShowS
$cshow :: V -> String
show :: V -> String
$cshowList :: [V] -> ShowS
showList :: [V] -> ShowS
Show, (forall x. V -> Rep V x) -> (forall x. Rep V x -> V) -> Generic V
forall x. Rep V x -> V
forall x. V -> Rep V x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. V -> Rep V x
from :: forall x. V -> Rep V x
$cto :: forall x. Rep V x -> V
to :: forall x. Rep V x -> V
Generic, Int -> Int -> String -> V -> String
Int -> V -> String
(Int -> V -> String)
-> (Int -> Int -> String -> V -> String)
-> (Int -> V -> String)
-> PrettyPrint V
forall a.
(Int -> a -> String)
-> (Int -> Int -> String -> a -> String)
-> (Int -> a -> String)
-> PrettyPrint a
$cpprint :: Int -> V -> String
pprint :: Int -> V -> String
$cpprintWithIndentations :: Int -> Int -> String -> V -> String
pprintWithIndentations :: Int -> Int -> String -> V -> String
$cpprintIndent :: Int -> V -> String
pprintIndent :: Int -> V -> String
PrettyPrint, V -> V
(V -> V) -> Simplifiable V
forall a. (a -> a) -> Simplifiable a
$csimplify :: V -> V
simplify :: V -> V
Simplifiable)
    
    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 -> VAr
(@) VAr
VIdA VAr
VIdA = VAr
VIdA
        (@) VAr
VIdB VAr
VIdB = VAr
VIdB
        (@) VAr
VF VAr
VIdB = VAr
VF
        (@) VAr
VG VAr
VIdC = VAr
VG
        (@) VAr
VIdC VAr
VIdC = VAr
VIdC
        (@) VAr
VIdA VAr
VF = VAr
VF
        (@) VAr
VIdA VAr
VG = VAr
VG
        (@) VAr
_ VAr
_ = String -> VAr
forall a. HasCallStack => String -> a
error String
"Incompatible composition of V morphisms."
    
    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]