{-# LANGUAGE MultiParamTypeClasses #-}

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

The __'Hat'__ category contains two arrows coming from the same object.

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

module Math.FiniteCategories.Hat
(
    HatOb(..),
    HatAr(..),
    Hat(..)
)
where
    import          Math.FiniteCategory
    import          Math.IO.PrettyPrint
    
    import          Data.WeakSet.Safe
    
    -- | Objects of the __'Hat'__ category.

    data HatOb = HatA | HatB | HatC deriving (HatOb -> HatOb -> Bool
(HatOb -> HatOb -> Bool) -> (HatOb -> HatOb -> Bool) -> Eq HatOb
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HatOb -> HatOb -> Bool
$c/= :: HatOb -> HatOb -> Bool
== :: HatOb -> HatOb -> Bool
$c== :: HatOb -> HatOb -> Bool
Eq, Int -> HatOb -> ShowS
[HatOb] -> ShowS
HatOb -> String
(Int -> HatOb -> ShowS)
-> (HatOb -> String) -> ([HatOb] -> ShowS) -> Show HatOb
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HatOb] -> ShowS
$cshowList :: [HatOb] -> ShowS
show :: HatOb -> String
$cshow :: HatOb -> String
showsPrec :: Int -> HatOb -> ShowS
$cshowsPrec :: Int -> HatOb -> ShowS
Show)
    
    -- | Morphisms of the __'Hat'__ category.

    data HatAr = HatIdA | HatIdB | HatIdC | HatF | HatG deriving (HatAr -> HatAr -> Bool
(HatAr -> HatAr -> Bool) -> (HatAr -> HatAr -> Bool) -> Eq HatAr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HatAr -> HatAr -> Bool
$c/= :: HatAr -> HatAr -> Bool
== :: HatAr -> HatAr -> Bool
$c== :: HatAr -> HatAr -> Bool
Eq, Int -> HatAr -> ShowS
[HatAr] -> ShowS
HatAr -> String
(Int -> HatAr -> ShowS)
-> (HatAr -> String) -> ([HatAr] -> ShowS) -> Show HatAr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HatAr] -> ShowS
$cshowList :: [HatAr] -> ShowS
show :: HatAr -> String
$cshow :: HatAr -> String
showsPrec :: Int -> HatAr -> ShowS
$cshowsPrec :: Int -> HatAr -> ShowS
Show)
    
    -- | The Hat category.

    data Hat = Hat deriving (Hat -> Hat -> Bool
(Hat -> Hat -> Bool) -> (Hat -> Hat -> Bool) -> Eq Hat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hat -> Hat -> Bool
$c/= :: Hat -> Hat -> Bool
== :: Hat -> Hat -> Bool
$c== :: Hat -> Hat -> Bool
Eq, Int -> Hat -> ShowS
[Hat] -> ShowS
Hat -> String
(Int -> Hat -> ShowS)
-> (Hat -> String) -> ([Hat] -> ShowS) -> Show Hat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hat] -> ShowS
$cshowList :: [Hat] -> ShowS
show :: Hat -> String
$cshow :: Hat -> String
showsPrec :: Int -> Hat -> ShowS
$cshowsPrec :: Int -> Hat -> ShowS
Show)
    
    instance Morphism HatAr HatOb where
        source :: HatAr -> HatOb
source HatAr
HatIdA = HatOb
HatA
        source HatAr
HatIdB = HatOb
HatB
        source HatAr
HatIdC = HatOb
HatC
        source HatAr
_ = HatOb
HatA
        target :: HatAr -> HatOb
target HatAr
HatIdA = HatOb
HatA
        target HatAr
HatIdB = HatOb
HatB
        target HatAr
HatIdC = HatOb
HatC
        target HatAr
HatF = HatOb
HatB
        target HatAr
HatG = HatOb
HatC
        @? :: HatAr -> HatAr -> Maybe HatAr
(@?) HatAr
HatIdA HatAr
HatIdA = HatAr -> Maybe HatAr
forall a. a -> Maybe a
Just HatAr
HatIdA
        (@?) HatAr
HatF HatAr
HatIdA = HatAr -> Maybe HatAr
forall a. a -> Maybe a
Just HatAr
HatF
        (@?) HatAr
HatG HatAr
HatIdA = HatAr -> Maybe HatAr
forall a. a -> Maybe a
Just HatAr
HatG
        (@?) HatAr
HatIdB HatAr
HatIdB = HatAr -> Maybe HatAr
forall a. a -> Maybe a
Just HatAr
HatIdB
        (@?) HatAr
HatIdC HatAr
HatIdC = HatAr -> Maybe HatAr
forall a. a -> Maybe a
Just HatAr
HatIdC
        (@?) HatAr
HatIdB HatAr
HatF = HatAr -> Maybe HatAr
forall a. a -> Maybe a
Just HatAr
HatF
        (@?) HatAr
HatIdC HatAr
HatG = HatAr -> Maybe HatAr
forall a. a -> Maybe a
Just HatAr
HatG
        (@?) HatAr
_ HatAr
_ = Maybe HatAr
forall a. Maybe a
Nothing
    
    instance Category Hat HatAr HatOb where
        identity :: Morphism HatAr HatOb => Hat -> HatOb -> HatAr
identity Hat
_ HatOb
HatA = HatAr
HatIdA
        identity Hat
_ HatOb
HatB = HatAr
HatIdB
        identity Hat
_ HatOb
HatC = HatAr
HatIdC
        ar :: Morphism HatAr HatOb => Hat -> HatOb -> HatOb -> Set HatAr
ar Hat
_ HatOb
HatA HatOb
HatA = [HatAr] -> Set HatAr
forall a. [a] -> Set a
set [HatAr
HatIdA]
        ar Hat
_ HatOb
HatB HatOb
HatB = [HatAr] -> Set HatAr
forall a. [a] -> Set a
set [HatAr
HatIdB]
        ar Hat
_ HatOb
HatC HatOb
HatC = [HatAr] -> Set HatAr
forall a. [a] -> Set a
set [HatAr
HatIdC]
        ar Hat
_ HatOb
HatA HatOb
HatB = [HatAr] -> Set HatAr
forall a. [a] -> Set a
set [HatAr
HatF]
        ar Hat
_ HatOb
HatA HatOb
HatC = [HatAr] -> Set HatAr
forall a. [a] -> Set a
set [HatAr
HatG]
        ar Hat
_ HatOb
_ HatOb
_ = [HatAr] -> Set HatAr
forall a. [a] -> Set a
set []
    
    instance FiniteCategory Hat HatAr HatOb where
        ob :: Hat -> Set HatOb
ob Hat
_ = [HatOb] -> Set HatOb
forall a. [a] -> Set a
set [HatOb
HatA, HatOb
HatB, HatOb
HatC]
    
    instance PrettyPrint HatOb where
        pprint :: HatOb -> String
pprint HatOb
HatA = String
"A"
        pprint HatOb
HatB = String
"B"
        pprint HatOb
HatC = String
"C"
        
    
    instance PrettyPrint HatAr where
        pprint :: HatAr -> String
pprint HatAr
HatIdA = String
"IdA"
        pprint HatAr
HatIdB = String
"IdB"
        pprint HatAr
HatIdC = String
"IdC"
        pprint HatAr
HatF = String
"f"
        pprint HatAr
HatG = String
"g"
        
    instance PrettyPrint Hat where
        pprint :: Hat -> String
pprint = Hat -> String
forall a. Show a => a -> String
show