add experimental GArrowKappa

diff --git a/GHC/HetMet/GArrow.hs b/GHC/HetMet/GArrow.hs
index 0c32468..b9bfccf 100644 (file)
--- a/GHC/HetMet/GArrow.hs
+++ b/GHC/HetMet/GArrow.hs
@@ -30,12 +30,14 @@ module GHC.HetMet.GArrow (
   GArrowCurry(..),
   GArrowApply(..),
 
+  GArrowKappa(..),
   GArrowSTKC(..),
   GArrowSTLC(..),
   GArrowPCF(..)
 
 ) where
-import Control.Category
+import Control.Category hiding ((.))
+import Prelude          hiding (id)
 
 ------------------------------------------------------------------------
 -- The main GArrow class
@@ -127,7 +129,7 @@ class GArrow g (**) u => GArrowConstant g (**) u t r where
 
 
 ------------------------------------------------------------------------
--- Reify and Reflect, which are "curried" versions
+-- Reify and Reflect, which are "curried" versions of eval/const
 
 -- If you have this for R the identity map on types, you're basically
 -- a Control.Arrow; you can also define essentially all the other
@@ -142,6 +144,19 @@ class GArrow g (**) u => GArrowReflect g (**) u r q x y where
 
 
 ------------------------------------------------------------------------
+-- The Kappa adjunction
+--
+-- See Hasegawa, Decomposing Typed Lambda Calculus into a Couple of
+-- Categorical Programming Languages) section 3, rule $(\times L)$
+
+class GArrow g (**) u => GArrowKappa g (**) u where
+  ga_kappa :: (g u x -> g u y) -> g x y
+
+
+
+
+
+------------------------------------------------------------------------
 -- Apply and Curry
 
 class GArrow g (**) u => GArrowApply g (**) u (~>) where