GHC/HetMet/GArrow.hs

   1 {-# OPTIONS -XRankNTypes -XMultiParamTypeClasses -XNoMonomorphismRestriction -XTypeOperators -XFlexibleInstances -XFunctionalDependencies #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  GHC.HetMet.GArrow
   5 -- Copyright   :  none
   6 -- License     :  public domain
   7 --
   8 -- Maintainer  :  Adam Megacz <megacz@acm.org>
   9 -- Stability   :  experimental
  10 -- Portability :  portable
  11
  12 module GHC.HetMet.GArrow (
  13   GArrow(..),
  14   GArrowDrop(..),
  15   GArrowCopy(..),
  16   GArrowSwap(..),
  17   GArrowLoop(..),
  18   GArrowReify(..),
  19   GArrowReflect(..),
  20   GArrowLiteral(..)
  21 ) where
  22 import Control.Category
  23
  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)
  33
  34 class GArrow g (**) => GArrowDrop g (**) where
  35   ga_drop      :: g x ()
  36
  37 class GArrow g (**) => GArrowCopy g (**) where
  38   ga_copy      :: g x (x**x)
  39
  40 class GArrow g (**) => GArrowSwap g (**) where
  41   ga_swap          :: g (x**y) (y**x)
  42
  43 -- implementation of ga_second for GArrowSwap instances
  44 ga_swap_second f = ga_swap >>> ga_first f >>> ga_swap
  45
  46 class GArrow g (**) => GArrowLoop g (**) where
  47   ga_loop      :: g (x**z) (y**z) -> g x y
  48
  49 class GArrow g (**) => GArrowLiteral g (**) a where
  50   ga_literal   :: a -> g () a
  51
  52 -- not sure -- subject to change
  53 class GArrow g (**) => GArrowReify g (**) where
  54   ga_reify     :: (x -> y) -> g x y
  55
  56 -- not sure -- subject to change
  57 class GArrow g (**) => GArrowReflect g (**) where
  58   ga_reflect   :: g x y -> (x -> y)
  59