-{-# OPTIONS -XRankNTypes -XMultiParamTypeClasses -XNoMonomorphismRestriction -XTypeOperators -XFlexibleInstances -XFunctionalDependencies #-}
+{-# OPTIONS -XRankNTypes -XMultiParamTypeClasses -XNoMonomorphismRestriction -XTypeOperators -XFunctionalDependencies #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.HetMet.GArrow
------------------------------------------------------------------------
-- The main GArrow class
-class Category g => GArrow g (**) u | (**) -> u where
+class Category g => GArrow g (**) u | (**) -> u, u -> (**) where
--id :: g x x
--comp :: g x y -> g y z -> g x z
ga_first :: g x y -> g (x ** z) (y ** z)
class (GArrow g (**) u,
GArrow g (<*>) v) =>
- GArrowProd g (**) u (<*>) v where
+ GArrowProd g (**) u (<*>) v
+
+ -- fundep: in any given context, (<*>) may serve as the
+ -- product for at most one GArrow
+ | (**) -> (<*>),
+ (<*>) -> v, v -> (<*>) where
ga_prod_copy :: g x (x<*>x)
ga_prod_drop :: g x v
class (GArrow g (**) u,
GArrow g (<+>) v) =>
- GArrowSum g (**) u (<+>) v where
+ GArrowSum g (**) u (<+>) v
+
+ -- fundep: in any given context, (<+>) may serve as the
+ -- coproduct for at most one GArrow
+ | (<+>) -> (**),
+ (<+>) -> v, v -> (<+>) where
ga_merge :: g (x<+>x) x
ga_never :: g v x
+-- Note to self: do not remove this type declaration; it ensures that if
+-- I fiddle with the GArrowSum fundeps and get them wrong (i.e. insufficient)
+-- I'll find out about it when compiling the base library.
+ga_inl :: GArrowSum g (**) u (<+>) v => g x (x<+>y)
ga_inl = ga_uncancelr >>> ga_second ga_never
+
+ga_inr :: GArrowSum g (**) u (<+>) v => g x (y<+>x)
ga_inr = ga_uncancell >>> ga_first ga_never
+
------------------------------------------------------------------------
-- Loop