module Control.Category.Cartesian
( module Control.Category.Associative
, module Control.Category.Monoidal
, PreCartesian(..)
, bimapPreCartesian, braidPreCartesian, associatePreCartesian, coassociatePreCartesian
, PreCoCartesian(..)
, bimapPreCoCartesian, braidPreCoCartesian, associatePreCoCartesian, coassociatePreCoCartesian
, Cartesian
, CoCartesian
) where
import Control.Category.Hask
import Control.Category.Associative
import Control.Category.Monoidal
import Prelude hiding (Functor, map, (.), id, fst, snd, curry, uncurry)
import qualified Prelude (fst,snd)
import Control.Functor
import Control.Category
infixr 3 &&&
infixr 2 |||
class (Associative k p, Coassociative k p, Braided k p) => PreCartesian k p | k -> p where
fst :: k (p a b) a
snd :: k (p a b) b
diag :: k a (p a a)
(&&&) :: k a b -> k a c -> k a (p b c)
diag = id &&& id
f &&& g = bimap f g . diag
instance PreCartesian Hask (,) where
fst = Prelude.fst
snd = Prelude.snd
diag a = (a,a)
(f &&& g) a = (f a, g a)
class (Monoidal k p i, PreCartesian k p) => Cartesian k p i | k -> p i
instance (Monoidal k p i, PreCartesian k p) => Cartesian k p i
bimapPreCartesian :: PreCartesian k p => k a c -> k b d -> k (p a b) (p c d)
bimapPreCartesian f g = (f . fst) &&& (g . snd)
braidPreCartesian :: PreCartesian k p => k (p a b) (p b a)
braidPreCartesian = snd &&& fst
associatePreCartesian :: PreCartesian k p => k (p (p a b) c) (p a (p b c))
associatePreCartesian = (fst . fst) &&& first snd
coassociatePreCartesian :: PreCartesian k p => k (p a (p b c)) (p (p a b) c)
coassociatePreCartesian = braid . second braid . associatePreCartesian . first braid . braid
class (Associative k s, Coassociative k s , Braided k s) => PreCoCartesian k s | k -> s where
inl :: k a (s a b)
inr :: k b (s a b)
codiag :: k (s a a) a
(|||) :: k a c -> k b c -> k (s a b) c
codiag = id ||| id
f ||| g = codiag . bimap f g
instance PreCoCartesian Hask Either where
inl = Left
inr = Right
codiag (Left a) = a
codiag (Right a) = a
(f ||| _) (Left a) = f a
(_ ||| g) (Right a) = g a
bimapPreCoCartesian :: PreCoCartesian k s => k a c -> k b d -> k (s a b) (s c d)
bimapPreCoCartesian f g = (inl . f) ||| (inr . g)
braidPreCoCartesian :: PreCoCartesian k s => k (s a b) (s b a)
braidPreCoCartesian = inr ||| inl
associatePreCoCartesian :: PreCoCartesian k s => k (s (s a b) c) (s a (s b c))
associatePreCoCartesian = braid . first braid . coassociatePreCoCartesian . second braid . braid
coassociatePreCoCartesian :: PreCoCartesian k s => k (s a (s b c)) (s (s a b) c)
coassociatePreCoCartesian = (inl . inl) ||| first inr
class (Comonoidal k s i, PreCoCartesian k s) => CoCartesian k s i | k -> s i
instance (Comonoidal k s i, PreCoCartesian k s) => CoCartesian k s i