Utility functions for handling effects (#231)

* Add utility functions for first order effects

* Add utility functions that take the effect handler as the last parameter

* Annotate type parameters of EffectHandler with their kinds

effectful-core/CHANGELOG.md

@@ -1,3 +1,9 @@
+# effectful-core-2.4.0.0 (????-??-??)
+* Add utility functions for handling effects that take the effect handler as the
+  last parameter to `Effectful.Dispatch.Dynamic`.
+* Add utility functions for handling first order effects to
+  `Effectful.Dispatch.Dynamic`.
+
 # effectful-core-2.3.1.0 (2024-06-07)
 * Drop support for GHC 8.8.
 * Remove inaccurate information from the `Show` instance of `ErrorWrapper`.

effectful-core/effectful-core.cabal

@@ -1,7 +1,7 @@
 cabal-version:      3.0
 build-type:         Simple
 name:               effectful-core
-version:            2.3.1.0
+version:            2.4.0.0
 license:            BSD-3-Clause
 license-file:       LICENSE
 category:           Control

effectful-core/src/Effectful/Dispatch/Dynamic.hs

@@ -23,9 +23,13 @@ module Effectful.Dispatch.Dynamic
     -- * Handling effects
   , EffectHandler
   , interpret
+  , interpretWith
   , reinterpret
+  , reinterpretWith
   , interpose
+  , interposeWith
   , impose
+  , imposeWith
 
     -- ** Handling local 'Eff' computations
   , LocalEnv
@@ -53,6 +57,17 @@ module Effectful.Dispatch.Dynamic
   , localBorrow
   , SharedSuffix
 
+    -- ** Utils for first order effects
+  , EffectHandler_
+  , interpret_
+  , interpretWith_
+  , reinterpret_
+  , reinterpretWith_
+  , interpose_
+  , interposeWith_
+  , impose_
+  , imposeWith_
+
     -- * Re-exports
   , HasCallStack
   ) where
@@ -212,6 +227,9 @@ import Effectful.Internal.Utils
 --
 -- If an effect makes use of the @m@ parameter, it is a /higher order effect/.
 --
+-- /Note:/ for handling first order effects you can use 'interpret_' or
+-- 'reinterpret_' whose 'EffectHandler_' doesn't take the 'LocalEnv' parameter.
+--
 -- Interpretation of higher order effects is slightly more involving. To see
 -- why, let's consider the @Profiling@ effect for logging how much time a
 -- specific action took to run:
@@ -343,7 +361,7 @@ import Effectful.Internal.Utils
 --
 -- >>> :{
 --   runDummyRNG :: Eff (RNG : es) a -> Eff es a
---   runDummyRNG = interpret $ \_ -> \case
+--   runDummyRNG = interpret_ $ \case
 --     RandomInt -> pure 55
 -- :}
 --
@@ -418,6 +436,17 @@ interpret handler m = unsafeEff $ \es -> do
   where
     mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)
 
+-- | 'interpret' with the effect handler as the last argument.
+--
+-- @since 2.4.0.0
+interpretWith
+  :: DispatchOf e ~ Dynamic
+  => Eff (e : es) a
+  -> EffectHandler e es
+  -- ^ The effect handler.
+  -> Eff      es  a
+interpretWith m handler = interpret handler m
+
 -- | Interpret an effect using other, private effects.
 --
 -- @'interpret' ≡ 'reinterpret' 'id'@
@@ -435,6 +464,19 @@ reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
   where
     mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)
 
+-- | 'reinterpret' with the effect handler as the last argument.
+--
+-- @since 2.4.0.0
+reinterpretWith
+  :: DispatchOf e ~ Dynamic
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> Eff (e : es) a
+  -> EffectHandler e handlerEs
+  -- ^ The effect handler.
+  -> Eff      es  b
+reinterpretWith runHandlerEs m handler = reinterpret runHandlerEs handler m
+
 -- | Replace the handler of an existing effect with a new one.
 --
 -- /Note:/ this function allows for augmenting handlers with a new functionality
@@ -448,7 +490,7 @@ reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
 --
 -- >>> :{
 --   runE :: IOE :> es => Eff (E : es) a -> Eff es a
---   runE = interpret $ \_ Op -> liftIO (putStrLn "op")
+--   runE = interpret_ $ \Op -> liftIO (putStrLn "op")
 -- :}
 --
 -- >>> runEff . runE $ send Op
@@ -456,7 +498,7 @@ reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
 --
 -- >>> :{
 --   augmentE :: (E :> es, IOE :> es) => Eff es a -> Eff es a
---   augmentE = interpose $ \_ Op -> liftIO (putStrLn "augmented op") >> send Op
+--   augmentE = interpose_ $ \Op -> liftIO (putStrLn "augmented op") >> send Op
 -- :}
 --
 -- >>> runEff . runE . augmentE $ send Op
@@ -489,6 +531,17 @@ interpose handler m = unsafeEff $ \es -> do
   where
     mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)
 
+-- | 'interpose' with the effect handler as the last argument.
+--
+-- @since 2.4.0.0
+interposeWith
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => Eff es a
+  -> EffectHandler e es
+  -- ^ The effect handler.
+  -> Eff es a
+interposeWith m handler = interpose handler m
+
 -- | Replace the handler of an existing effect with a new one that uses other,
 -- private effects.
 --
@@ -523,6 +576,127 @@ impose runHandlerEs handler m = unsafeEff $ \es -> do
   where
     mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)
 
+-- | 'impose' with the effect handler as the last argument.
+--
+-- @since 2.4.0.0
+imposeWith
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> Eff es a
+  -> EffectHandler e handlerEs
+  -- ^ The effect handler.
+  -> Eff es b
+imposeWith runHandlerEs m handler = impose runHandlerEs handler m
+
+----------------------------------------
+-- First order effects
+
+-- | Type signature of a first order effect handler.
+--
+-- @since 2.4.0.0
+type EffectHandler_ (e :: Effect) (es :: [Effect])
+  = forall a localEs. HasCallStack
+  => e (Eff localEs) a
+  -- ^ The operation.
+  -> Eff es a
+
+-- | 'interpret' for first order effects.
+--
+-- @since 2.4.0.0
+interpret_
+  :: DispatchOf e ~ Dynamic
+  => EffectHandler_ e es
+  -- ^ The effect handler.
+  -> Eff (e : es) a
+  -> Eff      es  a
+interpret_ handler = interpret (const handler)
+
+-- | 'interpretWith' for first order effects.
+--
+-- @since 2.4.0.0
+interpretWith_
+  :: DispatchOf e ~ Dynamic
+  => Eff (e : es) a
+  -> EffectHandler_ e es
+  -- ^ The effect handler.
+  -> Eff      es  a
+interpretWith_ m handler = interpretWith m (const handler)
+
+-- | 'reinterpret' for first order effects.
+--
+-- @since 2.4.0.0
+reinterpret_
+  :: DispatchOf e ~ Dynamic
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> EffectHandler_ e handlerEs
+  -- ^ The effect handler.
+  -> Eff (e : es) a
+  -> Eff      es  b
+reinterpret_ runHandlerEs handler = reinterpret runHandlerEs (const handler)
+
+-- | 'reinterpretWith' for first order effects.
+--
+-- @since 2.4.0.0
+reinterpretWith_
+  :: DispatchOf e ~ Dynamic
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> Eff (e : es) a
+  -> EffectHandler_ e handlerEs
+  -- ^ The effect handler.
+  -> Eff      es  b
+reinterpretWith_ runHandlerEs m handler = reinterpretWith runHandlerEs m (const handler)
+
+-- | 'interpose' for first order effects.
+--
+-- @since 2.4.0.0
+interpose_
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => EffectHandler_ e es
+  -- ^ The effect handler.
+  -> Eff es a
+  -> Eff es a
+interpose_ handler = interpose (const handler)
+
+-- | 'interposeWith' for first order effects.
+--
+-- @since 2.4.0.0
+interposeWith_
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => Eff es a
+  -> EffectHandler_ e es
+  -- ^ The effect handler.
+  -> Eff es a
+interposeWith_ m handler = interposeWith m (const handler)
+
+-- | 'impose' for first order effects.
+--
+-- @since 2.4.0.0
+impose_
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> EffectHandler_ e handlerEs
+  -- ^ The effect handler.
+  -> Eff es a
+  -> Eff es b
+impose_ runHandlerEs handler = impose runHandlerEs (const handler)
+
+-- | 'imposeWith' for first order effects.
+--
+-- @since 2.4.0.0
+imposeWith_
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> Eff es a
+  -> EffectHandler_ e handlerEs
+  -- ^ The effect handler.
+  -> Eff es b
+imposeWith_ runHandlerEs m handler = imposeWith runHandlerEs m (const handler)
+
 ----------------------------------------
 -- Unlifts
 

effectful-core/src/Effectful/Fail.hs

@@ -15,10 +15,10 @@ import Effectful.Internal.Monad (Fail(..))
 
 -- | Run the 'Fail' effect via 'Error'.
 runFail :: Eff (Fail : es) a -> Eff es (Either String a)
-runFail = reinterpret runErrorNoCallStack $ \_ -> \case
+runFail = reinterpret_ runErrorNoCallStack $ \case
   Fail msg -> throwError msg
 
 -- | Run the 'Fail' effect via the 'MonadFail' instance for 'IO'.
 runFailIO :: IOE :> es => Eff (Fail : es) a -> Eff es a
-runFailIO = interpret $ \_ -> \case
+runFailIO = interpret_ $ \case
   Fail msg -> liftIO $ fail msg

effectful-core/src/Effectful/Internal/Monad.hs

@@ -494,13 +494,13 @@ type role LocalEnv nominal nominal
 newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env localEs)
 
 -- | Type signature of the effect handler.
-type EffectHandler e es
+type EffectHandler (e :: Effect) (es :: [Effect])
   = forall a localEs. (HasCallStack, e :> localEs)
   => LocalEnv localEs es
   -- ^ Capture of the local environment for handling local 'Eff' computations
   -- when @e@ is a higher order effect.
   -> e (Eff localEs) a
-  -- ^ The effect performed in the local environment.
+  -- ^ The operation.
   -> Eff es a
 
 -- | An internal representation of dynamically dispatched effects, i.e. the

effectful-core/src/Effectful/Provider.hs

@@ -74,7 +74,7 @@ import Effectful.Internal.Utils
 --     => FilePath
 --     -> Eff (Write : es) a
 --     -> Eff es a
---   runWriteIO fp = interpret $ \_ -> \case
+--   runWriteIO fp = interpret_ $ \case
 --     Write msg -> liftIO . putStrLn $ fp ++ ": " ++ msg
 -- :}
 --
@@ -84,7 +84,7 @@ import Effectful.Internal.Utils
 --     => FilePath
 --     -> Eff (Write : es) a
 --     -> Eff es a
---   runWritePure fp = interpret $ \_ -> \case
+--   runWritePure fp = interpret_ $ \case
 --     Write msg -> modify $ M.insertWith (++) fp [msg]
 -- :}
 --

effectful-plugin/tests/PluginTests.hs

@@ -96,7 +96,7 @@ data TaggedState k s :: Effect where
 type instance DispatchOf (TaggedState k s) = Dynamic
 
 runTaggedState :: s -> Eff (TaggedState k s : es) a -> Eff es (a, s)
-runTaggedState s = reinterpret (runState s) $ \_ -> \case
+runTaggedState s = reinterpret_ (runState s) $ \case
   TaggedGet    -> get
   TaggedPut s' -> put s'
 
@@ -112,5 +112,5 @@ data DBAction whichDb :: Effect where
 type instance DispatchOf (DBAction whichDb) = Dynamic
 
 runDBAction :: Eff (DBAction which : es) a -> Eff es a
-runDBAction = interpret $ \_ -> \case
+runDBAction = interpret_ $ \case
   DoSelect (Select a) -> pure $ Just a

effectful/CHANGELOG.md

@@ -1,3 +1,9 @@
+# effectful-2.4.0.0 (????-??-??)
+* Add utility functions for handling effects that take the effect handler as the
+  last parameter to `Effectful.Dispatch.Dynamic`.
+* Add utility functions for handling first order effects to
+  `Effectful.Dispatch.Dynamic`.
+
 # effectful-2.3.1.0 (2024-06-07)
 * Drop support for GHC 8.8.
 * Remove inaccurate information from the `Show` instance of `ErrorWrapper`.

effectful/bench/FileSizes.hs

@@ -102,7 +102,7 @@ effectful_tryFileSize :: Effectful_File E.:> es => FilePath -> E.Eff es (Maybe I
 effectful_tryFileSize = E.send . Effectful_tryFileSize
 
 effectful_runFile :: E.IOE E.:> es => E.Eff (Effectful_File : es) a -> E.Eff es a
-effectful_runFile = E.interpret \_ -> \case
+effectful_runFile = E.interpret_ \case
   Effectful_tryFileSize path -> liftIO $ tryGetFileSize path
 
 data Effectful_Logging :: E.Effect where
@@ -116,7 +116,7 @@ effectful_logMsg = E.send . Effectful_logMsg . T.pack
 effectful_runLogging
   :: E.Eff (Effectful_Logging : es) a
   -> E.Eff es (a, [Text])
-effectful_runLogging = E.reinterpret (E.runState []) \_ -> \case
+effectful_runLogging = E.reinterpret_ (E.runState []) \case
   Effectful_logMsg msg -> E.modify (msg :)
 
 ----------

effectful/effectful.cabal

@@ -1,7 +1,7 @@
 cabal-version:      3.0
 build-type:         Simple
 name:               effectful
-version:            2.3.1.0
+version:            2.4.0.0
 license:            BSD-3-Clause
 license-file:       LICENSE
 category:           Control
@@ -69,7 +69,7 @@ library
                     , async               >= 2.2.2
                     , bytestring          >= 0.10
                     , directory           >= 1.3.2
-                    , effectful-core      >= 2.3.1.0   && < 2.3.2.0
+                    , effectful-core      >= 2.4.0.0   && < 2.4.1.0
                     , process             >= 1.6.9
 
                     , time                >= 1.9.2

effectful/tests/EnvTests.hs

@@ -191,11 +191,11 @@ data A :: Effect where
 type instance DispatchOf A = Dynamic
 
 runA :: Int -> Eff (A : es) a -> Eff es a
-runA n = interpret $ \_ -> \case
+runA n = interpret_ $ \case
   A -> pure n
 
 doubleA :: A :> es => Eff es a -> Eff es a
-doubleA = interpose $ \_ -> \case
+doubleA = interpose_ $ \case
   A -> (+) <$> send A <*> send A
 
 data B :: Effect where
@@ -203,9 +203,9 @@ data B :: Effect where
 type instance DispatchOf B = Dynamic
 
 runB :: A :> es => Eff (B : es) a -> Eff es a
-runB = interpret $ \_ -> \case
+runB = interpret_ $ \case
   B -> send A
 
 doubleB :: B :> es => Eff es a -> Eff es a
-doubleB = interpose $ \_ -> \case
+doubleB = interpose_ $ \case
   B -> (+) <$> send B <*> send B

effectful/tests/ErrorTests.hs

@@ -42,5 +42,5 @@ outerThrow :: (HasCallStack, OuterThrow :> es) => Eff es ()
 outerThrow = send OuterThrow
 
 runOuterThrow :: Error String :> es => Eff (OuterThrow : es) a -> Eff es a
-runOuterThrow = interpret $ \_ -> \case
+runOuterThrow = interpret_ $ \case
   OuterThrow -> throwError "outer"

effectful/tests/NonDetTests.hs

@@ -84,7 +84,7 @@ outerEmpty :: (HasCallStack, OuterEmpty :> es) => Eff es a
 outerEmpty = send OuterEmpty
 
 runOuterEmpty :: NonDet :> es => Eff (OuterEmpty : es) a -> Eff es a
-runOuterEmpty = interpret $ \_ -> \case
+runOuterEmpty = interpret_ $ \case
   OuterEmpty -> emptyEff
 
 ----

effectful/tests/StateTests.hs

@@ -117,7 +117,7 @@ putInt = send . PutInt
 runHasInt :: Int -> Eff (HasInt : es) a -> Eff es a
 runHasInt n =
   -- reinterpret with redundant local effects
-  reinterpret (evalState () . evalState n . evalState True) $ \_ -> \case
+  reinterpret_ (evalState () . evalState n . evalState True) $ \case
     GetInt   -> get
     PutInt i -> put i