Skip to content

Commit

Permalink
Utility functions for handling effects (#231)
Browse files Browse the repository at this point in the history
* 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
  • Loading branch information
arybczak committed Aug 9, 2024
1 parent e7adeef commit 14bbcfd
Show file tree
Hide file tree
Showing 14 changed files with 209 additions and 23 deletions.
6 changes: 6 additions & 0 deletions effectful-core/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -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`.
Expand Down
2 changes: 1 addition & 1 deletion effectful-core/effectful-core.cabal
Original file line number Diff line number Diff line change
@@ -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
Expand Down
180 changes: 177 additions & 3 deletions effectful-core/src/Effectful/Dispatch/Dynamic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,9 +23,13 @@ module Effectful.Dispatch.Dynamic
-- * Handling effects
, EffectHandler
, interpret
, interpretWith
, reinterpret
, reinterpretWith
, interpose
, interposeWith
, impose
, imposeWith

-- ** Handling local 'Eff' computations
, LocalEnv
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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:
Expand Down Expand Up @@ -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
-- :}
--
Expand Down Expand Up @@ -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'@
Expand All @@ -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
Expand All @@ -448,15 +490,15 @@ 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
-- op
--
-- >>> :{
-- 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
Expand Down Expand Up @@ -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.
--
Expand Down Expand Up @@ -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

Expand Down
4 changes: 2 additions & 2 deletions effectful-core/src/Effectful/Fail.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
4 changes: 2 additions & 2 deletions effectful-core/src/Effectful/Internal/Monad.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions effectful-core/src/Effectful/Provider.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
-- :}
--
Expand All @@ -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]
-- :}
--
Expand Down
4 changes: 2 additions & 2 deletions effectful-plugin/tests/PluginTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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'

Expand All @@ -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
6 changes: 6 additions & 0 deletions effectful/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -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`.
Expand Down
4 changes: 2 additions & 2 deletions effectful/bench/FileSizes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 :)

----------
Expand Down
4 changes: 2 additions & 2 deletions effectful/effectful.cabal
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit 14bbcfd

Please sign in to comment.