49 lines
1.5 KiB
Haskell
49 lines
1.5 KiB
Haskell
module Functor.Product where
|
|
|
|
import Functor.Associative
|
|
import Functor.Bifunctor
|
|
import Functor.Identity
|
|
import Relation
|
|
|
|
import Data.Either (Either (Left, Right))
|
|
import Data.Kind (Constraint)
|
|
import Data.Void (Void)
|
|
|
|
-- | A category with a tensor product is a monoidal category.
|
|
type TensorProduct :: (k -> k -> k) -> Constraint
|
|
type TensorProduct f = (Associative f, LeftRightIdentity f)
|
|
|
|
class HasTerminal (r :: Relation k) where
|
|
type Terminal r :: k
|
|
drop :: Object r x -> r x (Terminal r)
|
|
|
|
class HasInitial (r :: Relation k) where
|
|
type Initial r :: k
|
|
absurd :: Object r x -> r (Initial r) x
|
|
|
|
type Product :: (k -> k -> k) -> Constraint
|
|
class (TensorProduct f, HasTerminal (Cod1 f), Terminal (Cod1 f) ~ Unit f) => Product f where
|
|
projectL :: Object (Cod1 f) x -> Object (Cod1 f) y -> Cod1 f (f x y) x
|
|
projectR :: Object (Cod1 f) x -> Object (Cod1 f) y -> Cod1 f (f x y) y
|
|
|
|
type Coproduct :: (k -> k -> k) -> Constraint
|
|
class (TensorProduct f, HasInitial (Cod1 f), Initial (Cod1 f) ~ Unit f) => Coproduct f where
|
|
injectL :: Object (Cod1 f) x -> Object (Cod1 f) y -> Cod1 f x (f x y)
|
|
injectR :: Object (Cod1 f) x -> Object (Cod1 f) y -> Cod1 f y (f x y)
|
|
|
|
instance HasTerminal (->) where
|
|
type Terminal (->) = ()
|
|
drop _ = \_ -> ()
|
|
|
|
instance HasInitial (->) where
|
|
type Initial (->) = Void
|
|
absurd _ = \case{}
|
|
|
|
instance Product (,) where
|
|
projectL _ _ = \(x, _) -> x
|
|
projectR _ _ = \(_, y) -> y
|
|
|
|
instance Coproduct Either where
|
|
injectL _ _ = Left
|
|
injectR _ _ = Right
|