🔥 interposition

ChangeLog.md

@@ -6,8 +6,6 @@
 
 - Adds a `foldMapA` function to `Control.Effect.NonDet` mapping containers into nondeterministic computations using a supplied function. ([#204](https://github.com/fused-effects/fused-effects/pull/204))
 
-- Defines new `Inject` and `Project` typeclasses, each providing half of `Member`, and redefines `Member` as a constraint synonym for both of them. ([#217](https://github.com/fused-effects/fused-effects/pull/217))
-
 - Defines a new `Has` constraint synonym, conveniently combining `Carrier` and `Member` constraints and used for all effect constructors. ([#217](https://github.com/fused-effects/fused-effects/pull/217))
 
 - Allows effects to be defined and handled as sums of other effects, while still using the constructors for the component effects. This has been used to redefine `NonDet` as a sum of `Empty` and `Choose`. ([#199](https://github.com/fused-effects/fused-effects/pull/199), [#219](https://github.com/fused-effects/fused-effects/pull/219))
@@ -36,6 +34,10 @@
   - Handlers which return a `Monoid` are suffixed with `M`, e.g. `runNonDetM`.
   - Handlers which return a `Semigroup` are suffixed with `S`, e.g. `runChooseS`.
 
+- Removes `InterposeC` & `runInterpose` due to their inefficiency. They can be replaced with use of `InterpretC`/`runInterpret` for the desired effect. ([#223](https://github.com/fused-effects/fused-effects/pull/223))
+
+- Removes `prj` from `Member`, as it was only used in `InterposeC` (see above), and was generally inadvisable due to its lack of modularity. ([#223](https://github.com/fused-effects/fused-effects/pull/223))
+
 # v0.5.0.1
 
 - Adds support for ghc 8.8.1.

fused-effects.cabal

@@ -53,7 +53,6 @@ library
     Control.Carrier.Error.Either
     Control.Carrier.Fail.Either
     Control.Carrier.Fresh.Strict
-    Control.Carrier.Interpose
     Control.Carrier.Interpret
     Control.Carrier.Lift
     Control.Carrier.NonDet.Church

src/Control/Carrier.hs

@@ -14,7 +14,7 @@ import Control.Carrier.Pure
 import Control.Effect.Class
 import Control.Effect.Sum
 
-type Has eff sig m = (Inject eff sig, Carrier sig m)
+type Has eff sig m = (Member eff sig, Carrier sig m)
 
 -- | Construct a request for an effect to be interpreted by some handler later on.
 send :: Has eff sig m => eff m a -> m a

src/Control/Effect/Sum.hs

@@ -1,14 +1,16 @@
-{-# LANGUAGE ConstraintKinds, DeriveGeneric, DeriveTraversable, FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
+-- | Operations on /sums/, combining effects into a /signature/.
 module Control.Effect.Sum
-( (:+:)(..)
-, Member
-, Inject(..)
-, Project(..)
+( -- * Membership
+  Member(..)
+  -- * Sums
+, (:+:)(..)
 ) where
 
 import Control.Effect.Class
 import GHC.Generics (Generic1)
 
+-- | Higher-order sums are used to combine multiple effects into a signature, typically by chaining on the right.
 data (f :+: g) (m :: * -> *) k
   = L (f m k)
   | R (g m k)
@@ -20,54 +22,35 @@ instance (HFunctor f, HFunctor g) => HFunctor (f :+: g)
 instance (Effect f, Effect g)     => Effect   (f :+: g)
 
 
-type Member sub sup = (Inject sub sup, Project sub sup)
-
-
-class Inject (sub :: (* -> *) -> (* -> *)) sup where
+-- | The class of types present in a signature.
+--
+--   This is based on Wouter Swierstra’s design described in [Data types à la carte](http://www.cs.ru.nl/~W.Swierstra/Publications/DataTypesALaCarte.pdf). As described therein, overlapping instances are required in order to distinguish e.g. left-occurrence from right-recursion.
+--
+--   It should not generally be necessary for you to define new 'Member' instances, but these are not specifically prohibited if you wish to get creative.
+class Member (sub :: (* -> *) -> (* -> *)) sup where
+  -- | Inject a member of a signature into the signature.
   inj :: sub m a -> sup m a
 
-instance Inject t t where
+-- | Reflexivity: @t@ is a member of itself.
+instance Member t t where
   inj = id
 
+-- | Left-recursion: if @t@ is a member of @l1 ':+:' l2 ':+:' r@, then we can inject it into @(l1 ':+:' l2) ':+:' r@ by injection into a right-recursive signature, followed by left-association.
 instance {-# OVERLAPPABLE #-}
-         Inject t (l1 :+: l2 :+: r)
-      => Inject t ((l1 :+: l2) :+: r) where
+         Member t (l1 :+: l2 :+: r)
+      => Member t ((l1 :+: l2) :+: r) where
   inj = reassoc . inj where
     reassoc (L l)     = L (L l)
     reassoc (R (L l)) = L (R l)
     reassoc (R (R r)) = R r
 
+-- | Left-occurrence: if @t@ is at the head of a signature, we can inject it in O(1).
 instance {-# OVERLAPPABLE #-}
-         Inject l (l :+: r) where
+         Member l (l :+: r) where
   inj = L
 
+-- | Right-recursion: if @t@ is a member of @r@, we can inject it into @r@ in O(n), followed by lifting that into @l ':+:' r@ in O(1).
 instance {-# OVERLAPPABLE #-}
-         Inject l r
-      => Inject l (l' :+: r) where
+         Member l r
+      => Member l (l' :+: r) where
   inj = R . inj
-
-
-class Project (sub :: (* -> *) -> (* -> *)) sup where
-  prj :: sup m a -> Maybe (sub m a)
-
-instance Project t t where
-  prj = Just
-
-instance {-# OVERLAPPABLE #-}
-         Project t (l1 :+: l2 :+: r)
-      => Project t ((l1 :+: l2) :+: r) where
-  prj = prj . reassoc where
-    reassoc (L (L l)) = L l
-    reassoc (L (R l)) = R (L l)
-    reassoc (R r)     = R (R r)
-
-instance {-# OVERLAPPABLE #-}
-         Project l (l :+: r) where
-  prj (L f) = Just f
-  prj _     = Nothing
-
-instance {-# OVERLAPPABLE #-}
-         Project l r
-      => Project l (l' :+: r) where
-  prj (R g) = prj g
-  prj _     = Nothing

test/Control/Effect/Spec.hs

@@ -9,7 +9,6 @@ import Control.Carrier.Error.Either
 import Control.Carrier.Fail.Either
 import Control.Carrier.Reader
 import Control.Carrier.State.Strict
-import Control.Effect.Sum
 import Prelude hiding (fail)
 import Test.Hspec
 import Test.Inspection as Inspection
@@ -18,7 +17,6 @@ spec :: Spec
 spec = do
   inference
   reinterpretation
-  interposition
   fusion
 
 inference :: Spec
@@ -62,30 +60,6 @@ instance (Carrier sig m, Effect sig) => Carrier (Reader r :+: sig) (ReinterpretR
   eff (R other)         = ReinterpretReaderC (eff (R (handleCoercible other)))
 
 
-interposition :: Spec
-interposition = describe "interposition" $ do
-  it "can interpose handlers without changing the available effects" $
-    run (runFail (interposeFail (fail "world"))) `shouldBe` (Left "hello, world" :: Either String Int)
-
-  it "interposition only intercepts effects in its scope" $ do
-    run (runFail (fail "world" *> interposeFail (pure (0 :: Int)))) `shouldBe` Left "world"
-    run (runFail (interposeFail (pure (0 :: Int)) <* fail "world")) `shouldBe` Left "world"
-
-interposeFail :: InterposeC m a -> m a
-interposeFail = runInterposeC
-
-newtype InterposeC m a = InterposeC { runInterposeC :: m a }
-  deriving (Applicative, Functor, Monad)
-
-instance (Carrier sig m, Member Fail sig) => MonadFail (InterposeC m) where
-  fail s = send (Fail s)
-
-instance (Carrier sig m, Member Fail sig) => Carrier sig (InterposeC m) where
-  eff op
-    | Just (Fail s) <- prj op = InterposeC (send (Fail ("hello, " ++ s)))
-    | otherwise               = InterposeC (eff (handleCoercible op))
-
-
 shouldSucceed :: Inspection.Result -> Expectation
 shouldSucceed (Success _) = pure ()
 shouldSucceed (Failure f) = expectationFailure f