+{-# LANGUAGE RankNTypes, ScopedTypeVariables, NoMonomorphismRestriction, TypeOperators, FunctionalDependencies, FlexibleContexts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : GHC.HetMet.GArrow
+-- Copyright : none
+-- License : public domain
+--
+-- Maintainer : Adam Megacz <megacz@acm.org>
+-- Stability : experimental
+-- Portability : portable
+
+module GHC.HetMet.Private (
+ PGArrow,
+ pga_id,
+ pga_comp,
+ pga_first,
+ pga_second,
+ pga_cancell,
+ pga_cancelr,
+ pga_uncancell,
+ pga_uncancelr,
+ pga_assoc,
+ pga_unassoc,
+ pga_copy,
+ pga_drop,
+ pga_swap,
+ pga_applyl,
+ pga_applyr,
+ pga_curryl,
+ pga_curryr
+) where
+import Control.Category ( (>>>) )
+import qualified Control.Category
+import GHC.HetMet.GArrow
+
+-------------------------------------------------------------------------
+-- Used internally by the compiler, subject to change without notice!!
+
+newtype PGArrow x y = PGArrow { unG :: forall g. GArrowSTKC g (,) () => g x y }
+
+pga_id :: PGArrow x x
+pga_id = PGArrow { unG = Control.Category.id }
+pga_comp :: forall x y z. PGArrow x y -> PGArrow y z -> PGArrow x z
+pga_comp f g = PGArrow { unG = unG f >>> unG g }
+pga_first :: PGArrow x y -> PGArrow (x , z) (y , z)
+pga_first f = PGArrow { unG = ga_first $ unG f }
+pga_second :: PGArrow x y -> PGArrow (z , x) (z , y)
+pga_second f = PGArrow { unG = ga_second $ unG f }
+pga_cancell :: PGArrow ((),x) x
+pga_cancell = PGArrow { unG = ga_cancell }
+pga_cancelr :: PGArrow (x,()) x
+pga_cancelr = PGArrow { unG = ga_cancelr }
+pga_uncancell :: PGArrow x ((),x)
+pga_uncancell = PGArrow { unG = ga_uncancell }
+pga_uncancelr :: PGArrow x (x,())
+pga_uncancelr = PGArrow { unG = ga_uncancelr }
+pga_assoc :: PGArrow ((x, y),z ) ( x,(y ,z))
+pga_assoc = PGArrow { unG = ga_assoc }
+pga_unassoc :: PGArrow ( x,(y ,z)) ((x, y),z )
+pga_unassoc = PGArrow { unG = ga_unassoc }
+pga_copy :: PGArrow x (x,x)
+pga_copy = PGArrow { unG = ga_copy }
+pga_drop :: PGArrow x ()
+pga_drop = PGArrow { unG = ga_drop }
+pga_swap :: PGArrow (x,y) (y,x)
+pga_swap = PGArrow { unG = ga_swap }
+pga_applyl :: PGArrow (x,(x->y) ) y
+pga_applyl = error "not implemented"
+pga_applyr :: PGArrow ( (x->y),x) y
+pga_applyr = error "not implemented"
+pga_curryl :: PGArrow (x,y) z -> PGArrow x (y->z)
+pga_curryl = error "not implemented"
+pga_curryr :: PGArrow (x,y) z -> PGArrow y (x->z)
+pga_curryr = error "not implemented"