{-# LANGUAGE MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : The __0__ category contains no object and no morphism.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The __0__ category contains no object and no morphism.
-}

module UsualCategories.Zero 
(
    Zero(..)
)
where
    import          FiniteCategory.FiniteCategory
    import          IO.PrettyPrint
    
    -- | The __0__ category.

    data Zero = Zero deriving (Zero -> Zero -> Bool
(Zero -> Zero -> Bool) -> (Zero -> Zero -> Bool) -> Eq Zero
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Zero -> Zero -> Bool
$c/= :: Zero -> Zero -> Bool
== :: Zero -> Zero -> Bool
$c== :: Zero -> Zero -> Bool
Eq, Int -> Zero -> ShowS
[Zero] -> ShowS
Zero -> String
(Int -> Zero -> ShowS)
-> (Zero -> String) -> ([Zero] -> ShowS) -> Show Zero
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Zero] -> ShowS
$cshowList :: [Zero] -> ShowS
show :: Zero -> String
$cshow :: Zero -> String
showsPrec :: Int -> Zero -> ShowS
$cshowsPrec :: Int -> Zero -> ShowS
Show)
    
    instance Morphism Zero Zero where
        source :: Zero -> Zero
source Zero
_ = String -> Zero
forall a. HasCallStack => String -> a
error String
"No morphism in the zero category."
        target :: Zero -> Zero
target Zero
_ = String -> Zero
forall a. HasCallStack => String -> a
error String
"No morphism in the zero category."
        @ :: Zero -> Zero -> Zero
(@) Zero
_ Zero
_ = String -> Zero
forall a. HasCallStack => String -> a
error String
"No morphism in the zero category."
    
    instance FiniteCategory Zero Zero Zero where
        ob :: Zero -> [Zero]
ob = [Zero] -> Zero -> [Zero]
forall a b. a -> b -> a
const []
        identity :: Morphism Zero Zero => Zero -> Zero -> Zero
identity Zero
_ Zero
_ = String -> Zero
forall a. HasCallStack => String -> a
error String
"No object in the zero category."
        ar :: Morphism Zero Zero => Zero -> Zero -> Zero -> [Zero]
ar = (Zero -> Zero -> [Zero]) -> Zero -> Zero -> Zero -> [Zero]
forall a b. a -> b -> a
const((Zero -> Zero -> [Zero]) -> Zero -> Zero -> Zero -> [Zero])
-> ([Zero] -> Zero -> Zero -> [Zero])
-> [Zero]
-> Zero
-> Zero
-> Zero
-> [Zero]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zero -> [Zero]) -> Zero -> Zero -> [Zero]
forall a b. a -> b -> a
const((Zero -> [Zero]) -> Zero -> Zero -> [Zero])
-> ([Zero] -> Zero -> [Zero]) -> [Zero] -> Zero -> Zero -> [Zero]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Zero] -> Zero -> [Zero]
forall a b. a -> b -> a
const ([Zero] -> Zero -> Zero -> Zero -> [Zero])
-> [Zero] -> Zero -> Zero -> Zero -> [Zero]
forall a b. (a -> b) -> a -> b
$ []
        
    instance GeneratedFiniteCategory Zero Zero Zero where
        genAr :: Morphism Zero Zero => Zero -> Zero -> Zero -> [Zero]
genAr = Zero -> Zero -> Zero -> [Zero]
forall c m o.
(FiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
ar
        decompose :: Morphism Zero Zero => Zero -> Zero -> [Zero]
decompose Zero
_ Zero
_ = String -> [Zero]
forall a. HasCallStack => String -> a
error String
"No morphism in the zero category."
        
    instance PrettyPrintable Zero where
        pprint :: Zero -> String
pprint = Zero -> String
forall a. Show a => a -> String
show