[fix] Added/modified utility functions.

heftia/src/Control/Effect/Freer.hs

@@ -150,6 +150,18 @@ interpretContT ::
 interpretContT i = interpretMK i . splitFreerEffects @_ @fr
 {-# INLINE interpretContT #-}
 
+interpretAll ::
+    (TransFreer c fr, Union u, c f, c g) =>
+    (f ~> g) ->
+    (u es ~> g) ->
+    (e ~> g) ->
+    FreerEffects fr u (e ': es) f ~> g
+interpretAll iLower iOther iTarget a =
+    runFreerEffects a & interpretFT iLower \u ->
+        case decomp u of
+            Left e -> iTarget e
+            Right e -> iOther e
+
 reinterpret ::
     (TransFreer c fr, Union u, c f) =>
     (e ~> FreerEffects fr u (e ': es) f) ->
@@ -211,7 +223,7 @@ interposeT f a =
     hoistT = coerce
     {-# INLINE hoistT #-}
 
-interposeF ::
+interposeAll ::
     forall e g fr u es f c.
     ( TransFreer c fr
     , Union u
@@ -223,7 +235,7 @@ interposeF ::
     (u es ~> g) ->
     (e ~> g) ->
     FreerEffects fr u es f ~> g
-interposeF iLower iOther iTarget a =
+interposeAll iLower iOther iTarget a =
     runFreerEffects a & interpretFT iLower \u ->
         case project @_ @e u of
             Just e -> iTarget e

heftia/src/Control/Effect/Heftia.hs

@@ -28,7 +28,7 @@ import Control.Heftia.Trans (
     TransHeftia,
     elaborateHT,
     hoistHeftia,
-    interpretLowerH,
+    interpretLowerHT,
     liftLowerHT,
     liftSigT,
     reelaborateHT,
@@ -554,20 +554,26 @@ interposeIns ::
     , Member u' e es'
     , c (FreerEffects fr u' es' f)
     , c' f
-    , c' (h (u es) (FreerEffects fr u' es' f))
+    , c' (HeftiaEffects h u es (FreerEffects fr u' es' f))
     ) =>
     (e ~> HeftiaEffects h u es (FreerEffects fr u' es' f)) ->
     HeftiaEffects h u es (FreerEffects fr u' es' f)
         ~> HeftiaEffects h u es (FreerEffects fr u' es' f)
 interposeIns f =
-    overHeftiaEffects $
-        interpretLowerH $
-            runFreerEffects
-                >>> interpretFT
-                    (liftLowerHT . freerEffects . liftLowerFT)
-                    \u -> case project @_ @e u of
-                        Just e -> runHeftiaEffects $ f e
-                        Nothing -> liftLowerHT $ freerEffects $ liftInsT u
+    interpretLowerH $
+        runFreerEffects
+            >>> interpretFT
+                (liftLowerH . freerEffects . liftLowerFT)
+                \u -> case project @_ @e u of
+                    Just e -> f e
+                    Nothing -> liftLowerH $ freerEffects $ liftInsT u
+
+interpretLowerH ::
+    (c f, c g, TransHeftia c h, HFunctor (u es)) =>
+    (f ~> HeftiaEffects h u es g) ->
+    HeftiaEffects h u es f ~> HeftiaEffects h u es g
+interpretLowerH f = overHeftiaEffects $ interpretLowerHT (runHeftiaEffects . f)
+{-# INLINE interpretLowerH #-}
 
 liftLowerH :: (TransHeftia c h, c f, HFunctor (u es)) => f ~> HeftiaEffects h u es f
 liftLowerH = heftiaEffects . liftLowerHT

heftia/src/Control/Heftia/Trans.hs

@@ -42,9 +42,9 @@ class (forall sig f. c f => c (h sig f)) => TransHeftia c h | h -> c where
     hoistHeftia phi = elaborateHT (liftLowerHT . phi) liftSigT
     {-# INLINE hoistHeftia #-}
 
-    interpretLowerH :: (HFunctor sig, c f, c g) => (f ~> h sig g) -> h sig f ~> h sig g
-    interpretLowerH f = elaborateHT f liftSigT
-    {-# INLINE interpretLowerH #-}
+    interpretLowerHT :: (HFunctor sig, c f, c g) => (f ~> h sig g) -> h sig f ~> h sig g
+    interpretLowerHT f = elaborateHT f liftSigT
+    {-# INLINE interpretLowerHT #-}
 
     runElaborateH :: (c f, HFunctor sig) => (sig f ~> f) -> h sig f ~> f
     default runElaborateH :: (c f, c (IdentityT f), HFunctor sig) => (sig f ~> f) -> h sig f ~> f