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