fused-effects 0.5.0.1 → 1.0.0.0

raw patch · 93 files changed

+4798/−2315 lines, 93 filesdep +containersdep +hedgehogdep +hedgehog-fndep −MonadRandomdep −QuickCheckdep −deepseqdep ~basedep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, hedgehog, hedgehog-fn, mtl, tasty, tasty-hedgehog, tasty-hunit

Dependencies removed: MonadRandom, QuickCheck, deepseq, doctest, hspec, random, unliftio-core

Dependency ranges changed: base, transformers

API changes (from Hackage documentation)

Files

• ChangeLog.md +76/−0
• README.lhs +362/−0
• README.md +128/−51
• benchmark/Bench.hs +19/−17
• benchmark/Bench/NonDet.hs +17/−0
• benchmark/Bench/NonDet/NQueens.hs +54/−0
• examples/Inference.hs +50/−0
• examples/Main.hs +8/−5
• examples/Parser.hs +99/−63
• examples/ReinterpretLog.hs +42/−50
• examples/Teletype.hs +42/−29
• fused-effects.cabal +156/−78
• src/Control/Algebra.hs +172/−0
• src/Control/Carrier/Choose/Church.hs +90/−0
• src/Control/Carrier/Cull/Church.hs +76/−0
• src/Control/Carrier/Cut/Church.hs +100/−0
• src/Control/Carrier/Empty/Maybe.hs +52/−0
• src/Control/Carrier/Error/Either.hs +56/−0
• src/Control/Carrier/Fail/Either.hs +47/−0
• src/Control/Carrier/Fresh/Strict.hs +58/−0
• src/Control/Carrier/Interpret.hs +86/−0
• src/Control/Carrier/Lift.hs +38/−0
• src/Control/Carrier/NonDet/Church.hs +116/−0
• src/Control/Carrier/Reader.hs +86/−0
• src/Control/Carrier/State/Lazy.hs +120/−0
• src/Control/Carrier/State/Strict.hs +117/−0
• src/Control/Carrier/Throw/Either.hs +34/−0
• src/Control/Carrier/Trace/Ignoring.hs +47/−0
• src/Control/Carrier/Trace/Printing.hs +48/−0
• src/Control/Carrier/Trace/Returning.hs +45/−0
• src/Control/Carrier/Writer/Strict.hs +70/−0
• src/Control/Effect.hs +0/−20
• src/Control/Effect/Carrier.hs +0/−197
• src/Control/Effect/Catch.hs +32/−0
• src/Control/Effect/Catch/Internal.hs +20/−0
• src/Control/Effect/Choose.hs +111/−0
• src/Control/Effect/Choose/Internal.hs +15/−0
• src/Control/Effect/Class.hs +176/−0
• src/Control/Effect/Cull.hs +26/−82
• src/Control/Effect/Cut.hs +45/−96
• src/Control/Effect/Empty.hs +44/−0
• src/Control/Effect/Empty/Internal.hs +14/−0
• src/Control/Effect/Error.hs +17/−107
• src/Control/Effect/Error/Internal.hs +11/−0
• src/Control/Effect/Fail.hs +25/−41
• src/Control/Effect/Fresh.hs +23/−64
• src/Control/Effect/Interpose.hs +0/−55
• src/Control/Effect/Interpret.hs +0/−82
• src/Control/Effect/Lift.hs +42/−38
• src/Control/Effect/Lift/Internal.hs +24/−0
• src/Control/Effect/NonDet.hs +56/−82
• src/Control/Effect/NonDet/Internal.hs +13/−0
• src/Control/Effect/Pure.hs +0/−58
• src/Control/Effect/Random.hs +0/−111
• src/Control/Effect/Reader.hs +37/−102
• src/Control/Effect/Reader/Internal.hs +21/−0
• src/Control/Effect/Resource.hs +0/−131
• src/Control/Effect/Resumable.hs +0/−138
• src/Control/Effect/State.hs +88/−2
• src/Control/Effect/State/Internal.hs +7/−58
• src/Control/Effect/State/Lazy.hs +0/−104
• src/Control/Effect/State/Strict.hs +0/−102
• src/Control/Effect/Sum.hs +54/−13
• src/Control/Effect/Throw.hs +27/−0
• src/Control/Effect/Throw/Internal.hs +15/−0
• src/Control/Effect/Trace.hs +24/−79
• src/Control/Effect/Writer.hs +44/−93
• src/Control/Effect/Writer/Internal.hs +26/−0
• test/Catch.hs +40/−0
• test/Choose.hs +49/−0
• test/Control/Effect/NonDet/Spec.hs +0/−23
• test/Control/Effect/Spec.hs +0/−121
• test/Cull.hs +54/−0
• test/Cut.hs +66/−0
• test/Cut/Church.hs +17/−0
• test/Doctest.hs +0/−11
• test/Empty.hs +48/−0
• test/Error.hs +56/−0
• test/Fail.hs +49/−0
• test/Fresh.hs +46/−0
• test/Fusion.hs +51/−0
• test/Gen.hs +292/−0
• test/Lift.hs +24/−0
• test/Monad.hs +31/−0
• test/MonadFix.hs +29/−0
• test/NonDet.hs +60/−0
• test/NonDet/Church.hs +32/−0
• test/Reader.hs +71/−0
• test/Spec.hs +0/−12
• test/State.hs +69/−0
• test/Test.hs +43/−0
• test/Throw.hs +47/−0
• test/Writer.hs +76/−0

@@ -1,3 +1,79 @@+# v1.0.0.0++- Adds an `Empty` effect, modelling nondeterminism without choice ([#196](https://github.com/fused-effects/fused-effects/pull/196)).++- Adds an `EmptyC` carrier for `Empty`. ([#196](https://github.com/fused-effects/fused-effects/pull/196))++- Adds a `Choose` effect, modelling nondeterminism without failure ([#198](https://github.com/fused-effects/fused-effects/pull/198)).++- Adds a `Throw` effect, modelling failure with a value. ([#247](https://github.com/fused-effects/fused-effects/pull/247))++- Adds a `Catch` effect which can be used with `Throw` (or other kinds of failure) to model recoverable failure. ([#247](https://github.com/fused-effects/fused-effects/pull/247))++- Adds a `oneOf` function to `Control.Effect.NonDet` to provide an idiom for the common case of nondeterministically selecting from a container. ([#201](https://github.com/fused-effects/fused-effects/pull/201))++- 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 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`, and `Error` as a sum of `Throw` and `Catch`. ([#199](https://github.com/fused-effects/fused-effects/pull/199), [#219](https://github.com/fused-effects/fused-effects/pull/219), [#247](https://github.com/fused-effects/fused-effects/pull/247))++- Defines `Carrier` instances for a number of types in `base`, including `Either`, `Maybe`, `[]`, and `IO`. ([#206](https://github.com/fused-effects/fused-effects/pull/206))++- Defines `Carrier` instances for a number of types in `transformers`. ([#226](https://github.com/fused-effects/fused-effects/pull/226))++- Defines an `evalFresh` handler for `Control.Carrier.Strict.FreshC`, taking the initial value. ([#267](https://github.com/fused-effects/fused-effects/pull/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](https://github.com/fused-effects/fused-effects/pull/285), [#294](https://github.com/fused-effects/fused-effects/pull/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](https://github.com/fused-effects/fused-effects/pull/228))++- Improves the performance of `runInterpret` using reflection, changing its signature slightly ([#193](https://github.com/fused-effects/fused-effects/pull/193), h/t [@ocharles](https://github.com/ocharles)).++- Removes `Control.Effect.Random` (and the dependencies on `random` & `MonadRandom`) in favour of a new [`fused-effects-random` package](https://github.com/fused-effects/fused-effects-random) ([#200](https://github.com/fused-effects/fused-effects/pull/200)).++- Removes `fmap'` and `handlePure`, both deprecated in 0.5.0.0 ([#205](https://github.com/fused-effects/fused-effects/pull/205)).++- Redefines `NonDetC` as a Church-encoded binary tree instead of a Church-encoded list ([#197](https://github.com/fused-effects/fused-effects/pull/197)).++- Removes the `OnceC` carrier for `Cull` effects, replacing it with the composition of `CullC` on some other `Alternative` carrier, e.g. `NonDetC` ([#204](https://github.com/fused-effects/fused-effects/pull/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](https://github.com/fused-effects/fused-effects/pull/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](https://github.com/fused-effects/fused-effects/pull/217))++- Redesigns & renames the handlers for church-encoded nondeterminism carriers to standardize naming and usage patterns. ([#207](https://github.com/fused-effects/fused-effects/pull/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](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))++- Removes the `Resource` effect and carrier. Both have been relocated to `fused-effects-exceptions`. ([#268](https://github.com/fused-effects/fused-effects/pull/268))++- Redefines `Fail` as a synonym for `Throw String`. ([#247](https://github.com/fused-effects/fused-effects/pull/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](https://github.com/fused-effects/fused-effects/pull/269))++- Changes `Control.Carrier.Fresh.Strict.runFresh` to take and return the initial & final values, respectively, allowing for safer operation. ([#267](https://github.com/fused-effects/fused-effects/pull/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](https://github.com/fused-effects/fused-effects/pull/267))++- Removes `PureC`; `Data.Functor.Identity.Identity` should be used instead. Note that `run` is still provided as a convenient synonym for `runIdentity`. ([#307](https://github.com/fused-effects/fused-effects/pull/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](https://github.com/fused-effects/fused-effects/pull/307))++- Redefines the `Lift` effect, allowing inner contexts to run actions in outer contexts, e.g. to interoperate with `Control.Exception`. ([#306](https://github.com/fused-effects/fused-effects/pull/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](https://github.com/fused-effects/fused-effects/pull/306))++ # v0.5.0.1  - Adds support for ghc 8.8.1.

@@ -0,0 +1,362 @@+# A fast, flexible, fused effect system for Haskell++[![Build Status](https://action-badges.now.sh/fused-effects/fused-effects)](https://github.com/fused-effects/fused-effects/actions) [![hackage](https://img.shields.io/hackage/v/fused-effects.svg?color=blue&style=popout)](http://hackage.haskell.org/package/fused-effects)++- [Overview][]+  - [Algebraic effects][]+  - [Higher-order effects][]+  - [Fusion][]+- [Usage][]+  - [Using built-in effects][]+  - [Invoking effects][]+  - [Running effects][]+  - [Required compiler extensions][]+  - [Defining new effects][]+  - [Defining effect handlers][]+- [Project overview][]+  - [Development][]+  - [Versioning][]+- [Benchmarks][]+- [Related work][]+  - [Contributed packages][]+  - [Projects using `fused-effects`][]+  - [Comparison to `mtl`][]+  - [Comparison to `freer-simple`][]+  - [Comparison to `polysemy`][]+  - [Comparison to `eff`][]+- [Acknowledgments][]++[Overview]: https://github.com/fused-effects/fused-effects#overview+[Algebraic effects]: https://github.com/fused-effects/fused-effects#algebraic-effects+[Higher-order effects]: https://github.com/fused-effects/fused-effects#higher-order-effects+[Fusion]: https://github.com/fused-effects/fused-effects#fusion++[Usage]: https://github.com/fused-effects/fused-effects#usage+[Using built-in effects]: https://github.com/fused-effects/fused-effects#using-built-in-effects+[Invoking effects]: https://github.com/fused-effects/fused-effects#invoking-effects+[Running effects]: https://github.com/fused-effects/fused-effects#running-effects+[Required compiler extensions]: https://github.com/fused-effects/fused-effects#required-compiler-extensions+[Defining new effects]: https://github.com/fused-effects/fused-effects#defining-new-effects+[Defining effect handlers]: https://github.com/fused-effects/fused-effects#defining-effect-handlers++[Project overview]: https://github.com/fused-effects/fused-effects#project-overview+[Development]: https://github.com/fused-effects/fused-effects#development+[Versioning]: https://github.com/fused-effects/fused-effects#versioning++[Benchmarks]: https://github.com/fused-effects/fused-effects#benchmarks++[Related work]: https://github.com/fused-effects/fused-effects#related-work+[Contributed packages]: https://github.com/fused-effects/fused-effects#contributed-packages+[Projects using `fused-effects`]: https://github.com/fused-effects/fused-effects#projects-using-fused-effects+[Comparison to `mtl`]: https://github.com/fused-effects/fused-effects#comparison-to-mtl+[Comparison to `freer-simple`]: https://github.com/fused-effects/fused-effects#comparison-to-freer-simple+[Comparison to `polysemy`]: https://github.com/fused-effects/fused-effects#comparison-to-polysemy+[Comparison to `eff`]: https://github.com/fused-effects/fused-effects#comparison-to-eff++[Acknowledgments]: https://github.com/fused-effects/fused-effects#acknowledgements+++## Overview++`fused-effects` is an [effect system](https://en.wikipedia.org/wiki/Effect_system) for Haskell that values expressivity, efficiency, and rigor. It provides an encoding of [algebraic](#algebraic-effects), [higher-order](#higher-order-effects) effects, includes a library of the most common effects, and generates efficient code by [fusing](#fusion) 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](#usage) instead. For those interested, this [talk at Strange Loop](https://www.youtube.com/watch?v=vfDazZfxlNs) outlines the history of and motivation behind effect systems and `fused-effects` itself.++<!--+Setup, hidden from the rendered markdown.++```haskell+{-# LANGUAGE ConstraintKinds, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, UndecidableInstances #-}+module Main (module Main) where++import Control.Algebra+import Control.Carrier.Lift+import Control.Carrier.Reader+import Control.Carrier.State.Strict+import Control.Monad.IO.Class (liftIO)+import qualified Control.Monad.State.Class as MTL++main :: IO ()+main = pure ()+```+-->+++### 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:++```haskell+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:++```haskell+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:++```haskell+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:++```haskell+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`](#comparison-to-mtl).)++When all effects have been handled, a computation’s final value can be extracted with `run`:++```haskell+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 `Monad`s can be embedded into effectful computations using the `Lift` effect. In this case, the underlying `Monad`ic 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:++```haskell+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][common] 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.++[common]: https://github.com/fused-effects/fused-effects/blob/master/docs/common_errors.md++The following invocation, taken from the teletype example, should suffice for most use or construction of effects and carriers:++```haskell+{-# 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.++[`docs/defining_effects.md`]: https://github.com/fused-effects/fused-effects/blob/master/docs/defining_effects.md+++## 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][].++[`src`]: https://github.com/fused-effects/fused-effects/tree/master/src+[`test`]: https://github.com/fused-effects/fused-effects/tree/master/test+[`examples`]: https://github.com/fused-effects/fused-effects/tree/master/examples+[`docs`]: https://github.com/fused-effects/fused-effects/tree/master/docs+[code of conduct]: https://github.com/fused-effects/fused-effects/blob/master/CODE_OF_CONDUCT.md+[license]: https://github.com/fused-effects/fused-effects/blob/master/LICENSE.md+++### Development++Development of `fused-effects` is typically done using `cabal v2-build`:++```shell+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.++[hackage]: http://hackage.haskell.org+++### 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`](http://hackage.haskell.org/package/hedgehog) library.+++### Versioning++`fused-effects` adheres to the [Package Versioning Policy][pvp] standard.++[pvp]: https://pvp.haskell.org/faq/+++## 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](https://github.com/joshvera/freemonad-benchmark). See also [@patrickt’s benchmarks](https://github.com/patrickt/effects-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).++[Effect Handlers in Scope]: http://www.cs.ox.ac.uk/people/nicolas.wu/papers/Scope.pdf+[Monad Transformers and Modular Algebraic Effects: What Binds Them Together]: http://www.cs.kuleuven.be/publicaties/rapporten/cw/CW699.pdf+[Fusion for Free—Efficient Algebraic Effect Handlers]: https://people.cs.kuleuven.be/~tom.schrijvers/Research/papers/mpc2015.pdf+++### 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!++* [`fused-effects-lens`][felens] provides combinators to use the [`lens`][lens] library fluently inside effectful computations.+* [`fused-effects-exceptions`][exc] provides handlers for exceptions thrown in the `IO` monad.+* [`fused-effects-resumable`][] provides resumable exceptions, which can also serve as a limited form of coroutines.+* [`fused-effects-random`][] provides a `Random` effect integrated into a `fused-effects` stack.++[exc]: https://github.com/fused-effects/fused-effects-exceptions+[felens]: http://hackage.haskell.org/package/fused-effects-lens+[`fused-effects-random`]: https://github.com/fused-effects/fused-effects-random+[`fused-effects-resumable`]: https://github.com/fused-effects/fused-effects-resumable+[lens]: http://hackage.haskell.org/package/lens+++### Projects using `fused-effects`++* [`semantic`](http://github.com/github/semantic), a program analysis toolkit+* [`aurapm`](https://github.com/aurapm/aura), a package manager for Arch Linux+* [`now-haskell`](http://hackage.haskell.org/package/now-haskell), a client library for AWS Lambda+++### 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.:++```haskell+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`:++```haskell+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](#benchmarks)).++[`mtl`]: http://hackage.haskell.org/package/mtl+++#### 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 `newtype`s.++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](#benchmarks) as faster than `freer-simple`.++[`freer-simple`]: http://hackage.haskell.org/package/freer-simple+++#### Comparison to `polysemy`++Like [`polysemy`](http://hackage.haskell.org/package/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`](https://github.com/lexi-lambda/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.

@@ -1,6 +1,6 @@ # A fast, flexible, fused effect system for Haskell -[![Build Status](https://travis-ci.com/fused-effects/fused-effects.svg?branch=master)](https://travis-ci.com/fused-effects/fused-effects) [![hackage](https://img.shields.io/hackage/v/fused-effects.svg?color=blue&style=popout)](http://hackage.haskell.org/package/fused-effects)+[![Build Status](https://action-badges.now.sh/fused-effects/fused-effects)](https://github.com/fused-effects/fused-effects/actions) [![hackage](https://img.shields.io/hackage/v/fused-effects.svg?color=blue&style=popout)](http://hackage.haskell.org/package/fused-effects)  - [Overview][]   - [Algebraic effects][]@@ -8,17 +8,23 @@   - [Fusion][] - [Usage][]   - [Using built-in effects][]+  - [Invoking effects][]   - [Running effects][]   - [Required compiler extensions][]   - [Defining new effects][]+  - [Defining effect handlers][] - [Project overview][]   - [Development][]   - [Versioning][] - [Benchmarks][] - [Related work][]   - [Contributed packages][]+  - [Projects using `fused-effects`][]   - [Comparison to `mtl`][]   - [Comparison to `freer-simple`][]+  - [Comparison to `polysemy`][]+  - [Comparison to `eff`][]+- [Acknowledgments][]  [Overview]: https://github.com/fused-effects/fused-effects#overview [Algebraic effects]: https://github.com/fused-effects/fused-effects#algebraic-effects@@ -27,6 +33,7 @@  [Usage]: https://github.com/fused-effects/fused-effects#usage [Using built-in effects]: https://github.com/fused-effects/fused-effects#using-built-in-effects+[Invoking effects]: https://github.com/fused-effects/fused-effects#invoking-effects [Running effects]: https://github.com/fused-effects/fused-effects#running-effects [Required compiler extensions]: https://github.com/fused-effects/fused-effects#required-compiler-extensions [Defining new effects]: https://github.com/fused-effects/fused-effects#defining-new-effects@@ -40,29 +47,53 @@  [Related work]: https://github.com/fused-effects/fused-effects#related-work [Contributed packages]: https://github.com/fused-effects/fused-effects#contributed-packages+[Projects using `fused-effects`]: https://github.com/fused-effects/fused-effects#projects-using-fused-effects [Comparison to `mtl`]: https://github.com/fused-effects/fused-effects#comparison-to-mtl [Comparison to `freer-simple`]: https://github.com/fused-effects/fused-effects#comparison-to-freer-simple+[Comparison to `polysemy`]: https://github.com/fused-effects/fused-effects#comparison-to-polysemy+[Comparison to `eff`]: https://github.com/fused-effects/fused-effects#comparison-to-eff +[Acknowledgments]: https://github.com/fused-effects/fused-effects#acknowledgements + ## Overview -`fused-effects` is an effect system for Haskell emphasizing expressivity and efficiency. The former is achieved by encoding [algebraic](#algebraic-effects), [higher-order](#higher-order-effects) effects, while the latter is the result of [fusing](#fusion) effect handlers all the way through computations.+`fused-effects` is an [effect system](https://en.wikipedia.org/wiki/Effect_system) for Haskell that values expressivity, efficiency, and rigor. It provides an encoding of [algebraic](#algebraic-effects), [higher-order](#higher-order-effects) effects, includes a library of the most common effects, and generates efficient code by [fusing](#fusion) 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](#usage) instead.+Readers already familiar with effect systems may wish to start with the [usage](#usage) instead. For those interested, this [talk at Strange Loop](https://www.youtube.com/watch?v=vfDazZfxlNs) outlines the history of and motivation behind effect systems and `fused-effects` itself. +<!--+Setup, hidden from the rendered markdown. +```haskell+{-# LANGUAGE ConstraintKinds, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, UndecidableInstances #-}+module Main (module Main) where++import Control.Algebra+import Control.Carrier.Lift+import Control.Carrier.Reader+import Control.Carrier.State.Strict+import Control.Monad.IO.Class (liftIO)+import qualified Control.Monad.State.Class as MTL++main :: IO ()+main = pure ()+```+-->++ ### 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. Thus, a program written using the syntax of an effect can be given different meanings by using different effect handlers.+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. -These roles are performed by the effect and carrier types, respectively. Effects are datatypes with one constructor for each action. Carriers are generally `newtype`s, with a `Carrier` instance specifying how an effect’s constructors should be interpreted. Each carrier handles one effect, but multiple carriers can be defined for the same effect, corresponding to different interpreters for the effect’s syntax.+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 most 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, these operations are likewise able to be given 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).+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.+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@@ -73,55 +104,58 @@  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 very easy to reason about and tune.+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 -### Using built-in effects+### Package organization -Like other effect systems, effects are performed in a `Monad` extended with operations relating to the effect. In `fused-effects`, this is done by means of a `Member` constraint to require the effect’s presence in a _signature_, and a `Carrier` constraint to relate the signature to the `Monad`. For example, to use a `State` effect managing a `String`, one would write:+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. -```haskell-action :: (Member (State String) sig, Carrier sig m) => m ()-```+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. -(Additional constraints may be necessary depending on the precise operations required, e.g. to make the `Monad` methods available.) -Multiple effects can be required simply by adding their corresponding `Member` constraints to the context. For example, to add a `Reader` effect managing an `Int`, we would write:+### 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:+ ```haskell-action :: (Member (State String) sig, Member (Reader Int) sig, Carrier sig m) => m ()+action1 :: Has (State String) sig m => m ()+action1 = get >>= \ s -> put ("hello, " ++ s) ``` -Different effects make different operations available; see the documentation for individual effects for more information about their operations. Note that we generally don't program against an explicit list of effect components: we take the typeclass-oriented approach, adding new constraints to `sig` as new capabilities become necessary. If you want to name and share some predefined list of effects, it's best to use the `-XConstraintKinds` extension to GHC, capturing the elements of `sig` as a type synonym of kind `Constraint`:+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. -```haskell-type Shared sig = ( Member (State String) sig-                  , Member (Reader Int)   sig-                  , Member (Writer Graph) sig-                  )+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: -myFunction :: (Shared sig, Carrier sig m) => Int -> m ()+```haskell+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…`) invoking some specific `Carrier` instance. For example, we can run a `State` computation using `runState`:+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:  ```haskell-example1 :: (Carrier sig m, Effect sig) => [a] -> m (Int, ())+example1 :: (Algebra sig m, Effect sig) => [a] -> m (Int, ()) example1 list = runState 0 $ do-  i <- get @Int+  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).+`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:  ```haskell-example2 :: (Carrier sig m, Effect sig, Monad m) => m (Int, ())+example2 :: (Algebra sig m, Effect sig) => m (Int, ()) example2 = runReader "hello" . runState 0 $ do   list <- ask   put (length (list :: String))@@ -138,7 +172,7 @@   put (length (list :: String)) ``` -`run` is itself actually an effect handler for the `Pure` effect, which has no operations and thus can only represent a final result value.+`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 `Monad`s can be embedded into effectful computations using the `Lift` effect. In this case, the underlying `Monad`ic 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: @@ -152,31 +186,32 @@  (Note that we no longer need to give a type annotation for `list`, since `putStrLn` constrains the type for us.) -### Required compiler extensions -To use effects, you'll typically need `-XFlexibleContexts`.+### 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][common] 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.+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.  [common]: https://github.com/fused-effects/fused-effects/blob/master/docs/common_errors.md  The following invocation, taken from the teletype example, should suffice for most use or construction of effects and carriers:  ```haskell-{-# LANGUAGE DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# 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.  [`docs/defining_effects.md`]: https://github.com/fused-effects/fused-effects/blob/master/docs/defining_effects.md + ## Project overview -This project builds a Haskell package named `fused-effects`. The library’s sources are in [`src`][], with doctests (property tests written in documentation comments) attached to most functions. Unit tests are in [`test`][], and library usage examples are in [`examples`][]. Further documentation can be found in [`docs`][].+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. @@ -192,26 +227,33 @@  ### Development -Development of `fused-effects` is typically done using `cabal new-build`:+Development of `fused-effects` is typically done using `cabal v2-build`:  ```shell-cabal new-build # build the library-cabal new-test  # build and run the examples, unit tests, and doctests+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.  [hackage]: http://hackage.haskell.org ++### 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`](http://hackage.haskell.org/package/hedgehog) library.++ ### Versioning -Though `fused-effects` is suitable for production work, it is currently in a pre-release state. Though we will attempt to comply with the Haskell [Package Versioning Policy][pvp] standard, we make no concrete guarantees of API stability between versions < 1.0.0.0. Once v1.0.0.0 lands, all changes will abide by the PVP MAJOR.MAJOR.MINOR.PATCH standard.+`fused-effects` adheres to the [Package Versioning Policy][pvp] standard.  [pvp]: https://pvp.haskell.org/faq/ + ## Benchmarks -To run the provided benchmark suite, use `cabal new-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](https://github.com/joshvera/freemonad-benchmark). See also [@patrickt’s benchmarks](https://github.com/patrickt/effects-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](https://github.com/joshvera/freemonad-benchmark). See also [@patrickt’s benchmarks](https://github.com/patrickt/effects-benchmarks).   ## Related work@@ -222,19 +264,34 @@ [Monad Transformers and Modular Algebraic Effects: What Binds Them Together]: http://www.cs.kuleuven.be/publicaties/rapporten/cw/CW699.pdf [Fusion for Free—Efficient Algebraic Effect Handlers]: https://people.cs.kuleuven.be/~tom.schrijvers/Research/papers/mpc2015.pdf + ### 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!+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!  * [`fused-effects-lens`][felens] provides combinators to use the [`lens`][lens] library fluently inside effectful computations. * [`fused-effects-exceptions`][exc] provides handlers for exceptions thrown in the `IO` monad.+* [`fused-effects-resumable`][] provides resumable exceptions, which can also serve as a limited form of coroutines.+* [`fused-effects-random`][] provides a `Random` effect integrated into a `fused-effects` stack.  [exc]: https://github.com/fused-effects/fused-effects-exceptions [felens]: http://hackage.haskell.org/package/fused-effects-lens+[`fused-effects-random`]: https://github.com/fused-effects/fused-effects-random+[`fused-effects-resumable`]: https://github.com/fused-effects/fused-effects-resumable [lens]: http://hackage.haskell.org/package/lens -### Comparison to `mtl` +### Projects using `fused-effects`++* [`semantic`](http://github.com/github/semantic), a program analysis toolkit+* [`aurapm`](https://github.com/aurapm/aura), a package manager for Arch Linux+* [`now-haskell`](http://hackage.haskell.org/package/now-haskell), a client library for AWS Lambda+++### 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.@@ -247,35 +304,34 @@ newtype Wrapper s m a = Wrapper { runWrapper :: m a }   deriving (Applicative, Functor, Monad) -instance Carrier sig m => Carrier sig (Wrapper s m) where …+instance Algebra sig m => Algebra sig (Wrapper s m) where+  alg = Wrapper . alg . handleCoercible -getState :: (Carrier sig m, Member (State s) m) => Wrapper m s+getState :: Has (State s) sig m => Wrapper s m s getState = get ```  Indeed, `Wrapper` can now be made an instance of `MonadState`:  ```haskell-instance (Carrier sig m, Member (State s) sig, Monad m) => MTL.MonadState s (Wrapper s m) where-  get = Control.Effect.State.get-  put = Control.Effect.State.put+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. Further, `fused-effects` provides a relatively large palette of these, including resumable exceptions, tracing, resource management, and others, as well as tools to define your own.+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 approximately as fast as `mtl` (see [benchmarks](#benchmarks)).+Finally, thanks to the fusion and inlining of carriers, `fused-effects` is only marginally slower than equivalent `mtl` code (see [benchmarks](#benchmarks)).  [`mtl`]: http://hackage.haskell.org/package/mtl  -### Comparison to `freer-simple`+#### 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 `newtype`s. -(Tho note that as of `fused-effects` 0.3.1, it is possible to define handlers using `runInterpret` in a manner analogous to `freer-simple`’s `interpret`, with the caveat that its use of higher-order functions defeats the fusion and inlining of `Carrier` instances which makes `fused-effects` so efficient.)- 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.@@ -283,3 +339,24 @@ Finally, `fused-effects` has been [benchmarked](#benchmarks) as faster than `freer-simple`.  [`freer-simple`]: http://hackage.haskell.org/package/freer-simple+++#### Comparison to `polysemy`++Like [`polysemy`](http://hackage.haskell.org/package/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`](https://github.com/lexi-lambda/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.

@@ -1,21 +1,23 @@-{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, RankNTypes, TypeApplications, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor, FlexibleInstances, LambdaCase, MultiParamTypeClasses, RankNTypes, TypeApplications, TypeOperators, UndecidableInstances #-} module Main ( main ) where -import Control.Effect.Carrier-import Control.Effect.Interpret-import Control.Effect.Writer-import Control.Effect.State+import Control.Algebra+import Control.Carrier.Interpret+import Control.Carrier.State.Strict+import Control.Carrier.Writer.Strict import Control.Monad (ap, replicateM_) import Data.Functor.Identity import Data.Monoid (Sum(..)) import Gauge +import qualified Bench.NonDet as NonDet+ main :: IO () main = defaultMain-  [-    bgroup "WriterC"+  [ NonDet.benchmark+  , bgroup "WriterC"     [ bgroup "Cod"       [ bench "100"   $ whnf (run . runCod pure . execWriter @(Sum Int) . runCod pure . tellLoop) 100       , bench "1000"  $ whnf (run . runCod pure . execWriter @(Sum Int) . runCod pure . tellLoop) 1000@@ -43,14 +45,14 @@   ,     bgroup "InterpretC vs InterpretStateC vs StateC"     [ bgroup "InterpretC"-      [ bench "100"   $ whnf (run . evalState @(Sum Int) 0 . runInterpret (\case { Get k -> get @(Sum Int) >>= k ; Put s k -> put s >> k }) . modLoop) 100-      , bench "1000"  $ whnf (run . evalState @(Sum Int) 0 . runInterpret (\case { Get k -> get @(Sum Int) >>= k ; Put s k -> put s >> k }) . modLoop) 1000-      , bench "10000" $ whnf (run . evalState @(Sum Int) 0 . runInterpret (\case { Get k -> get @(Sum Int) >>= k ; Put s k -> put s >> k }) . modLoop) 10000+      [ bench "100"   $ whnf (\n -> run $ evalState @(Sum Int) 0 $ runInterpret (\case { Get k -> get @(Sum Int) >>= k ; Put s k -> put s >> k }) $ modLoop n) 100+      , bench "1000"  $ whnf (\n -> run $ evalState @(Sum Int) 0 $ runInterpret (\case { Get k -> get @(Sum Int) >>= k ; Put s k -> put s >> k }) $ modLoop n) 1000+      , bench "10000" $ whnf (\n -> run $ evalState @(Sum Int) 0 $ runInterpret (\case { Get k -> get @(Sum Int) >>= k ; Put s k -> put s >> k }) $ modLoop n) 10000       ]     , bgroup "InterpretStateC"-      [ bench "100"   $ whnf (run . runInterpretState (\ s -> \case { Get k -> runState @(Sum Int) s (k s) ; Put s k -> runState s k }) 0 . modLoop) 100-      , bench "1000"  $ whnf (run . runInterpretState (\ s -> \case { Get k -> runState @(Sum Int) s (k s) ; Put s k -> runState s k }) 0 . modLoop) 1000-      , bench "10000" $ whnf (run . runInterpretState (\ s -> \case { Get k -> runState @(Sum Int) s (k s) ; Put s k -> runState s k }) 0 . modLoop) 10000+      [ bench "100"   $ whnf (\n -> run $ runInterpretState (\ s -> \case { Get k -> runState @(Sum Int) s (k s) ; Put s k -> runState s k }) 0 $ modLoop n) 100+      , bench "1000"  $ whnf (\n -> run $ runInterpretState (\ s -> \case { Get k -> runState @(Sum Int) s (k s) ; Put s k -> runState s k }) 0 $ modLoop n) 1000+      , bench "10000" $ whnf (\n -> run $ runInterpretState (\ s -> \case { Get k -> runState @(Sum Int) s (k s) ; Put s k -> runState s k }) 0 $ modLoop n) 10000       ]     , bgroup "StateC"       [ bench "100"   $ whnf (run . evalState @(Sum Int) 0 . modLoop) 100@@ -60,10 +62,10 @@     ]   ] -tellLoop :: (Carrier sig m, Member (Writer (Sum Int)) sig) => Int -> m ()+tellLoop :: Has (Writer (Sum Int)) sig m => Int -> m () tellLoop i = replicateM_ i (tell (Sum (1 :: Int))) -modLoop :: (Carrier sig m, Member (State (Sum Int)) sig) => Int -> m ()+modLoop :: Has (State (Sum Int)) sig m => Int -> m () modLoop i = replicateM_ i (modify (+ (Sum (1 :: Int))))  newtype Cod m a = Cod { unCod :: forall b . (a -> m b) -> m b }@@ -79,5 +81,5 @@ instance Monad (Cod m) where   Cod a >>= f = Cod (\ k -> a (runCod k . f)) -instance (Carrier sig m, Effect sig) => Carrier sig (Cod m) where-  eff op = Cod (\ k -> eff (handle (Identity ()) (runCod (pure . Identity) . runIdentity) op) >>= k . runIdentity)+instance (Algebra sig m, Effect sig) => Algebra sig (Cod m) where+  alg op = Cod (\ k -> alg (thread (Identity ()) (runCod (pure . Identity) . runIdentity) op) >>= k . runIdentity)

@@ -0,0 +1,17 @@+{-# LANGUAGE TypeApplications #-}+module Bench.NonDet+( benchmark+) where++import Control.Algebra+import qualified Control.Carrier.NonDet.Church as NonDet.Church+import           Gauge hiding (benchmark)+import qualified Bench.NonDet.NQueens as NQueens++benchmark :: Gauge.Benchmark+benchmark = bgroup "NonDet"+  [ bgroup "N-queens problem"+    [ NQueens.benchmark "NonDet.Church" (run . NonDet.Church.runNonDetA)+    , NQueens.benchmark "[]"            (id @[_])+    ]+  ]

@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveFunctor, FlexibleInstances, LambdaCase, MultiParamTypeClasses, RankNTypes,+             TypeApplications, TypeOperators, UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++-- Based largely on the implementation by Sreekar Shastry,+-- available at https://github.com/sshastry/queenslogic++module Bench.NonDet.NQueens (benchmark) where++import Control.Applicative+import Control.Monad (guard)+import Data.Foldable+import Data.List+import Gauge hiding (benchmark)++type Square = (Int,Int)+type Board = [Int]++data Diagonal = Row Int+              | Col Int+              | Backslash Int+              | Forwardslash Int+              deriving (Eq, Show)++diags :: Square -> [Diagonal]+diags (i,j) = [ Row i+              , Col j+              , Backslash (j-i)+              , Forwardslash (i+j) ]++isSafeIn :: Square -> Board -> Bool+isSafeIn (i,j) qs = null (diags (i,j) `intersect` underThreat)+  where+    qs' = zip [1..length qs] qs+    underThreat = qs' >>= diags++addOne :: (Alternative m, Monad m) => Int -> Board -> m Board+addOne n curr = do+  let i = length curr + 1+  let choose = asum . fmap pure+  j <- choose [1..n]+  guard ((i, j) `isSafeIn` curr)+  pure (curr ++ [j])++queens :: (Alternative m, Monad m) => Int -> m Board+queens n = foldl' (>>=) (pure empty) (replicate n (addOne n))++benchmark :: (Alternative m, Monad m) => String -> (m Board -> [Board]) -> Gauge.Benchmark+benchmark title runQueens = bgroup title+  [ bench "4"  $ whnf (runQueens . queens) 4+  , bench "8"  $ whnf (runQueens . queens) 8+  , bench "16" $ whnf (runQueens . queens) 16+  ]+{-# INLINE benchmark #-}

@@ -0,0 +1,50 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeApplications, TypeOperators, UndecidableInstances #-}+module Inference+( example+) where++import Control.Algebra+import Control.Carrier.Reader+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Tasty+import Test.Tasty.Hedgehog++example :: TestTree+example = testGroup "inference"+  [ testProperty "type applications instantiate types" . property $ do+  -- Without @-XTypeApplications@ or some other constraint on the type, 'ask' would error: all @ghc@ would be able to prove about type of the 'Reader' effect, and thus the return type of 'ask', is that it’s a list of some kind. The type application allows us to specify it.+    x <- forAll Gen.alphaNum+    run (runEnv [x] ((++) <$> ask @String <*> ask @String)) === [x, x]+  -- However, when the type is polymorphic, this can require contortions: @-XScopedTypeVariables@ and @forall@ annotations just to bring the type variables into scope, etc., and can be especially inconvenient in @ghci.+  --+  -- Sometimes we would like to be able to constrain the type by context instead. In these cases, we can use a @newtype@ with a phantom type parameter, plus a wrapper around 'ask' which uses that type parameter to constrain its return type, to provide enough context for the types to be inferred without annotation or @-XTypeApplications@.+  , testProperty "phantom type parameters constrain inference" . property $ do+    x <- forAll (Gen.integral (Range.linear 0 100))+    run (runEnv [x] ((++) <$> askEnv <*> askEnv)) === [x, x :: Integer]+  ]+++-- | A constrained wrapper around 'ask'.+--+--   Like 'ask', 'askEnv' uses the same type parameter for both the 'Reader' and return types. Unlike 'ask'—which doesn’t impose any extra structure on the monad—it’s specialized to 'HasEnv', and uses the /same/ type parameter as its phantom type parameter.+--+--   Thus, any two calls to 'askEnv' occurring in the same 'HasEnv' context will be required to have their @env@ type parameters unify, allowing them to be inferred from context more often.+askEnv :: Has (Reader env) sig m => HasEnv env m env+askEnv = ask++-- | A handler for 'HasEnv' & 'ReaderC' with the same @env@ parameter.+--+--   Any 'askEnv's occurring in the second argument will have to unify not only with each other, but also with the first argument. Thus, if @ghc@ can infer the type of the any of these, it can infer all of them.+runEnv :: env -> HasEnv env (ReaderC env m) a -> m a+runEnv r = runReader r . runHasEnv+++-- | The identity monad transformer, with an extra phantom type parameter.+newtype HasEnv env m a = HasEnv { runHasEnv :: m a }+  deriving (Applicative, Functor, Monad)++-- | The 'Carrier' instance for 'HasEnv' simply delegates all effects to the underlying carrier.+instance Algebra sig m => Algebra sig (HasEnv env m) where+  alg = HasEnv . alg . handleCoercible

@@ -2,13 +2,16 @@ ( main ) where +import qualified Inference import qualified Parser import qualified ReinterpretLog import qualified Teletype-import Test.Hspec+import Test.Tasty  main :: IO ()-main = hspec $ do-  Teletype.spec-  ReinterpretLog.spec-  Parser.spec+main = defaultMain $ testGroup "examples"+  [ Inference.example+  , Parser.example+  , ReinterpretLog.example+  , Teletype.example+  ]

@@ -1,91 +1,127 @@-{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DerivingStrategies, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveGeneric, DeriveTraversable, ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-} module Parser-( spec+( example ) where -import Control.Effect.Carrier-import Control.Effect.Cut-import Control.Effect.NonDet-import Control.Effect.State+import Control.Algebra+import Control.Carrier.Cut.Church+import Control.Carrier.NonDet.Church+import Control.Carrier.State.Strict import Control.Monad (replicateM) import Data.Char import Data.List (intercalate) import GHC.Generics (Generic1)-import Test.Hspec-import Test.Hspec.QuickCheck-import Test.QuickCheck+import Hedgehog+import qualified Hedgehog.Function as Fn+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Tasty+import Test.Tasty.Hedgehog -spec :: Spec-spec = describe "parser" $ do-  describe "parse" $ do-    prop "returns pure values at the end of input" $-      \ a -> run (runNonDet (parse "" (pure a))) == [a :: Integer]+example :: TestTree+example = testGroup "parser"+  [ testGroup "parse"+    [ testProperty "returns pure values at the end of input" . property $ do+      a <- forAll genFactor+      run (runNonDetA (parse "" (pure a))) === [a] -    prop "fails if input remains" $-      \ c cs a -> run (runNonDet (parse (c:cs) (pure (a :: Integer)))) == []+    , testProperty "fails if input remains" . property $ do+      c  <- forAll Gen.alphaNum+      cs <- forAll (Gen.string (Range.linear 0 10) Gen.alphaNum)+      a  <- forAll genFactor+      run (runNonDetA (parse (c:cs) (pure a))) === []+    ] -  describe "satisfy" $ do-    prop "matches with a predicate" $-      \ c f -> run (runNonDet (parse [c] (satisfy (applyFun f)))) == if applyFun f c then [c] else []+  , testGroup "satisfy"+    [ testProperty "matches with a predicate" . property $ do+      c <- forAll Gen.alphaNum+      f <- (. ord) <$> Fn.forAllFn predicate+      run (runNonDetA (parse [c] (satisfy f))) === if f c then [c] else [] -    prop "fails at end of input" $-      \ f -> run (runNonDet (parse "" (satisfy (applyFun f)))) == []+    , testProperty "fails at end of input" . property $ do+      f <- (. ord) <$> Fn.forAllFn predicate+      run (runNonDetA (parse "" (satisfy f))) === [] -    prop "fails if input remains" $-      \ c1 c2 f -> run (runNonDet (parse [c1, c2] (satisfy (applyFun f)))) == []+    , testProperty "fails if input remains" . property $ do+      c1 <- forAll Gen.alphaNum+      c2 <- forAll Gen.alphaNum+      f <- (. ord) <$> Fn.forAllFn predicate+      run (runNonDetA (parse [c1, c2] (satisfy f))) === [] -    prop "consumes input" $-      \ c1 c2 f -> run (runNonDet (parse [c1, c2] ((,) <$> satisfy (applyFun f) <*> satisfy (applyFun f)))) == if applyFun f c1 && applyFun f c2 then [(c1, c2)] else []+    , testProperty "consumes input" . property $ do+      c1 <- forAll Gen.alphaNum+      c2 <- forAll Gen.alphaNum+      f <- (. ord) <$> Fn.forAllFn predicate+      run (runNonDetA (parse [c1, c2] ((,) <$> satisfy f <*> satisfy f))) === if f c1 && f c2 then [(c1, c2)] else []+    ] -  describe "factor" $ do-    prop "matches positive integers" $-      \ a -> run (runNonDet (runCut (parse (show (abs a)) factor))) == [abs a]+  , testGroup "factor"+    [ testProperty "matches positive integers" . property $ do+      a <- forAll genFactor+      run (runCutA (parse (show (abs a)) factor)) === [abs a] -    prop "matches parenthesized expressions" . forAll (sized arbNested) $-      \ as -> run (runNonDet (runCut (parse ('(' : intercalate "+" (intercalate "*" . map (show . abs) . (1:) <$> [0]:as) ++ ")") factor))) == [sum (map (product . map abs) as)]+    , testProperty "matches parenthesized expressions" . property $ do+      as <- forAll (Gen.sized (arbNested genFactor))+      run (runCutA (parse ('(' : intercalate "+" (intercalate "*" . map (show . abs) . (1:) <$> [0]:as) ++ ")") factor)) === [sum (map (product . map abs) as)]+    ] -  describe "term" $ do-    prop "matches factors" $-      \ a -> run (runNonDet (runCut (parse (show (abs a)) term))) == [abs a]+  , testGroup "term"+    [ testProperty "matches factors" . property $ do+      a <- forAll genFactor+      run (runCutA (parse (show (abs a)) term)) === [abs a] -    prop "matches multiplication" $-      \ as -> run (runNonDet (runCut (parse (intercalate "*" (show . abs <$> 1:as)) term))) == [product (map abs as)]+    , testProperty "matches multiplication" . property $ do+      as <- forAll genFactors+      run (runCutA (parse (intercalate "*" (show . abs <$> 1:as)) term)) === [product (map abs as)]+    ] -  describe "expr" $ do-    prop "matches factors" $-      \ a -> run (runNonDet (runCut (parse (show (abs a)) expr))) == [abs a]+  , testGroup "expr"+    [ testProperty "matches factors" . property $ do+      a <- forAll genFactor+      run (runCutA (parse (show (abs a)) expr)) === [abs a] -    prop "matches multiplication" $-      \ as -> run (runNonDet (runCut (parse (intercalate "*" (show . abs <$> 1:as)) expr))) == [product (map abs as)]+    , testProperty "matches multiplication" . property $ do+      as <- forAll genFactors+      run (runCutA (parse (intercalate "*" (show . abs <$> 1:as)) expr)) === [product (map abs as)] -    prop "matches addition" $-      \ as -> run (runNonDet (runCut (parse (intercalate "+" (show . abs <$> 0:as)) expr))) == [sum (map abs as)]+    , testProperty "matches addition" . property $ do+      as <- forAll genFactors+      run (runCutA (parse (intercalate "+" (show . abs <$> 0:as)) expr)) === [sum (map abs as)] -    prop "respects order of operations" . forAll (sized arbNested) $-      \ as -> run (runNonDet (runCut (parse (intercalate "+" (intercalate "*" . map (show . abs) . (1:) <$> [0]:as)) expr))) == [sum (map (product . map abs) as)]+    , testProperty "respects order of operations" . property $ do+      as <- forAll (Gen.sized (arbNested (Gen.integral (Range.linear 0 100))))+      run (runCutA (parse (intercalate "+" (intercalate "*" . map (show . abs) . (1:) <$> [0]:as)) expr)) === [sum (map (product . map abs) as)]+    ]+  ] -    where arbNested :: Arbitrary a => Int -> Gen [[a]]-          arbNested 0 = pure []-          arbNested n = do-            Positive m <- arbitrary+    where arbNested :: Gen a -> Range.Size -> Gen [[a]]+          arbNested _ 0 = pure []+          arbNested g n = do+            m <- Gen.integral (Range.linear 0 10)             let n' = n `div` (m + 1)-            replicateM m (vector n')+            replicateM (Range.unSize m) (Gen.list (Range.singleton (Range.unSize n')) g) +          predicate = Fn.fn Gen.bool+          genFactor = Gen.integral (Range.linear 0 100)+          genFactors = Gen.list (Range.linear 0 10) genFactor + data Symbol m k = Satisfy (Char -> Bool) (Char -> m k)-  deriving stock (Functor, Generic1)-  deriving anyclass (HFunctor, Effect)+  deriving (Functor, Generic1) -satisfy :: (Carrier sig m, Member Symbol sig) => (Char -> Bool) -> m Char+instance HFunctor Symbol+instance Effect   Symbol++satisfy :: Has Symbol sig m => (Char -> Bool) -> m Char satisfy p = send (Satisfy p pure) -char :: (Carrier sig m, Member Symbol sig) => Char -> m Char+char :: Has Symbol sig m => Char -> m Char char = satisfy . (==) -digit :: (Carrier sig m, Member Symbol sig) => m Char+digit :: Has Symbol sig m => m Char digit = satisfy isDigit -parens :: (Carrier sig m, Member Symbol sig) => m a -> m a+parens :: Has Symbol sig m => m a -> m a parens m = char '(' *> m <* char ')'  @@ -95,31 +131,31 @@         exhaustive _       = empty  newtype ParseC m a = ParseC { runParseC :: StateC String m a }-  deriving newtype (Alternative, Applicative, Functor, Monad)+  deriving (Alternative, Applicative, Functor, Monad) -instance (Alternative m, Carrier sig m, Effect sig) => Carrier (Symbol :+: sig) (ParseC m) where-  eff (L (Satisfy p k)) = do+instance (Alternative m, Algebra sig m, Effect sig) => Algebra (Symbol :+: sig) (ParseC m) where+  alg (L (Satisfy p k)) = do     input <- ParseC get     case input of       c:cs | p c -> ParseC (put cs) *> k c       _          -> empty-  eff (R other)         = ParseC (eff (R (handleCoercible other)))-  {-# INLINE eff #-}+  alg (R other)         = ParseC (alg (R (handleCoercible other)))+  {-# INLINE alg #-}  -expr :: (Alternative m, Carrier sig m, Member Cut sig, Member Symbol sig) => m Int+expr :: (Alternative m, Has Cut sig m, Has Symbol sig m) => m Int expr = do   i <- term   call ((i +) <$ char '+' <* cut <*> expr     <|> pure i) -term :: (Alternative m, Carrier sig m, Member Cut sig, Member Symbol sig) => m Int+term :: (Alternative m, Has Cut sig m, Has Symbol sig m) => m Int term = do   i <- factor   call ((i *) <$ char '*' <* cut <*> term     <|> pure i) -factor :: (Alternative m, Carrier sig m, Member Cut sig, Member Symbol sig) => m Int+factor :: (Alternative m, Has Cut sig m, Has Symbol sig m) => m Int factor   =   read <$> some digit   <|> parens expr

@@ -10,11 +10,8 @@ --   structured log messages as strings.  -{-# LANGUAGE DeriveAnyClass             #-} {-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE DerivingStrategies         #-}-{-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs               #-}@@ -28,21 +25,22 @@ {-# LANGUAGE UndecidableInstances       #-}  module ReinterpretLog-  ( spec+  ( example   , application   , runApplication   ) where -import Control.Effect.Carrier-import Control.Effect.Lift-import Control.Effect.Reader-import Control.Effect.Writer+import Control.Algebra+import Control.Carrier.Lift+import Control.Carrier.Reader+import Control.Carrier.Writer.Strict import Control.Monad.IO.Class (MonadIO(..)) import Data.Function          ((&)) import Data.Kind              (Type) import GHC.Generics           (Generic1) import Prelude                hiding (log)-import Test.Hspec+import Test.Tasty+import Test.Tasty.HUnit   --------------------------------------------------------------------------------@@ -64,10 +62,7 @@   Info  message -> "[info] "  ++ message  -- The application: it logs two messages, then quits.-application ::-     ( Carrier sig m-     , Member (Log Message) sig-     )+application :: Has (Log Message) sig m   => m () application = do   log (Debug "debug message")@@ -109,14 +104,13 @@ -- Log an 'a', then continue with 'k'. data Log (a :: Type) (m :: Type -> Type) (k :: Type)   = Log a (m k)-  deriving stock (Functor, Generic1)-  deriving anyclass (HFunctor, Effect)+  deriving (Functor, Generic1) +instance HFunctor (Log a)+instance Effect   (Log a)+ -- Log an 'a'.-log ::-     ( Carrier sig m-     , Member (Log a) sig-     )+log :: Has (Log a) sig m   => a   -> m () log x =@@ -130,26 +124,26 @@ -- Carrier one: log strings to stdout. newtype LogStdoutC m a   = LogStdoutC (m a)-  deriving newtype (Applicative, Functor, Monad, MonadIO)+  deriving (Applicative, Functor, Monad, MonadIO)  instance      -- So long as the 'm' monad can interpret the 'sig' effects (and also      -- perform IO)...-     ( Carrier sig m+     ( Algebra sig m      , MonadIO m      )      -- ... the 'LogStdoutC m' monad can interpret 'Log String :+: sig' effects-  => Carrier (Log String :+: sig) (LogStdoutC m) where+  => Algebra (Log String :+: sig) (LogStdoutC m) where -  eff :: (Log String :+: sig) (LogStdoutC m) a -> LogStdoutC m a-  eff = \case+  alg :: (Log String :+: sig) (LogStdoutC m) a -> LogStdoutC m a+  alg = \case     L (Log message k) ->       LogStdoutC $ do         liftIO (putStrLn message)         runLogStdout k      R other ->-      LogStdoutC (eff (hmap runLogStdout other))+      LogStdoutC (alg (hmap runLogStdout other))  -- The 'LogStdoutC' runner. runLogStdout ::@@ -163,22 +157,20 @@ -- using a function (provided at runtime) from 's' to 't'. newtype ReinterpretLogC s t m a   = ReinterpretLogC { unReinterpretLogC :: ReaderC (s -> t) m a }-  deriving newtype (Applicative, Functor, Monad, MonadIO)+  deriving (Applicative, Functor, Monad, MonadIO)  instance      -- So long as the 'm' monad can interpret the 'sig' effects, one of which      -- is 'Log t'...-     ( Carrier sig m-     , Member (Log t) sig-     )+     Has (Log t) sig m      -- ... the 'ReinterpretLogC s t m' monad can interpret 'Log s :+: sig'      -- effects-  => Carrier (Log s :+: sig) (ReinterpretLogC s t m) where+  => Algebra (Log s :+: sig) (ReinterpretLogC s t m) where -  eff ::+  alg ::        (Log s :+: sig) (ReinterpretLogC s t m) a     -> ReinterpretLogC s t m a-  eff = \case+  alg = \case     L (Log s k) ->       ReinterpretLogC $ do         f <- ask @(s -> t)@@ -186,7 +178,7 @@         unReinterpretLogC k      R other ->-      ReinterpretLogC (eff (R (handleCoercible other)))+      ReinterpretLogC (alg (R (handleCoercible other)))  -- The 'ReinterpretLogC' runner. reinterpretLog ::@@ -202,28 +194,28 @@ -- example's test spec. newtype CollectLogMessagesC s m a   = CollectLogMessagesC { unCollectLogMessagesC :: WriterC [s] m a }-  deriving newtype (Applicative, Functor, Monad)+  deriving (Applicative, Functor, Monad)  instance      -- So long as the 'm' monad can interpret the 'sig' effects...-     ( Carrier sig m+     ( Algebra sig m      , Effect sig      )      -- ...the 'CollectLogMessagesC s m' monad can interpret 'Log s :+: sig'      -- effects-  => Carrier (Log s :+: sig) (CollectLogMessagesC s m) where+  => Algebra (Log s :+: sig) (CollectLogMessagesC s m) where -  eff ::+  alg ::        (Log s :+: sig) (CollectLogMessagesC s m) a     -> CollectLogMessagesC s m a-  eff = \case+  alg = \case     L (Log s k) ->       CollectLogMessagesC $ do         tell [s]         unCollectLogMessagesC k      R other ->-      CollectLogMessagesC (eff (R (handleCoercible other)))+      CollectLogMessagesC (alg (R (handleCoercible other)))  -- The 'CollectLogMessagesC' runner. collectLogMessages ::@@ -234,14 +226,14 @@   -- Test spec.-spec :: Spec-spec =-  describe "reinterpret log" $-    it "reinterprets logs" $-      ((do-          log (Debug "foo")-          log (Info "bar"))-        & reinterpretLog renderLogMessage-        & collectLogMessages-        & run)-      `shouldBe` (["[debug] foo", "[info] bar"], ())+example :: TestTree+example = testGroup "reinterpret log"+  [ testCase "reinterprets logs" $+    ((do+        log (Debug "foo")+        log (Info "bar"))+      & reinterpretLog renderLogMessage+      & collectLogMessages+      & run)+    @?= (["[debug] foo", "[info] bar"], ())+  ]

@@ -1,41 +1,54 @@-{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}  module Teletype-( spec+( example , runTeletypeIO ) where  import Prelude hiding (read) -import Control.Effect.Carrier-import Control.Effect.State-import Control.Effect.Writer+import Control.Algebra+import Control.Carrier.State.Strict+import Control.Carrier.Writer.Strict import Control.Monad.IO.Class import GHC.Generics (Generic1)-import Test.Hspec-import Test.Hspec.QuickCheck+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Tasty+import Test.Tasty.Hedgehog -spec :: Spec-spec = describe "teletype" $ do-  prop "reads" $-    \ line -> run (runTeletypeRet [line] read) `shouldBe` ([], ([], line))+example :: TestTree+example = testGroup "teletype"+  [ testProperty "reads" . property $ do+    line <- forAll genLine+    run (runTeletypeRet [line] read) === ([], ([], line)) -  prop "writes" $-    \ input output -> run (runTeletypeRet input (write output)) `shouldBe` ([output], (input, ()))+  , testProperty "writes" . property $ do+    input  <- forAll (Gen.list (Range.linear 0 10) genLine)+    output <- forAll genLine+    run (runTeletypeRet input (write output)) === ([output], (input, ())) -  prop "writes multiple things" $-    \ input output1 output2 -> run (runTeletypeRet input (write output1 >> write output2)) `shouldBe` ([output1, output2], (input, ()))+  , testProperty "writes multiple things" . property $ do+    input   <- forAll (Gen.list (Range.linear 0 10) genLine)+    output1 <- forAll genLine+    output2 <- forAll genLine+    run (runTeletypeRet input (write output1 >> write output2)) === ([output1, output2], (input, ()))+  ] where+  genLine = Gen.string (Range.linear 0 20) Gen.unicode  data Teletype m k   = Read (String -> m k)   | Write String (m k)-  deriving stock (Functor, Generic1)-  deriving anyclass (HFunctor, Effect)+  deriving (Functor, Generic1) -read :: (Member Teletype sig, Carrier sig m) => m String+instance HFunctor Teletype+instance Effect   Teletype++read :: Has Teletype sig m => m String read = send (Read pure) -write :: (Member Teletype sig, Carrier sig m) => String -> m ()+write :: Has Teletype sig m => String -> m () write s = send (Write s (pure ()))  @@ -43,25 +56,25 @@ runTeletypeIO = runTeletypeIOC  newtype TeletypeIOC m a = TeletypeIOC { runTeletypeIOC :: m a }-  deriving newtype (Applicative, Functor, Monad, MonadIO)+  deriving (Applicative, Functor, Monad, MonadIO) -instance (MonadIO m, Carrier sig m) => Carrier (Teletype :+: sig) (TeletypeIOC m) where-  eff (L (Read    k)) = liftIO getLine      >>= k-  eff (L (Write s k)) = liftIO (putStrLn s) >>  k-  eff (R other)       = TeletypeIOC (eff (handleCoercible other))+instance (MonadIO m, Algebra sig m) => Algebra (Teletype :+: sig) (TeletypeIOC m) where+  alg (L (Read    k)) = liftIO getLine      >>= k+  alg (L (Write s k)) = liftIO (putStrLn s) >>  k+  alg (R other)       = TeletypeIOC (alg (handleCoercible other))   runTeletypeRet :: [String] -> TeletypeRetC m a -> m ([String], ([String], a)) runTeletypeRet i = runWriter . runState i . runTeletypeRetC  newtype TeletypeRetC m a = TeletypeRetC { runTeletypeRetC :: StateC [String] (WriterC [String] m) a }-  deriving newtype (Applicative, Functor, Monad)+  deriving (Applicative, Functor, Monad) -instance (Carrier sig m, Effect sig) => Carrier (Teletype :+: sig) (TeletypeRetC m) where-  eff (L (Read    k)) = do+instance (Algebra sig m, Effect sig) => Algebra (Teletype :+: sig) (TeletypeRetC m) where+  alg (L (Read    k)) = do     i <- TeletypeRetC get     case i of       []  -> k ""       h:t -> TeletypeRetC (put t) *> k h-  eff (L (Write s k)) = TeletypeRetC (tell [s]) *> k-  eff (R other)       = TeletypeRetC (eff (R (R (handleCoercible other))))+  alg (L (Write s k)) = TeletypeRetC (tell [s]) *> k+  alg (R other)       = TeletypeRetC (alg (R (R (handleCoercible other))))

@@ -1,7 +1,7 @@ cabal-version:       2.2  name:                fused-effects-version:             0.5.0.1+version:             1.0.0.0 synopsis:            A fast, flexible, fused effect system. description:         A fast, flexible, fused effect system, à la Effect Handlers in Scope, Monad Transformers and Modular Algebraic Effects: What Binds Them Together, and Fusion for Free—Efficient Algebraic Effect Handlers. homepage:            https://github.com/fused-effects/fused-effects@@ -16,98 +16,176 @@   README.md   ChangeLog.md -tested-with:         GHC == 8.2.2-                   , GHC == 8.4.4-                   , GHC == 8.6.2-                   , GHC == 8.8.1+tested-with:+  GHC == 8.2.2+  GHC == 8.4.4+  GHC == 8.6.5+  GHC == 8.8.1  common common-  default-language:    Haskell2010-  ghc-options:         -Weverything -Wno-missing-local-signatures -Wno-missing-import-lists -Wno-implicit-prelude -Wno-safe -Wno-unsafe -Wno-name-shadowing -Wno-monomorphism-restriction -Wno-missed-specialisations -Wno-all-missed-specialisations+  default-language: Haskell2010+  ghc-options:+    -Weverything+    -Wno-all-missed-specialisations+    -Wno-implicit-prelude+    -Wno-missed-specialisations+    -Wno-missing-import-lists+    -Wno-missing-local-signatures+    -Wno-monomorphism-restriction+    -Wno-name-shadowing+    -Wno-safe+    -Wno-unsafe   if (impl(ghc >= 8.6))-    ghc-options:       -Wno-star-is-type+    ghc-options: -Wno-star-is-type   if (impl(ghc >= 8.8))-    ghc-options:       -Wno-missing-deriving-strategies+    ghc-options: -Wno-missing-deriving-strategies  library-  import:              common-  exposed-modules:     Control.Effect-                     , Control.Effect.Carrier-                     , Control.Effect.Cull-                     , Control.Effect.Cut-                     , Control.Effect.Error-                     , Control.Effect.Fail-                     , Control.Effect.Fresh-                     , Control.Effect.Interpose-                     , Control.Effect.Interpret-                     , Control.Effect.Lift-                     , Control.Effect.NonDet-                     , Control.Effect.Pure-                     , Control.Effect.Random-                     , Control.Effect.Reader-                     , Control.Effect.Resource-                     , Control.Effect.Resumable-                     , Control.Effect.State-                     , Control.Effect.State.Internal-                     , Control.Effect.State.Lazy-                     , Control.Effect.State.Strict-                     , Control.Effect.Sum-                     , Control.Effect.Trace-                     , Control.Effect.Writer-  build-depends:       base           >= 4.9 && < 4.14-                     , deepseq       ^>= 1.4.3-                     , MonadRandom   ^>= 0.5-                     , unliftio-core ^>= 0.1.2-                     , random-                     , transformers-  hs-source-dirs:      src+  import:         common+  hs-source-dirs: src+  exposed-modules:+    Control.Algebra+    -- Carriers+    Control.Carrier.Choose.Church+    Control.Carrier.Cull.Church+    Control.Carrier.Cut.Church+    Control.Carrier.Empty.Maybe+    Control.Carrier.Error.Either+    Control.Carrier.Fail.Either+    Control.Carrier.Fresh.Strict+    Control.Carrier.Interpret+    Control.Carrier.Lift+    Control.Carrier.NonDet.Church+    Control.Carrier.Reader+    Control.Carrier.State.Lazy+    Control.Carrier.State.Strict+    Control.Carrier.Throw.Either+    Control.Carrier.Trace.Ignoring+    Control.Carrier.Trace.Printing+    Control.Carrier.Trace.Returning+    Control.Carrier.Writer.Strict+    -- Effects+    Control.Effect.Catch+    Control.Effect.Choose+    Control.Effect.Class+    Control.Effect.Cull+    Control.Effect.Cut+    Control.Effect.Empty+    Control.Effect.Error+    Control.Effect.Fail+    Control.Effect.Fresh+    Control.Effect.Lift+    Control.Effect.NonDet+    Control.Effect.Reader+    Control.Effect.State+    Control.Effect.Sum+    Control.Effect.Throw+    Control.Effect.Trace+    Control.Effect.Writer+  other-modules:+    Control.Effect.Catch.Internal+    Control.Effect.Choose.Internal+    Control.Effect.Empty.Internal+    Control.Effect.Error.Internal+    Control.Effect.Lift.Internal+    Control.Effect.NonDet.Internal+    Control.Effect.Reader.Internal+    Control.Effect.State.Internal+    Control.Effect.Throw.Internal+    Control.Effect.Writer.Internal+  build-depends:+      base          >= 4.9 && < 4.14+    , transformers  >= 0.4 && < 0.6   test-suite examples-  import:              common-  type:                exitcode-stdio-1.0-  main-is:             Main.hs-  other-modules:       Parser-                     , ReinterpretLog-                     , Teletype-  build-depends:       base        >= 4.9 && < 4.14-                     , fused-effects-                     , hspec       >= 2.4.1-                     , QuickCheck  >= 2.7 && < 3-                     , transformers-  hs-source-dirs:      examples+  import:         common+  type:           exitcode-stdio-1.0+  hs-source-dirs: examples+  main-is:        Main.hs+  other-modules:+    Inference+    Parser+    ReinterpretLog+    Teletype+  build-depends:+      base+    , fused-effects+    , hedgehog           ^>= 1+    , hedgehog-fn        ^>= 1+    , tasty              ^>= 1.2+    , tasty-hedgehog     ^>= 1+    , tasty-hunit        ^>= 0.10+    , transformers + test-suite test-  import:              common-  type:                exitcode-stdio-1.0-  main-is:             Spec.hs-  other-modules:       Control.Effect.Spec-                     , Control.Effect.NonDet.Spec-  build-depends:       base                >= 4.9 && < 4.14-                     , fused-effects-                     , hspec               >= 2.4.1-                     , inspection-testing ^>= 0.4-  hs-source-dirs:      test+  import:         common+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Test.hs+  other-modules:+    Catch+    Choose+    Cull+    Cut+    Cut.Church+    Empty+    Error+    Fail+    Fresh+    Fusion+    Gen+    Lift+    Monad+    MonadFix+    NonDet+    NonDet.Church+    Reader+    State+    Throw+    Writer+  build-depends:+      base+    , containers          >= 0.5 && < 0.7+    , fused-effects+    , hedgehog           ^>= 1+    , hedgehog-fn        ^>= 1+    , inspection-testing ^>= 0.4+    , tasty              ^>= 1.2+    , tasty-hedgehog     ^>= 1+    , tasty-hunit        ^>= 0.10+    , transformers -test-suite doctest-  import:              common-  type:                exitcode-stdio-1.0-  main-is:             Doctest.hs-  build-depends:       base     >= 4.9 && < 4.14-                     , doctest  >= 0.7 && < 1-                     , fused-effects-  hs-source-dirs:      test +test-suite docs+  import:      common+  type:        exitcode-stdio-1.0+  main-is:     README.lhs+  ghc-options: -pgmL markdown-unlit+  build-depends:+      base+    , fused-effects+    , mtl           ^>= 2.2+  build-tool-depends:+      markdown-unlit:markdown-unlit ^>= 0.5 + benchmark benchmark-  import:             common-  type:               exitcode-stdio-1.0-  main-is:            Bench.hs-  build-depends:      base >= 4.9 && < 4.14-                    , fused-effects-                    , gauge-  hs-source-dirs:     benchmark-  ghc-options:        -threaded -rtsopts "-with-rtsopts=-N -A4m -n2m"+  import:         common+  type:           exitcode-stdio-1.0+  hs-source-dirs: benchmark+  main-is:        Bench.hs+  other-modules:+    Bench.NonDet+    Bench.NonDet.NQueens+  build-depends:+      base+    , fused-effects+    , gauge+  ghc-options:+    -threaded+    -rtsopts "-with-rtsopts=-N -A4m -n2m"   source-repository head

@@ -0,0 +1,172 @@+{-# LANGUAGE ConstraintKinds, DeriveFunctor, FlexibleInstances, FunctionalDependencies, RankNTypes, TypeOperators, UndecidableInstances #-}++{- | The 'Algebra' class is the mechanism with which effects are interpreted.++An instance of the 'Algebra' class defines an interpretation of an effect signature atop a given monad.++@since 1.0.0.0+-}+module Control.Algebra+( Algebra(..)+, run+, Has+, send+  -- * Re-exports+, (:+:) (..)+, module Control.Effect.Class+) where++import Control.Effect.Catch.Internal+import Control.Effect.Choose.Internal+import Control.Effect.Class+import Control.Effect.Empty.Internal+import Control.Effect.Error.Internal+import Control.Effect.Lift.Internal+import Control.Effect.NonDet.Internal+import Control.Effect.Reader.Internal+import Control.Effect.State.Internal+import Control.Effect.Sum ((:+:)(..), Member(..), Members)+import Control.Effect.Throw.Internal+import Control.Effect.Writer.Internal+import Control.Monad ((<=<))+import Data.Coerce+import Data.Functor.Identity+import qualified Control.Monad.Trans.Except as Except+import qualified Control.Monad.Trans.Identity as Identity+import qualified Control.Monad.Trans.Reader as Reader+import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy+import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict+import qualified Control.Monad.Trans.State.Lazy as State.Lazy+import qualified Control.Monad.Trans.State.Strict as State.Strict+import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy+import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict+import Data.List.NonEmpty (NonEmpty)+import qualified Data.Semigroup as S+import Data.Tuple (swap)++-- | The class of carriers (results) for algebras (effect handlers) over signatures (effects), whose actions are given by the 'alg' method.+--+-- @since 1.0.0.0+class (HFunctor sig, Monad m) => Algebra sig m | m -> sig where+  -- | Construct a value in the carrier for an effect signature (typically a sum of a handled effect and any remaining effects).+  alg :: sig m a -> m a+++-- | Run an action exhausted of effects to produce its final result value.+--+-- @since 1.0.0.0+run :: Identity a -> a+run = runIdentity+{-# INLINE run #-}+++-- | @m@ is a carrier for @sig@ containing @eff@.+--+-- Note that if @eff@ is a sum, it will be decomposed into multiple 'Member' constraints. While this technically allows one to combine multiple unrelated effects into a single 'Has' constraint, doing so has two significant drawbacks:+--+-- 1. Due to [a problem with recursive type families](https://gitlab.haskell.org/ghc/ghc/issues/8095), this can lead to significantly slower compiles.+--+-- 2. It defeats @ghc@’s warnings for redundant constraints, and thus can lead to a proliferation of redundant constraints as code is changed.+type Has eff sig m = (Members eff sig, Algebra sig m)++-- | Construct a request for an effect to be interpreted by some handler later on.+send :: (Member eff sig, Algebra sig m) => eff m a -> m a+send = alg . inj+{-# INLINE send #-}+++-- base++instance Algebra (Lift IO) IO where+  alg (LiftWith with k) = with (Identity ()) coerce >>= k . runIdentity++instance Algebra (Lift Identity) Identity where+  alg (LiftWith with k) = with (Identity ()) coerce >>= k . runIdentity++instance Algebra Choose NonEmpty where+  alg (Choose m) = m True S.<> m False++instance Algebra Empty Maybe where+  alg Empty = Nothing++instance Algebra (Error e) (Either e) where+  alg (L (Throw e))     = Left e+  alg (R (Catch m h k)) = either (k <=< h) k m++instance Algebra (Reader r) ((->) r) where+  alg (Ask       k) r = k r r+  alg (Local f m k) r = k (m (f r)) r++instance Algebra NonDet [] where+  alg (L Empty)      = []+  alg (R (Choose k)) = k True ++ k False++instance Monoid w => Algebra (Writer w) ((,) w) where+  alg (Tell w (w', k))    = (mappend w w', k)+  alg (Listen (w, a) k)   = let (w', a') = k w a in (mappend w w', a')+  alg (Censor f (w, a) k) = let (w', a') = k a in (mappend (f w) w', a')+++-- transformers++instance (Algebra sig m, Effect sig) => Algebra (Error e :+: sig) (Except.ExceptT e m) where+  alg (L (L (Throw e)))     = Except.throwE e+  alg (L (R (Catch m h k))) = Except.catchE m h >>= k+  alg (R other)             = Except.ExceptT $ alg (thread (Right ()) (either (pure . Left) Except.runExceptT) other)++instance Algebra sig m => Algebra sig (Identity.IdentityT m) where+  alg = Identity.IdentityT . alg . handleCoercible++instance Algebra sig m => Algebra (Reader r :+: sig) (Reader.ReaderT r m) where+  alg (L (Ask       k)) = Reader.ask >>= k+  alg (L (Local f m k)) = Reader.local f m >>= k+  alg (R other)         = Reader.ReaderT $ \ r -> alg (hmap (flip Reader.runReaderT r) other)++newtype RWSTF w s a = RWSTF { unRWSTF :: (a, s, w) }+  deriving (Functor)++toRWSTF :: Monoid w => w -> (a, s, w) -> RWSTF w s a+toRWSTF w (a, s, w') = RWSTF (a, s, mappend w w')+{-# INLINE toRWSTF #-}++instance (Algebra sig m, Effect sig, Monoid w) => Algebra (Reader r :+: Writer w :+: State s :+: sig) (RWS.Lazy.RWST r w s m) where+  alg (L (Ask       k))      = RWS.Lazy.ask >>= k+  alg (L (Local f m k))      = RWS.Lazy.local f m >>= k+  alg (R (L (Tell w k)))     = RWS.Lazy.tell w *> k+  alg (R (L (Listen m k)))   = RWS.Lazy.listen m >>= uncurry (flip k)+  alg (R (L (Censor f m k))) = RWS.Lazy.censor f m >>= k+  alg (R (R (L (Get   k))))  = RWS.Lazy.get >>= k+  alg (R (R (L (Put s k))))  = RWS.Lazy.put s *> k+  alg (R (R (R other)))      = RWS.Lazy.RWST $ \ r s -> unRWSTF <$> alg (thread (RWSTF ((), s, mempty)) (\ (RWSTF (x, s, w)) -> toRWSTF w <$> RWS.Lazy.runRWST x r s) other)++instance (Algebra sig m, Effect sig, Monoid w) => Algebra (Reader r :+: Writer w :+: State s :+: sig) (RWS.Strict.RWST r w s m) where+  alg (L (Ask       k))      = RWS.Strict.ask >>= k+  alg (L (Local f m k))      = RWS.Strict.local f m >>= k+  alg (R (L (Tell w k)))     = RWS.Strict.tell w *> k+  alg (R (L (Listen m k)))   = RWS.Strict.listen m >>= uncurry (flip k)+  alg (R (L (Censor f m k))) = RWS.Strict.censor f m >>= k+  alg (R (R (L (Get   k))))  = RWS.Strict.get >>= k+  alg (R (R (L (Put s k))))  = RWS.Strict.put s *> k+  alg (R (R (R other)))      = RWS.Strict.RWST $ \ r s -> unRWSTF <$> alg (thread (RWSTF ((), s, mempty)) (\ (RWSTF (x, s, w)) -> toRWSTF w <$> RWS.Strict.runRWST x r s) other)++instance (Algebra sig m, Effect sig) => Algebra (State s :+: sig) (State.Lazy.StateT s m) where+  alg (L (Get   k)) = State.Lazy.get >>= k+  alg (L (Put s k)) = State.Lazy.put s *> k+  alg (R other)     = State.Lazy.StateT $ \ s -> swap <$> alg (thread (s, ()) (\ (s, x) -> swap <$> State.Lazy.runStateT x s) other)++instance (Algebra sig m, Effect sig) => Algebra (State s :+: sig) (State.Strict.StateT s m) where+  alg (L (Get   k)) = State.Strict.get >>= k+  alg (L (Put s k)) = State.Strict.put s *> k+  alg (R other)     = State.Strict.StateT $ \ s -> swap <$> alg (thread (s, ()) (\ (s, x) -> swap <$> State.Strict.runStateT x s) other)++instance (Algebra sig m, Effect sig, Monoid w) => Algebra (Writer w :+: sig) (Writer.Lazy.WriterT w m) where+  alg (L (Tell w k))     = Writer.Lazy.tell w *> k+  alg (L (Listen m k))   = Writer.Lazy.listen m >>= uncurry (flip k)+  alg (L (Censor f m k)) = Writer.Lazy.censor f m >>= k+  alg (R other)          = Writer.Lazy.WriterT $ swap <$> alg (thread (mempty, ()) (\ (s, x) -> swap . fmap (mappend s) <$> Writer.Lazy.runWriterT x) other)++instance (Algebra sig m, Effect sig, Monoid w) => Algebra (Writer w :+: sig) (Writer.Strict.WriterT w m) where+  alg (L (Tell w k))     = Writer.Strict.tell w *> k+  alg (L (Listen m k))   = Writer.Strict.listen m >>= uncurry (flip k)+  alg (L (Censor f m k)) = Writer.Strict.censor f m >>= k+  alg (R other)          = Writer.Strict.WriterT $ swap <$> alg (thread (mempty, ()) (\ (s, x) -> swap . fmap (mappend s) <$> Writer.Strict.runWriterT x) other)

@@ -0,0 +1,90 @@+{-# LANGUAGE DeriveTraversable, FlexibleInstances, LambdaCase, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}++{- | A carrier for 'Choose' effects (nondeterminism without failure).++Under the hood, it uses a Church-encoded binary tree to avoid the problems associated with a naïve list-based implementation (see ["ListT done right"](http://wiki.haskell.org/ListT_done_right)).++@since 1.0.0.0+-}++module Control.Carrier.Choose.Church+( -- * Choose carrier+  runChoose+, runChooseS+, ChooseC(..)+  -- * Choose effect+, module Control.Effect.Choose+) where++import Control.Algebra+import Control.Applicative (liftA2)+import Control.Effect.Choose+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Coerce (coerce)+import Data.Functor.Identity+import Data.List.NonEmpty (NonEmpty(..), head, tail)+import qualified Data.Semigroup as S+import Prelude hiding (head, tail)++-- | Run a 'Choose' effect with continuations respectively interpreting '<|>' and 'pure'.+--+-- @since 1.0.0.0+runChoose :: (m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b+runChoose fork leaf (ChooseC runChooseC) = runChooseC fork leaf++-- | Run a 'Choose' effect, mapping results into a 'S.Semigroup'.+--+-- @since 1.0.0.0+runChooseS :: (S.Semigroup b, Applicative m) => (a -> m b) -> ChooseC m a -> m b+runChooseS = runChoose (liftA2 (S.<>))++-- | A carrier for 'Choose' effects based on Ralf Hinze’s design described in [Deriving Backtracking Monad Transformers](https://www.cs.ox.ac.uk/ralf.hinze/publications/#P12).+--+-- @since 1.0.0.0+newtype ChooseC m a = ChooseC (forall b . (m b -> m b -> m b) -> (a -> m b) -> m b)+  deriving (Functor)++instance Applicative (ChooseC m) where+  pure a = ChooseC (\ _ leaf -> leaf a)+  {-# INLINE pure #-}+  ChooseC f <*> ChooseC a = ChooseC $ \ fork leaf ->+    f fork (\ f' -> a fork (leaf . f'))+  {-# INLINE (<*>) #-}++instance Monad (ChooseC m) where+  ChooseC a >>= f = ChooseC $ \ fork leaf ->+    a fork (runChoose fork leaf . f)+  {-# INLINE (>>=) #-}++instance Fail.MonadFail m => Fail.MonadFail (ChooseC m) where+  fail s = lift (Fail.fail s)+  {-# INLINE fail #-}++-- | Separate fixpoints are computed for each branch.+instance MonadFix m => MonadFix (ChooseC m) where+  mfix f = ChooseC $ \ fork leaf ->+    mfix (runChooseS (pure . pure) . f . head)+    >>= \case+      a:|[] -> leaf a+      a:|_  -> leaf a `fork` runChoose fork leaf (mfix (liftAll . fmap tail . runChooseS (pure . pure) . f))+      where+    liftAll m = ChooseC $ \ fork leaf -> m >>= foldr1 fork . fmap leaf+  {-# INLINE mfix #-}++instance MonadIO m => MonadIO (ChooseC m) where+  liftIO io = lift (liftIO io)+  {-# INLINE liftIO #-}++instance MonadTrans ChooseC where+  lift m = ChooseC (\ _ leaf -> m >>= leaf)+  {-# INLINE lift #-}++instance (Algebra sig m, Effect sig) => Algebra (Choose :+: sig) (ChooseC m) where+  alg (L (Choose k)) = ChooseC $ \ fork leaf -> fork (runChoose fork leaf (k True)) (runChoose fork leaf (k False))+  alg (R other)      = ChooseC $ \ fork leaf -> alg (thread (pure ()) dst other) >>= runIdentity . runChoose (coerce fork) (coerce leaf) where+    dst :: Applicative m => ChooseC Identity (ChooseC m a) -> m (ChooseC Identity a)+    dst = runIdentity . runChoose (liftA2 (liftA2 (<|>))) (pure . runChoose (liftA2 (<|>)) (pure . pure))+  {-# INLINE alg #-}

@@ -0,0 +1,76 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-}++-- | A carrier for 'Cull' and 'NonDet' effects used in tandem (@Cull :+: NonDet@).+--+-- @since 1.0.0.0+module Control.Carrier.Cull.Church+( -- * Cull carrier+  runCull+, runCullA+, runCullM+, CullC(..)+  -- * Cull effect+, module Control.Effect.Cull+  -- * NonDet effects+, module Control.Effect.NonDet+) where++import Control.Algebra+import Control.Applicative (liftA2)+import Control.Carrier.NonDet.Church+import Control.Carrier.Reader+import Control.Effect.Cull+import Control.Effect.NonDet+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++-- | Run a 'Cull' effect with continuations respectively interpreting '<|>', 'pure', and 'empty'. Branches outside of any 'cull' block will not be pruned.+--+-- @since 1.0.0.0+runCull :: (m b -> m b -> m b) -> (a -> m b) -> m b -> CullC m a -> m b+runCull fork leaf nil (CullC m) = runNonDet fork leaf nil (runReader False m)++-- | Run a 'Cull' effect, interpreting the result into an 'Alternative' functor. Choice is handled with '<|>', embedding with 'pure', and failure with 'empty'.+--+-- @since 1.0.0.0+runCullA :: (Alternative f, Applicative m) => CullC m a -> m (f a)+runCullA = runCull (liftA2 (<|>)) (pure . pure) (pure empty)++-- | Run a 'Cull' effect, mapping results into a 'Monoid'.+--+-- @since 1.0.0.0+runCullM :: (Applicative m, Monoid b) => (a -> b) -> CullC m a -> m b+runCullM leaf = runCull (liftA2 mappend) (pure . leaf) (pure mempty)++-- | @since 1.0.0.0+newtype CullC m a = CullC (ReaderC Bool (NonDetC m) a)+  deriving (Applicative, Functor, Monad, Fail.MonadFail, MonadIO)++instance Alternative (CullC m) where+  empty = CullC empty+  {-# INLINE empty #-}+  CullC l <|> CullC r = CullC $ ReaderC $ \ cull ->+    if cull then+      NonDetC $ \ fork leaf nil ->+        runNonDet fork leaf (runNonDet fork leaf nil (runReader cull r)) (runReader cull l)+    else+      runReader cull l <|> runReader cull r+  {-# INLINE (<|>) #-}++-- | Separate fixpoints are computed for each branch.+deriving instance MonadFix m => MonadFix (CullC m)++instance MonadPlus (CullC m)++instance MonadTrans CullC where+  lift = CullC . lift . lift+  {-# INLINE lift #-}++instance (Algebra sig m, Effect sig) => Algebra (Cull :+: NonDet :+: sig) (CullC m) where+  alg (L (Cull (CullC m) k)) = CullC (local (const True) m) >>= k+  alg (R (L (L Empty)))      = empty+  alg (R (L (R (Choose k)))) = k True <|> k False+  alg (R (R other))          = CullC (alg (R (R (handleCoercible other))))+  {-# INLINE alg #-}

@@ -0,0 +1,100 @@+{-# LANGUAGE DeriveFunctor, FlexibleInstances, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}++-- | A carrier for 'Cut' and 'NonDet' effects used in tandem (@Cut :+: NonDet@).+--+-- @since 1.0.0.0+module Control.Carrier.Cut.Church+( -- * Cut carrier+  runCut+, runCutA+, runCutM+, CutC(..)+  -- * Cut effect+, module Control.Effect.Cut+  -- * NonDet effects+, module Control.Effect.NonDet+) where++import Control.Algebra+import Control.Applicative (liftA2)+import Control.Effect.Cut+import Control.Effect.NonDet+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Coerce (coerce)+import Data.Functor.Identity++-- | Run a 'Cut' effect with continuations respectively interpreting 'pure' / '<|>', 'empty', and 'cutfail'.+--+-- @since 1.0.0.0+runCut :: (a -> m b -> m b) -> m b -> m b -> CutC m a -> m b+runCut cons nil fail (CutC runCutC) = runCutC cons nil fail++-- | Run a 'Cut' effect, returning all its results in an 'Alternative' collection.+--+-- @since 1.0.0.0+runCutA :: (Alternative f, Applicative m) => CutC m a -> m (f a)+runCutA = runCut (fmap . (<|>) . pure) (pure empty) (pure empty)++-- | Run a 'Cut' effect, mapping results into a 'Monoid'.+--+-- @since 1.0.0.0+runCutM :: (Applicative m, Monoid b) => (a -> b) -> CutC m a -> m b+runCutM leaf = runCut (fmap . mappend . leaf) (pure mempty) (pure mempty)++-- | @since 1.0.0.0+newtype CutC m a = CutC (forall b . (a -> m b -> m b) -> m b -> m b -> m b)+  deriving (Functor)++instance Applicative (CutC m) where+  pure a = CutC (\ cons nil _ -> cons a nil)+  {-# INLINE pure #-}+  CutC f <*> CutC a = CutC $ \ cons nil fail ->+    f (\ f' fs -> a (cons . f') fs fail) nil fail+  {-# INLINE (<*>) #-}++instance Alternative (CutC m) where+  empty = CutC (\ _ nil _ -> nil)+  {-# INLINE empty #-}+  CutC l <|> CutC r = CutC (\ cons nil fail -> l cons (r cons nil fail) fail)+  {-# INLINE (<|>) #-}++instance Monad (CutC m) where+  CutC a >>= f = CutC $ \ cons nil fail ->+    a (\ a' as -> runCut cons as fail (f a')) nil fail+  {-# INLINE (>>=) #-}++instance Fail.MonadFail m => Fail.MonadFail (CutC m) where+  fail s = lift (Fail.fail s)+  {-# INLINE fail #-}++-- | A single fixpoint is shared between all branches.+instance MonadFix m => MonadFix (CutC m) where+  mfix f = CutC $ \ cons nil fail -> mfix+    (toCut . f . run . fromCut)+    >>= run . runCut (fmap . cons) (pure nil) (pure fail) where+    toCut = runCut (fmap . (<|>) . pure) (pure empty) (pure cutfail)+    fromCut = runCut (<$) (error "mfix CutC: empty") (error "mfix CutC: cutfail")+  {-# INLINE mfix #-}++instance MonadIO m => MonadIO (CutC m) where+  liftIO io = lift (liftIO io)+  {-# INLINE liftIO #-}++instance MonadPlus (CutC m)++instance MonadTrans CutC where+  lift m = CutC (\ cons nil _ -> m >>= flip cons nil)+  {-# INLINE lift #-}++instance (Algebra sig m, Effect sig) => Algebra (Cut :+: NonDet :+: sig) (CutC m) where+  alg (L Cutfail)    = CutC $ \ _    _   fail -> fail+  alg (L (Call m k)) = CutC $ \ cons nil fail -> runCut (\ a as -> runCut cons as fail (k a)) nil nil m+  alg (R (L (L Empty)))      = empty+  alg (R (L (R (Choose k)))) = k True <|> k False+  alg (R (R other))          = CutC $ \ cons nil fail -> alg (thread (pure ()) dst other) >>= runIdentity . runCut (coerce cons) (coerce nil) (coerce fail) where+    dst :: Applicative m => CutC Identity (CutC m a) -> m (CutC Identity a)+    dst = runIdentity . runCut (fmap . liftA2 (<|>) . runCut (fmap . (<|>) . pure) (pure empty) (pure cutfail)) (pure (pure empty)) (pure (pure cutfail))+  {-# INLINE alg #-}

@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++{- | A carrier for an 'Empty' effect, indicating failure with a 'Nothing' value. Users that need access to an error message should use the 'Control.Effect.Fail.Fail' effect.++Note that 'Empty' effects can, when they are the last effect in a stack, be interpreted directly to a 'Maybe' without a call to 'runEmpty'.++@since 1.0.0.0+-}++module Control.Carrier.Empty.Maybe+( -- * Empty carrier+  runEmpty+, EmptyC(..)+  -- * Empty effect+, module Control.Effect.Empty+) where++import Control.Algebra+import Control.Effect.Empty+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Maybe++-- | Run an 'Empty' effect, returning 'Nothing' for empty computations, or 'Just' the result otherwise.+--+-- @+-- 'runEmpty' 'empty' = 'pure' 'Nothing'+-- @+-- @+-- 'runEmpty' ('pure' a) = 'Just' a+-- @+--+-- @since 1.0.0.0+runEmpty :: EmptyC m a -> m (Maybe a)+runEmpty (EmptyC m) = runMaybeT m+{-# INLINE runEmpty #-}++-- | @since 1.0.0.0+newtype EmptyC m a = EmptyC (MaybeT m a)+  deriving (Applicative, Functor, Monad, MonadFix, MonadIO, MonadTrans)++-- | 'EmptyC' passes 'Fail.MonadFail' operations along to the underlying monad @m@, rather than interpreting it as a synonym for 'empty' à la 'MaybeT'.+instance Fail.MonadFail m => Fail.MonadFail (EmptyC m) where+  fail = lift . Fail.fail+  {-# INLINE fail #-}++instance (Algebra sig m, Effect sig) => Algebra (Empty :+: sig) (EmptyC m) where+  alg (L Empty) = EmptyC (MaybeT (pure Nothing))+  alg (R other) = EmptyC (MaybeT (alg (thread (Just ()) (maybe (pure Nothing) runEmpty) other)))+  {-# INLINE alg #-}

@@ -0,0 +1,56 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++-- | A carrier for an 'Error' effect.+--+-- @since 1.0.0.0+module Control.Carrier.Error.Either+( -- * Error carrier+  runError+, ErrorC(..)+  -- * Error effect+, module Control.Effect.Error+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Effect.Error+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Except++-- | Run an 'Error' effect, returning uncaught errors in 'Left' and successful computations’ values in 'Right'.+--+-- @+-- 'runError' ('pure' a) = 'pure' ('Right' a)+-- @+-- @+-- 'runError' ('throwError' e) = 'pure' ('Left' e)+-- @+-- @+-- 'runError' ('throwError' e `catchError` 'pure') = 'pure' ('Right' e)+-- @+--+-- @since 0.1.0.0+runError :: ErrorC exc m a -> m (Either exc a)+runError (ErrorC m) = runExceptT m++-- | @since 0.1.0.0+newtype ErrorC e m a = ErrorC (ExceptT e m a)+  deriving (Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadTrans)++-- | 'ErrorC' passes 'Alternative' operations along to the underlying monad @m@, rather than combining errors à la 'ExceptT'.+instance (Alternative m, Monad m) => Alternative (ErrorC e m) where+  empty = ErrorC (ExceptT empty)+  {-# INLINE empty #-}+  ErrorC (ExceptT l) <|> ErrorC (ExceptT r) = ErrorC (ExceptT (l <|> r))+  {-# INLINE (<|>) #-}++-- | 'ErrorC' passes 'MonadPlus' operations along to the underlying monad @m@, rather than combining errors à la 'ExceptT'.+instance (Alternative m, Monad m) => MonadPlus (ErrorC e m)++instance (Algebra sig m, Effect sig) => Algebra (Error e :+: sig) (ErrorC e m) where+  alg = ErrorC . alg . handleCoercible+  {-# INLINE alg #-}

@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++-- | A carrier for a 'Control.Effect.Fail.Fail' effect, returning the result as an 'Either' 'String'. Failed computations will return a 'Left' containing the 'String' value passed to 'Fail.fail'.+--+-- @since 1.0.0.0+module Control.Carrier.Fail.Either+( -- * Fail carrier+  runFail+, FailC(..)+  -- * Fail effect+, module Control.Effect.Fail+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Carrier.Throw.Either+import Control.Effect.Fail+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++-- | Run a 'Control.Effect.Fail.Fail' effect, returning failure messages in 'Left' and successful computations’ results in 'Right'.+--+-- @+-- 'runFail' ('pure' a) = 'pure' ('Right' a)+-- @+-- @+-- 'runFail' ('Fail.fail' s) = 'pure' ('Left' s)+-- @+--+-- @since 1.0.0.0+runFail :: FailC m a -> m (Either String a)+runFail (FailC m) = runThrow m++-- | @since 1.0.0.0+newtype FailC m a = FailC (ThrowC String m a)+  deriving (Alternative, Applicative, Functor, Monad, MonadFix, MonadIO, MonadPlus, MonadTrans)++instance (Algebra sig m, Effect sig) => Fail.MonadFail (FailC m) where+  fail = send . Fail+  {-# INLINE fail #-}++instance (Algebra sig m, Effect sig) => Algebra (Fail :+: sig) (FailC m) where+  alg = FailC . alg . handleCoercible+  {-# INLINE alg #-}

@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++-- | A carrier for a 'Fresh' effect, providing access to a monotonically increasing stream of 'Int' values.+--+-- @since 1.0.0.0+module Control.Carrier.Fresh.Strict+( -- * Fresh carrier+  runFresh+, evalFresh+, FreshC(..)+  -- * Fresh effect+, module Control.Effect.Fresh+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Carrier.State.Strict+import Control.Effect.Fresh+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++-- | Run a 'Fresh' effect counting up from 0.+--+-- @+-- 'runFresh' n ('pure' a) = 'pure' (n, a)+-- @+-- @+-- 'runFresh' n 'fresh' = 'pure' (n '+' 1, n)+-- @+--+-- @since 0.1.0.0+runFresh :: Int -> FreshC m a -> m (Int, a)+runFresh n (FreshC m) = runState n m++-- | Run a 'Fresh' effect counting up from an initial value, and forgetting the final value.+--+-- @+-- 'evalFresh' n ('pure' a) = 'pure' a+-- @+-- @+-- 'evalFresh' n 'fresh' = 'pure' n+-- @+--+-- @since 1.0.0.0+evalFresh :: Functor m => Int -> FreshC m a -> m a+evalFresh n (FreshC m) = evalState n m++-- | @since 1.0.0.0+newtype FreshC m a = FreshC (StateC Int m a)+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)++instance (Algebra sig m, Effect sig) => Algebra (Fresh :+: sig) (FreshC m) where+  alg (L (Fresh k)) = FreshC (get <* modify (+ (1 :: Int))) >>= k+  alg (R other)     = FreshC (alg (R (handleCoercible other)))+  {-# INLINE alg #-}

@@ -0,0 +1,86 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-}++-- | Provides an 'InterpretC' carrier capable of interpreting an arbitrary effect using a passed-in higher order function to interpret that effect. This is suitable for prototyping new effects quickly.++module Control.Carrier.Interpret+( -- * Interpret carrier+  runInterpret+, runInterpretState+, InterpretC(..)+, Reifies+, Handler+  -- * Re-exports+, Algebra+, Has+, run+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Carrier.State.Strict+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Functor.Const (Const(..))+import Unsafe.Coerce (unsafeCoerce)++-- | A @Handler@ is a function that interprets effects described by @sig@ into the carrier monad @m@.+newtype Handler sig m = Handler+  { runHandler :: forall s x . sig (InterpretC s sig m) x -> InterpretC s sig m x }+++class Reifies s a | s -> a where+  reflect :: Const a s+++data Skolem++-- | @Magic@ captures the GHC implementation detail of how single method type classes are implemented.+newtype Magic a r = Magic (Reifies Skolem a => Const r Skolem)++-- For more information on this technique, see the @reflection@ library. We use the formulation described in https://github.com/ekmett/reflection/issues/31 for better inlining.+--+-- Essentially we can view @k@ as internally a function of type @Reifies s a -> Tagged s r@, whch we can again view as just @a -> Tagged s r@ through @unsafeCoerce@. After this coercion, we just apply the function to @a@.+reify :: a -> (forall s . Reifies s a => Const r s) -> r+reify a k = unsafeCoerce (Magic k) a+++-- | Interpret an effect using a higher-order function.+--+-- Note that due to the higher-rank type, you have to use either '$' or explicit application when applying this interpreter. That is, you will need to write @runInterpret f (runInterpret g myPrgram)@ or @runInterpret f $ runInterpret g $ myProgram@. If you try and write @runInterpret f . runInterpret g@, you will unfortunately get a rather scary type error!+--+-- @since 1.0.0.0+runInterpret+  :: (HFunctor eff, Monad m)+  => (forall x . eff m x -> m x)+  -> (forall s . Reifies s (Handler eff m) => InterpretC s eff m a)+  -> m a+runInterpret f m = reify (Handler (InterpretC . f . handleCoercible)) (go m) where+  go :: InterpretC s eff m x -> Const (m x) s+  go (InterpretC m) = Const m++-- | Interpret an effect using a higher-order function with some state variable.+--+-- @since 1.0.0.0+runInterpretState+  :: (HFunctor eff, Monad m)+  => (forall x . s -> eff (StateC s m) x -> m (s, x))+  -> s+  -> (forall t . Reifies t (Handler eff (StateC s m)) => InterpretC t eff (StateC s m) a)+  -> m (s, a)+runInterpretState handler state m+  = runState state+  $ runInterpret (\e -> StateC (\s -> handler s e)) m++-- | @since 1.0.0.0+newtype InterpretC s (sig :: (* -> *) -> * -> *) m a = InterpretC (m a)+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)++instance MonadTrans (InterpretC s sig) where+  lift = InterpretC++instance (HFunctor eff, HFunctor sig, Reifies s (Handler eff m), Monad m, Algebra sig m) => Algebra (eff :+: sig) (InterpretC s eff m) where+  alg (L eff)   = runHandler (getConst (reflect @s)) eff+  alg (R other) = InterpretC (alg (handleCoercible other))

@@ -0,0 +1,38 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}++-- | A carrier for 'Lift' allowing monadic actions to be lifted from an outer context into an inner one with 'sendM', and for an inner context to run actions in an outer one with 'liftWith'.+--+-- @since 1.0.0.0+module Control.Carrier.Lift+( -- * Lift carrier+  runM+, LiftC(..)+  -- * Lift effect+, module Control.Effect.Lift+) where++import Control.Algebra+import Control.Applicative (Alternative)+import Control.Effect.Lift+import Control.Monad (MonadPlus)+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Functor.Identity++-- | Extract a 'Lift'ed 'Monad'ic action from an effectful computation.+--+-- @since 1.0.0.0+runM :: LiftC m a -> m a+runM (LiftC m) = m++-- | @since 1.0.0.0+newtype LiftC m a = LiftC (m a)+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)++instance MonadTrans LiftC where+  lift = LiftC++instance Monad m => Algebra (Lift m) (LiftC m) where+  alg (LiftWith with k) = LiftC (with (Identity ()) (fmap Identity . runM . runIdentity)) >>= k . runIdentity

@@ -0,0 +1,116 @@+{-# LANGUAGE DeriveTraversable, FlexibleInstances, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}++{- | Provides 'NonDetC', a carrier for 'NonDet' effects providing choice and failure.++Under the hood, it uses a Church-encoded structure and a binary tree to prevent the problems associated with a naïve list-based implementation.++@since 1.0.0.0+-}++module Control.Carrier.NonDet.Church+( -- * NonDet carrier+  runNonDet+, runNonDetA+, runNonDetM+, NonDetC(..)+  -- * NonDet effects+, module Control.Effect.NonDet+) where++import Control.Algebra+import Control.Applicative (liftA2)+import Control.Effect.NonDet+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Coerce (coerce)+import Data.Functor.Identity++-- | Run a 'NonDet' effect, using the provided functions to interpret choice, leaf results, and failure.+--+-- @since 1.0.0.0+runNonDet+  :: (m b -> m b -> m b) -- ^ Handles choice ('<|>')+  -> (a -> m b)          -- ^ Handles embedding results ('pure')+  -> m b                 -- ^ Handles failure ('empty')+  -> NonDetC m a         -- ^ A nondeterministic computation to execute+  -> m b+runNonDet fork leaf nil (NonDetC m) = m fork leaf nil++-- | Run a 'NonDet' effect, collecting all branches’ results into an 'Alternative' functor.+--+-- Using @[]@ as the 'Alternative' functor will produce all results, while 'Maybe' will return only the first. However, unless used with 'Control.Effect.Cull.cull', this will still enumerate the entire search space before returning, meaning that it will diverge for infinite search spaces, even when using 'Maybe'.+--+-- @+-- 'runNonDetA' ('pure' a) = 'pure' [a]+-- @+-- @+-- 'runNonDetA' ('pure' a) = 'pure' ('Just' a)+-- @+--+-- @since 1.0.0.0+runNonDetA :: (Alternative f, Applicative m) => NonDetC m a -> m (f a)+runNonDetA = runNonDet (liftA2 (<|>)) (pure . pure) (pure empty)++-- | Run a 'NonDet' effect, mapping results into a 'Monoid'.+--+-- @since 1.0.0.0+runNonDetM :: (Applicative m, Monoid b) => (a -> b) -> NonDetC m a -> m b+runNonDetM leaf = runNonDet (liftA2 mappend) (pure . leaf) (pure mempty)++-- | A carrier for 'NonDet' effects based on Ralf Hinze’s design described in [Deriving Backtracking Monad Transformers](https://www.cs.ox.ac.uk/ralf.hinze/publications/#P12).+--+-- @since 1.0.0.0+newtype NonDetC m a = NonDetC (forall b . (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)+  deriving (Functor)++instance Applicative (NonDetC m) where+  pure a = NonDetC (\ _ leaf _ -> leaf a)+  {-# INLINE pure #-}+  NonDetC f <*> NonDetC a = NonDetC $ \ fork leaf nil ->+    f fork (\ f' -> a fork (leaf . f') nil) nil+  {-# INLINE (<*>) #-}++instance Alternative (NonDetC m) where+  empty = NonDetC (\ _ _ nil -> nil)+  {-# INLINE empty #-}+  NonDetC l <|> NonDetC r = NonDetC $ \ fork leaf nil -> fork (l fork leaf nil) (r fork leaf nil)+  {-# INLINE (<|>) #-}++instance Monad (NonDetC m) where+  NonDetC a >>= f = NonDetC $ \ fork leaf nil ->+    a fork (runNonDet fork leaf nil . f) nil+  {-# INLINE (>>=) #-}++instance Fail.MonadFail m => Fail.MonadFail (NonDetC m) where+  fail s = lift (Fail.fail s)+  {-# INLINE fail #-}++-- | Separate fixpoints are computed for each branch.+instance MonadFix m => MonadFix (NonDetC m) where+  mfix f = NonDetC $ \ fork leaf nil ->+    mfix (runNonDetA . f . head)+    >>= runNonDet fork leaf nil . foldr+      (\ a _ -> pure a <|> mfix (liftAll . fmap tail . runNonDetA . f))+      empty where+    liftAll m = NonDetC $ \ fork leaf nil -> m >>= foldr (fork . leaf) nil+  {-# INLINE mfix #-}++instance MonadIO m => MonadIO (NonDetC m) where+  liftIO io = lift (liftIO io)+  {-# INLINE liftIO #-}++instance MonadPlus (NonDetC m)++instance MonadTrans NonDetC where+  lift m = NonDetC (\ _ leaf _ -> m >>= leaf)+  {-# INLINE lift #-}++instance (Algebra sig m, Effect sig) => Algebra (NonDet :+: sig) (NonDetC m) where+  alg (L (L Empty))      = empty+  alg (L (R (Choose k))) = k True <|> k False+  alg (R other)          = NonDetC $ \ fork leaf nil -> alg (thread (pure ()) dst other) >>= runIdentity . runNonDet (coerce fork) (coerce leaf) (coerce nil) where+    dst :: Applicative m => NonDetC Identity (NonDetC m a) -> m (NonDetC Identity a)+    dst = runIdentity . runNonDet (liftA2 (liftA2 (<|>))) (Identity . runNonDetA) (pure (pure empty))+  {-# INLINE alg #-}

@@ -0,0 +1,86 @@+{-# LANGUAGE DeriveFunctor, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++-- | A carrier for 'Reader' effects.+--+-- @since 1.0.0.0+module Control.Carrier.Reader+( -- * Reader carrier+  runReader+, ReaderC(..)+  -- * Reader effect+, module Control.Effect.Reader+) where++import Control.Algebra+import Control.Applicative (Alternative(..), liftA2)+import Control.Effect.Reader+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++-- | Run a 'Reader' effect with the passed environment value.+--+-- @+-- 'runReader' a 'ask' = 'pure' a+-- @+-- @+-- 'runReader' a ('pure' b) = 'pure' b+-- @+-- @+-- 'runReader' a ('local' f m) = 'runReader' (f a) m+-- @+--+-- @since 1.0.0.0+runReader :: r -> ReaderC r m a -> m a+runReader r (ReaderC runReaderC) = runReaderC r+{-# INLINE runReader #-}++-- | @since 1.0.0.0+newtype ReaderC r m a = ReaderC (r -> m a)+  deriving (Functor)++instance Applicative m => Applicative (ReaderC r m) where+  pure = ReaderC . const . pure+  {-# INLINE pure #-}+  ReaderC f <*> ReaderC a = ReaderC (liftA2 (<*>) f a)+  {-# INLINE (<*>) #-}+  ReaderC u *> ReaderC v = ReaderC $ \ r -> u r *> v r+  {-# INLINE (*>) #-}+  ReaderC u <* ReaderC v = ReaderC $ \ r -> u r <* v r+  {-# INLINE (<*) #-}++instance Alternative m => Alternative (ReaderC r m) where+  empty = ReaderC (const empty)+  {-# INLINE empty #-}+  ReaderC l <|> ReaderC r = ReaderC (liftA2 (<|>) l r)+  {-# INLINE (<|>) #-}++instance Monad m => Monad (ReaderC r m) where+  ReaderC a >>= f = ReaderC (\ r -> a r >>= runReader r . f)+  {-# INLINE (>>=) #-}++instance Fail.MonadFail m => Fail.MonadFail (ReaderC r m) where+  fail = ReaderC . const . Fail.fail+  {-# INLINE fail #-}++instance MonadFix m => MonadFix (ReaderC s m) where+  mfix f = ReaderC (\ r -> mfix (runReader r . f))+  {-# INLINE mfix #-}++instance MonadIO m => MonadIO (ReaderC r m) where+  liftIO = ReaderC . const . liftIO+  {-# INLINE liftIO #-}++instance (Alternative m, Monad m) => MonadPlus (ReaderC r m)++instance MonadTrans (ReaderC r) where+  lift = ReaderC . const+  {-# INLINE lift #-}++instance Algebra sig m => Algebra (Reader r :+: sig) (ReaderC r m) where+  alg (L (Ask       k)) = ReaderC (\ r -> runReader r (k r))+  alg (L (Local f m k)) = ReaderC (\ r -> runReader (f r) m) >>= k+  alg (R other)         = ReaderC (\ r -> alg (hmap (runReader r) other))+  {-# INLINE alg #-}

@@ -0,0 +1,120 @@+{-# LANGUAGE ExplicitForAll, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++{- | A carrier for the 'State' effect that refrains from evaluating its state until necessary. This is less efficient than "Control.Carrier.State.Strict" but allows some cyclic computations to terminate that would loop infinitely in a strict state carrier.++Note that the parameter order in 'runState', 'evalState', and 'execState' is reversed compared the equivalent functions provided by @transformers@. This is an intentional decision made to enable the composition of effect handlers with '.' without invoking 'flip'.++@since 1.0.0.0+-}++module Control.Carrier.State.Lazy+( -- * Lazy state carrier+  runState+, evalState+, execState+, StateC(..)+  -- * State effect+, module Control.Effect.State+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Effect.State+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++-- | Run a lazy 'State' effect, yielding the result value and the final state. More programs terminate with lazy state than strict state, but injudicious use of lazy state may lead to thunk buildup.+--+-- @+-- 'runState' s ('pure' a) = 'pure' (s, a)+-- @+-- @+-- 'runState' s 'get' = 'pure' (s, s)+-- @+-- @+-- 'runState' s ('put' t) = 'pure' (t, ())+-- @+--+-- @since 1.0.0.0+runState :: s -> StateC s m a -> m (s, a)+runState s (StateC runStateC) = runStateC s+{-# INLINE[3] runState #-}++-- | Run a lazy 'State' effect, yielding the result value and discarding the final state.+--+-- @+-- 'evalState' s m = 'fmap' 'snd' ('runState' s m)+-- @+--+-- @since 1.0.0.0+evalState :: forall s m a . Functor m => s -> StateC s m a -> m a+evalState s = fmap snd . runState s+{-# INLINE[3] evalState #-}++-- | Run a lazy 'State' effect, yielding the final state and discarding the return value.+--+-- @+-- 'execState' s m = 'fmap' 'fst' ('runState' s m)+-- @+--+-- @since 1.0.0.0+execState :: forall s m a . Functor m => s -> StateC s m a -> m s+execState s = fmap fst . runState s+{-# INLINE[3] execState #-}++-- | @since 1.0.0.0+newtype StateC s m a = StateC { runStateC :: s -> m (s, a) }++instance Functor m => Functor (StateC s m) where+  fmap f m = StateC $ \ s -> (\ ~(s', a) -> (s', f a)) <$> runState s m+  {-# INLINE fmap #-}++instance Monad m => Applicative (StateC s m) where+  pure a = StateC $ \ s -> pure (s, a)+  {-# INLINE pure #-}+  StateC mf <*> StateC mx = StateC $ \ s -> do+    ~(s',  f) <- mf s+    ~(s'', x) <- mx s'+    pure (s'', f x)+  {-# INLINE (<*>) #-}+  m *> k = m >>= \_ -> k+  {-# INLINE (*>) #-}++instance Monad m => Monad (StateC s m) where+  m >>= k = StateC $ \ s -> do+    ~(s', a) <- runState s m+    runState s' (k a)+  {-# INLINE (>>=) #-}++instance (Alternative m, Monad m) => Alternative (StateC s m) where+  empty = StateC (const empty)+  {-# INLINE empty #-}+  StateC l <|> StateC r = StateC (\ s -> l s <|> r s)+  {-# INLINE (<|>) #-}++instance Fail.MonadFail m => Fail.MonadFail (StateC s m) where+  fail s = StateC (const (Fail.fail s))+  {-# INLINE fail #-}++instance MonadFix m => MonadFix (StateC s m) where+  mfix f = StateC (\ s -> mfix (runState s . f . snd))+  {-# INLINE mfix #-}++instance MonadIO m => MonadIO (StateC s m) where+  liftIO io = StateC (\ s -> (,) s <$> liftIO io)+  {-# INLINE liftIO #-}++instance (Alternative m, Monad m) => MonadPlus (StateC s m)++instance MonadTrans (StateC s) where+  lift m = StateC (\ s -> (,) s <$> m)+  {-# INLINE lift #-}++instance (Algebra sig m, Effect sig) => Algebra (State s :+: sig) (StateC s m) where+  alg (L (Get   k)) = StateC (\ s -> runState s (k s))+  alg (L (Put s k)) = StateC (\ _ -> runState s k)+  alg (R other)     = StateC (\ s -> alg (thread (s, ()) (uncurry runState) other))+  {-# INLINE alg #-}

@@ -0,0 +1,117 @@+{-# LANGUAGE DeriveFunctor, ExplicitForAll, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++{- | A carrier for the 'State' effect. It evaluates its inner state strictly, which is the correct choice for the majority of use cases.++Note that the parameter order in 'runState', 'evalState', and 'execState' is reversed compared the equivalent functions provided by @transformers@. This is an intentional decision made to enable the composition of effect handlers with '.' without invoking 'flip'.++@since 1.0.0.0+-}+module Control.Carrier.State.Strict+( -- * Strict state carrier+  runState+, evalState+, execState+, StateC(..)+  -- * State effect+, module Control.Effect.State+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Effect.State+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++-- | Run a 'State' effect starting from the passed value.+--+-- @+-- 'runState' s ('pure' a) = 'pure' (s, a)+-- @+-- @+-- 'runState' s 'get' = 'pure' (s, s)+-- @+-- @+-- 'runState' s ('put' t) = 'pure' (t, ())+-- @+--+-- @since 1.0.0.0+runState :: s -> StateC s m a -> m (s, a)+runState s (StateC runStateC) = runStateC s+{-# INLINE[3] runState #-}++-- | Run a 'State' effect, yielding the result value and discarding the final state.+--+-- @+-- 'evalState' s m = 'fmap' 'snd' ('runState' s m)+-- @+--+-- @since 1.0.0.0+evalState :: forall s m a . Functor m => s -> StateC s m a -> m a+evalState s = fmap snd . runState s+{-# INLINE[3] evalState #-}++-- | Run a 'State' effect, yielding the final state and discarding the return value.+--+-- @+-- 'execState' s m = 'fmap' 'fst' ('runState' s m)+-- @+--+-- @since 1.0.0.0+execState :: forall s m a . Functor m => s -> StateC s m a -> m s+execState s = fmap fst . runState s+{-# INLINE[3] execState #-}+++-- | @since 1.0.0.0+newtype StateC s m a = StateC (s -> m (s, a))+  deriving (Functor)++instance Monad m => Applicative (StateC s m) where+  pure a = StateC (\ s -> pure (s, a))+  {-# INLINE pure #-}+  StateC f <*> StateC a = StateC $ \ s -> do+    (s', f') <- f s+    (s'', a') <- a s'+    pure (s'', f' a')+  {-# INLINE (<*>) #-}+  m *> k = m >>= \_ -> k+  {-# INLINE (*>) #-}++instance (Alternative m, Monad m) => Alternative (StateC s m) where+  empty = StateC (const empty)+  {-# INLINE empty #-}+  StateC l <|> StateC r = StateC (\ s -> l s <|> r s)+  {-# INLINE (<|>) #-}++instance Monad m => Monad (StateC s m) where+  StateC m >>= f = StateC $ \ s -> do+    (s', a) <- m s+    runState s' (f a)+  {-# INLINE (>>=) #-}++instance Fail.MonadFail m => Fail.MonadFail (StateC s m) where+  fail s = StateC (const (Fail.fail s))+  {-# INLINE fail #-}++instance MonadFix m => MonadFix (StateC s m) where+  mfix f = StateC (\ s -> mfix (runState s . f . snd))+  {-# INLINE mfix #-}++instance MonadIO m => MonadIO (StateC s m) where+  liftIO io = StateC (\ s -> (,) s <$> liftIO io)+  {-# INLINE liftIO #-}++instance (Alternative m, Monad m) => MonadPlus (StateC s m)++instance MonadTrans (StateC s) where+  lift m = StateC (\ s -> (,) s <$> m)+  {-# INLINE lift #-}++instance (Algebra sig m, Effect sig) => Algebra (State s :+: sig) (StateC s m) where+  alg (L (Get   k)) = StateC (\ s -> runState s (k s))+  alg (L (Put s k)) = StateC (\ _ -> runState s k)+  alg (R other)     = StateC (\ s -> alg (thread (s, ()) (uncurry runState) other))+  {-# INLINE alg #-}

@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{- | A carrier for a 'Throw' effect.++@since 1.0.0.0+-}+module Control.Carrier.Throw.Either+( -- * Throw carrier+  runThrow+, ThrowC(..)+  -- * Throw effect+, module Control.Effect.Throw+) where++import Control.Algebra+import Control.Applicative (Alternative)+import Control.Carrier.Error.Either+import Control.Effect.Throw+import Control.Monad (MonadPlus)+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++-- | Run a 'Throw' effect, returning failures in 'Left' and successful computations’ results in 'Right'.+runThrow :: ThrowC e m a -> m (Either e a)+runThrow (ThrowC m) = runError m++-- | @since 1.0.0.0+newtype ThrowC e m a = ThrowC (ErrorC e m a)+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)++instance (Algebra sig m, Effect sig) => Algebra (Throw e :+: sig) (ThrowC e m) where+  alg (L (Throw e)) = ThrowC (throwError e)+  alg (R other)     = ThrowC (alg (R (handleCoercible other)))

@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++-- | A carrier for the 'Control.Effect.Trace' effect that ignores all traced results. Useful when you wish to disable tracing without removing all trace statements.+--+-- @since 1.0.0.0+module Control.Carrier.Trace.Ignoring+( -- * Trace carrier+  runTrace+, TraceC(..)+  -- * Trace effect+, module Control.Effect.Trace+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Effect.Trace+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++-- | Run a 'Trace' effect, ignoring all traces.+--+-- @+-- 'runTrace' ('trace' s) = 'pure' ()+-- @+-- @+-- 'runTrace' ('pure' a) = 'pure' a+-- @+--+-- @since 1.0.0.0+runTrace :: TraceC m a -> m a+runTrace (TraceC m) = m++-- | @since 1.0.0.0+newtype TraceC m a = TraceC (m a)+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)++instance MonadTrans TraceC where+  lift = TraceC+  {-# INLINE lift #-}++instance Algebra sig m => Algebra (Trace :+: sig) (TraceC m) where+  alg (L trace) = traceCont trace+  alg (R other) = TraceC (alg (handleCoercible other))+  {-# INLINE alg #-}

@@ -0,0 +1,48 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++-- | A carrier for the 'Control.Effect.Trace' effect that prints all traced results to stderr.+--+-- @since 1.0.0.0+module Control.Carrier.Trace.Printing+( -- * Trace carrier+  runTrace+, TraceC(..)+  -- * Trace effect+, module Control.Effect.Trace+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Effect.Trace+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import System.IO++-- | Run a 'Trace' effect, printing traces to 'stderr'.+--+-- @+-- 'runTrace' ('trace' s) = 'liftIO' ('putStrLn' s)+-- @+-- @+-- 'runTrace' ('pure' a) = 'pure' a+-- @+--+-- @since 1.0.0.0+runTrace :: TraceC m a -> m a+runTrace (TraceC m) = m++-- | @since 1.0.0.0+newtype TraceC m a = TraceC (m a)+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)++instance MonadTrans TraceC where+  lift = TraceC+  {-# INLINE lift #-}++instance (MonadIO m, Algebra sig m) => Algebra (Trace :+: sig) (TraceC m) where+  alg (L (Trace s k)) = liftIO (hPutStrLn stderr s) *> k+  alg (R other)       = TraceC (alg (handleCoercible other))+  {-# INLINE alg #-}

@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++-- | A carrier for the 'Control.Effect.Trace' effect that aggregates and returns all traced values.+--+-- @since 1.0.0.0+module Control.Carrier.Trace.Returning+( -- * Trace carrier+  runTrace+, TraceC(..)+  -- * Trace effect+, module Control.Effect.Trace+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Carrier.Writer.Strict+import Control.Effect.Trace+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Bifunctor (first)+import Data.Monoid (Endo(..))++-- | Run a 'Trace' effect, returning all traces as a list.+--+-- @+-- 'runTrace' ('pure' a) = 'pure' ([], a)+-- @+-- @+-- 'runTrace' ('trace' s) = 'pure' ([s], ())+-- @+--+-- @since 1.0.0.0+runTrace :: Functor m => TraceC m a -> m ([String], a)+runTrace (TraceC m) = first (($[]) . appEndo) <$> runWriter m++-- | @since 1.0.0.0+newtype TraceC m a = TraceC (WriterC (Endo [String]) m a)+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)++instance (Algebra sig m, Effect sig) => Algebra (Trace :+: sig) (TraceC m) where+  alg (L (Trace m k)) = TraceC (tell (Endo (m :))) *> k+  alg (R other)       = TraceC (alg (R (handleCoercible other)))

@@ -0,0 +1,70 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}++{- | A carrier for 'Writer' effects. This carrier performs its append operations strictly and thus avoids the space leaks inherent in lazy writer monads. These appends are left-associative; as such, @[]@ is a poor choice of monoid for computations that entail many calls to 'tell'. The [Seq](http://hackage.haskell.org/package/containersdocs/Data-Sequence.html) or [DList](http://hackage.haskell.org/package/dlist) monoids may be a superior choice.++This implementation is based on a post Gabriel Gonzalez made to the Haskell mailing list: <https://mail.haskell.org/pipermail/libraries/2013-March/019528.html>++@since 1.0.0.0+-}++module Control.Carrier.Writer.Strict+( -- * Writer carrier+  runWriter+, execWriter+, WriterC(..)+  -- * Writer effect+, module Control.Effect.Writer+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Carrier.State.Strict+import Control.Effect.Writer+import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as Fail+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++-- | Run a 'Writer' effect with a 'Monoid'al log, producing the final log alongside the result value.+--+-- @+-- 'runWriter' ('tell' w) = 'pure' (w, ())+-- @+-- @+-- 'runWriter' ('pure' a) = 'pure' ('mempty', a)+-- @+runWriter :: Monoid w => WriterC w m a -> m (w, a)+runWriter (WriterC m) = runState mempty m+{-# INLINE runWriter #-}++-- | Run a 'Writer' effect with a 'Monoid'al log, producing the final log and discarding the result value.+--+-- @+-- 'execWriter' m = 'fmap' 'fst' ('runWriter' m)+-- @+execWriter :: (Monoid w, Functor m) => WriterC w m a -> m w+execWriter = fmap fst . runWriter+{-# INLINE execWriter #-}+++-- | A space-efficient carrier for 'Writer' effects, implemented atop "Control.Carrier.State.Strict".+--+-- @since 1.0.0.0+newtype WriterC w m a = WriterC (StateC w m a)+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)++instance (Monoid w, Algebra sig m, Effect sig) => Algebra (Writer w :+: sig) (WriterC w m) where+  alg (L (Tell w     k)) = WriterC (modify (`mappend` w)) >> k+  alg (L (Listen   m k)) = WriterC (StateC (\ w -> do+    (w', a) <- runWriter m+    let w'' = mappend w w'+    w'' `seq` pure (w'', (w', a))))+    >>= uncurry k+  alg (L (Censor f m k)) = WriterC (StateC (\ w -> do+    (w', a) <- runWriter m+    let w'' = mappend w (f w')+    w'' `seq` pure (w'', a)))+    >>= k+  alg (R other)          = WriterC (alg (R (handleCoercible other)))+  {-# INLINE alg #-}

@@ -1,20 +0,0 @@-module Control.Effect-( module X-) where--import Control.Effect.Carrier   as X ((:+:), Carrier, Effect, Member)-import Control.Effect.Cull      as X (Cull, CullC, OnceC)-import Control.Effect.Cut       as X (Cut, CutC)-import Control.Effect.Error     as X (Error, ErrorC)-import Control.Effect.Fail      as X (Fail, FailC)-import Control.Effect.Fresh     as X (Fresh, FreshC)-import Control.Effect.Lift      as X (Lift, LiftC, runM)-import Control.Effect.NonDet    as X (NonDet, NonDetC)-import Control.Effect.Pure      as X (Pure, PureC, run)-import Control.Effect.Random    as X (Random, RandomC)-import Control.Effect.Reader    as X (Reader, ReaderC)-import Control.Effect.Resource  as X (Resource, ResourceC)-import Control.Effect.Resumable as X (Resumable, ResumableC, ResumableWithC)-import Control.Effect.State     as X (State, StateC)-import Control.Effect.Trace     as X (Trace, TraceByPrintingC, TraceByIgnoringC, TraceByReturningC)-import Control.Effect.Writer    as X (Writer, WriterC)

@@ -1,197 +0,0 @@-{-# LANGUAGE DefaultSignatures, DeriveFunctor, EmptyCase, FlexibleContexts, FlexibleInstances, FunctionalDependencies, RankNTypes, TypeOperators, UndecidableInstances #-}-module Control.Effect.Carrier-( HFunctor(..)-, Effect(..)-, Carrier(..)-, send-, handlePure-, handleCoercible--- * Generic deriving of 'HFunctor' & 'Effect' instances.-, GHFunctor(..)-, GEffect(..)--- * Re-exports-, Pure.run-, (Sum.:+:)(..)-, Sum.Member(..)-) where--import qualified Control.Effect.Pure as Pure-import qualified Control.Effect.Sum as Sum-import           Data.Coerce-import           GHC.Generics---- | Higher-order functors of kind @(* -> *) -> (* -> *)@ map functors to functors.------   All effects must be 'HFunctor's.-class HFunctor h where-  -- | Apply a handler specified as a natural transformation to both higher-order and continuation positions within an 'HFunctor'.-  fmap' :: Functor (h f) => (a -> b) -> h f a -> h f b-  fmap' = fmap-  {-# INLINE fmap' #-}--  -- | Higher-order functor map of a natural transformation over higher-order positions within the effect.-  ---  -- A definition for 'hmap' over first-order effects can be derived automatically provided a 'Generic1' instance is available.-  hmap :: Functor m => (forall x . m x -> n x) -> (h m a -> h n a)-  default hmap :: (Functor m, Generic1 (h m), Generic1 (h n), GHFunctor m n (Rep1 (h m)) (Rep1 (h n))) => (forall x . m x -> n x) -> (h m a -> h n a)-  hmap f = to1 . ghmap f . from1-  {-# INLINE hmap #-}--{-# DEPRECATED fmap' "fmap' has been subsumed by fmap." #-}--instance HFunctor Pure.Pure-instance (HFunctor f, HFunctor g) => HFunctor (f Sum.:+: g)----- | The class of effect types, which must:------   1. Be functorial in their last two arguments, and---   2. Support threading effects in higher-order positions through using the carrier’s suspended state.------ All first-order effects (those without existential occurrences of @m@) admit a default definition of 'handle' provided a 'Generic1' instance is available for the effect.-class HFunctor sig => Effect sig where-  -- | Handle any effects in a signature by threading the carrier’s state all the way through to the continuation.-  handle :: (Functor f, Monad m)-         => f ()-         -> (forall x . f (m x) -> n (f x))-         -> sig m a-         -> sig n (f a)-  default handle :: (Functor f, Monad m, Generic1 (sig m), Generic1 (sig n), GEffect m n (Rep1 (sig m)) (Rep1 (sig n)))-                 => f ()-                 -> (forall x . f (m x) -> n (f x))-                 -> sig m a-                 -> sig n (f a)-  handle state handler = to1 . ghandle state handler . from1-  {-# INLINE handle #-}--instance Effect Pure.Pure-instance (Effect f, Effect g) => Effect (f Sum.:+: g)----- | The class of carriers (results) for algebras (effect handlers) over signatures (effects), whose actions are given by the 'eff' method.-class (HFunctor sig, Monad m) => Carrier sig m | m -> sig where-  -- | Construct a value in the carrier for an effect signature (typically a sum of a handled effect and any remaining effects).-  eff :: sig m a -> m a---instance Carrier Pure.Pure Pure.PureC where-  eff v = case v of {}-  {-# INLINE eff #-}----- | Construct a request for an effect to be interpreted by some handler later on.-send :: (Sum.Member effect sig, Carrier sig m) => effect m a -> m a-send = eff . Sum.inj-{-# INLINE send #-}----- | Apply a handler specified as a natural transformation to both higher-order and continuation positions within an 'HFunctor'.-handlePure :: (HFunctor sig, Functor f) => (forall x . f x -> g x) -> sig f a -> sig g a-handlePure = hmap-{-# INLINE handlePure #-}-{-# DEPRECATED handlePure "handlePure has been subsumed by hmap." #-}---- | Thread a 'Coercible' carrier through an 'HFunctor'.------   This is applicable whenever @f@ is 'Coercible' to @g@, e.g. simple @newtype@s.-handleCoercible :: (HFunctor sig, Functor f, Coercible f g) => sig f a -> sig g a-handleCoercible = hmap coerce-{-# INLINE handleCoercible #-}----- | Generic implementation of 'HFunctor'.-class GHFunctor m m' rep rep' where-  -- | Generic implementation of 'hmap'.-  ghmap :: Functor m => (forall x . m x -> m' x) -> (rep a -> rep' a)--instance GHFunctor m m' rep rep' => GHFunctor m m' (M1 i c rep) (M1 i c rep') where-  ghmap f = M1 . ghmap f . unM1-  {-# INLINE ghmap #-}--instance (GHFunctor m m' l l', GHFunctor m m' r r') => GHFunctor m m' (l :+: r) (l' :+: r') where-  ghmap f (L1 l) = L1 (ghmap f l)-  ghmap f (R1 r) = R1 (ghmap f r)-  {-# INLINE ghmap #-}--instance (GHFunctor m m' l l', GHFunctor m m' r r') => GHFunctor m m' (l :*: r) (l' :*: r') where-  ghmap f (l :*: r) = ghmap f l :*: ghmap f r-  {-# INLINE ghmap #-}--instance GHFunctor m m' V1 V1 where-  ghmap _ v = case v of {}-  {-# INLINE ghmap #-}--instance GHFunctor m m' U1 U1 where-  ghmap _ = id-  {-# INLINE ghmap #-}--instance GHFunctor m m' (K1 R c) (K1 R c) where-  ghmap _ = coerce-  {-# INLINE ghmap #-}--instance GHFunctor m m' Par1 Par1 where-  ghmap _ = coerce-  {-# INLINE ghmap #-}--instance (Functor f, GHFunctor m m' g g') => GHFunctor m m' (f :.: g) (f :.: g') where-  ghmap f = Comp1 . fmap (ghmap f) . unComp1-  {-# INLINE ghmap #-}--instance GHFunctor m m' (Rec1 m) (Rec1 m') where-  ghmap f = Rec1 . f . unRec1-  {-# INLINE ghmap #-}--instance HFunctor f => GHFunctor m m' (Rec1 (f m)) (Rec1 (f m')) where-  ghmap f = Rec1 . hmap f . unRec1-  {-# INLINE ghmap #-}----- | Generic implementation of 'Effect'.-class GEffect m m' rep rep' where-  -- | Generic implementation of 'handle'.-  ghandle :: (Functor f, Monad m)-          => f ()-          -> (forall x . f (m x) -> m' (f x))-          -> rep a-          -> rep' (f a)--instance GEffect m m' rep rep' => GEffect m m' (M1 i c rep) (M1 i c rep') where-  ghandle state handler = M1 . ghandle state handler . unM1-  {-# INLINE ghandle #-}--instance (GEffect m m' l l', GEffect m m' r r') => GEffect m m' (l :+: r) (l' :+: r') where-  ghandle state handler (L1 l) = L1 (ghandle state handler l)-  ghandle state handler (R1 r) = R1 (ghandle state handler r)-  {-# INLINE ghandle #-}--instance (GEffect m m' l l', GEffect m m' r r') => GEffect m m' (l :*: r) (l' :*: r') where-  ghandle state handler (l :*: r) = ghandle state handler l :*: ghandle state handler r-  {-# INLINE ghandle #-}--instance GEffect m m' V1 V1 where-  ghandle _ _ v = case v of {}-  {-# INLINE ghandle #-}--instance GEffect m m' U1 U1 where-  ghandle _ _ = coerce-  {-# INLINE ghandle #-}--instance GEffect m m' (K1 R c) (K1 R c) where-  ghandle _ _ = coerce-  {-# INLINE ghandle #-}--instance GEffect m m' Par1 Par1 where-  ghandle state _ = Par1 . (<$ state) . unPar1-  {-# INLINE ghandle #-}--instance (Functor f, GEffect m m' g g') => GEffect m m' (f :.: g) (f :.: g') where-  ghandle state handler = Comp1 . fmap (ghandle state handler) . unComp1-  {-# INLINE ghandle #-}--instance GEffect m m' (Rec1 m) (Rec1 m') where-  ghandle state handler = Rec1 . handler . (<$ state) . unRec1-  {-# INLINE ghandle #-}--instance Effect f => GEffect m m' (Rec1 (f m)) (Rec1 (f m')) where-  ghandle state handler = Rec1 . handle state handler . unRec1-  {-# INLINE ghandle #-}

@@ -0,0 +1,32 @@+{- | An effect modelling catchable failure when used with 'Control.Effect.Throw.Throw'.++Predefined carriers:++* "Control.Carrier.Error.Either" (with 'Control.Effect.Throw.Throw')++@since 1.0.0.0+-}+module Control.Effect.Catch+( -- * Catch effect+  Catch(..)+, catchError+  -- * Re-exports+, Algebra+, Has+, run+) where++import Control.Algebra+import Control.Effect.Catch.Internal (Catch(..))++-- | Run a computation which can throw errors with a handler to run on error.+--+-- Errors thrown by the handler will escape up to the nearest enclosing 'catchError' (if any). Note that this effect does /not/ handle errors thrown from impure contexts such as IO, nor will it handle exceptions thrown from pure code. If you need to handle IO-based errors, consider if @fused-effects-exceptions@ fits your use case; if not, use 'Control.Monad.IO.Class.liftIO' with 'Control.Exception.try' or use 'Control.Exception.catch' from outside the effect invocation.+--+-- @+-- runError ('Control.Effect.Throw.throwError' e `catchError` f) = runError (f e)+-- @+--+-- @since 0.1.0.0+catchError :: Has (Catch e) sig m => m a -> (e -> m a) -> m a+catchError m h = send (Catch m h pure)

@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}+module Control.Effect.Catch.Internal+( Catch(..)+) where++import Control.Effect.Class++-- | 'Catch' effects can be used alongside 'Control.Effect.Throw.Throw' to provide recoverable exceptions.+--+-- @since 1.0.0.0+data Catch e m k+  = forall b . Catch (m b) (e -> m b) (b -> m k)++deriving instance Functor m => Functor (Catch e m)++instance HFunctor (Catch e) where+  hmap f (Catch m h k) = Catch (f m) (f . h) (f . k)++instance Effect (Catch e) where+  thread ctx handler (Catch m h k) = Catch (handler (m <$ ctx)) (handler . (<$ ctx) . h) (handler . fmap k)

@@ -0,0 +1,111 @@+{-# LANGUAGE UndecidableInstances #-}++{- | An effect modelling nondeterminism without failure (one or more successful results).++The 'Control.Effect.NonDet.NonDet' effect is the composition of 'Choose' and 'Empty'.++Predefined carriers:++* "Control.Carrier.Choose.Church".+* If 'Choose' is the last effect in a stack, it can be interpreted directly to a 'NonEmpty'.++@since 1.0.0.0+-}++module Control.Effect.Choose+( -- * Choose effect+  Choose(..)+, (<|>)+, optional+, many+, some+, some1+  -- * Choosing semigroup+, Choosing(..)+  -- * Re-exports+, Algebra+, Has+, run+) where++import Control.Algebra+import Control.Effect.Choose.Internal (Choose(..))+import Control.Effect.Empty+import Data.Bool (bool)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.Semigroup as S++-- | Nondeterministically choose between two computations.+--+-- @+-- (m '<|>' n) '>>=' k = (m '>>=' k) '<|>' (n '>>=' k)+-- @+-- @+-- (m '<|>' n) '<|>' o = m '<|>' (n '<|>' o)+-- @+-- @+-- 'empty' '<|>' m = m+-- @+-- @+-- m '<|>' 'empty' = m+-- @+--+-- @since 1.0.0.0+(<|>) :: Has Choose sig m => m a -> m a -> m a+(<|>) a b = send (Choose (bool b a))++infixl 3 <|>++-- | Select between 'Just' the result of an operation, and 'Nothing'.+--+-- @+-- 'optional' 'empty' = 'pure' 'Nothing'+-- @+-- @+-- 'optional' ('pure' a) = 'pure' ('Just' a)+-- @+--+-- @since 1.0.0.0+optional :: Has Choose sig m => m a -> m (Maybe a)+optional a = Just <$> a <|> pure Nothing++-- | Zero or more.+--+-- @+-- 'many' m = 'some' m '<|>' 'pure' []+-- @+--+-- @since 1.0.0.0+many :: Has Choose sig m => m a -> m [a]+many a = go where go = (:) <$> a <*> go <|> pure []++-- | One or more.+--+-- @+-- 'some' m = (:) '<$>' m '<*>' 'many' m+-- @+--+-- @since 1.0.0.0+some :: Has Choose sig m => m a -> m [a]+some a = (:) <$> a <*> many a++-- | One or more, returning a 'NonEmpty' list of the results.+--+-- @+-- 'some1' m = (':|') '<$>' m '<*>' 'many' m+-- @+--+-- @since 1.0.0.0+some1 :: Has Choose sig m => m a -> m (NonEmpty a)+some1 a = (:|) <$> a <*> many a+++-- | @since 1.0.0.0+newtype Choosing m a = Choosing { getChoosing :: m a }++instance Has Choose sig m => S.Semigroup (Choosing m a) where+  Choosing m1 <> Choosing m2 = Choosing (m1 <|> m2)++instance (Has Choose sig m, Has Empty sig m) => Monoid (Choosing m a) where+  mempty = Choosing empty+  mappend = (S.<>)

@@ -0,0 +1,15 @@+{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}+module Control.Effect.Choose.Internal+( Choose(..)+) where++import Control.Effect.Class+import GHC.Generics (Generic1)++-- | @since 1.0.0.0+newtype Choose m k+  = Choose (Bool -> m k)+  deriving (Functor, Generic1)++instance HFunctor Choose+instance Effect   Choose

@@ -0,0 +1,176 @@+{-# LANGUAGE DefaultSignatures, EmptyCase, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, TypeOperators #-}++-- | Provides the 'HFunctor' and 'Effect' classes that effect types implement.+--+-- @since 1.0.0.0+module Control.Effect.Class+( HFunctor(..)+, handleCoercible+, Effect(..)+-- * Generic deriving of 'HFunctor' & 'Effect' instances.+, GHFunctor(..)+, GEffect(..)+) where++import Data.Coerce+import GHC.Generics++-- | Higher-order functors of kind @(* -> *) -> (* -> *)@ map functors to functors.+--+--   All effects must be 'HFunctor's.+--+-- @since 1.0.0.0+class HFunctor h where+  -- | Higher-order functor map of a natural transformation over higher-order positions within the effect.+  --+  -- A definition for 'hmap' over first-order effects can be derived automatically provided a 'Generic1' instance is available.+  hmap :: Functor m => (forall x . m x -> n x) -> (h m a -> h n a)+  default hmap :: (Functor m, Generic1 (h m), Generic1 (h n), GHFunctor m n (Rep1 (h m)) (Rep1 (h n))) => (forall x . m x -> n x) -> (h m a -> h n a)+  hmap f = to1 . ghmap f . from1+  {-# INLINE hmap #-}+++-- | Thread a 'Coercible' carrier through an 'HFunctor'.+--+--   This is applicable whenever @f@ is 'Coercible' to @g@, e.g. simple @newtype@s.+--+-- @since 1.0.0.0+handleCoercible :: (HFunctor sig, Functor f, Coercible f g) => sig f a -> sig g a+handleCoercible = hmap coerce+{-# INLINE handleCoercible #-}+++-- | The class of effect types, which must:+--+--   1. Be functorial in their last two arguments, and+--   2. Support threading effects in higher-order positions through using the carrier’s suspended context.+--+-- All first-order effects (those without existential occurrences of @m@) admit a default definition of 'thread' provided a 'Generic1' instance is available for the effect.+--+-- @since 1.0.0.0+class HFunctor sig => Effect sig where+  -- | Handle any effects in a signature by threading the algebra’s handler all the way through to the continuation, starting from some initial context.+  --+  -- The handler is expressed as a /distributive law/, and required to adhere to the following laws:+  --+  -- @+  -- handler . 'fmap' 'pure' = 'pure'+  -- @+  -- @+  -- handler . 'fmap' (k '=<<') = handler . 'fmap' k 'Control.Monad.<=<' handler+  -- @+  --+  -- respectively expressing that the handler does not alter the context of pure computations, and that the handler distributes over monadic composition.+  thread+    :: (Functor ctx, Monad m)+    => ctx ()                              -- ^ The initial context.+    -> (forall x . ctx (m x) -> n (ctx x)) -- ^ A handler for actions in a context, producing actions with a derived context.+    -> sig m a                             -- ^ The effect to thread the handler through.+    -> sig n (ctx a)+  default thread+    :: (Functor ctx, Monad m, Generic1 (sig m), Generic1 (sig n), GEffect m n (Rep1 (sig m)) (Rep1 (sig n)))+    => ctx ()+    -> (forall x . ctx (m x) -> n (ctx x))+    -> sig m a+    -> sig n (ctx a)+  thread ctx handler = to1 . gthread ctx handler . from1+  {-# INLINE thread #-}+++-- | Generic implementation of 'HFunctor'.+class GHFunctor m m' rep rep' where+  -- | Generic implementation of 'hmap'.+  ghmap :: Functor m => (forall x . m x -> m' x) -> (rep a -> rep' a)++instance GHFunctor m m' rep rep' => GHFunctor m m' (M1 i c rep) (M1 i c rep') where+  ghmap f = M1 . ghmap f . unM1+  {-# INLINE ghmap #-}++instance (GHFunctor m m' l l', GHFunctor m m' r r') => GHFunctor m m' (l :+: r) (l' :+: r') where+  ghmap f (L1 l) = L1 (ghmap f l)+  ghmap f (R1 r) = R1 (ghmap f r)+  {-# INLINE ghmap #-}++instance (GHFunctor m m' l l', GHFunctor m m' r r') => GHFunctor m m' (l :*: r) (l' :*: r') where+  ghmap f (l :*: r) = ghmap f l :*: ghmap f r+  {-# INLINE ghmap #-}++instance GHFunctor m m' V1 V1 where+  ghmap _ v = case v of {}+  {-# INLINE ghmap #-}++instance GHFunctor m m' U1 U1 where+  ghmap _ = id+  {-# INLINE ghmap #-}++instance GHFunctor m m' (K1 R c) (K1 R c) where+  ghmap _ = coerce+  {-# INLINE ghmap #-}++instance GHFunctor m m' Par1 Par1 where+  ghmap _ = coerce+  {-# INLINE ghmap #-}++instance (Functor f, GHFunctor m m' g g') => GHFunctor m m' (f :.: g) (f :.: g') where+  ghmap f = Comp1 . fmap (ghmap f) . unComp1+  {-# INLINE ghmap #-}++instance GHFunctor m m' (Rec1 m) (Rec1 m') where+  ghmap f = Rec1 . f . unRec1+  {-# INLINE ghmap #-}++instance HFunctor f => GHFunctor m m' (Rec1 (f m)) (Rec1 (f m')) where+  ghmap f = Rec1 . hmap f . unRec1+  {-# INLINE ghmap #-}+++-- | Generic implementation of 'Effect'.+class GEffect m m' rep rep' where+  -- | Generic implementation of 'thread'.+  gthread+    :: (Functor ctx, Monad m)+    => ctx ()+    -> (forall x . ctx (m x) -> m' (ctx x))+    -> rep a+    -> rep' (ctx a)++instance GEffect m m' rep rep' => GEffect m m' (M1 i c rep) (M1 i c rep') where+  gthread ctx handler = M1 . gthread ctx handler . unM1+  {-# INLINE gthread #-}++instance (GEffect m m' l l', GEffect m m' r r') => GEffect m m' (l :+: r) (l' :+: r') where+  gthread ctx handler (L1 l) = L1 (gthread ctx handler l)+  gthread ctx handler (R1 r) = R1 (gthread ctx handler r)+  {-# INLINE gthread #-}++instance (GEffect m m' l l', GEffect m m' r r') => GEffect m m' (l :*: r) (l' :*: r') where+  gthread ctx handler (l :*: r) = gthread ctx handler l :*: gthread ctx handler r+  {-# INLINE gthread #-}++instance GEffect m m' V1 V1 where+  gthread _ _ v = case v of {}+  {-# INLINE gthread #-}++instance GEffect m m' U1 U1 where+  gthread _ _ = coerce+  {-# INLINE gthread #-}++instance GEffect m m' (K1 R c) (K1 R c) where+  gthread _ _ = coerce+  {-# INLINE gthread #-}++instance GEffect m m' Par1 Par1 where+  gthread ctx _ = Par1 . (<$ ctx) . unPar1+  {-# INLINE gthread #-}++instance (Functor f, GEffect m m' g g') => GEffect m m' (f :.: g) (f :.: g') where+  gthread ctx handler = Comp1 . fmap (gthread ctx handler) . unComp1+  {-# INLINE gthread #-}++instance GEffect m m' (Rec1 m) (Rec1 m') where+  gthread ctx handler = Rec1 . handler . (<$ ctx) . unRec1+  {-# INLINE gthread #-}++instance Effect sig => GEffect m m' (Rec1 (sig m)) (Rec1 (sig m')) where+  gthread ctx handler = Rec1 . thread ctx handler . unRec1+  {-# INLINE gthread #-}

@@ -1,30 +1,29 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}+{- | Provides an effect to cull choices in a given nondeterministic context. This effect is used in concert with 'Control.Effect.NonDet.NonDet'.++Computations run inside a call to 'cull' will return at most one result.++Predefined carriers:++* "Control.Carrier.Cull.Church"++@since 0.1.2.0+-} module Control.Effect.Cull ( -- * Cull effect   Cull(..) , cull-  -- * Cull carriers-, runCull-, CullC(..)-, runNonDetOnce-, OnceC(..)--- * Re-exports-, Carrier-, Member+  -- * Re-exports+, Algebra+, Has , run ) where -import Control.Effect.Carrier-import Control.Effect.NonDet-import Control.Effect.Reader-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Prelude hiding (fail)+import Control.Algebra --- | 'Cull' effects are used with 'NonDet' to provide control over branching.+-- | 'Cull' effects are used with 'Control.Effect.Choose' to provide control over branching.+--+-- @since 0.1.2.0 data Cull m k   = forall a . Cull (m a) (a -> m k) @@ -35,70 +34,15 @@   {-# INLINE hmap #-}  instance Effect Cull where-  handle state handler (Cull m k) = Cull (handler (m <$ state)) (handler . fmap k)-  {-# INLINE handle #-}+  thread ctx handler (Cull m k) = Cull (handler (m <$ ctx)) (handler . fmap k)+  {-# INLINE thread #-}  -- | Cull nondeterminism in the argument, returning at most one result. -----   prop> run (runNonDet (runCull (cull (pure a <|> pure b)))) === [a]---   prop> run (runNonDet (runCull (cull (pure a <|> pure b) <|> pure c))) === [a, c]---   prop> run (runNonDet (runCull (cull (asum (map pure (repeat a)))))) === [a]-cull :: (Carrier sig m, Member Cull sig) => m a -> m a-cull m = send (Cull m pure)----- | Run a 'Cull' effect. Branches outside of any 'cull' block will not be pruned.------   prop> run (runNonDet (runCull (pure a <|> pure b))) === [a, b]-runCull :: Alternative m => CullC m a -> m a-runCull (CullC m) = runNonDetC (runReader False m) ((<|>) . pure) empty--newtype CullC m a = CullC { runCullC :: ReaderC Bool (NonDetC m) a }-  deriving (Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO)--instance Alternative (CullC m) where-  empty = CullC empty-  {-# INLINE empty #-}-  l <|> r = CullC $ ReaderC $ \ cull -> NonDetC $ \ cons nil -> do-    runNonDetC (runReader cull (runCullC l))-      (\ a as -> cons a (if cull then nil else as))-      (runNonDetC (runReader cull (runCullC r)) cons nil)-  {-# INLINE (<|>) #-}--instance MonadPlus (CullC m)--instance MonadTrans CullC where-  lift = CullC . lift . lift-  {-# INLINE lift #-}--instance (Carrier sig m, Effect sig) => Carrier (Cull :+: NonDet :+: sig) (CullC m) where-  eff (L (Cull m k))     = CullC (local (const True) (runCullC m)) >>= k-  eff (R (L Empty))      = empty-  eff (R (L (Choose k))) = k True <|> k False-  eff (R (R other))      = CullC (eff (R (R (handleCoercible other))))-  {-# INLINE eff #-}----- | Run a 'NonDet' effect, returning the first successful result in an 'Alternative' functor.------   Unlike 'runNonDet', this will terminate immediately upon finding a solution.+-- @+-- 'cull' ('pure' a 'Control.Effect.Choose.<|>' m) 'Control.Effect.Choose.<|>' n = 'pure' a 'Control.Effect.Choose.<|>' n+-- @ -----   prop> run (runNonDetOnce (asum (map pure (repeat a)))) === [a]---   prop> run (runNonDetOnce (asum (map pure (repeat a)))) === Just a-runNonDetOnce :: (Alternative f, Carrier sig m, Effect sig) => OnceC m a -> m (f a)-runNonDetOnce = runNonDet . runCull . cull . runOnceC--newtype OnceC m a = OnceC { runOnceC :: CullC (NonDetC m) a }-  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)--instance (Carrier sig m, Effect sig) => Carrier (NonDet :+: sig) (OnceC m) where-  eff = OnceC . eff . R . R . handleCoercible-  {-# INLINE eff #-}----- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.NonDet--- >>> import Control.Effect.Pure--- >>> import Data.Foldable (asum)+-- @since 0.1.2.0+cull :: Has Cull sig m => m a -> m a+cull m = send (Cull m pure)

@@ -1,29 +1,34 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, GeneralizedNewtypeDeriving, StandaloneDeriving #-}++{- | Provides an effect to delimit backtracking in a given nondeterministic context. This effect is used in concert with 'Control.Effect.NonDet.NonDet'.++Computations that signal failure with 'cutfail' prevent backtracking within the nearest enclosing 'call'.++Predefined carriers:++* "Control.Carrier.Cut.Church"++@since 0.1.2.0+-}+ module Control.Effect.Cut ( -- * Cut effect   Cut(..) , cutfail , call , cut-  -- * Cut carrier-, runCut-, runCutAll-, CutC(..)--- * Re-exports-, Carrier-, Member+  -- * Re-exports+, Algebra+, Has , run ) where -import Control.Effect.Carrier-import Control.Effect.NonDet-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import Control.Algebra+import Control.Applicative (Alternative(..)) --- | 'Cut' effects are used with 'NonDet' to provide control over backtracking.+-- | 'Cut' effects are used with 'Control.Effect.Choose' to provide control over backtracking.+--+-- @since 0.1.2.0 data Cut m k   = Cutfail   | forall a . Call (m a) (a -> m k)@@ -36,100 +41,44 @@   {-# INLINE hmap #-}  instance Effect Cut where-  handle _     _       Cutfail    = Cutfail-  handle state handler (Call m k) = Call (handler (m <$ state)) (handler . fmap k)-  {-# INLINE handle #-}+  thread _   _       Cutfail    = Cutfail+  thread ctx handler (Call m k) = Call (handler (m <$ ctx)) (handler . fmap k)+  {-# INLINE thread #-}  -- | Fail the current branch, and prevent backtracking within the nearest enclosing 'call' (if any). -- --   Contrast with 'empty', which fails the current branch but allows backtracking. -----   prop> run (runNonDet (runCut (cutfail <|> pure a))) === []---   prop> run (runNonDet (runCut (pure a <|> cutfail))) === [a]-cutfail :: (Carrier sig m, Member Cut sig) => m a+-- @+-- 'cutfail' '>>=' k = 'cutfail'+-- @+-- @+-- 'cutfail' '<|>' m = 'cutfail'+-- @+--+-- @since 0.1.2.0+cutfail :: Has Cut sig m => m a cutfail = send Cutfail {-# INLINE cutfail #-}  -- | Delimit the effect of 'cutfail's, allowing backtracking to resume. -----   prop> run (runNonDet (runCut (call (cutfail <|> pure a) <|> pure b))) === [b]-call :: (Carrier sig m, Member Cut sig) => m a -> m a+-- @+-- 'call' 'cutfail' '<|>' m = m+-- @+--+-- @since 0.1.2.0+call :: Has Cut sig m => m a -> m a call m = send (Call m pure) {-# INLINE call #-}  -- | Commit to the current branch, preventing backtracking within the nearest enclosing 'call' (if any) on failure. -----   prop> run (runNonDet (runCut (pure a <|> cut *> pure b))) === [a, b]---   prop> run (runNonDet (runCut (cut *> pure a <|> pure b))) === [a]---   prop> run (runNonDet (runCut (cut *> empty <|> pure a))) === []-cut :: (Alternative m, Carrier sig m, Member Cut sig) => m ()+-- @+-- 'cut' '>>' 'empty' = 'cutfail'+-- @+--+-- @since 0.1.2.0+cut :: (Alternative m, Has Cut sig m) => m () cut = pure () <|> cutfail {-# INLINE cut #-}----- | Run a 'Cut' effect within an underlying 'Alternative' instance (typically another 'Carrier' for a 'NonDet' effect).------   prop> run (runNonDetOnce (runCut (pure a))) === Just a-runCut :: Alternative m => CutC m a -> m a-runCut m = runCutC m ((<|>) . pure) empty empty---- | Run a 'Cut' effect, returning all its results in an 'Alternative' collection.-runCutAll :: (Alternative f, Applicative m) => CutC m a -> m (f a)-runCutAll (CutC m) = m (fmap . (<|>) . pure) (pure empty) (pure empty)--newtype CutC m a = CutC-  { -- | A higher-order function receiving three parameters: a function to combine each solution with the rest of the solutions, an action to run when no results are produced (e.g. on 'empty'), and an action to run when no results are produced and backtrcking should not be attempted (e.g. on 'cutfail').-    runCutC :: forall b . (a -> m b -> m b) -> m b -> m b -> m b-  }-  deriving (Functor)--instance Applicative (CutC m) where-  pure a = CutC (\ cons nil _ -> cons a nil)-  {-# INLINE pure #-}-  CutC f <*> CutC a = CutC $ \ cons nil fail ->-    f (\ f' fs -> a (cons . f') fs fail) nil fail-  {-# INLINE (<*>) #-}--instance Alternative (CutC m) where-  empty = CutC (\ _ nil _ -> nil)-  {-# INLINE empty #-}-  CutC l <|> CutC r = CutC (\ cons nil fail -> l cons (r cons nil fail) fail)-  {-# INLINE (<|>) #-}--instance Monad (CutC m) where-  CutC a >>= f = CutC $ \ cons nil fail ->-    a (\ a' as -> runCutC (f a') cons as fail) nil fail-  {-# INLINE (>>=) #-}--instance Fail.MonadFail m => Fail.MonadFail (CutC m) where-  fail s = CutC (\ _ _ _ -> Fail.fail s)-  {-# INLINE fail #-}--instance MonadFix m => MonadFix (CutC m) where-  mfix f = CutC (\ cons nil _ -> mfix (\ a -> runCutC (f (head a)) (fmap . (:)) (pure []) (pure [])) >>= foldr cons nil)-  {-# INLINE mfix #-}--instance MonadIO m => MonadIO (CutC m) where-  liftIO io = CutC (\ cons nil _ -> liftIO io >>= flip cons nil)-  {-# INLINE liftIO #-}--instance MonadPlus (CutC m)--instance MonadTrans CutC where-  lift m = CutC (\ cons nil _ -> m >>= flip cons nil)-  {-# INLINE lift #-}--instance (Carrier sig m, Effect sig) => Carrier (Cut :+: NonDet :+: sig) (CutC m) where-  eff (L Cutfail)    = CutC $ \ _    _   fail -> fail-  eff (L (Call m k)) = CutC $ \ cons nil fail -> runCutC m (\ a as -> runCutC (k a) cons as fail) nil nil-  eff (R (L Empty))      = empty-  eff (R (L (Choose k))) = k True <|> k False-  eff (R (R other)) = CutC $ \ cons nil _ -> eff (handle [()] (fmap concat . traverse runCutAll) other) >>= foldr cons nil-  {-# INLINE eff #-}----- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.Cull--- >>> import Control.Effect.Pure

@@ -0,0 +1,44 @@+{- | An effect modelling nondeterminism without choice (success or failure).++This can be seen as similar to 'Control.Effect.Fail.Fail', but without an error message. The 'Control.Effect.NonDet.NonDet' effect is the composition of 'Empty' and 'Control.Effect.Choice.Choice'.++Predefined carriers:++* "Control.Carrier.Empty.Maybe".+* If 'Empty' is the last effect in a stack, it can be interpreted directly to a 'Maybe'.++@since 1.0.0.0+-}++module Control.Effect.Empty+( -- * Empty effect+  Empty(..)+, empty+, guard+  -- * Re-exports+, Algebra+, Has+, run+) where++import Control.Algebra+import Control.Effect.Empty.Internal (Empty(..))++-- | Abort the computation.+--+-- 'empty' annihilates '>>=':+--+-- @+-- 'empty' '>>=' k = 'empty'+-- @+--+-- @since 1.0.0.0+empty :: Has Empty sig m => m a+empty = send Empty++-- | Conditional failure, returning only if the condition is 'True'.+--+-- @since 1.0.0.0+guard :: Has Empty sig m => Bool -> m ()+guard True  = pure ()+guard False = empty

@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveFunctor, DeriveGeneric, KindSignatures #-}+module Control.Effect.Empty.Internal+( Empty(..)+) where++import Control.Effect.Class+import GHC.Generics (Generic1)++-- | @since 1.0.0.0+data Empty (m :: * -> *) k = Empty+  deriving (Functor, Generic1)++instance HFunctor Empty+instance Effect   Empty

@@ -1,113 +1,23 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-}-module Control.Effect.Error-( -- * Error effect-  Error(..)-, throwError-, catchError-  -- * Error carrier-, runError-, ErrorC(..)-  -- * Re-exports-, Carrier-, Member-, run-) where--import Control.Applicative (Alternative(..), liftA2)-import Control.Effect.Carrier-import Control.Monad (MonadPlus(..), (<=<))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class--data Error exc m k-  = Throw exc-  | forall b . Catch (m b) (exc -> m b) (b -> m k)--deriving instance Functor m => Functor (Error exc m)--instance HFunctor (Error exc) where-  hmap _ (Throw exc)   = Throw exc-  hmap f (Catch m h k) = Catch (f m) (f . h) (f . k)--instance Effect (Error exc) where-  handle _     _       (Throw exc)   = Throw exc-  handle state handler (Catch m h k) = Catch (handler (m <$ state)) (handler . (<$ state) . h) (handler . fmap k)---- | Throw an error, escaping the current computation up to the nearest 'catchError' (if any).------   prop> run (runError (throwError a)) === Left @Int @Int a-throwError :: (Member (Error exc) sig, Carrier sig m) => exc -> m a-throwError = send . Throw---- | Run a computation which can throw errors with a handler to run on error.------ Errors thrown by the handler will escape up to the nearest enclosing 'catchError' (if any).--- Note that this effect does /not/ handle errors thrown from impure contexts such as IO,--- nor will it handle exceptions thrown from pure code. If you need to handle IO-based errors,--- consider if 'Control.Effect.Resource' fits your use case; if not, use 'liftIO' with--- 'Control.Exception.try' or use 'Control.Exception.Catch' from outside the effect invocation.------   prop> run (runError (pure a `catchError` pure)) === Right a---   prop> run (runError (throwError a `catchError` pure)) === Right @Int @Int a---   prop> run (runError (throwError a `catchError` (throwError @Int))) === Left @Int @Int a-catchError :: (Member (Error exc) sig, Carrier sig m) => m a -> (exc -> m a) -> m a-catchError m h = send (Catch m h pure)----- | Run an 'Error' effect, returning uncaught errors in 'Left' and successful computations’ values in 'Right'.------   prop> run (runError (pure a)) === Right @Int @Int a-runError :: ErrorC exc m a -> m (Either exc a)-runError = runErrorC--newtype ErrorC e m a = ErrorC { runErrorC :: m (Either e a) }-  deriving (Functor)--instance Applicative m => Applicative (ErrorC e m) where-  pure a = ErrorC (pure (Right a))-  {-# INLINE pure #-}-  ErrorC f <*> ErrorC a = ErrorC (liftA2 (<*>) f a)-  {-# INLINE (<*>) #-}--instance Alternative m => Alternative (ErrorC e m) where-  empty = ErrorC empty-  {-# INLINE empty #-}-  ErrorC l <|> ErrorC r = ErrorC (l <|> r)-  {-# INLINE (<|>) #-}--instance Monad m => Monad (ErrorC e m) where-  ErrorC a >>= f = ErrorC (a >>= either (pure . Left) (runError . f))-  {-# INLINE (>>=) #-}--instance MonadFix m => MonadFix (ErrorC e m) where-  mfix f = ErrorC (mfix (runError . either (error "mfix (ErrorC): function returned failure") f))-  {-# INLINE mfix #-}--instance MonadIO m => MonadIO (ErrorC e m) where-  liftIO io = ErrorC (Right <$> liftIO io)-  {-# INLINE liftIO #-}+{- | An effect modelling catchable failure with a polymorphic error type, the combination of 'Throw' and 'Catch'. -instance Fail.MonadFail m => Fail.MonadFail (ErrorC e m) where-  fail s = ErrorC (Fail.fail s)-  {-# INLINE fail #-}+This effect is similar to the traditional @MonadError@ typeclass, though it allows the presence of multiple @Error@ effects in a given effect stack. It offers precise exception handling, rather than the dynamic exception hierarchy provided by the @exceptions@ package. The @fused-effects-exceptions@ package may be more suitable for handling dynamic/impure effect handling. -instance (Alternative m, Monad m) => MonadPlus (ErrorC e m)+Predefined carriers: -instance MonadTrans (ErrorC e) where-  lift = ErrorC . fmap Right-  {-# INLINE lift #-}+* "Control.Carrier.Error.Either".+* "Control.Monad.Trans.Except".+* If 'Error' @e@ is the last effect in a stack, it can be interpreted directly to an 'Either' @e@. -instance (Carrier sig m, Effect sig) => Carrier (Error e :+: sig) (ErrorC e m) where-  eff (L (Throw e))     = ErrorC (pure (Left e))-  eff (L (Catch m h k)) = ErrorC (runError m >>= either (either (pure . Left) (runError . k) <=< runError . h) (runError . k))-  eff (R other)         = ErrorC (eff (handle (Right ()) (either (pure . Left) runError) other))-  {-# INLINE eff #-}+@since 0.1.0.0+-} +module Control.Effect.Error+( -- * Error effects+  Error+, module Control.Effect.Throw+, module Control.Effect.Catch+) where --- $setup--- >>> :seti -XFlexibleContexts--- >>> :seti -XTypeApplications--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure+import Control.Effect.Catch+import Control.Effect.Error.Internal (Error)+import Control.Effect.Throw

@@ -0,0 +1,11 @@+{-# LANGUAGE TypeOperators #-}+module Control.Effect.Error.Internal+( Error+) where++import Control.Effect.Catch.Internal (Catch)+import Control.Effect.Sum ((:+:))+import Control.Effect.Throw.Internal (Throw)++-- | @since 0.1.0.0+type Error e = Throw e :+: Catch e

@@ -1,51 +1,35 @@-{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor, DeriveGeneric, KindSignatures, PatternSynonyms #-}++{- | An effect providing failure with an error message.++This effect is invoked through the 'Control.Monad.Fail.fail' method from 'Control.Monad.Fail.MonadFail'.++Predefined carriers:++* "Control.Carrier.Fail.Either"++@since 0.1.0.0+-}+ module Control.Effect.Fail ( -- * Fail effect-  Fail(..)-  -- * Fail carrier-, runFail-, FailC(..)-  -- * Re-exports-, Carrier-, Member+  Fail+, pattern Fail , Fail.MonadFail(..)+  -- * Re-exports+, Algebra+, Has , run ) where -import Control.Applicative (Alternative(..))-import Control.Effect.Carrier-import Control.Effect.Error-import Control.Monad (MonadPlus(..))+import Control.Effect.Throw import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import GHC.Generics (Generic1) -newtype Fail (m :: * -> *) k = Fail String-  deriving stock (Functor, Generic1)-  deriving anyclass (HFunctor, Effect)---- | Run a 'Fail' effect, returning failure messages in 'Left' and successful computations’ results in 'Right'.------   prop> run (runFail (pure a)) === Right a-runFail :: FailC m a -> m (Either String a)-runFail = runError . runFailC--newtype FailC m a = FailC { runFailC :: ErrorC String m a }-  deriving newtype (Alternative, Applicative, Functor, Monad, MonadFix, MonadIO, MonadPlus, MonadTrans)--instance (Carrier sig m, Effect sig) => Fail.MonadFail (FailC m) where-  fail s = FailC (throwError s)-  {-# INLINE fail #-}--instance (Carrier sig m, Effect sig) => Carrier (Fail :+: sig) (FailC m) where-  eff (L (Fail s)) = Fail.fail s-  eff (R other)    = FailC (eff (R (handleCoercible other)))-  {-# INLINE eff #-}+-- | @since 0.1.0.0+type Fail = Throw String +-- | @since 1.0.0.0+pattern Fail :: String -> Fail m k+pattern Fail s = Throw s --- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure+{-# COMPLETE Fail #-}

@@ -1,81 +1,40 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}++{- | This effect provides source to an infinite source of 'Int' values, suitable for generating "fresh" values to uniquely identify data without needing to invoke random numbers or impure IO.++Predefined carriers:++* "Control.Carrier.Fresh.Strict".++-} module Control.Effect.Fresh ( -- * Fresh effect   Fresh(..) , fresh-, resetFresh-  -- * Fresh carrier-, runFresh-, FreshC(..)   -- * Re-exports-, Carrier-, Member+, Algebra+, Has , run ) where -import Control.Applicative (Alternative(..))-import Control.Effect.Carrier-import Control.Effect.State-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class+import Control.Algebra+import GHC.Generics (Generic1) +-- | @since 0.1.0.0 data Fresh m k   = Fresh (Int -> m k)-  | forall b . Reset (m b) (b -> m k)+  deriving (Functor, Generic1) -deriving instance Functor m => Functor (Fresh m)+instance HFunctor Fresh+instance Effect   Fresh -instance HFunctor Fresh where-  hmap f (Fresh   k) = Fresh       (f . k)-  hmap f (Reset m k) = Reset (f m) (f . k) -instance Effect Fresh where-  handle state handler (Fresh   k) = Fresh (handler . (<$ state) . k)-  handle state handler (Reset m k) = Reset (handler (m <$ state)) (handler . fmap k)- -- | Produce a fresh (i.e. unique) 'Int'. -----   prop> run (runFresh (replicateM n fresh)) === nub (run (runFresh (replicateM n fresh)))-fresh :: (Member Fresh sig, Carrier sig m) => m Int-fresh = send (Fresh pure)---- | Reset the fresh counter after running a computation.------   prop> run (runFresh (resetFresh (replicateM m fresh) *> replicateM n fresh)) === run (runFresh (replicateM n fresh))-resetFresh :: (Member Fresh sig, Carrier sig m) => m a -> m a-resetFresh m = send (Reset m pure)----- | Run a 'Fresh' effect counting up from 0.+-- @+-- m '>>' 'fresh' ≠ m '>>' 'fresh' '>>' 'fresh'+-- @ -----   prop> run (runFresh (replicateM n fresh)) === [0..pred n]---   prop> run (runFresh (replicateM n fresh *> pure b)) === b-runFresh :: Functor m => FreshC m a -> m a-runFresh = evalState 0 . runFreshC--newtype FreshC m a = FreshC { runFreshC :: StateC Int m a }-  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)--instance (Carrier sig m, Effect sig) => Carrier (Fresh :+: sig) (FreshC m) where-  eff (L (Fresh   k)) = FreshC $ do-    i <- get-    put (succ i)-    runFreshC (k i)-  eff (L (Reset m k)) = FreshC $ do-    i <- get-    a <- runFreshC m-    put (i :: Int)-    runFreshC (k a)-  eff (R other)       = FreshC (eff (R (handleCoercible other)))-  {-# INLINE eff #-}----- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure--- >>> import Control.Monad (replicateM)--- >>> import Data.List (nub)+-- @since 0.1.0.0+fresh :: Has Fresh sig m => m Int+fresh = send (Fresh pure)

@@ -1,55 +0,0 @@-{-# LANGUAGE DeriveFunctor, ExplicitForAll, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}--{- |-This module provides an 'InterposeC' carrier capable of "eavesdropping" on requests-made to other carriers. This is a useful capability for dynamism in deeply-nested-effect stacks, but can lead to complicated control flow. Be careful.--}-module Control.Effect.Interpose-  ( InterposeC (..)-  , runInterpose-  ) where--import Control.Applicative-import Control.Effect.Carrier-import Control.Effect.Reader-import Control.Monad (MonadPlus (..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class---- | 'runInterpose' takes a handler for a given effect (such as 'State' or 'Reader')--- and runs that handler whenever an effect of that type is encountered. Within a--- handler you can use all the capabilities of the underlying monad stack, including--- the intercepted effect, and you can pass the effect on to the original handler--- using 'send'.------   prop> run . evalState @Int a . runInterpose @(State Int) (\op -> modify @Int (+b) *> send op) $ modify @Int (+b) === a + b + b----runInterpose :: (forall x . eff m x -> m x) -> InterposeC eff m a -> m a-runInterpose handler = runReader (Handler handler) . runInterposeC--newtype InterposeC eff m a = InterposeC { runInterposeC :: ReaderC (Handler eff m) m a }-  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)--instance MonadTrans (InterposeC eff) where-  lift = InterposeC . lift--newtype Handler eff m = Handler (forall x . eff m x -> m x)--runHandler :: (HFunctor eff, Functor m) => Handler eff m -> eff (ReaderC (Handler eff m) m) a -> m a-runHandler h@(Handler handler) = handler . hmap (runReader h)--instance (HFunctor eff, Carrier sig m, Member eff sig) => Carrier sig (InterposeC eff m) where-  eff (op :: sig (InterposeC eff m) a)-    | Just (op' :: eff (InterposeC eff m) a) <- prj op = do-      handler <- InterposeC ask-      lift (runHandler handler (handleCoercible op'))-    | otherwise = InterposeC (ReaderC (\ handler -> eff (hmap (runReader handler . runInterposeC) op)))---- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure--- >>> import Control.Effect.State

@@ -1,82 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}-module Control.Effect.Interpret-( runInterpret-, InterpretC(..)-, runInterpretState-, InterpretStateC(..)-) where--import Control.Applicative (Alternative(..))-import Control.Effect.Carrier-import Control.Effect.Reader-import Control.Effect.State-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class---- | Interpret an effect using a higher-order function.------   This involves a great deal less boilerplate than defining a custom 'Carrier' instance, at the expense of somewhat less performance. It’s a reasonable starting point for new interpretations, and if more performance or flexibility is required, it’s straightforward to “graduate” by replacing the relevant 'runInterpret' handlers with specialized 'Carrier' instances for the effects.------   At time of writing, a simple passthrough use of 'runInterpret' to handle a 'State' effect is about five times slower than using 'StateC' directly.------   prop> run (runInterpret (\ op -> case op of { Get k -> k a ; Put _ k -> k }) get) === a-runInterpret :: (forall x . eff m x -> m x) -> InterpretC eff m a -> m a-runInterpret handler = runReader (Handler handler) . runInterpretC--newtype InterpretC eff m a = InterpretC { runInterpretC :: ReaderC (Handler eff m) m a }-  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)--instance MonadTrans (InterpretC eff) where-  lift = InterpretC . lift-  {-# INLINE lift #-}--newtype Handler eff m = Handler (forall x . eff m x -> m x)--runHandler :: (HFunctor eff, Functor m) => Handler eff m -> eff (InterpretC eff m) a -> m a-runHandler h@(Handler handler) = handler . hmap (runReader h . runInterpretC)--instance (HFunctor eff, Carrier sig m) => Carrier (eff :+: sig) (InterpretC eff m) where-  eff (L op) = do-    handler <- InterpretC ask-    lift (runHandler handler op)-  eff (R other) = InterpretC (eff (R (handleCoercible other)))-  {-# INLINE eff #-}----- | Interpret an effect using a higher-order function with some state variable.------   This involves a great deal less boilerplate than defining a custom 'Carrier' instance, at the expense of somewhat less performance. It’s a reasonable starting point for new interpretations, and if more performance or flexibility is required, it’s straightforward to “graduate” by replacing the relevant 'runInterpretState' handlers with specialized 'Carrier' instances for the effects.------   At time of writing, a simple use of 'runInterpretState' to handle a 'State' effect is about four times slower than using 'StateC' directly.------   prop> run (runInterpretState (\ s op -> case op of { Get k -> runState s (k s) ; Put s' k -> runState s' k }) a get) === a-runInterpretState :: (forall x . s -> eff (StateC s m) x -> m (s, x)) -> s -> InterpretStateC eff s m a -> m (s, a)-runInterpretState handler state = runState state . runReader (HandlerState (\ eff -> StateC (\ s -> handler s eff))) . runInterpretStateC--newtype InterpretStateC eff s m a = InterpretStateC { runInterpretStateC :: ReaderC (HandlerState eff s m) (StateC s m) a }-  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)--instance MonadTrans (InterpretStateC eff s) where-  lift = InterpretStateC . lift . lift-  {-# INLINE lift #-}--newtype HandlerState eff s m = HandlerState (forall x . eff (StateC s m) x -> StateC s m x)--runHandlerState :: (HFunctor eff, Functor m) => HandlerState eff s m -> eff (InterpretStateC eff s m) a -> StateC s m a-runHandlerState h@(HandlerState handler) = handler . hmap (runReader h . runInterpretStateC)--instance (HFunctor eff, Carrier sig m, Effect sig) => Carrier (eff :+: sig) (InterpretStateC eff s m) where-  eff (L op) = do-    handler <- InterpretStateC ask-    InterpretStateC (lift (runHandlerState handler op))-  eff (R other) = InterpretStateC (eff (R (R (handleCoercible other))))-  {-# INLINE eff #-}----- $setup--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure--- >>> import Control.Effect.State

@@ -1,52 +1,56 @@-{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}++{- | Provides a mechanism to kick off the evaluation of an effect stack that takes place in a monadic context.++'Lift' effects are always the last effect in a given effect stack. These stacks are invoked with 'Control.Carrier.Lift.runM' or 'Control.Algebra.run'.++Predefined carriers:++* "Control.Carrier.Lift"+* 'IO'+* 'Data.Functor.Identity.Identity'++@since 0.1.0.0+-}+ module Control.Effect.Lift ( -- * Lift effect   Lift(..) , sendM-  -- * Lift carrier-, runM-, LiftC(..)+, liftWith   -- * Re-exports-, Carrier-, Member+, Algebra+, Has , run ) where -import Control.Applicative (Alternative(..))-import Control.Effect.Carrier-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.IO.Unlift-import Control.Monad.Trans.Class-import GHC.Generics--newtype Lift sig m k = Lift { unLift :: sig (m k) }-  deriving stock (Functor, Generic1)-  deriving anyclass (HFunctor, Effect)---- | Extract a 'Lift'ed 'Monad'ic action from an effectful computation.-runM :: LiftC m a -> m a-runM = runLiftC+import Control.Algebra+import Control.Effect.Lift.Internal (Lift(..))  -- | Given a @Lift n@ constraint in a signature carried by @m@, 'sendM' -- promotes arbitrary actions of type @n a@ to @m a@. It is spiritually -- similar to @lift@ from the @MonadTrans@ typeclass.-sendM :: (Member (Lift n) sig, Carrier sig m, Functor n) => n a -> m a-sendM = send . Lift . fmap pure+--+-- @since 1.0.0.0+sendM :: (Has (Lift n) sig m, Functor n) => n a -> m a+sendM m = send (LiftWith (\ ctx _ -> (<$ ctx) <$> m) pure) -newtype LiftC m a = LiftC { runLiftC :: m a }-  deriving newtype (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus) -instance MonadTrans LiftC where-  lift = LiftC--instance Monad m => Carrier (Lift m) (LiftC m) where-  eff = LiftC . (>>= runLiftC) . unLift--instance MonadUnliftIO m => MonadUnliftIO (LiftC m) where-  askUnliftIO = LiftC $ withUnliftIO $ \u -> return (UnliftIO (unliftIO u . runLiftC))-  {-# INLINE askUnliftIO #-}-  withRunInIO inner = LiftC $ withRunInIO $ \run -> inner (run . runLiftC)-  {-# INLINE withRunInIO #-}+-- | Run actions in an outer context.+--+-- This can be used to provide interoperation with @base@ functionality like @"Control.Exception".'Control.Exception.catch'@:+--+-- @+-- 'liftWith' $ \ ctx hdl -> 'Control.Exception.catch' (hdl (m <$ ctx)) (hdl . (<$ ctx) . h)+-- @+--+-- The higher-order function takes both an initial context, and a handler phrased as the same sort of distributive law as described in the documentation for 'thread'. This handler takes actions lifted into a context functor, which can be either the initial context, or the derived context produced by handling a previous action.+--+-- As with @MonadBaseControl@, care must be taken when lifting functions like @"Control.Exception".'Control.Exception.finally'@ which don’t use the return value of one of their actions, as this can lead to dropped effects.+--+-- @since 1.0.0.0+liftWith+  :: Has (Lift n) sig m+  => (forall ctx . Functor ctx => ctx () -> (forall a . ctx (m a) -> n (ctx a)) -> n (ctx a))+  -> m a+liftWith with = send (LiftWith with pure)

@@ -0,0 +1,24 @@+{-# LANGUAGE ExistentialQuantification, RankNTypes #-}+module Control.Effect.Lift.Internal+( Lift(..)+) where++import Control.Effect.Class+import Data.Functor.Compose++-- | @since 1.0.0.0+data Lift sig m k+  = forall a . LiftWith+    (forall ctx . Functor ctx => ctx () -> (forall a . ctx (m a) -> sig (ctx a)) -> sig (ctx a))+    (a -> m k)++instance Functor m => Functor (Lift sig m) where+  fmap f (LiftWith with k) = LiftWith with (fmap f . k)++instance HFunctor (Lift sig) where+  hmap f (LiftWith go k) = LiftWith (\c lift -> go c (lift . fmap f)) (f . k)++instance Functor sig => Effect (Lift sig) where+  thread ctx dst (LiftWith with k) = LiftWith+    (\ ctx' dst' -> getCompose <$> with (Compose (ctx <$ ctx')) (fmap Compose . dst' . fmap dst . getCompose))+    (dst . fmap k)

@@ -1,94 +1,68 @@-{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}+{- | An effect modelling nondeterminism with choice and failure.++Nondeterministic operations are encapsulated by the 'Alternative' class, where 'empty' represents failure and '<|>' represents choice. This module re-exports the 'Alternative' interface. If you can't or don't want to use 'Alternative', you can use the 'Control.Effect.Empty.empty' and 'Control.Effect.Choose.<|>' operations (from "Control.Effect.Empty" and "Control.Effect.Choose" respectively) directly, as the 'NonDet' effect is the composition of 'Choose' and 'Empty'.++Predefined carriers:++* "Control.Carrier.NonDet.Church", which collects all branches' results using an @Alternative@ functor.+* If 'NonDet' is the last effect in a stack, it can be interpreted directly into a @[]@.++@since 0.1.0.0+-}+ module Control.Effect.NonDet-( -- * NonDet effect-  NonDet(..)-  -- * NonDet carrier-, runNonDet-, NonDetC(..)+( -- * NonDet effects+  NonDet+, module Control.Effect.Choose+, module Control.Effect.Empty+, oneOf+, foldMapA   -- * Re-exports , Alternative(..)-, Carrier-, Member+, Algebra+, Has+, MonadPlus(..)+, guard+, optional , run ) where -import Control.Applicative (Alternative(..))-import Control.Effect.Carrier-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import GHC.Generics (Generic1)--data NonDet m k-  = Empty-  | Choose (Bool -> m k)-  deriving stock (Functor, Generic1)-  deriving anyclass (HFunctor, Effect)-+import Control.Algebra+import Control.Applicative (Alternative(..), optional)+import Control.Effect.Choose (Choose(..))+import Control.Effect.Empty (Empty(..))+import Control.Effect.NonDet.Internal (NonDet)+import Control.Monad (MonadPlus(..), guard)+import Data.Coerce+import Data.Monoid (Alt(..)) --- | Run a 'NonDet' effect, collecting all branches’ results into an 'Alternative' functor.+-- | Nondeterministically choose an element from a 'Foldable' collection.+-- This can be used to emulate the style of nondeterminism associated with+-- programming in the list monad: -----   Using '[]' as the 'Alternative' functor will produce all results, while 'Maybe' will return only the first. However, unlike 'runNonDetOnce', this will still enumerate the entire search space before returning, meaning that it will diverge for infinite search spaces, even when using 'Maybe'.+-- @+--   pythagoreanTriples = do+--     a <- oneOf [1..10]+--     b <- oneOf [1..10]+--     c <- oneOf [1..10]+--     guard (a^2 + b^2 == c^2)+--     pure (a, b, c)+-- @ -----   prop> run (runNonDet (pure a)) === [a]---   prop> run (runNonDet (pure a)) === Just a-runNonDet :: (Alternative f, Applicative m) => NonDetC m a -> m (f a)-runNonDet (NonDetC m) = m (fmap . (<|>) . pure) (pure empty)---- | A carrier for 'NonDet' effects based on Ralf Hinze’s design described in [Deriving Backtracking Monad Transformers](https://www.cs.ox.ac.uk/ralf.hinze/publications/#P12).-newtype NonDetC m a = NonDetC-  { -- | A higher-order function receiving two parameters: a function to combine each solution with the rest of the solutions, and an action to run when no results are produced.-    runNonDetC :: forall b . (a -> m b -> m b) -> m b -> m b-  }-  deriving stock (Functor)--instance Applicative (NonDetC m) where-  pure a = NonDetC (\ cons -> cons a)-  {-# INLINE pure #-}-  NonDetC f <*> NonDetC a = NonDetC $ \ cons ->-    f (\ f' -> a (cons . f'))-  {-# INLINE (<*>) #-}--instance Alternative (NonDetC m) where-  empty = NonDetC (\ _ nil -> nil)-  {-# INLINE empty #-}-  NonDetC l <|> NonDetC r = NonDetC $ \ cons -> l cons . r cons-  {-# INLINE (<|>) #-}--instance Monad (NonDetC m) where-  NonDetC a >>= f = NonDetC $ \ cons ->-    a (\ a' -> runNonDetC (f a') cons)-  {-# INLINE (>>=) #-}--instance Fail.MonadFail m => Fail.MonadFail (NonDetC m) where-  fail s = NonDetC (\ _ _ -> Fail.fail s)-  {-# INLINE fail #-}--instance MonadFix m => MonadFix (NonDetC m) where-  mfix f = NonDetC (\ cons nil -> mfix (\ a -> runNonDetC (f (head a)) (fmap . (:)) (pure [])) >>= foldr cons nil)-  {-# INLINE mfix #-}--instance MonadIO m => MonadIO (NonDetC m) where-  liftIO io = NonDetC (\ cons nil -> liftIO io >>= flip cons nil)-  {-# INLINE liftIO #-}--instance MonadPlus (NonDetC m)--instance MonadTrans NonDetC where-  lift m = NonDetC (\ cons nil -> m >>= flip cons nil)-  {-# INLINE lift #-}+-- @since 1.0.0.0+oneOf :: (Foldable t, Alternative m) => t a -> m a+oneOf = foldMapA pure -instance (Carrier sig m, Effect sig) => Carrier (NonDet :+: sig) (NonDetC m) where-  eff (L Empty)      = empty-  eff (L (Choose k)) = k True <|> k False-  eff (R other)      = NonDetC $ \ cons nil -> eff (handle [()] (fmap concat . traverse runNonDet) other) >>= foldr cons nil-  {-# INLINE eff #-}+-- | Map a 'Foldable' collection of values into a nondeterministic computation using the supplied action.+--+-- @since 1.0.0.0+foldMapA :: (Foldable t, Alternative m) => (a -> m b) -> t a -> m b+foldMapA f = getAlt #. foldMap (Alt #. f)  --- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure--- >>> import Data.Foldable (asum)+-- | Compose a function operationally equivalent to 'id' on the left.+--+--   cf https://github.com/fused-effects/diffused-effects/pull/1#discussion_r323560758+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)+(#.) _ = coerce+{-# INLINE (#.) #-}

@@ -0,0 +1,13 @@+{-# LANGUAGE TypeOperators #-}+module Control.Effect.NonDet.Internal+( NonDet+) where++import Control.Effect.Choose.Internal (Choose)+import Control.Effect.Empty.Internal (Empty)+import Control.Effect.Sum++-- | The nondeterminism effect is the composition of 'Empty' and 'Choose' effects.+--+-- @since 0.1.0.0+type NonDet = Empty :+: Choose

@@ -1,58 +0,0 @@-{-# LANGUAGE DeriveFunctor, DeriveGeneric, KindSignatures #-}-module Control.Effect.Pure-( -- * Pure effect-  Pure-  -- * Pure carrier-, run-, PureC(..)-) where--import Control.Applicative-import Control.Monad.Fix-import Data.Coerce-import GHC.Generics (Generic1)--data Pure (m :: * -> *) k-  deriving (Functor, Generic1)----- | Run an action exhausted of effects to produce its final result value.-run :: PureC a -> a-run = runPureC-{-# INLINE run #-}--newtype PureC a = PureC { runPureC :: a }--instance Functor PureC where-  fmap = coerce-  {-# INLINE fmap #-}--  a <$ _ = pure a-  {-# INLINE (<$) #-}--instance Applicative PureC where-  pure = PureC-  {-# INLINE pure #-}--  (<*>) = coerce-  {-# INLINE (<*>) #-}--  liftA2 = coerce-  {-# INLINE liftA2 #-}--  _ *> b = b-  {-# INLINE (*>) #-}--  a <* _ = a-  {-# INLINE (<*) #-}--instance Monad PureC where-  return = pure-  {-# INLINE return #-}--  PureC a >>= f = f a-  {-# INLINE (>>=) #-}--instance MonadFix PureC where-  mfix f = PureC (fix (runPureC . f))-  {-# INLINE mfix #-}

@@ -1,111 +0,0 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-}-module Control.Effect.Random-( -- * Random effect-  Random(..)-  -- * Random carrier-, runRandom-, evalRandom-, execRandom-, evalRandomIO-, RandomC(..)-  -- * Re-exports-, Carrier-, Member-, MonadRandom(..)-, MonadInterleave(..)-, run-) where--import Control.Applicative (Alternative(..))-import Control.Effect.Carrier-import Control.Effect.State-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.Random.Class (MonadInterleave(..), MonadRandom(..))-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Trans.Class-import qualified System.Random as R (Random(..), RandomGen(..), StdGen, newStdGen)--data Random m k-  = forall a . R.Random a => Random (a -> m k)-  | forall a . R.Random a => RandomR (a, a) (a -> m k)-  | forall a . Interleave (m a) (a -> m k)--deriving instance Functor m => Functor (Random m)--instance HFunctor Random where-  hmap f (Random       k) = Random           (f . k)-  hmap f (RandomR r    k) = RandomR r        (f . k)-  hmap f (Interleave m k) = Interleave (f m) (f . k)-  {-# INLINE hmap #-}--instance Effect Random where-  handle state handler (Random       k) = Random                            (handler . (<$ state) . k)-  handle state handler (RandomR r    k) = RandomR r                         (handler . (<$ state) . k)-  handle state handler (Interleave m k) = Interleave (handler (m <$ state)) (handler . fmap k)----- | Run a random computation starting from a given generator.------   prop> run (runRandom (PureGen a) (pure b)) === (PureGen a, b)-runRandom :: g -> RandomC g m a -> m (g, a)-runRandom g = runState g . runRandomC---- | Run a random computation starting from a given generator and discarding the final generator.------   prop> run (evalRandom (PureGen a) (pure b)) === b-evalRandom :: Functor m => g -> RandomC g m a -> m a-evalRandom g = fmap snd . runRandom g---- | Run a random computation starting from a given generator and discarding the final result.------   prop> run (execRandom (PureGen a) (pure b)) === PureGen a-execRandom :: Functor m => g -> RandomC g m a -> m g-execRandom g = fmap fst . runRandom g---- | Run a random computation in 'IO', splitting the global standard generator to get a new one for the computation.-evalRandomIO :: MonadIO m => RandomC R.StdGen m a -> m a-evalRandomIO m = liftIO R.newStdGen >>= flip evalRandom m--newtype RandomC g m a = RandomC { runRandomC :: StateC g m a }-  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)--instance (Carrier sig m, Effect sig, R.RandomGen g) => MonadRandom (RandomC g m) where-  getRandom = RandomC $ do-    (a, g') <- gets R.random-    a <$ put (g' :: g)-  {-# INLINE getRandom #-}-  getRandomR r = RandomC $ do-    (a, g') <- gets (R.randomR r)-    a <$ put (g' :: g)-  {-# INLINE getRandomR #-}-  getRandomRs interval = (:) <$> getRandomR interval <*> getRandomRs interval-  {-# INLINE getRandomRs #-}-  getRandoms = (:) <$> getRandom <*> getRandoms-  {-# INLINE getRandoms #-}--instance (Carrier sig m, Effect sig, R.RandomGen g) => MonadInterleave (RandomC g m) where-  interleave m = RandomC $ do-    (g1, g2) <- gets R.split-    put (g1 :: g)-    a <- runRandomC m-    a <$ put g2-  {-# INLINE interleave #-}--instance (Carrier sig m, Effect sig, R.RandomGen g) => Carrier (Random :+: sig) (RandomC g m) where-  eff (L (Random       k)) = getRandom >>= k-  eff (L (RandomR r    k)) = getRandomR r >>= k-  eff (L (Interleave m k)) = interleave m >>= k-  eff (R other)            = RandomC (eff (R (handleCoercible other)))-  {-# INLINE eff #-}----- $setup--- >>> :seti -XFlexibleContexts--- >>> import System.Random--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure--- >>> import Control.Effect.NonDet--- >>> newtype PureGen = PureGen Int deriving (Eq, Show)--- >>> instance RandomGen PureGen where next (PureGen i) = (i, PureGen i) ; split g = (g, g)

@@ -1,124 +1,59 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-}+{- | An effect providing access to an immutable (but locally-modifiable) context value.++This effect is similar to the traditional @MonadReader@ typeclass, though it allows the presence of multiple @Reader t@ effects.++Predefined carriers:++* "Control.Carrier.Reader".+* "Control.Monad.Trans.Reader".+* "Control.Monad.Trans.RWS.Lazy"+* "Control.Monad.Trans.RWS.Strict"+* If 'Reader' @r@ is the last effect in a stack, it can be interpreted directly to @(-> r)@ (a function taking an @r@).++@since 0.1.0.0+-}+ module Control.Effect.Reader ( -- * Reader effect   Reader(..) , ask , asks , local-  -- * Reader carrier-, runReader-, ReaderC(..)   -- * Re-exports-, Carrier-, Member+, Algebra+, Has , run ) where -import Control.Applicative (Alternative(..), liftA2)-import Control.Effect.Carrier-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.IO.Unlift-import Control.Monad.Trans.Class--data Reader r m k-  = Ask (r -> m k)-  | forall b . Local (r -> r) (m b) (b -> m k)--deriving instance Functor m => Functor (Reader r m)--instance HFunctor (Reader r) where-  hmap f (Ask k)       = Ask           (f . k)-  hmap f (Local g m k) = Local g (f m) (f . k)--instance Effect (Reader r) where-  handle state handler (Ask k)       = Ask (handler . (<$ state) . k)-  handle state handler (Local f m k) = Local f (handler (m <$ state)) (handler . fmap k)+import Control.Algebra+import Control.Effect.Reader.Internal (Reader(..))  -- | Retrieve the environment value. -----   prop> run (runReader a ask) === a-ask :: (Member (Reader r) sig, Carrier sig m) => m r+-- @+-- runReader a ('ask' '>>=' k) = runReader a (k a)+-- @+--+-- @since 0.1.0.0+ask :: Has (Reader r) sig m => m r ask = send (Ask pure)  -- | Project a function out of the current environment value. -----   prop> snd (run (runReader a (asks (applyFun f)))) === applyFun f a-asks :: (Member (Reader r) sig, Carrier sig m) => (r -> a) -> m a+-- @+-- 'asks' f = 'fmap' f 'ask'+-- @+--+-- @since 0.1.0.0+asks :: Has (Reader r) sig m => (r -> a) -> m a asks f = send (Ask (pure . f))  -- | Run a computation with an environment value locally modified by the passed function. -----   prop> run (runReader a (local (applyFun f) ask)) === applyFun f a---   prop> run (runReader a ((,,) <$> ask <*> local (applyFun f) ask <*> ask)) === (a, applyFun f a, a)-local :: (Member (Reader r) sig, Carrier sig m) => (r -> r) -> m a -> m a-local f m = send (Local f m pure)----- | Run a 'Reader' effect with the passed environment value.+-- @+-- runReader a ('local' f m) = runReader (f a) m+-- @ -----   prop> run (runReader a (pure b)) === b-runReader :: r -> ReaderC r m a -> m a-runReader r c = runReaderC c r-{-# INLINE runReader #-}--newtype ReaderC r m a = ReaderC { runReaderC :: r -> m a }-  deriving (Functor)--instance Applicative m => Applicative (ReaderC r m) where-  pure = ReaderC . const . pure-  {-# INLINE pure #-}-  ReaderC f <*> ReaderC a = ReaderC (liftA2 (<*>) f a)-  {-# INLINE (<*>) #-}-  ReaderC u *> ReaderC v = ReaderC $ \ r -> u r *> v r-  {-# INLINE (*>) #-}-  ReaderC u <* ReaderC v = ReaderC $ \ r -> u r <* v r-  {-# INLINE (<*) #-}--instance Alternative m => Alternative (ReaderC r m) where-  empty = ReaderC (const empty)-  {-# INLINE empty #-}-  ReaderC l <|> ReaderC r = ReaderC (liftA2 (<|>) l r)-  {-# INLINE (<|>) #-}--instance Monad m => Monad (ReaderC r m) where-  ReaderC a >>= f = ReaderC (\ r -> a r >>= runReader r . f)-  {-# INLINE (>>=) #-}--instance Fail.MonadFail m => Fail.MonadFail (ReaderC r m) where-  fail = ReaderC . const . Fail.fail-  {-# INLINE fail #-}--instance MonadFix m => MonadFix (ReaderC s m) where-  mfix f = ReaderC (\ r -> mfix (runReader r . f))-  {-# INLINE mfix #-}--instance MonadIO m => MonadIO (ReaderC r m) where-  liftIO = ReaderC . const . liftIO-  {-# INLINE liftIO #-}--instance (Alternative m, Monad m) => MonadPlus (ReaderC r m)--instance MonadTrans (ReaderC r) where-  lift = ReaderC . const-  {-# INLINE lift #-}--instance MonadUnliftIO m => MonadUnliftIO (ReaderC r m) where-  askUnliftIO = ReaderC $ \r -> withUnliftIO $ \u -> pure (UnliftIO (\(ReaderC x) -> unliftIO u (x r)))-  {-# INLINE askUnliftIO #-}-  withRunInIO inner = ReaderC $ \r -> withRunInIO $ \go -> inner (go . runReader r)-  {-# INLINE withRunInIO #-}--instance Carrier sig m => Carrier (Reader r :+: sig) (ReaderC r m) where-  eff (L (Ask       k)) = ReaderC (\ r -> runReader r (k r))-  eff (L (Local f m k)) = ReaderC (\ r -> runReader (f r) m) >>= k-  eff (R other)         = ReaderC (\ r -> eff (hmap (runReader r) other))-  {-# INLINE eff #-}----- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure+-- @since 0.1.0.0+local :: Has (Reader r) sig m => (r -> r) -> m a -> m a+local f m = send (Local f m pure)

@@ -0,0 +1,21 @@+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}+module Control.Effect.Reader.Internal+( Reader(..)+) where++import Control.Effect.Class++-- | @since 0.1.0.0+data Reader r m k+  = Ask (r -> m k)+  | forall b . Local (r -> r) (m b) (b -> m k)++deriving instance Functor m => Functor (Reader r m)++instance HFunctor (Reader r) where+  hmap f (Ask k)       = Ask           (f . k)+  hmap f (Local g m k) = Local g (f m) (f . k)++instance Effect (Reader r) where+  thread ctx handler (Ask k)       = Ask                          (handler . (<$ ctx) . k)+  thread ctx handler (Local f m k) = Local f (handler (m <$ ctx)) (handler . fmap k)

@@ -1,131 +0,0 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}-module Control.Effect.Resource-( -- * Resource effect-  Resource(..)-, bracket-, bracketOnError-, finally-, onException-  -- * Resource carrier-, runResource-, ResourceC(..)-) where--import           Control.Applicative (Alternative(..))-import           Control.Effect.Carrier-import           Control.Effect.Reader-import qualified Control.Exception as Exc-import           Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import           Control.Monad.Fix-import           Control.Monad.IO.Class-import           Control.Monad.IO.Unlift-import           Control.Monad.Trans.Class--data Resource m k-  = forall resource any output . Resource (m resource) (resource -> m any) (resource -> m output) (output -> m k)-  | forall resource any output . OnError  (m resource) (resource -> m any) (resource -> m output) (output -> m k)--deriving instance Functor m => Functor (Resource m)--instance HFunctor Resource where-  hmap f (Resource acquire release use k) = Resource (f acquire) (f . release) (f . use) (f . k)-  hmap f (OnError acquire release use k)  = OnError  (f acquire) (f . release) (f . use) (f . k)--instance Effect Resource where-  handle state handler (Resource acquire release use k) = Resource (handler (acquire <$ state)) (handler . fmap release) (handler . fmap use) (handler . fmap k)-  handle state handler (OnError acquire release use k)  = OnError  (handler (acquire <$ state)) (handler . fmap release) (handler . fmap use) (handler . fmap k)---- | Provides a safe idiom to acquire and release resources safely.------ When acquiring and operating on a resource (such as opening and--- reading file handle with 'openFile' or writing to a blob of memory--- with 'malloc'), any exception thrown during the operation may mean--- that the resource is not properly released. @bracket acquire release op@--- ensures that @release@ is run on the value returned from @acquire@ even--- if @op@ throws an exception.------ 'bracket' is safe in the presence of asynchronous exceptions.-bracket :: (Member Resource sig, Carrier sig m)-        => m resource           -- ^ computation to run first ("acquire resource")-        -> (resource -> m any)  -- ^ computation to run last ("release resource")-        -> (resource -> m a)    -- ^ computation to run in-between-        -> m a-bracket acquire release use = send (Resource acquire release use pure)---- | Like 'bracket', but only performs the final action if there was an--- exception raised by the in-between computation.-bracketOnError :: (Member Resource sig, Carrier sig m)-               => m resource           -- ^ computation to run first ("acquire resource")-               -> (resource -> m any)  -- ^ computation to run last ("release resource")-               -> (resource -> m a)    -- ^ computation to run in-between-               -> m a-bracketOnError acquire release use = send (OnError acquire release use pure)---- | Like 'bracket', but for the simple case of one computation to run afterward.-finally :: (Member Resource sig, Carrier sig m)-        => m a -- ^ computation to run first-        -> m b -- ^ computation to run afterward (even if an exception was raised)-        -> m a-finally act end = bracket (pure ()) (const end) (const act)---- | Like 'bracketOnError', but for the simple case of one computation to run afterward.-onException :: (Member Resource sig, Carrier sig m)-        => m a -- ^ computation to run first-        -> m b -- ^ computation to run afterward if an exception was raised-        -> m a-onException act end = bracketOnError (pure ()) (const end) (const act)---- Not exposed due to its potential to silently drop effects (#180).-unliftResource :: (forall x . m x -> IO x) -- ^ "unlifting" function to run the carrier in 'IO'-            -> ResourceC m a-            -> m a-unliftResource handler = runReader (Handler handler) . runResourceC---- | Executes a 'Resource' effect. Because this runs using 'MonadUnliftIO',--- invocations of 'runResource' must happen at the "bottom" of a stack of--- effect invocations, i.e. before the use of any monads that lack such--- instances, such as 'StateC':------ @---   runM---   . runResource---   . runState @Int 1---   $ myComputation--- @-runResource :: MonadUnliftIO m-            => ResourceC m a-            -> m a-runResource r = withRunInIO (\f -> runHandler (Handler f) r)--newtype ResourceC m a = ResourceC { runResourceC :: ReaderC (Handler m) m a }-  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)--instance MonadUnliftIO m => MonadUnliftIO (ResourceC m) where-  askUnliftIO = ResourceC . ReaderC $ \(Handler h) ->-    withUnliftIO $ \u -> pure (UnliftIO $ \r -> unliftIO u (unliftResource h r))--instance MonadTrans ResourceC where-  lift = ResourceC . lift--newtype Handler m = Handler (forall x . m x -> IO x)--runHandler :: Handler m -> ResourceC m a -> IO a-runHandler h@(Handler handler) = handler . runReader h . runResourceC--instance (Carrier sig m, MonadIO m) => Carrier (Resource :+: sig) (ResourceC m) where-  eff (L (Resource acquire release use k)) = do-    handler <- ResourceC ask-    a <- liftIO (Exc.bracket-      (runHandler handler acquire)-      (runHandler handler . release)-      (runHandler handler . use))-    k a-  eff (L (OnError  acquire release use k)) = do-    handler <- ResourceC ask-    a <- liftIO (Exc.bracketOnError-      (runHandler handler acquire)-      (runHandler handler . release)-      (runHandler handler . use))-    k a-  eff (R other)                            = ResourceC (eff (R (handleCoercible other)))

@@ -1,138 +0,0 @@-{-# LANGUAGE DeriveFunctor, DerivingStrategies, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-}-module Control.Effect.Resumable-( -- * Resumable effect-  Resumable(..)-, throwResumable-, SomeError(..)-  -- * Resumable carriers-, runResumable-, ResumableC(..)-, runResumableWith-, ResumableWithC(..)-  -- * Re-exports-, Carrier-, Member-, run-) where--import Control.Applicative (Alternative(..))-import Control.DeepSeq-import Control.Effect.Carrier-import Control.Effect.Error-import Control.Effect.Reader-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Data.Functor.Classes---- | Errors which can be resumed with values of some existentially-quantified type.-data Resumable err m k-  = forall a . Resumable (err a) (a -> m k)--deriving instance Functor m => Functor (Resumable err m)--instance HFunctor (Resumable err) where-  hmap f (Resumable err k) = Resumable err (f . k)--instance Effect (Resumable err) where-  handle state handler (Resumable err k) = Resumable err (handler . (<$ state) . k)---- | Throw an error which can be resumed with a value of its result type.------   prop> run (runResumable (throwResumable (Identity a))) === Left (SomeError (Identity a))-throwResumable :: (Member (Resumable err) sig, Carrier sig m) => err a -> m a-throwResumable err = send (Resumable err pure)----- | An error at some existentially-quantified type index.-data SomeError err-  = forall a . SomeError (err a)---- | Equality for 'SomeError' is determined by an 'Eq1' instance for the error type.------   Note that since we can’t tell whether the type indices are equal, let alone what 'Eq' instance to use for them, the comparator passed to 'liftEq' always returns 'True'. Thus, 'SomeError' is best used with type-indexed GADTs for the error type.------   prop> SomeError (Identity a) === SomeError (Identity b)---   prop> (SomeError (Const a) === SomeError (Const b)) == (a == b)-instance Eq1 err => Eq (SomeError err) where-  SomeError exc1 == SomeError exc2 = liftEq (const (const True)) exc1 exc2---- | Ordering for 'SomeError' is determined by an 'Ord1' instance for the error type.------   Note that since we can’t tell whether the type indices are equal, let alone what 'Ord' instance to use for them, the comparator passed to 'liftCompare' always returns 'EQ'. Thus, 'SomeError' is best used with type-indexed GADTs for the error type.------   prop> (SomeError (Identity a) `compare` SomeError (Identity b)) === EQ---   prop> (SomeError (Const a) `compare` SomeError (Const b)) === (a `compare` b)-instance Ord1 err => Ord (SomeError err) where-  SomeError exc1 `compare` SomeError exc2 = liftCompare (const (const EQ)) exc1 exc2---- | Showing for 'SomeError' is determined by a 'Show1' instance for the error type.------   Note that since we can’t tell what 'Show' instance to use for the type index, the functions passed to 'liftShowsPrec' always return the empty 'ShowS'. Thus, 'SomeError' is best used with type-indexed GADTs for the error type.------   prop> show (SomeError (Identity a)) === "SomeError (Identity )"---   prop> show (SomeError (Const a)) === ("SomeError (Const " ++ showsPrec 11 a ")")-instance Show1 err => Show (SomeError err) where-  showsPrec d (SomeError err) = showsUnaryWith (liftShowsPrec (const (const id)) (const id)) "SomeError" d err----- | Evaluation of 'SomeError' to normal forms is determined by a 'NFData1' instance for the error type.------   prop> pure (rnf (SomeError (Identity (error "error"))) :: SomeError Identity) `shouldThrow` errorCall "error"-instance NFData1 err => NFData (SomeError err) where-  rnf (SomeError err) = liftRnf (\a -> seq a ()) err----- | Run a 'Resumable' effect, returning uncaught errors in 'Left' and successful computations’ values in 'Right'.------   prop> run (runResumable (pure a)) === Right @(SomeError Identity) @Int a-runResumable :: ResumableC err m a -> m (Either (SomeError err) a)-runResumable = runError . runResumableC--newtype ResumableC err m a = ResumableC { runResumableC :: ErrorC (SomeError err) m a }-  deriving newtype (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)--instance (Carrier sig m, Effect sig) => Carrier (Resumable err :+: sig) (ResumableC err m) where-  eff (L (Resumable err _)) = ResumableC (throwError (SomeError err))-  eff (R other)             = ResumableC (eff (R (handleCoercible other)))-  {-# INLINE eff #-}----- | Run a 'Resumable' effect, resuming uncaught errors with a given handler.------   Note that this may be less efficient than defining a specialized carrier type and instance specifying the handler’s behaviour directly. Performance-critical code may wish to do that to maximize the opportunities for fusion and inlining.------   >>> data Err a where Err :: Int -> Err Int------   prop> run (runResumableWith (\ (Err b) -> pure (1 + b)) (pure a)) === a---   prop> run (runResumableWith (\ (Err b) -> pure (1 + b)) (throwResumable (Err a))) === 1 + a-runResumableWith :: (forall x . err x -> m x)-                 -> ResumableWithC err m a-                 -> m a-runResumableWith with = runReader (Handler with) . runResumableWithC--newtype ResumableWithC err m a = ResumableWithC { runResumableWithC :: ReaderC (Handler err m) m a }-  deriving newtype (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)--instance MonadTrans (ResumableWithC err) where-  lift = ResumableWithC . lift-  {-# INLINE lift #-}--newtype Handler err m = Handler { runHandler :: forall x . err x -> m x }--instance Carrier sig m => Carrier (Resumable err :+: sig) (ResumableWithC err m) where-  eff (L (Resumable err k)) = ResumableWithC (ReaderC (\ handler -> runHandler handler err)) >>= k-  eff (R other)             = ResumableWithC (eff (R (handleCoercible other)))-  {-# INLINE eff #-}----- $setup--- >>> :seti -XFlexibleContexts--- >>> :seti -XGADTs--- >>> :seti -XTypeApplications--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure--- >>> import Data.Functor.Const--- >>> import Data.Functor.Identity

@@ -1,5 +1,91 @@+{- | An effect that adds a mutable, updatable state value to a given computation.++Not all computations require a full-fledged state effect: read-only state is better served by 'Control.Effect.Reader.Reader', and append-only state without reads is better served by 'Control.Effect.Writer.Writer'.++Predefined carriers:++* "Control.Carrier.State.Strict", which is strict in its updates.+* "Control.Carrier.State.Lazy", which is lazy in its updates. This enables more programs to terminate, such as cyclic computations expressed with @MonadFix@ or @-XRecursiveDo@, at the cost of efficiency.+* "Control.Monad.Trans.RWS.Lazy"+* "Control.Monad.Trans.RWS.Strict"+* "Control.Monad.Trans.State.Lazy"+* "Control.Monad.Trans.State.Strict"++@since 0.1.0.0+-}+ module Control.Effect.State-( module Control.Effect.State.Strict+( -- * State effect+  State(..)+, get+, gets+, put+, modify+, modifyLazy+  -- * Re-exports+, Algebra+, Has+, run ) where -import Control.Effect.State.Strict+import Control.Algebra+import Control.Effect.State.Internal (State(..))++-- | Get the current state value.+--+-- @+-- runState a ('get' '>>=' k) = runState a (k a)+-- @+--+-- @since 0.1.0.0+get :: Has (State s) sig m => m s+get = send (Get pure)+{-# INLINEABLE get #-}++-- | Project a function out of the current state value.+--+-- @+-- 'gets' f = 'fmap' f 'get'+-- @+--+-- @since 0.1.0.0+gets :: Has (State s) sig m => (s -> a) -> m a+gets f = send (Get (pure . f))+{-# INLINEABLE gets #-}++-- | Replace the state value with a new value.+--+-- @+-- runState a ('put' b '>>' m) = runState b m+-- @+--+-- @since 0.1.0.0+put :: Has (State s) sig m => s -> m ()+put s = send (Put s (pure ()))+{-# INLINEABLE put #-}++-- | Replace the state value with the result of applying a function to the current state value.+--   This is strict in the new state.+--+-- @+-- 'modify' f = 'get' '>>=' ('put' . f '$!')+-- @+--+-- @since 0.1.0.0+modify :: Has (State s) sig m => (s -> s) -> m ()+modify f = do+  a <- get+  put $! f a+{-# INLINEABLE modify #-}++-- | Replace the state value with the result of applying a function to the current state value.+--   This is lazy in the new state; injudicious use of this function may lead to space leaks.+--+-- @+-- 'modifyLazy' f = 'get' '>>=' 'put' . f+-- @+--+-- @since 0.3.0.0+modifyLazy :: Has (State s) sig m => (s -> s) -> m ()+modifyLazy f = get >>= put . f+{-# INLINEABLE modifyLazy #-}

@@ -1,67 +1,16 @@-{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, ExplicitForAll, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor, DeriveGeneric #-} module Control.Effect.State.Internal-( -- * State effect-  State(..)-, get-, gets-, put-, modify-, modifyLazy-  -- * Re-exports-, Member+( State(..) ) where -import Control.Effect.Carrier+import Control.Effect.Class import GHC.Generics (Generic1)-import Prelude hiding (fail) +-- | @since 0.1.0.0 data State s m k   = Get (s -> m k)   | Put s (m k)-  deriving stock (Functor, Generic1)-  deriving anyclass (HFunctor, Effect)---- | Get the current state value.------   prop> snd (run (runState a get)) === a-get :: (Member (State s) sig, Carrier sig m) => m s-get = send (Get pure)-{-# INLINEABLE get #-}---- | Project a function out of the current state value.------   prop> snd (run (runState a (gets (applyFun f)))) === applyFun f a-gets :: (Member (State s) sig, Carrier sig m) => (s -> a) -> m a-gets f = send (Get (pure . f))-{-# INLINEABLE gets #-}---- | Replace the state value with a new value.------   prop> fst (run (runState a (put b))) === b---   prop> snd (run (runState a (get <* put b))) === a---   prop> snd (run (runState a (put b *> get))) === b-put :: (Member (State s) sig, Carrier sig m) => s -> m ()-put s = send (Put s (pure ()))-{-# INLINEABLE put #-}---- | Replace the state value with the result of applying a function to the current state value.---   This is strict in the new state.------   prop> fst (run (runState a (modify (+1)))) === (1 + a :: Integer)-modify :: (Member (State s) sig, Carrier sig m) => (s -> s) -> m ()-modify f = do-  a <- get-  put $! f a-{-# INLINEABLE modify #-}---- | Replace the state value with the result of applying a function to the current state value.---   This is lazy in the new state; injudicious use of this function may lead to space leaks.-modifyLazy :: (Member (State s) sig, Carrier sig m) => (s -> s) -> m ()-modifyLazy f = get >>= put . f-{-# INLINEABLE modifyLazy #-}+  deriving (Functor, Generic1) --- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure--- >>> import Control.Effect.State.Strict+instance HFunctor (State s)+instance Effect   (State s)

@@ -1,104 +0,0 @@-{-# LANGUAGE DeriveFunctor, ExplicitForAll, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}-module Control.Effect.State.Lazy-( -- * State effect-  module State-  -- * Lazy state carrier-, runState-, evalState-, execState-, StateC(..)-  -- * Re-exports-, Carrier-, run-) where--import Control.Applicative (Alternative(..))-import Control.Effect.Carrier-import Control.Effect.State.Internal as State-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class--newtype StateC s m a = StateC { runStateC :: s -> m (s, a) }--instance Functor m => Functor (StateC s m) where-  fmap f m = StateC $ \ s -> fmap (\ ~(s', a) -> (s', f a)) $ runStateC m s-  {-# INLINE fmap #-}--instance (Functor m, Monad m) => Applicative (StateC s m) where-  pure a = StateC $ \ s -> pure (s, a)-  {-# INLINE pure #-}-  StateC mf <*> StateC mx = StateC $ \ s -> do-    ~(s', f) <- mf s-    ~(s'', x) <- mx s'-    return (s'', f x)-  {-# INLINE (<*>) #-}-  m *> k = m >>= \_ -> k-  {-# INLINE (*>) #-}--instance Monad m => Monad (StateC s m) where-  m >>= k  = StateC $ \ s -> do-    ~(s', a) <- runStateC m s-    runStateC (k a) s'-  {-# INLINE (>>=) #-}--instance (Alternative m, Monad m) => Alternative (StateC s m) where-  empty = StateC (const empty)-  {-# INLINE empty #-}-  StateC l <|> StateC r = StateC (\ s -> l s <|> r s)-  {-# INLINE (<|>) #-}--instance Fail.MonadFail m => Fail.MonadFail (StateC s m) where-  fail s = StateC (const (Fail.fail s))-  {-# INLINE fail #-}--instance MonadFix m => MonadFix (StateC s m) where-  mfix f = StateC (\ s -> mfix (runState s . f . snd))-  {-# INLINE mfix #-}--instance MonadIO m => MonadIO (StateC s m) where-  liftIO io = StateC (\ s -> (,) s <$> liftIO io)-  {-# INLINE liftIO #-}--instance (Alternative m, Monad m) => MonadPlus (StateC s m)--instance MonadTrans (StateC s) where-  lift m = StateC (\ s -> (,) s <$> m)-  {-# INLINE lift #-}--instance (Carrier sig m, Effect sig) => Carrier (State s :+: sig) (StateC s m) where-  eff (L (Get   k)) = StateC (\ s -> runState s (k s))-  eff (L (Put s k)) = StateC (\ _ -> runState s k)-  eff (R other)     = StateC (\ s -> eff (handle (s, ()) (uncurry runState) other))-  {-# INLINE eff #-}---- | Run a lazy 'State' effect, yielding the result value and the final state.---   More programs terminate with lazy state than strict state, but injudicious---   use of lazy state may lead to thunk buildup.------   prop> run (runState a (pure b)) === (a, b)---   prop> take 5 . snd . run $ runState () (traverse pure [1..]) === [1,2,3,4,5]-runState :: s -> StateC s m a -> m (s, a)-runState s c = runStateC c s-{-# INLINE[3] runState #-}---- | Run a lazy 'State' effect, yielding the result value and discarding the final state.------   prop> run (evalState a (pure b)) === b-evalState :: forall s m a . Functor m => s -> StateC s m a -> m a-evalState s = fmap snd . runState s-{-# INLINE[3] evalState #-}---- | Run a lazy 'State' effect, yielding the final state and discarding the return value.------   prop> run (execState a (pure b)) === a-execState :: forall s m a . Functor m => s -> StateC s m a -> m s-execState s = fmap fst . runState s-{-# INLINE[3] execState #-}---- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure

@@ -1,102 +0,0 @@-{-# LANGUAGE DeriveFunctor, ExplicitForAll, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}-module Control.Effect.State.Strict-( -- * State effect-  module State-  -- * Strict state carrier-, runState-, evalState-, execState-, StateC(..)-  -- * Re-exports-, Carrier-, run-) where--import Control.Applicative (Alternative(..))-import Control.Effect.Carrier-import Control.Effect.State.Internal as State-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class---- | Run a 'State' effect starting from the passed value.------   prop> run (runState a (pure b)) === (a, b)-runState :: s -> StateC s m a -> m (s, a)-runState s x = runStateC x s-{-# INLINE[3] runState #-}---- | Run a 'State' effect, yielding the result value and discarding the final state.------   prop> run (evalState a (pure b)) === b-evalState :: forall s m a . Functor m => s -> StateC s m a -> m a-evalState s = fmap snd . runState s-{-# INLINE[3] evalState #-}---- | Run a 'State' effect, yielding the final state and discarding the return value.------   prop> run (execState a (pure b)) === a-execState :: forall s m a . Functor m => s -> StateC s m a -> m s-execState s = fmap fst . runState s-{-# INLINE[3] execState #-}---newtype StateC s m a = StateC { runStateC :: s -> m (s, a) }-  deriving (Functor)--instance Monad m => Applicative (StateC s m) where-  pure a = StateC (\ s -> pure (s, a))-  {-# INLINE pure #-}-  StateC f <*> StateC a = StateC $ \ s -> do-    (s', f') <- f s-    (s'', a') <- a s'-    let fa = f' a'-    fa `seq` pure (s'', fa)-  {-# INLINE (<*>) #-}-  m *> k = m >>= \_ -> k-  {-# INLINE (*>) #-}--instance (Alternative m, Monad m) => Alternative (StateC s m) where-  empty = StateC (const empty)-  {-# INLINE empty #-}-  StateC l <|> StateC r = StateC (\ s -> l s <|> r s)-  {-# INLINE (<|>) #-}--instance Monad m => Monad (StateC s m) where-  StateC m >>= f = StateC $ \ s -> do-    (s', a) <- m s-    let fa = f a-    fa `seq` runState s' fa-  {-# INLINE (>>=) #-}--instance Fail.MonadFail m => Fail.MonadFail (StateC s m) where-  fail s = StateC (const (Fail.fail s))-  {-# INLINE fail #-}--instance MonadFix m => MonadFix (StateC s m) where-  mfix f = StateC (\ s -> mfix (runState s . f . snd))-  {-# INLINE mfix #-}--instance MonadIO m => MonadIO (StateC s m) where-  liftIO io = StateC (\ s -> (,) s <$> liftIO io)-  {-# INLINE liftIO #-}--instance (Alternative m, Monad m) => MonadPlus (StateC s m)--instance MonadTrans (StateC s) where-  lift m = StateC (\ s -> (,) s <$> m)-  {-# INLINE lift #-}--instance (Carrier sig m, Effect sig) => Carrier (State s :+: sig) (StateC s m) where-  eff (L (Get   k)) = StateC (\ s -> runState s (k s))-  eff (L (Put s k)) = StateC (\ _ -> runState s k)-  eff (R other)     = StateC (\ s -> eff (handle (s, ()) (uncurry runState) other))-  {-# INLINE eff #-}----- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure

@@ -1,11 +1,21 @@-{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleInstances, KindSignatures, MultiParamTypeClasses, TypeOperators #-}+{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleInstances, KindSignatures, MultiParamTypeClasses, TypeFamilies, TypeOperators, UndecidableInstances #-}++-- | Operations on /sums/, combining effects into a /signature/.+--+-- @since 0.1.0.0 module Control.Effect.Sum-( (:+:)(..)-, Member(..)+( -- * Membership+  Member(..)+, Members+  -- * Sums+, (:+:)(..) ) where +import Control.Effect.Class+import Data.Kind (Constraint) 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)@@ -13,20 +23,51 @@  infixr 4 :+: +instance (HFunctor f, HFunctor g) => HFunctor (f :+: g)+instance (Effect f, Effect g)     => Effect   (f :+: g)+++-- | 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.+--+-- @since 0.1.0.0 class Member (sub :: (* -> *) -> (* -> *)) sup where+  -- | Inject a member of a signature into the signature.   inj :: sub m a -> sup m a-  prj :: sup m a -> Maybe (sub m a) -instance Member sub sub where+-- | Reflexivity: @t@ is a member of itself.+instance Member t t where   inj = id-  prj = Just -instance {-# OVERLAPPABLE #-} Member sub (sub :+: sup) where-  inj = L . inj-  prj (L f) = Just f-  prj _     = Nothing+-- | 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 #-}+         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 -instance {-# OVERLAPPABLE #-} Member sub sup => Member sub (sub' :+: sup) where+-- | Left-occurrence: if @t@ is at the head of a signature, we can inject it in O(1).+instance {-# OVERLAPPABLE #-}+         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 #-}+         Member l r+      => Member l (l' :+: r) where   inj = R . inj-  prj (R g) = prj g-  prj _     = Nothing+++-- | Decompose sums on the left into multiple 'Member' constraints.+--+-- Note that while this, and by extension 'Control.Algebra.Has', can be used to group together multiple membership checks into a single (composite) constraint, large signatures on the left can slow compiles down due to [a problem with recursive type families](https://gitlab.haskell.org/ghc/ghc/issues/8095).+--+-- @since 1.0.0.0+type family Members sub sup :: Constraint where+  Members (l :+: r) u = (Members l u, Members r u)+  Members t         u = Member t u

@@ -0,0 +1,27 @@+{- | An effect for polymorphic failure.++Predefined carriers:++* "Control.Carrier.Throw.Either"+* "Control.Carrier.Error.Either" (with 'Control.Effect.Catch.Catch')++@since 1.0.0.0+-}+module Control.Effect.Throw+( -- * Throw effect+  Throw(..)+, throwError+  -- * Re-exports+, Algebra+, Has+, run+) where++import Control.Algebra+import Control.Effect.Throw.Internal (Throw(..))++-- | Throw an error, escaping the current computation up to the nearest 'Control.Effect.Catch.catchError' (if any).+--+-- @since 0.1.0.0+throwError :: Has (Throw e) sig m => e -> m a+throwError = send . Throw

@@ -0,0 +1,15 @@+{-# LANGUAGE DeriveFunctor, DeriveGeneric, KindSignatures #-}+module Control.Effect.Throw.Internal+( Throw(..)+) where++import Control.Effect.Class+import GHC.Generics (Generic1)++-- | @since 1.0.0.0+data Throw e (m :: * -> *) k+  = Throw e+  deriving (Functor, Generic1)++instance HFunctor (Throw e)+instance Effect   (Throw e)

@@ -1,96 +1,41 @@-{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}++{- | An effect that provides a record of 'String' values ("traces") aggregate during the execution of a given computation.++Predefined carriers:++* "Control.Carrier.Trace.Printing", which logs to stderr in a 'Control.Monad.IO.Class.MonadIO' context.+* "Control.Carrier.Trace.Returning", which aggregates all traces in a @[String].+* "Control.Carrier.Trace.Ignoring", which discards all traced values.++@since 0.1.0.0+-}+ module Control.Effect.Trace ( -- * Trace effect   Trace(..) , trace-  -- * Trace carriers-, runTraceByPrinting-, TraceByPrintingC(..)-, runTraceByIgnoring-, TraceByIgnoringC(..)-, runTraceByReturning-, TraceByReturningC(..)   -- * Re-exports-, Carrier-, Member+, Algebra+, Has , run ) where -import Control.Applicative (Alternative(..))-import Control.Effect.Carrier-import Control.Effect.State-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Data.Bifunctor (first)+import Control.Algebra import GHC.Generics (Generic1)-import System.IO +-- | @since 0.1.0.0 data Trace m k = Trace   { traceMessage :: String   , traceCont    :: m k   }-  deriving stock (Functor, Generic1)-  deriving anyclass (HFunctor, Effect)---- | Append a message to the trace log.-trace :: (Member Trace sig, Carrier sig m) => String -> m ()-trace message = send (Trace message (pure ()))----- | Run a 'Trace' effect, printing traces to 'stderr'.-runTraceByPrinting :: TraceByPrintingC m a -> m a-runTraceByPrinting = runTraceByPrintingC--newtype TraceByPrintingC m a = TraceByPrintingC { runTraceByPrintingC :: m a }-  deriving newtype (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)--instance MonadTrans TraceByPrintingC where-  lift = TraceByPrintingC-  {-# INLINE lift #-}--instance (MonadIO m, Carrier sig m) => Carrier (Trace :+: sig) (TraceByPrintingC m) where-  eff (L (Trace s k)) = liftIO (hPutStrLn stderr s) *> k-  eff (R other)       = TraceByPrintingC (eff (handleCoercible other))-  {-# INLINE eff #-}----- | Run a 'Trace' effect, ignoring all traces.------   prop> run (runTraceByIgnoring (trace a *> pure b)) === b-runTraceByIgnoring :: TraceByIgnoringC m a -> m a-runTraceByIgnoring = runTraceByIgnoringC--newtype TraceByIgnoringC m a = TraceByIgnoringC { runTraceByIgnoringC :: m a }-  deriving newtype (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)--instance MonadTrans TraceByIgnoringC where-  lift = TraceByIgnoringC-  {-# INLINE lift #-}--instance Carrier sig m => Carrier (Trace :+: sig) (TraceByIgnoringC m) where-  eff (L trace) = traceCont trace-  eff (R other) = TraceByIgnoringC (eff (handleCoercible other))-  {-# INLINE eff #-}+  deriving (Functor, Generic1) +instance HFunctor Trace+instance Effect   Trace --- | Run a 'Trace' effect, returning all traces as a list.+-- | Append a message to the trace log. -----   prop> run (runTraceByReturning (trace a *> trace b *> pure c)) === ([a, b], c)-runTraceByReturning :: Functor m => TraceByReturningC m a -> m ([String], a)-runTraceByReturning = fmap (first reverse) . runState [] . runTraceByReturningC--newtype TraceByReturningC m a = TraceByReturningC { runTraceByReturningC :: StateC [String] m a }-  deriving newtype (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)--instance (Carrier sig m, Effect sig) => Carrier (Trace :+: sig) (TraceByReturningC m) where-  eff (L (Trace m k)) = TraceByReturningC (modify (m :)) *> k-  eff (R other)       = TraceByReturningC (eff (R (handleCoercible other)))----- $setup--- >>> :seti -XFlexibleContexts--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure+-- @since 0.1.0.0+trace :: Has Trace sig m => String -> m ()+trace message = send (Trace message (pure ()))

@@ -1,4 +1,19 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, RankNTypes, StandaloneDeriving #-}++{- | An effect allowing writes to an accumulated quantity alongside a computed value. A 'Writer' @w@ effect keeps track of a monoidal datum of type @w@ and strictly appends to that monoidal value with the 'tell' effect. Writes to that value can be detected and intercepted with the 'listen' and 'censor' effects.++Predefined carriers:++* "Control.Carrier.Writer.Strict". (A lazy carrier is not provided due to the inherent space leaks associated with lazy writer monads.)+* "Control.Monad.Trans.RWS.Lazy"+* "Control.Monad.Trans.RWS.Strict"+* "Control.Monad.Trans.Writer.Lazy"+* "Control.Monad.Trans.Writer.Strict"+* If 'Writer' @w@ is the last effect in a stack, it can be interpreted to a tuple @(w, a)@ given some result type @a@ and the presence of a 'Monoid' instance for @w@.++@since 0.1.0.0+-}+ module Control.Effect.Writer ( -- * Writer effect   Writer(..)@@ -6,119 +21,55 @@ , listen , listens , censor-  -- * Writer carrier-, runWriter-, execWriter-, WriterC(..)   -- * Re-exports-, Carrier-, Member+, Algebra+, Has , run ) where -import Control.Applicative (Alternative(..))-import Control.Effect.Carrier-import Control.Effect.State-import Control.Monad (MonadPlus(..))-import qualified Control.Monad.Fail as Fail-import Control.Monad.Fix-import Control.Monad.IO.Class-import Control.Monad.Trans.Class--data Writer w m k-  = Tell w (m k)-  | forall a . Listen (m a) (w -> a -> m k)-  | forall a . Censor (w -> w) (m a) (a -> m k)--deriving instance Functor m => Functor (Writer w m)--instance HFunctor (Writer w) where-  hmap f (Tell w     k) = Tell w         (f       k)-  hmap f (Listen   m k) = Listen   (f m) ((f .) . k)-  hmap f (Censor g m k) = Censor g (f m) (f     . k)-  {-# INLINE hmap #-}--instance Effect (Writer w) where-  handle state handler (Tell w     k) = Tell w                          (handler (k <$ state))-  handle state handler (Listen   m k) = Listen   (handler (m <$ state)) (fmap handler . fmap . k)-  handle state handler (Censor f m k) = Censor f (handler (m <$ state)) (handler . fmap k)-  {-# INLINE handle #-}+import Control.Algebra+import Control.Effect.Writer.Internal (Writer(..))  -- | Write a value to the log. -----   prop> fst (run (runWriter (mapM_ (tell . Sum) (0 : ws)))) === foldMap Sum ws-tell :: (Member (Writer w) sig, Carrier sig m) => w -> m ()+-- @+-- runWriter ('tell' w '>>' m) = 'Data.Bifunctor.first' ('mappend' w) '<$>' runWriter m+-- @+--+-- @since 0.1.0.0+tell :: Has (Writer w) sig m => w -> m () tell w = send (Tell w (pure ())) {-# INLINE tell #-}  -- | Run a computation, returning the pair of its output and its result. -----   prop> run (runWriter (fst <$ tell (Sum a) <*> listen @(Sum Integer) (tell (Sum b)))) === (Sum a <> Sum b, Sum b)-listen :: (Member (Writer w) sig, Carrier sig m) => m a -> m (w, a)+-- @+-- runWriter ('listen' m) = 'fmap' ('fst' 'Control.Arrow.&&&' 'id') (runWriter m)+-- @+--+-- @since 0.2.0.0+listen :: Has (Writer w) sig m => m a -> m (w, a) listen m = send (Listen m (curry pure)) {-# INLINE listen #-}  -- | Run a computation, applying a function to its output and returning the pair of the modified output and its result. -----   prop> run (runWriter (fst <$ tell (Sum a) <*> listens @(Sum Integer) (applyFun f) (tell (Sum b)))) === (Sum a <> Sum b, applyFun f (Sum b))-listens :: (Member (Writer w) sig, Carrier sig m) => (w -> b) -> m a -> m (b, a)+-- @+-- 'listens' f m = 'fmap' ('Data.Bifunctor.first' f) ('listen' m)+-- @+--+-- @since 0.2.0.0+listens :: Has (Writer w) sig m => (w -> b) -> m a -> m (b, a) listens f m = send (Listen m (curry pure . f)) {-# INLINE listens #-}  -- | Run a computation, modifying its output with the passed function. -----   prop> run (execWriter (censor (applyFun f) (tell (Sum a)))) === applyFun f (Sum a)---   prop> run (execWriter (tell (Sum a) *> censor (applyFun f) (tell (Sum b)) *> tell (Sum c))) === (Sum a <> applyFun f (Sum b) <> Sum c)-censor :: (Member (Writer w) sig, Carrier sig m) => (w -> w) -> m a -> m a+-- @+-- runWriter ('censor' f m) = 'fmap' ('Data.Bifunctor.first' f) (runWriter m)+-- @+--+-- @since 0.2.0.0+censor :: Has (Writer w) sig m => (w -> w) -> m a -> m a censor f m = send (Censor f m pure) {-# INLINE censor #-}----- | Run a 'Writer' effect with a 'Monoid'al log, producing the final log alongside the result value.------   prop> run (runWriter (tell (Sum a) *> pure b)) === (Sum a, b)-runWriter :: Monoid w => WriterC w m a -> m (w, a)-runWriter = runState mempty . runWriterC-{-# INLINE runWriter #-}---- | Run a 'Writer' effect with a 'Monoid'al log, producing the final log and discarding the result value.------   prop> run (execWriter (tell (Sum a) *> pure b)) === Sum a-execWriter :: (Monoid w, Functor m) => WriterC w m a -> m w-execWriter = fmap fst . runWriter-{-# INLINE execWriter #-}----- | A space-efficient carrier for 'Writer' effects.------   This is based on a post Gabriel Gonzalez made to the Haskell mailing list: https://mail.haskell.org/pipermail/libraries/2013-March/019528.html-newtype WriterC w m a = WriterC { runWriterC :: StateC w m a }-  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)--instance (Monoid w, Carrier sig m, Effect sig) => Carrier (Writer w :+: sig) (WriterC w m) where-  eff (L (Tell w     k)) = WriterC $ do-    modify (`mappend` w)-    runWriterC k-  eff (L (Listen   m k)) = WriterC $ do-    w <- get-    put (mempty :: w)-    a <- runWriterC m-    w' <- get-    modify (mappend (w :: w))-    runWriterC (k w' a)-  eff (L (Censor f m k)) = WriterC $ do-    w <- get-    put (mempty :: w)-    a <- runWriterC m-    modify (mappend w . f)-    runWriterC (k a)-  eff (R other)          = WriterC (eff (R (handleCoercible other)))-  {-# INLINE eff #-}----- $setup--- >>> :seti -XFlexibleContexts--- >>> :seti -XTypeApplications--- >>> import Test.QuickCheck--- >>> import Control.Effect.Pure--- >>> import Data.Semigroup (Semigroup(..), Sum(..))

@@ -0,0 +1,26 @@+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}+module Control.Effect.Writer.Internal+( Writer(..)+) where++import Control.Effect.Class++-- | @since 0.1.0.0+data Writer w m k+  = Tell w (m k)+  | forall a . Listen (m a) (w -> a -> m k)+  | forall a . Censor (w -> w) (m a) (a -> m k)++deriving instance Functor m => Functor (Writer w m)++instance HFunctor (Writer w) where+  hmap f (Tell w     k) = Tell w         (f       k)+  hmap f (Listen   m k) = Listen   (f m) ((f .) . k)+  hmap f (Censor g m k) = Censor g (f m) (f     . k)+  {-# INLINE hmap #-}++instance Effect (Writer w) where+  thread ctx handler (Tell w     k) = Tell w                        (handler (k <$ ctx))+  thread ctx handler (Listen   m k) = Listen   (handler (m <$ ctx)) (fmap handler . fmap . k)+  thread ctx handler (Censor f m k) = Censor f (handler (m <$ ctx)) (handler . fmap k)+  {-# INLINE thread #-}

@@ -0,0 +1,40 @@+{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeApplications #-}+module Catch+( tests+, genN+, test+) where++import Control.Effect.Error+import Gen+import Test.Tasty+import Test.Tasty.Hedgehog++tests :: TestTree+tests = testGroup "Catch"+  []+++genN+  :: forall e m a sig+  .  (Has (Catch e) sig m, Arg e, Show e, Vary e)+  => GenTerm e+  -> GenM m+  -> GenTerm a+  -> [GenTerm (m a)]+genN _ m a = [ addLabel "catchError" $ subtermM (m a) (\ m' -> infixL 9 "`catchError`" catchError <*> m' <*> fn @e (m a)) ]+++test+  :: (Has (Error e) sig m, Arg e, Eq a, Eq e, Show a, Show e, Vary e, Functor f)+  => GenTerm e+  -> GenM m+  -> GenTerm a+  -> GenTerm b+  -> GenTerm (f ())+  -> Run f (Either e) m+  -> [TestTree]+test e m a _ i (Run runCatch) =+  [ testProperty "catchError intercepts throwError" . forall (i :. e :. fn (m a) :. Nil) $+    \ i e h -> runCatch ((throwError e `catchError` h) <$ i) === runCatch (h e <$ i)+  ]