+data
+ Ext g x y
+ = Ext (g x y)
+
+
+--
+-- | Every IGArrow of (->) is a GArrow
+--
+instance IGArrow (->) (,) () g (**) u => Category (Ext g) where
+ id = Ext (iga_id ())
+ (Ext g) . (Ext f) = Ext (iga_comp (f,g))
+
+instance IGArrow (->) (,) () g (**) u => GArrow (Ext g) (**) u where
+-- ga_first (Ext f) = Ext $ iga_first f
+-- ga_second (Ext f) = Ext $ iga_second f
+ ga_cancell = Ext $ iga_cancell ()
+ ga_cancelr = Ext $ iga_cancelr ()
+ ga_uncancell = Ext $ iga_uncancell ()
+ ga_uncancelr = Ext $ iga_uncancelr ()
+ ga_assoc = Ext $ iga_assoc ()
+ ga_unassoc = Ext $ iga_unassoc ()
+
+instance IGArrowSwap (->) (,) () g (**) u => GArrowSwap (Ext g) (**) u where
+instance IGArrowCopy (->) (,) () g (**) u => GArrowCopy (Ext g) (**) u where
+instance IGArrowDrop (->) (,) () g (**) u => GArrowDrop (Ext g) (**) u where
+
+
+-- iga_kappa :: forall a b c uu . (forall gg (***) . IGArrow g (**) u gg (***) uu => g (gg uu a) (gg b c)) ->
+-- (forall gg (***) . IGArrow g (**) u gg (***) uu => g u (gg (a***b) c))
+{-
+ Could not deduce (GArrowDrop gg (***) uu,
+ GArrowSwap gg (***) uu,
+ GArrowCopy gg (***) uu)
+ arising from a use of `homfunctor_inv'
+ from the context (IGArrow (->) (,) () gg (***) uu)
+-}
+
+--homfunctor_inv :: forall a b c u .
+-- (forall g (**) . (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => g u a -> g b c) ->
+-- (forall g (**) . (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => g (a**b) c)
+
+--
+-- | Every GArrow is also an IKappa of (->) by virtue of GArrowFullyEnriched
+--
+instance IKappa (->) (,) () where
+-- iga_kappa :: forall a b c u .
+-- (forall g (**) . (IGArrow (->) (,) () g (**) u,
+-- IGArrowCopy (->) (,) () g (**) u,
+-- IGArrowSwap (->) (,) () g (**) u,
+-- IGArrowDrop (->) (,) () g (**) u) => (g u a) -> (g b c)) ->
+-- (forall g (**) . (IGArrow (->) (,) () g (**) u,
+-- IGArrowCopy (->) (,) () g (**) u,
+-- IGArrowSwap (->) (,) () g (**) u,
+-- IGArrowDrop (->) (,) () g (**) u) => () -> (g (a**b) c))
+ iga_kappa (f :: forall g (**) .
+ (IGArrow (->) (,) () g (**) u,
+ IGArrowCopy (->) (,) () g (**) u,
+ IGArrowDrop (->) (,) () g (**) u,
+ IGArrowSwap (->) (,) () g (**) u) =>
+ (g u a)->(g b c)) ()
+ = mork $ homfunctor_inv (\y -> case f (In y) of (In q) -> q)
+
+mork :: forall u a b c .
+ (forall g (**) . (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => g (a**b) c)
+ -> (forall g (**) . (IGArrow (->) (,) () g (**) u,
+ IGArrowCopy (->) (,) () g (**) u,
+ IGArrowSwap (->) (,) () g (**) u,
+ IGArrowDrop (->) (,) () g (**) u) => (g (a**b) c))
+mork = undefined
+{-
+ z :: forall g (**) . IGArrow (->) (,) () g (**) u => g (a**b) c
+ z = let
+ qf :: forall g (**) . (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => g u a -> g b c
+ qf y = f y
+ in case homfunctor_inv qf of Ext q -> q
+-}
+
+{-
+instance IGArrow (->) (,) () g (**) u => GArrowSTKC (Ext g)
+-}