1 {-# OPTIONS -XRankNTypes -XMultiParamTypeClasses -XNoMonomorphismRestriction -XTypeOperators -XFlexibleInstances -XFunctionalDependencies #-}
2 -----------------------------------------------------------------------------
4 -- Module : GHC.HetMet.GArrow
6 -- License : public domain
8 -- Maintainer : Adam Megacz <megacz@acm.org>
9 -- Stability : experimental
10 -- Portability : portable
12 module GHC.HetMet.GArrow (
22 import Control.Category
24 class Category g => GArrow g (**) | g -> (**) where
25 ga_first :: g x y -> g (x ** z) (y ** z)
26 ga_second :: g x y -> g (z ** x) (z ** y)
27 ga_cancell :: g (()**x) x
28 ga_cancelr :: g (x**()) x
29 ga_uncancell :: g x (()**x)
30 ga_uncancelr :: g x (x**())
31 ga_assoc :: g ((x**y)**z) (x**(y**z))
32 ga_unassoc :: g (x**(y**z)) ((x**y)**z)
34 class GArrow g (**) => GArrowDrop g (**) where
37 class GArrow g (**) => GArrowCopy g (**) where
40 class GArrow g (**) => GArrowSwap g (**) where
41 ga_swap :: g (x**y) (y**x)
43 -- implementation of ga_second for GArrowSwap instances
44 ga_swap_second f = ga_swap >>> ga_first f >>> ga_swap
46 class GArrow g (**) => GArrowLoop g (**) where
47 ga_loop :: g (x**z) (y**z) -> g x y
49 class GArrow g (**) => GArrowLiteral g (**) a where
50 ga_literal :: a -> g () a
52 -- not sure -- subject to change
53 class GArrow g (**) => GArrowReify g (**) where
54 ga_reify :: (x -> y) -> g x y
56 -- not sure -- subject to change
57 class GArrow g (**) => GArrowReflect g (**) where
58 ga_reflect :: g x y -> (x -> y)