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

{-| Module  : FiniteCategories
Description : The __1__ category contains one object and its identity.
Copyright   : Guillaume Sabbagh 2022
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The __1__ category contains one object and its identity.

You can construct it using 'NumberCategory', it is defined as a standalone category because it is often used unlike other number categories.
-}

module Math.FiniteCategories.One
(
    One(..)
)
where
    import          Math.FiniteCategory
    import          Math.IO.PrettyPrint
    
    import          Data.WeakSet.Safe
    import          Data.Simplifiable
    
    import          GHC.Generics
    
    -- | 'One' is a datatype used as the object type, the morphism type and the category type of __1__.

    data One = One deriving (One -> One -> Bool
(One -> One -> Bool) -> (One -> One -> Bool) -> Eq One
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: One -> One -> Bool
== :: One -> One -> Bool
$c/= :: One -> One -> Bool
/= :: One -> One -> Bool
Eq, Int -> One -> ShowS
[One] -> ShowS
One -> String
(Int -> One -> ShowS)
-> (One -> String) -> ([One] -> ShowS) -> Show One
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> One -> ShowS
showsPrec :: Int -> One -> ShowS
$cshow :: One -> String
show :: One -> String
$cshowList :: [One] -> ShowS
showList :: [One] -> ShowS
Show, (forall x. One -> Rep One x)
-> (forall x. Rep One x -> One) -> Generic One
forall x. Rep One x -> One
forall x. One -> Rep One x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. One -> Rep One x
from :: forall x. One -> Rep One x
$cto :: forall x. Rep One x -> One
to :: forall x. Rep One x -> One
Generic, Int -> Int -> String -> One -> String
Int -> One -> String
(Int -> One -> String)
-> (Int -> Int -> String -> One -> String)
-> (Int -> One -> String)
-> PrettyPrint One
forall a.
(Int -> a -> String)
-> (Int -> Int -> String -> a -> String)
-> (Int -> a -> String)
-> PrettyPrint a
$cpprint :: Int -> One -> String
pprint :: Int -> One -> String
$cpprintWithIndentations :: Int -> Int -> String -> One -> String
pprintWithIndentations :: Int -> Int -> String -> One -> String
$cpprintIndent :: Int -> One -> String
pprintIndent :: Int -> One -> String
PrettyPrint, One -> One
(One -> One) -> Simplifiable One
forall a. (a -> a) -> Simplifiable a
$csimplify :: One -> One
simplify :: One -> One
Simplifiable)
    
    instance Morphism One One where
        source :: One -> One
source One
One = One
One
        target :: One -> One
target One
One = One
One
        @ :: One -> One -> One
(@) One
One One
One = One
One
    
    instance Category One One One where
        identity :: Morphism One One => One -> One -> One
identity One
One One
One = One
One
        ar :: Morphism One One => One -> One -> One -> Set One
ar One
One One
One One
One = [One] -> Set One
forall a. [a] -> Set a
set [One
One]
    
    instance FiniteCategory One One One where
        ob :: One -> Set One
ob One
One = [One] -> Set One
forall a. [a] -> Set a
set [One
One]