BSD-3-Clause licensed by Nicolas Wu, Tom Schrijvers, Rob Rix, Patrick Thomson
Maintained by [email protected]
This version can be pinned in stack with:fused-effects-1.0.0.0@sha256:45119e0982e27aeda95aecb47a900ffe1e590a3f22c5c75ce05a2c775180a3fd,4726
Depends on 2 packages(full list with versions):

A fast, flexible, fused effect system for Haskell

Build Status hackage

Overview

fused-effects is an effect system for Haskell that values expressivity, efficiency, and rigor. It provides an encoding of algebraic, higher-order effects, includes a library of the most common effects, and generates efficient code by fusing effect handlers through computations. It is suitable for use in hobbyist, research, and industrial contexts.

Readers already familiar with effect systems may wish to start with the usage instead. For those interested, this talk at Strange Loop outlines the history of and motivation behind effect systems and fused-effects itself.

Algebraic effects

In fused-effects and other systems with algebraic (or, sometimes, extensible) effects, effectful programs are split into two parts: the specification (or syntax) of the actions to be performed, and the interpretation (or semantics) given to them.

In fused-effects, effect types provide syntax and carrier types provide semantics. Effect types are datatypes with one constructor for each action, invoked using the send builtin. Carriers are monads, with an Algebra instance specifying how an effect’s constructors should be interpreted. Carriers can handle more than one effect, and multiple carriers can be defined for the same effect, corresponding to different interpreters for the effect’s syntax.

Higher-order effects

Unlike some other effect systems, fused-effects offers higher-order (or scoped) effects in addition to first-order algebraic effects. In a strictly first-order algebraic effect system, operations like local or catchError, which specify some action limited to a given scope, must be implemented as interpreters, hard-coding their meaning in precisely the manner algebraic effects were designed to avoid. By specifying effects as higher-order functors, this limitation is removed, meaning that these operations admit a variety of interpretations. This means, for example, that you can introspect and redefine both the local and ask operations provided by the Reader effect, rather than solely ask (as is the case with certain formulations of algebraic effects).

As Nicolas Wu et al. showed in Effect Handlers in Scope, this has implications for the expressiveness of effect systems. It also has the benefit of making effect handling more consistent, since scoped operations are just syntax which can be interpreted like any other, and are thus simpler to reason about.

Fusion

In order to maximize efficiency, fused-effects applies fusion laws, avoiding the construction of intermediate representations of effectful computations between effect handlers. In fact, this is applied as far as the initial construction as well: there is no representation of the computation as a free monad parameterized by some syntax type. As such, fused-effects avoids the overhead associated with constructing and evaluating any underlying free or freer monad.

Instead, computations are performed in a carrier type for the syntax, typically a monad wrapping further monads, via an instance of the Carrier class. This carrier is specific to the effect handler selected, but since it isn’t described until the handler is applied, the separation between specification and interpretation is maintained. Computations are written against an abstract effectful signature, and only specialized to some concrete carrier when their effects are interpreted.

Since the interpretation of effects is written as a typeclass instance which ghc is eager to inline, performance is excellent: approximately on par with mtl.

Finally, since the fusion of carrier algebras occurs as a result of the selection of the carriers, it doesn’t depend on complex RULES pragmas, making it easy to reason about and tune.

Usage

Package organization

The fused-effects package is organized into two module hierarchies:

  • those under Control.Effect, which provide effects and functions that invoke these effects’ capabilities.
  • those under Control.Carrier, which provide carrier types capable of executing the effects described by a given effect type.

An additional module, Control.Algebra, provides the Algebra interface that carrier types implement to provide an interpretation of a given effect. You shouldn’t need to import it unless you’re defining your own effects.

Invoking effects

Each module under the Control.Effect hierarchy provides a set of functions that invoke effects, each mapping to a constructor of the underlying effect type. These functions are similar to, but more powerful than, those provided by mtl. In this example, we invoke the get and put functions provided by Control.Effect.State, first extracting the state and then updating it with a new value:

action1 :: Has (State String) sig m => m ()
action1 = get >>= \ s -> put ("hello, " ++ s)

The Has constraint requires a given effect (here State) to be present in a signature (sig), and relates that signature to be present in a carrier type (m). We generally, but not always, program against an abstract carrier type, usually called m, as carrier types always implement the Monad typeclass.

To add effects to a given computation, add more Has constraints to the signature/carrier pair sig and m. For example, to add a Reader effect managing an Int, we would write:

action2 :: (Has (State String) sig m, Has (Reader Int) sig m) => m ()
action2 = do
  i <- ask
  put (replicate i '!')

Running effects

Effects are run with effect handlers, specified as functions (generally starting with run…) unpacking some specific monad with a Carrier instance. For example, we can run a State computation using runState, imported from the Control.Carrier.State.Strict carrier module:

example1 :: (Algebra sig m, Effect sig) => [a] -> m (Int, ())
example1 list = runState 0 $ do
  i <- get
  put (i + length list)

runState returns a tuple of both the computed value (the ()) and the final state (the Int), visible in the result of the returned computation. The get function is resolved with a visible type application, due to the fact that effects can contain more than one state type (in contrast with mtl’s MonadState, which limits the user to a single state type).

Since this function returns a value in some carrier m, effect handlers can be chained to run multiple effects. Here, we get the list to compute the length of from a Reader effect:

example2 :: (Algebra sig m, Effect sig) => m (Int, ())
example2 = runReader "hello" . runState 0 $ do
  list <- ask
  put (length (list :: String))

(Note that the type annotation on list is necessary to disambiguate the requested value, since otherwise all the typechecker knows is that it’s an arbitrary Foldable. For more information, see the comparison to mtl.)

When all effects have been handled, a computation’s final value can be extracted with run:

example3 :: (Int, ())
example3 = run . runReader "hello" . runState 0 $ do
  list <- ask
  put (length (list :: String))

run is itself actually an effect handler for the Lift Identity effect, whose only operation is to lift a result value into a computation.

Alternatively, arbitrary Monads can be embedded into effectful computations using the Lift effect. In this case, the underlying Monadic computation can be extracted using runM. Here, we use the MonadIO instance for the LiftC carrier to lift putStrLn into the middle of our computation:

example4 :: IO (Int, ())
example4 = runM . runReader "hello" . runState 0 $ do
  list <- ask
  liftIO (putStrLn list)
  put (length list)

(Note that we no longer need to give a type annotation for list, since putStrLn constrains the type for us.)

Required compiler extensions

When defining your own effects, you may need -XKindSignatures if GHC cannot correctly infer the type of your handler; see the documentation on common errors for more information about this case. -XDeriveGeneric can be used with many first-order effects to derive default implementations of HFunctor and Effect.

When defining carriers, you’ll need -XTypeOperators to declare a Carrier instance over (:+:), -XFlexibleInstances to loosen the conditions on the instance, -XMultiParamTypeClasses since Carrier takes two parameters, and -XUndecidableInstances to satisfy the coverage condition for this instance.

The following invocation, taken from the teletype example, should suffice for most use or construction of effects and carriers:

{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}

Defining new effects

The process of defining new effects is outlined in docs/defining_effects.md, using the classic Teletype effect as an example.

Project overview

This project builds a Haskell package named fused-effects. The library’s sources are in src. Unit tests are in test, and library usage examples are in examples. Further documentation can be found in docs.

This project adheres to the Contributor Covenant code of conduct. By participating, you are expected to uphold this code.

Finally, this project is licensed under the BSD 3-clause license.

Development

Development of fused-effects is typically done using cabal v2-build:

cabal v2-build # build the library
cabal v2-test  # build and run the examples and tests

The package is available on hackage, and can be used by adding it to a component’s build-depends field in your .cabal file.

Testing

fused-effects comes with a rigorous test suite. Each law or property stated in the Haddock documentation is checked using generative tests powered by the hedgehog library.

Versioning

fused-effects adheres to the Package Versioning Policy standard.

Benchmarks

To run the provided benchmark suite, use cabal v2-bench. You may wish to provide the -O2 compiler option to view performance under aggressive optimizations. fused-effects has been benchmarked against a number of other effect systems. See also @patrickt’s benchmarks.

Related work

fused-effects is an encoding of higher-order algebraic effects following the recipes in Effect Handlers in Scope (Nicolas Wu, Tom Schrijvers, Ralf Hinze), Monad Transformers and Modular Algebraic Effects: What Binds Them Together (Tom Schrijvers, Maciej Piróg, Nicolas Wu, Mauro Jaskelioff), and Fusion for Free—Efficient Algebraic Effect Handlers (Nicolas Wu, Tom Schrijvers).

Contributed packages

Though we aim to keep the fused-effects core minimal, we encourage the development of external fused-effects-compatible libraries. If you’ve written one that you’d like to be mentioned here, get in touch!

Projects using fused-effects

Comparison to other effect libraries

Comparison to mtl

Like mtl, fused-effects provides a library of monadic effects which can be given different interpretations. In mtl this is done by defining new instances of the typeclasses encoding the actions of the effect, e.g. MonadState. In fused-effects, this is done by defining new instances of the Carrier typeclass for the effect.

Also like mtl, fused-effects allows scoped operations like local and catchError to be given different interpretations. As with first-order operations, mtl achieves this with a final tagless encoding via methods, whereas fused-effects achieves this with an initial algebra encoding via Carrier instances.

Unlike mtl, effects are automatically available regardless of where they occur in the signature; in mtl this requires instances for all valid orderings of the transformers (O(n²) of them, in general).

Also unlike mtl, there can be more than one State or Reader effect in a signature. This is a tradeoff: mtl is able to provide excellent type inference for effectful operations like get, since the functional dependencies can resolve the state type from the monad type. On the other hand, this behaviour can be recovered in fused-effects using newtype wrappers with phantom type parameters and helper functions, e.g.:

newtype Wrapper s m a = Wrapper { runWrapper :: m a }
  deriving (Applicative, Functor, Monad)

instance Algebra sig m => Algebra sig (Wrapper s m) where
  alg = Wrapper . alg . handleCoercible

getState :: Has (State s) sig m => Wrapper s m s
getState = get

Indeed, Wrapper can now be made an instance of MonadState:

instance Has (State s) sig m => MTL.MonadState s (Wrapper s m) where
  get = Control.Carrier.State.Strict.get
  put = Control.Carrier.State.Strict.put

Thus, the approaches aren’t mutually exclusive; consumers are free to decide which approach makes the most sense for their situation.

Unlike fused-effects, mtl provides a ContT monad transformer; however, it’s worth noting that many behaviours possible with delimited continuations (e.g. resumable exceptions) are directly encodable as effects.

Finally, thanks to the fusion and inlining of carriers, fused-effects is only marginally slower than equivalent mtl code (see benchmarks).

Comparison to freer-simple

Like freer-simple, fused-effects uses an initial encoding of library- and user-defined effects as syntax which can then be given different interpretations. In freer-simple, this is done with a family of interpreter functions (which cover a variety of needs, and which can be extended for more bespoke needs), whereas in fused-effects this is done with Carrier instances for newtypes.

Unlike fused-effects, in freer-simple, scoped operations like catchError and local are implemented as interpreters, and can therefore not be given new interpretations.

Unlike freer-simple, fused-effects has relatively little attention paid to compiler error messaging, which can make common (compile-time) errors somewhat more confusing to diagnose. Similarly, freer-simple’s family of interpreter functions can make the job of defining new effect handlers somewhat easier than in fused-effects. Further, freer-simple provides many of the same effects as fused-effects, plus a coroutine effect, but minus resource management and random generation.

Finally, fused-effects has been benchmarked as faster than freer-simple.

Comparison to polysemy

Like polysemy, fused-effects is a batteries-included effect system capable of scoped, reinterpretable algebraic effects.

As of GHC 8.8, fused-effects outperforms polysemy, though new effects take more code to define in fused-effects than polysemy (though the Control.Effect.Interpret effect is suitable for rapid prototyping of new effects). Like freer-simple and unlike fused-effects, polysemy provides custom type errors if a given effect invocation is ambigous or invalid in the current context.

Comparison to eff

eff is similar in many ways to fused-effects, but is slightly more performant due to its representation of effects as typeclasses. This approach lets GHC generate better code in exchange for sacrificing the flexibility associated with effects represented as data types. eff also uses the monad-control package to lift effects between contexts rather than implementing an Algebra-style class itself.

Acknowledgements

The authors of fused-effects would like to thank:

  • Tom Schrijvers, Nicholas Wu, and all their collaborators for the research that led to fused-effects;
  • Alexis King for thoughtful discussions about and suggestions regarding our methodology;
  • the authors of other effect libraries, including eff, polysemy, and capabilities, for their exploration of the space.

Changes

v1.0.0.0

  • Adds an Empty effect, modelling nondeterminism without choice (#196).

  • Adds an EmptyC carrier for Empty. (#196)

  • Adds a Choose effect, modelling nondeterminism without failure (#198).

  • Adds a Throw effect, modelling failure with a value. (#247)

  • Adds a Catch effect which can be used with Throw (or other kinds of failure) to model recoverable failure. (#247)

  • Adds a oneOf function to Control.Effect.NonDet to provide an idiom for the common case of nondeterministically selecting from a container. (#201)

  • Adds a foldMapA function to Control.Effect.NonDet mapping containers into nondeterministic computations using a supplied function. (#204)

  • Defines a new Has constraint synonym, conveniently combining Carrier and Member constraints and used for all effect constructors. (#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, and Error as a sum of Throw and Catch. (#199, #219, #247)

  • Defines Carrier instances for a number of types in base, including Either, Maybe, [], and IO. (#206)

  • Defines Carrier instances for a number of types in transformers. (#226)

  • Defines an evalFresh handler for Control.Carrier.Strict.FreshC, taking the initial value. (#267)

Backwards-incompatible changes

  • Renames the Carrier class to Algebra and its eff method to alg, and moved the responsibilities of Control.Carrier to Control.Algebra. This makes the library more consistent with the literature and encourages a style of naming that focuses on morphisms rather than objects. (#285, #294)

  • Fixes unlawful behaviour in the Applicative instance for ErrorC, which had different behaviour between <*> and ap in the presence of a divergent rhs. In order to accomplish this, ErrorC has been defined as a wrapper around Control.Monad.Trans.Except.ExceptT. (#228)

  • Improves the performance of runInterpret using reflection, changing its signature slightly (#193, h/t @ocharles).

  • Removes Control.Effect.Random (and the dependencies on random & MonadRandom) in favour of a new fused-effects-random package (#200).

  • Removes fmap' and handlePure, both deprecated in 0.5.0.0 (#205).

  • Redefines NonDetC as a Church-encoded binary tree instead of a Church-encoded list (#197).

  • Removes the OnceC carrier for Cull effects, replacing it with the composition of CullC on some other Alternative carrier, e.g. NonDetC (#204).

  • Moves all the carriers into their own modules in the Control.Carrier namespace. Several have also been renamed, e.g. the various Trace carriers are all named TraceC within their separate modules, and should be imported qualified if disambiguation is required. This simplifies naming schemes, and ensures that the choice of e.g. strict or lazy carrier is always made consciously and expliclty, instead of defaulting to whichever is exported by the effect module (#204).

  • Removes the re-export of Member from all carrier modules, re-exporting Has in its place. Has constraints should generally be used instead, and specialist cases can import Control.Effect.Sum for Member. (#217)

  • Redesigns & renames the handlers for church-encoded nondeterminism carriers to standardize naming and usage patterns. (#207)

    • The primary handlers (runChoose, runNonDet, runCut, runCull) take multiple continuations.
    • Handlers which return an Alternative are suffixed with A, e.g. runNonDetA.
    • 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)

  • Removes prj from Member, as it was only used in InterposeC (see above), and was generally inadvisable due to its lack of modularity. (#223)

  • Removes the Resource effect and carrier. Both have been relocated to fused-effects-exceptions. (#268)

  • Redefines Fail as a synonym for Throw String. (#247)

  • Removes Resumable and its carriers. Both have been relocated to fused-effects-resumable; they can also be usefully and flexibly replaced by arbitrary effects, Lift, and InterpretC. (#269)

  • Changes Control.Carrier.Fresh.Strict.runFresh to take and return the initial & final values, respectively, allowing for safer operation. (#267)

  • Removes resetFresh, as it was unsafe. Greater safety and control over the generation of fresh values can be obtained by use of runFresh. (#267)

  • Removes PureC; Data.Functor.Identity.Identity should be used instead. Note that run is still provided as a convenient synonym for runIdentity. (#307)

  • Removes the Pure effect. It’s unlikely that this will require changes, as Pure had no operations, but Lift Identity should be used instead. (#307)

  • Redefines the Lift effect, allowing inner contexts to run actions in outer contexts, e.g. to interoperate with Control.Exception. (#306)

  • Removes MonadUnliftIO instances as they’ve been subsumed by the new definition of Lift. Additionally, the ReaderT & IdentityT types defined in transformers may be useful. (#306)

v0.5.0.1

  • Adds support for ghc 8.8.1.

v0.5.0.0

  • Derives Generic1 instances for all non-existentially-quantified effect datatypes.

  • Derives Foldable & Traversable instances for :+:.

  • Defines MonadFix instances for all of the carriers.

  • Re-exports run, :+:, and Member from Control.Effect.Carrier, reducing the number of imports needed when defining new effects.

  • Re-exports Carrier, Member, and run from the various effect modules, reducing the number of imports needed when using existing effects.

Backwards-incompatible changes

  • Replaces runResource with an equivalent function that uses MonadUnliftIO to select the correct unlifting function (a la withResource, which is removed in favor of runResource).

  • Changes the signature of eff from sig m (m a) -> m a to sig m a -> m a, requiring effects to hold m k in their continuation positions instead of merely k. This was done in order to improve interoperability with other presentations of higher-order syntax, e.g. bound; syntax used with bound can now be given HFunctor and Carrier instances.

    To upgrade effects used with previous versions, change any continuations from k to m k. If no existential type variables appear in the effect, you can derive Generic1, and thence HFunctor & Effect instances. Otherwise, implement the required instances by hand. Since continuation positions now occur in m, hmap definitions will have to apply the higher-order function to these as well.

  • Adds Functor constraints to hmap and Monad constraints to handle, allowing a greater variety of instances to be defined (e.g. for recursively-nested syntax).

  • Replaces the default definitions of hmap and handle with derivations based on Generic1 instead of Coercible. Therefore, first-order effects wishing to derive these instances will require Generic1 instances, presumably derived using -XDeriveGeneric.

  • Moves send from Control.Effect.Sum to Control.Effect.Carrier. Likewise removes the re-export of send from Control.Effect.

  • Deprecates fmap' in favour of fmap.

  • Deprecates handlePure in favour of hmap.

v0.4.0.0

Backwards-incompatible changes

  • Removes APIs deprecated in 0.3.0.0, including Eff, interpret, ret, and the handle* family of helper functions.

Other changes

  • Adds the ability to derive default instances of HFunctor and Effect for first-order effects, using the -XDeriveAnyClass extension.
  • Adds a generic Interpose effect that enables arbitrary “eavesdropping” on other effects.

0.3.1.0

  • Improved speed of Reader, State, Writer, and Pure effects by defining and inlining auxiliary Applicative methods.
  • Adds runInterpret & runInterpretState handlers in Control.Effect.Interpret as a convenient way to experiment with effect handlers without defining a new carrier type and Carrier instance. Such handlers are somewhat less efficient than custom Carriers, but allow for a smooth upgrade path when more efficiency is required.
  • Added unliftio-core as a dependency so as to provide a blessed API for unlift-style effects and a solution to the cubic-caller problem.

0.3.0.0

Backwards-incompatible changes

  • Adds Monad as a superclass of Carrier, obviating the need for a lot of constraints, and Monad instances for all carrier types. This is a backwards-incompatible change, as any carriers users have defined now require Monad instances. Note that in many cases carriers can be composed out of existing carriers and monad transformers, and thus these instances can often be derived using -XGeneralizedNewtypeDeriving. We also recommend compiling with -Wredundant-constraints as many of these can now be removed.
  • Replaces AltC with a new carrier, NonDetC, based on Ralf Hinze’s work in Deriving Backtracking Monad Transformers. This is a backwards-incompatible change. AltC was equivalent to the ListT monad transformer, and had the same well-known limitation to commutative monads. Therefore, the elimination of Eff required a more durable approach.
  • Removes Branch. This is a backwards-incompatible change, but was necessitated by the difficulty of implementing correct Applicative & Monad instances for carriers which used it. Carriers which were employing Branch internally should be reimplemented using NonDetC or a similar approach; see CutC and CullC for examples.
  • Renames Control.Effect.Void, Void, and VoidC to Control.Effect.Pure, Pure, and PureC respectively. This is a backwards-incompatible change for code mentioning VoidC; it should be updated to reference PureC instead.

Deprecations

  • Eff and interpret, in favour of computing directly in the carriers. This enables the compiler to perform significant optimizations; see the benchmarks for details. Handlers can simply remove the Eff wrapping the carrier type & any use of interpret. As above, we also recommend compiling with -Wredundant-constraints as many of these can now be removed.
  • ret, in favor of pure or return.
  • handleEither, handleReader, handleState, handleSum, and handleTraversable in favour of composing carrier types directly. Carriers can be composed from other carriers and eff defined with handleCoercible; and other definitions can use handlePure & handle directly.

All deprecated APIs will be removed in the next release.

Other changes

  • Adds a lazy State carrier in Control.Effect.State.Lazy
  • Rewrites CutC using an approach related to NonDetC, with the addition of a continuation to distinguish empty from cutfail.
  • Rewrites CullC using ListC and ReaderC.
  • Moves OnceC from Control.Effect.NonDet to Control.Effect.Cull to avoid cyclic dependencies.
  • Adds a runCutAll handler for Cut effects, returning a collection of all results.

0.2.0.2

  • Loosens the bounds on QuickCheck to accommodate 2.x.

0.2.0.1

  • Fixes the benchmarks, and builds them in CI to avoid regressing them again.

0.2.0.0

  • Adds listen, listens, and censor operations to Writer.
  • Provides explicit type parameters to run-style functions in State, Reader, Writer, and Error. This is a backwards-incompatible change for clients using these functions in combination with visible type applications.
  • Adds benchmarks of WriterC/VoidC wrapped with Eff against their unwrapped counterparts.
  • Adds Functor, Applicative, and Monad instances for WriterC.
  • Adds Functor, Applicative, and Monad instances for VoidC.
  • Fixes a space leak with WriterC.
  • Removes the Functor constraint on asks and gets.
  • Adds bracketOnError, finally, and onException to Resource.
  • Adds sendM to Lift.

0.1.2.1

  • Loosens the bounds on QuickCheck to accommodate 0.12.

0.1.2.0

  • Adds support for ghc 8.6.2, courtesy of @jkachmar.
  • Adds a Cut effect which adds committed choice to nondeterminism.
  • Adds a Cull effect which adds pruning to nondeterminism.
  • Adds an example of using NonDet, Cut, and a character parser effect to define parsers.
  • Fixes the table of contents links in the README.

0.1.1.0

  • Adds a runNonDetOnce handler which terminates immediately upon finding a solution.

0.1.0.0

Initial release.