module Control.Category.Cartesian where
import Control.Category.Monoidal
import Control.Category ((>>>))
class MonoidalProduct k => Cartesian k where
(&&&) :: (a `k` l) -> (a `k` r) -> (a `k` (l, r))
k a l
l &&& k a r
r = k a (a, a)
forall (k :: * -> * -> *) a. Cartesian k => k a (a, a)
copy k a (a, a) -> k (a, a) (l, r) -> k a (l, r)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (k a l
l k a l -> k a r -> k (a, a) (l, r)
forall (k :: * -> * -> *) al bl ar br.
MonoidalProduct k =>
k al bl -> k ar br -> k (al, ar) (bl, br)
*** k a r
r)
consume :: a `k` ()
copy :: a `k` (a, a)
fst' :: (l, r) `k` l
snd' :: (l, r) `k` r
instance Cartesian (->) where
copy :: a -> (a, a)
copy a
x = (a
x, a
x)
consume :: a -> ()
consume a
_ = ()
fst' :: (l, r) -> l
fst' = (l, r) -> l
forall l r. (l, r) -> l
fst
snd' :: (l, r) -> r
snd' = (l, r) -> r
forall l r. (l, r) -> r
snd
class MonoidalSum k => Cocartesian k where
(|||) :: (al `k` b) -> (ar `k` b) -> (Either al ar `k` b)
(|||) k al b
l k ar b
r = (k al b
l k al b -> k ar b -> k (Either al ar) (Either b b)
forall (k :: * -> * -> *) al bl ar br.
MonoidalSum k =>
k al bl -> k ar br -> k (Either al ar) (Either bl br)
+++ k ar b
r) k (Either al ar) (Either b b)
-> k (Either b b) b -> k (Either al ar) b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> k (Either b b) b
forall (k :: * -> * -> *) a. Cocartesian k => k (Either a a) a
unify
injectL :: a `k` (Either a b)
injectR :: a `k` (Either b a)
unify :: Either a a `k` a
tag :: k (Bool, a) (Either a a)
instance Cocartesian (->) where
injectL :: a -> Either a b
injectL = a -> Either a b
forall a b. a -> Either a b
Left
injectR :: a -> Either b a
injectR = a -> Either b a
forall a b. b -> Either a b
Right
unify :: Either a a -> a
unify = (a -> a) -> (a -> a) -> Either a a -> a
forall al b ar. (al -> b) -> (ar -> b) -> Either al ar -> b
either a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id
tag :: (Bool, a) -> Either a a
tag (Bool
True, a
a) = a -> Either a a
forall a b. b -> Either a b
Right a
a
tag (Bool
False, a
a) = a -> Either a a
forall a b. a -> Either a b
Left a
a