{-# LANGUAGE MultiParamTypeClasses #-}
module UsualCategories.Three
(
ThreeOb(..),
ThreeAr(..),
Three(..)
)
where
import FiniteCategory.FiniteCategory
import IO.PrettyPrint
data ThreeOb = A | B | C deriving (ThreeOb -> ThreeOb -> Bool
(ThreeOb -> ThreeOb -> Bool)
-> (ThreeOb -> ThreeOb -> Bool) -> Eq ThreeOb
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreeOb -> ThreeOb -> Bool
$c/= :: ThreeOb -> ThreeOb -> Bool
== :: ThreeOb -> ThreeOb -> Bool
$c== :: ThreeOb -> ThreeOb -> Bool
Eq, Int -> ThreeOb -> ShowS
[ThreeOb] -> ShowS
ThreeOb -> String
(Int -> ThreeOb -> ShowS)
-> (ThreeOb -> String) -> ([ThreeOb] -> ShowS) -> Show ThreeOb
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreeOb] -> ShowS
$cshowList :: [ThreeOb] -> ShowS
show :: ThreeOb -> String
$cshow :: ThreeOb -> String
showsPrec :: Int -> ThreeOb -> ShowS
$cshowsPrec :: Int -> ThreeOb -> ShowS
Show)
data ThreeAr = IdA | IdB | IdC | F | G | GF deriving (ThreeAr -> ThreeAr -> Bool
(ThreeAr -> ThreeAr -> Bool)
-> (ThreeAr -> ThreeAr -> Bool) -> Eq ThreeAr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreeAr -> ThreeAr -> Bool
$c/= :: ThreeAr -> ThreeAr -> Bool
== :: ThreeAr -> ThreeAr -> Bool
$c== :: ThreeAr -> ThreeAr -> Bool
Eq,Int -> ThreeAr -> ShowS
[ThreeAr] -> ShowS
ThreeAr -> String
(Int -> ThreeAr -> ShowS)
-> (ThreeAr -> String) -> ([ThreeAr] -> ShowS) -> Show ThreeAr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreeAr] -> ShowS
$cshowList :: [ThreeAr] -> ShowS
show :: ThreeAr -> String
$cshow :: ThreeAr -> String
showsPrec :: Int -> ThreeAr -> ShowS
$cshowsPrec :: Int -> ThreeAr -> ShowS
Show)
data Three = Three deriving (Three -> Three -> Bool
(Three -> Three -> Bool) -> (Three -> Three -> Bool) -> Eq Three
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Three -> Three -> Bool
$c/= :: Three -> Three -> Bool
== :: Three -> Three -> Bool
$c== :: Three -> Three -> Bool
Eq,Int -> Three -> ShowS
[Three] -> ShowS
Three -> String
(Int -> Three -> ShowS)
-> (Three -> String) -> ([Three] -> ShowS) -> Show Three
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Three] -> ShowS
$cshowList :: [Three] -> ShowS
show :: Three -> String
$cshow :: Three -> String
showsPrec :: Int -> Three -> ShowS
$cshowsPrec :: Int -> Three -> ShowS
Show)
instance Morphism ThreeAr ThreeOb where
source :: ThreeAr -> ThreeOb
source ThreeAr
IdA = ThreeOb
A
source ThreeAr
IdB = ThreeOb
B
source ThreeAr
IdC = ThreeOb
C
source ThreeAr
F = ThreeOb
A
source ThreeAr
G = ThreeOb
B
source ThreeAr
GF = ThreeOb
A
target :: ThreeAr -> ThreeOb
target ThreeAr
IdA = ThreeOb
A
target ThreeAr
IdB = ThreeOb
B
target ThreeAr
IdC = ThreeOb
C
target ThreeAr
F = ThreeOb
B
target ThreeAr
G = ThreeOb
C
target ThreeAr
GF = ThreeOb
C
@ :: ThreeAr -> ThreeAr -> ThreeAr
(@) ThreeAr
IdA ThreeAr
IdA = ThreeAr
IdA
(@) ThreeAr
F ThreeAr
IdA = ThreeAr
F
(@) ThreeAr
GF ThreeAr
IdA = ThreeAr
GF
(@) ThreeAr
IdB ThreeAr
IdB = ThreeAr
IdB
(@) ThreeAr
G ThreeAr
IdB = ThreeAr
G
(@) ThreeAr
IdC ThreeAr
IdC = ThreeAr
IdC
(@) ThreeAr
IdB ThreeAr
F = ThreeAr
F
(@) ThreeAr
G ThreeAr
F = ThreeAr
GF
(@) ThreeAr
IdC ThreeAr
G = ThreeAr
G
(@) ThreeAr
IdC ThreeAr
GF = ThreeAr
GF
(@) ThreeAr
x ThreeAr
y = String -> ThreeAr
forall a. HasCallStack => String -> a
error (String
"Invalid composition of ThreeMorph : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ThreeAr -> String
forall a. Show a => a -> String
show ThreeAr
xString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" * "String -> ShowS
forall a. [a] -> [a] -> [a]
++ThreeAr -> String
forall a. Show a => a -> String
show ThreeAr
y)
instance FiniteCategory Three ThreeAr ThreeOb where
ob :: Three -> [ThreeOb]
ob = [ThreeOb] -> Three -> [ThreeOb]
forall a b. a -> b -> a
const [ThreeOb
A,ThreeOb
B,ThreeOb
C]
identity :: Morphism ThreeAr ThreeOb => Three -> ThreeOb -> ThreeAr
identity Three
_ ThreeOb
A = ThreeAr
IdA
identity Three
_ ThreeOb
B = ThreeAr
IdB
identity Three
_ ThreeOb
C = ThreeAr
IdC
ar :: Morphism ThreeAr ThreeOb =>
Three -> ThreeOb -> ThreeOb -> [ThreeAr]
ar Three
_ ThreeOb
A ThreeOb
A = [ThreeAr
IdA]
ar Three
_ ThreeOb
A ThreeOb
B = [ThreeAr
F]
ar Three
_ ThreeOb
A ThreeOb
C = [ThreeAr
GF]
ar Three
_ ThreeOb
B ThreeOb
B = [ThreeAr
IdB]
ar Three
_ ThreeOb
B ThreeOb
C = [ThreeAr
G]
ar Three
_ ThreeOb
C ThreeOb
C = [ThreeAr
IdC]
ar Three
_ ThreeOb
_ ThreeOb
_ = []
instance GeneratedFiniteCategory Three ThreeAr ThreeOb where
genAr :: Morphism ThreeAr ThreeOb =>
Three -> ThreeOb -> ThreeOb -> [ThreeAr]
genAr Three
_ ThreeOb
A ThreeOb
C = []
genAr Three
c ThreeOb
x ThreeOb
y = Three -> ThreeOb -> ThreeOb -> [ThreeAr]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
defaultGenAr Three
c ThreeOb
x ThreeOb
y
decompose :: Morphism ThreeAr ThreeOb => Three -> ThreeAr -> [ThreeAr]
decompose Three
_ ThreeAr
GF = [ThreeAr
G,ThreeAr
F]
decompose Three
c ThreeAr
m = Three -> ThreeAr -> [ThreeAr]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> m -> [m]
defaultDecompose Three
c ThreeAr
m
instance PrettyPrintable ThreeOb where
pprint :: ThreeOb -> String
pprint = ThreeOb -> String
forall a. Show a => a -> String
show
instance PrettyPrintable ThreeAr where
pprint :: ThreeAr -> String
pprint = ThreeAr -> String
forall a. Show a => a -> String
show
instance PrettyPrintable Three where
pprint :: Three -> String
pprint = Three -> String
forall a. Show a => a -> String
show