eff-0.0.0.0
Safe HaskellNone
LanguageHaskell2010

Control.Effect

Description

eff is a fast, flexible, easy to use effect system for Haskell. eff makes it easy to write composable, modular effects and effect handlers without sacrificing performance. Broadly speaking, eff provides the following features:

  • The Eff monad, which provides an extremely flexible set of control operations that can be used to implement a variety of effects.
  • A standard library of built-in effects and effect handlers, including common effects like Reader, State, and Error.
  • A framework for defining your own effects and effect handlers, which can either be built from scratch using the Eff primitives or by delegating to an existing handler.

eff is far from the first effect system for Haskell, but it differentiates itself from existing libraries in the following respects:

  • eff is built atop a direct, low-level implementation of delimited continuations to provide the best performance possible.
  • eff provides a simpler, more streamlined API for handling effects.
  • Like polysemy and fused-effects (but unlike freer-simple), eff supports so called “scoped” effect operations like local and catch, but unlike polysemy and fused-effects (and also unlike transformers/mtl), eff provides a consistent semantics for such operations regardless of handler order.

eff aspires to be a turnkey replacement for most traditional uses of monad transformers. eff provides comparable performance to transformers and mtl with less complexity, less boilerplate, and a simpler semantics.

Synopsis

The Eff monad

data Eff effs a Source #

All eff computations operate in the Eff monad. Eff computations are parameterized by a type-level list that specifies which effects they are allowed to perform. For example, a computation of type Eff '[Error e, Reader r, State s] a can raise exceptions of type e, can access a global environment of type r, and can read and modify a single cell of mutable state of type s.

To run an Eff computation that performs effects, the effects must be explicitly handled. Functions that handle effects are called effect handlers, and they usually have types like the following:

runX :: Eff (X ': effs) a -> Eff effs a

Note that the argument to runX can perform the X effect, but the result cannot! Any X operations have been handled by runX, which interprets their meaning. Examples of effect handlers include runError, runReader, and runState.

After all effects have been handled, the resulting computation will have type Eff '[] a, a computation that performs no effects. A computation with this type is pure, so it can be converted to an ordinary value using run.

Some effects cannot be handled locally, but instead require performing I/O. These effects will delegate to the IOE effect, which provides low-level interop with Haskell’s built-in IO monad. After all other effects have been handled, a computation of type Eff '[IOE] a can be converted to an ordinary IO a computation using runIO.

Instances

Instances details
Monad (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

(>>=) :: Eff effs a -> (a -> Eff effs b) -> Eff effs b #

(>>) :: Eff effs a -> Eff effs b -> Eff effs b #

return :: a -> Eff effs a #

Functor (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

fmap :: (a -> b) -> Eff effs a -> Eff effs b #

(<$) :: a -> Eff effs b -> Eff effs a #

Applicative (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

pure :: a -> Eff effs a #

(<*>) :: Eff effs (a -> b) -> Eff effs a -> Eff effs b #

liftA2 :: (a -> b -> c) -> Eff effs a -> Eff effs b -> Eff effs c #

(*>) :: Eff effs a -> Eff effs b -> Eff effs b #

(<*) :: Eff effs a -> Eff effs b -> Eff effs a #

IOE :< effs => MonadIO (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

liftIO :: IO a -> Eff effs a #

NonDet :< effs => Alternative (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

empty :: Eff effs a #

(<|>) :: Eff effs a -> Eff effs a -> Eff effs a #

some :: Eff effs a -> Eff effs [a] #

many :: Eff effs a -> Eff effs [a] #

run :: Eff '[] a -> a Source #

Runs a pure Eff computation to produce a value.

>>> run $ pure 42
42
>>> run $ runError $ throw "bang"
Left "bang"

lift :: forall effs1 effs2 a. Lift effs1 effs2 => Eff effs1 a -> Eff effs2 a Source #

Lifts an Eff computation into one that performs all the same effects, and possibly more. For example, if you have a computation

m :: Eff '[Foo, Bar] ()

then lift will transform it into a polymorphic computation with the following type:

lift m :: (Foo :< effs, Bar :< effs) => Eff effs ()

This type is much more general, and effs can now be instantiated at many different types. Generally, lift can manipulate the list of effects in any of the following ways:

  • Effects can be reordered.
  • New effects can be inserted anywhere in the list.
  • Duplicate effects can be collapsed.

More generally, the list of effects doesn’t need to be entirely concrete in order for lift to work. For example, if you have a computation

n :: Eff (Foo ': Bar ': effs1) ()

then lift n will have the following type:

lift n :: (Foo :< effs2, Bar :< effs2, effs1 :<< effs2) => Eff effs2 ()

This type is extremely general, and it allows lift to manipulate the head of the effects list even if the entire list is not completely known.

The Lift typeclass provides some type-level programming machinery to implement lift, but it should be treated as an implementation detail. In most situations, the machinery should “just work,” but if it doesn’t, the type errors can be somewhat inscrutable. In those situations, adding some explicit type annotations (or using TypeApplications) can improve the type errors significantly.

lift1 :: forall eff effs a. Eff effs a -> Eff (eff ': effs) a Source #

Like lift, but restricted to introducing a single additional effect in the result. This is behaviorally identical to just using lift, but the restricted type can produce better type inference.

Defining new effects

type Effect = (Type -> Type) -> Type -> Type Source #

The kind of effects.

send :: forall eff a effs. eff :< effs => eff (Eff effs) a -> Eff effs a Source #

class eff :< effs Source #

Minimal complete definition

reifyIndex

Instances

Instances details
eff :< effs => eff :< (eff' ': effs) Source # 
Instance details

Defined in Control.Effect.Internal

eff :< (eff ': effs) Source # 
Instance details

Defined in Control.Effect.Internal

type DictRep (eff :< effs) Source # 
Instance details

Defined in Control.Effect.Internal

type DictRep (eff :< effs) = Int

class effs1 :<< effs2 Source #

Minimal complete definition

reifySubIndex

Instances

Instances details
(effs2 ~ (eff ': effs3), effs1 :<< effs3) => effs1 :<< effs2 Source # 
Instance details

Defined in Control.Effect.Internal

effs :<< effs Source # 
Instance details

Defined in Control.Effect.Internal

type DictRep (effs1 :<< effs2) Source # 
Instance details

Defined in Control.Effect.Internal

type DictRep (effs1 :<< effs2) = Int

Handling effects

Simple effect handlers

interpret Source #

Arguments

:: (forall m b. eff m b -> Eff (eff ': effs) b)

The handler function.

-> Eff (eff ': effs) a

The action to handle.

-> Eff effs a 

The simplest way to handle an effect. Each use of send for the handled effect dispatches to the handler function, which provides an interpretation for the operation. The handler function may handle the operation directly, or it may defer to other effects currently in scope.

Most effect handlers should be implemented using interpret, possibly with the help of additional Error or State effects. Especially complex handlers can be defined via the more general handle, which interpret is defined in terms of:

interpret f = handle (liftH . f)

Advanced effect handlers

data Handle eff effs i r effs' a Source #

The monad that effect handlers run in.

  • The eff parameter is the effect being handled, and the effs parameter includes the other effects in scope at the point of the handle call (used by liftH).
  • The i parameter is the return type of the handled computation before the exit handler has been applied (used by control0).
  • The r parameter is the final return type of the handled computation (used by abort, control, and control0).
  • The effs' parameter is the list of effects in scope at the point of the originating send call (used by locally).

See handle for more details.

Instances

Instances details
Monad (Handle eff effs i r effs') Source # 
Instance details

Defined in Control.Effect.Internal

Methods

(>>=) :: Handle eff effs i r effs' a -> (a -> Handle eff effs i r effs' b) -> Handle eff effs i r effs' b #

(>>) :: Handle eff effs i r effs' a -> Handle eff effs i r effs' b -> Handle eff effs i r effs' b #

return :: a -> Handle eff effs i r effs' a #

Functor (Handle eff effs i r effs') Source # 
Instance details

Defined in Control.Effect.Internal

Methods

fmap :: (a -> b) -> Handle eff effs i r effs' a -> Handle eff effs i r effs' b #

(<$) :: a -> Handle eff effs i r effs' b -> Handle eff effs i r effs' a #

Applicative (Handle eff effs i r effs') Source # 
Instance details

Defined in Control.Effect.Internal

Methods

pure :: a -> Handle eff effs i r effs' a #

(<*>) :: Handle eff effs i r effs' (a -> b) -> Handle eff effs i r effs' a -> Handle eff effs i r effs' b #

liftA2 :: (a -> b -> c) -> Handle eff effs i r effs' a -> Handle eff effs i r effs' b -> Handle eff effs i r effs' c #

(*>) :: Handle eff effs i r effs' a -> Handle eff effs i r effs' b -> Handle eff effs i r effs' b #

(<*) :: Handle eff effs i r effs' a -> Handle eff effs i r effs' b -> Handle eff effs i r effs' a #

handle Source #

Arguments

:: (a -> Eff effs r)

The exit handler, aka the action to take on normal returns (often just pure).

-> (forall effs' b. eff :< effs' => eff (Eff effs') b -> Handle eff effs a r effs' b)

The handler function.

-> Eff (eff ': effs) a

The action to handle.

-> Eff effs r 

Handles the topmost effect in an Eff computation. The given handler function must provide an interpretation for each effectful operation. The handler runs in the restrictive Handle monad, which generally uses one of the following core Handle operations:

  • liftH — Runs an action in the context of the original handle call. This is the most common way to handle an effect.
  • abort — Aborts the computation to the handle call and returns a value directly. This is usually used to implement exception-like operations.
  • control — Captures the current continuation up to and including the handle call and aborts, passing the captured continuation to the handler. This can be used to implement complex control operators such as coroutines or resumable exceptions.
  • control0 — Like control, but does not include the handle call itself in the captured continuation, so a different handler may be installed before resuming the computation.
  • locally — Runs an action directly in the context of the originating send call. This can be used to implement “scoped” operations like local and catch.

See the documentation for each of the above functions for examples and more details.

liftH :: Eff (eff ': effs) a -> Handle eff effs i r effs' a Source #

abort :: r -> Handle eff effs i r effs' a Source #

control :: ((a -> Eff effs r) -> Eff effs r) -> Handle eff effs i r effs' a Source #

control0 :: ((a -> Eff (eff ': effs) i) -> Eff effs r) -> Handle eff effs i r effs' a Source #

locally :: Eff effs' a -> Handle eff effs i r effs' a Source #

Performing I/O

data IOE :: Effect where Source #

An effect used to run IO operations via liftIO. Handled by the special runIO handler.

Constructors

LiftIO :: IO a -> IOE m a 

class Monad m => MonadIO (m :: Type -> Type) where #

Monads in which IO computations may be embedded. Any monad built by applying a sequence of monad transformers to the IO monad will be an instance of this class.

Instances should satisfy the following laws, which state that liftIO is a transformer of monads:

Methods

liftIO :: IO a -> m a #

Lift a computation from the IO monad.

Instances

Instances details
MonadIO IO

Since: base-4.9.0.0

Instance details

Defined in Control.Monad.IO.Class

Methods

liftIO :: IO a -> IO a #

MonadIO EVM Source # 
Instance details

Defined in Control.Effect.Internal

Methods

liftIO :: IO a -> EVM a #

MonadIO m => MonadIO (MaybeT m) 
Instance details

Defined in Control.Monad.Trans.Maybe

Methods

liftIO :: IO a -> MaybeT m a #

MonadIO m => MonadIO (ListT m) 
Instance details

Defined in Control.Monad.Trans.List

Methods

liftIO :: IO a -> ListT m a #

IOE :< effs => MonadIO (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

liftIO :: IO a -> Eff effs a #

(Monoid w, MonadIO m) => MonadIO (WriterT w m) 
Instance details

Defined in Control.Monad.Trans.Writer.Strict

Methods

liftIO :: IO a -> WriterT w m a #

(Monoid w, Functor m, MonadIO m) => MonadIO (AccumT w m) 
Instance details

Defined in Control.Monad.Trans.Accum

Methods

liftIO :: IO a -> AccumT w m a #

(Monoid w, MonadIO m) => MonadIO (WriterT w m) 
Instance details

Defined in Control.Monad.Trans.Writer.Lazy

Methods

liftIO :: IO a -> WriterT w m a #

MonadIO m => MonadIO (WriterT w m) 
Instance details

Defined in Control.Monad.Trans.Writer.CPS

Methods

liftIO :: IO a -> WriterT w m a #

MonadIO m => MonadIO (StateT s m) 
Instance details

Defined in Control.Monad.Trans.State.Strict

Methods

liftIO :: IO a -> StateT s m a #

MonadIO m => MonadIO (StateT s m) 
Instance details

Defined in Control.Monad.Trans.State.Lazy

Methods

liftIO :: IO a -> StateT s m a #

MonadIO m => MonadIO (SelectT r m) 
Instance details

Defined in Control.Monad.Trans.Select

Methods

liftIO :: IO a -> SelectT r m a #

MonadIO m => MonadIO (ReaderT r m) 
Instance details

Defined in Control.Monad.Trans.Reader

Methods

liftIO :: IO a -> ReaderT r m a #

MonadIO m => MonadIO (IdentityT m) 
Instance details

Defined in Control.Monad.Trans.Identity

Methods

liftIO :: IO a -> IdentityT m a #

MonadIO m => MonadIO (ExceptT e m) 
Instance details

Defined in Control.Monad.Trans.Except

Methods

liftIO :: IO a -> ExceptT e m a #

(Error e, MonadIO m) => MonadIO (ErrorT e m) 
Instance details

Defined in Control.Monad.Trans.Error

Methods

liftIO :: IO a -> ErrorT e m a #

MonadIO m => MonadIO (ContT r m) 
Instance details

Defined in Control.Monad.Trans.Cont

Methods

liftIO :: IO a -> ContT r m a #

(Monoid w, MonadIO m) => MonadIO (RWST r w s m) 
Instance details

Defined in Control.Monad.Trans.RWS.Strict

Methods

liftIO :: IO a -> RWST r w s m a #

(Monoid w, MonadIO m) => MonadIO (RWST r w s m) 
Instance details

Defined in Control.Monad.Trans.RWS.Lazy

Methods

liftIO :: IO a -> RWST r w s m a #

MonadIO m => MonadIO (RWST r w s m) 
Instance details

Defined in Control.Monad.Trans.RWS.CPS

Methods

liftIO :: IO a -> RWST r w s m a #

runIO :: Eff '[IOE] a -> IO a Source #

Converts an Eff computation to IO. Unlike most handlers, IOE must be the final effect handled, and runIO completely replaces the call to run.

Re-exports

(&) :: a -> (a -> b) -> b infixl 1 #

& is a reverse application operator. This provides notational convenience. Its precedence is one higher than that of the forward application operator $, which allows & to be nested in $.

>>> 5 & (+1) & show
"6"

Since: base-4.8.0.0

(>>>) :: forall k cat (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c infixr 1 #

Left-to-right composition

Built-in effects