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   GArrowConstant(..),
  19   GArrowRun(..),
  20   GArrowReify(..),
  21   GArrowReflect(..)
  22 ) where
  23 import Control.Category
  24
  25 ------------------------------------------------------------------------
  26 -- The main GArrow class
  27
  28 class Category g => GArrow g (**) | g -> (**) where
  29 --id           :: g x x
  30 --comp         :: g x y -> g y z -> g x z
  31   ga_first     :: g x y -> g (x ** z) (y ** z)
  32   ga_second    :: g x y -> g (z ** x) (z ** y)
  33   ga_cancell   :: g (()**x) x
  34   ga_cancelr   :: g (x**()) x
  35   ga_uncancell :: g x       (()**x)
  36   ga_uncancelr :: g x       (x**())
  37   ga_assoc     :: g ((x**y)**z) (x**(y**z))
  38   ga_unassoc   :: g (x**(y**z)) ((x**y)**z)
  39
  40
  41 ------------------------------------------------------------------------
  42 -- The three context-manipulation classes
  43
  44 class GArrow g (**) => GArrowCopy g (**) where
  45   ga_copy      :: g x (x**x)
  46
  47 class GArrow g (**) => GArrowDrop g (**) where
  48   ga_drop      :: g x ()
  49
  50 class GArrow g (**) => GArrowSwap g (**) where
  51   ga_swap      :: g (x**y) (y**x)
  52
  53 ga_swap_second f =
  54    ga_swap >>> ga_first f >>> ga_swap
  55    -- implementation of ga_second for GArrowSwap
  56    -- See also
  57    -- http://haskell.org/haskellwiki/Class_system_extension_proposal
  58    -- "Allowing superclass methods to be overridden in derived classes";
  59    -- if we had this we could do a better job here
  60
  61
  62
  63 ------------------------------------------------------------------------
  64 -- Loop
  65
  66 class GArrow g (**) => GArrowLoop g (**) where
  67   ga_loop      :: g (x**z) (y**z) -> g x y
  68
  69
  70
  71 ------------------------------------------------------------------------
  72 -- Constant and Run, which are dual to each other
  73
  74 class GArrow g (**) => GArrowConstant g (**) where
  75   ga_constant  :: a -> g () a
  76
  77 -- the dual of GArrowConstant
  78 class GArrow g (**) => GArrowRun g (**) where
  79   ga_run       :: g () a -> a
  80
  81
  82
  83 ------------------------------------------------------------------------
  84 -- Reify and Reflect, which are "curried" versions
  85
  86 -- Not sure -- subject to change.  If you have this, you're basically
  87 -- a Control.Arrow; you can also define essentially all the other
  88 -- methods of GArrow, GArrowDrop, GArrowCopy, etc in terms of this.
  89 class GArrow g (**) => GArrowReify g (**) where
  90   ga_reify     :: (x -> y) -> g x y
  91
  92 -- not sure -- subject to change
  93 class GArrow g (**) => GArrowReflect g (**) where
  94   ga_reflect   :: g x y -> (x -> y)