bluefin-algae 0.1.0.1 → 0.1.0.2

raw patch · 16 files changed

+2039/−2028 lines, 16 filesdep ~basedep ~bluefindep ~bluefin-internalPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, bluefin, bluefin-internal

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−9
• LICENSE +20/−20
• README.md +202/−200
• bench/quadratic-counter.hs +50/−50
• bluefin-algae.cabal +74/−74
• src/Bluefin/Algae.hs +183/−182
• src/Bluefin/Algae/Coroutine.hs +467/−467
• src/Bluefin/Algae/DelCont.hs +187/−186
• src/Bluefin/Algae/DynExn.hs +87/−86
• src/Bluefin/Algae/Exception.hs +102/−102
• src/Bluefin/Algae/Exception/DynExn.hs +45/−45
• src/Bluefin/Algae/NonDeterminism.hs +95/−95
• src/Bluefin/Algae/Reader.hs +39/−39
• src/Bluefin/Algae/State.hs +100/−100
• src/Bluefin/Exception/Dynamic.hs +86/−85
• test/Main.hs +288/−288

@@ -1,9 +1,14 @@-# Revision history for bluefin-algae--## 0.1.0.1 -- 2024-05-04--- Include `README.md` in the cabal distribution.--## 0.1.0.0 -- 2024-05-04--- First version. Released on an unsuspecting world.+# Revision history for bluefin-algae
+
+## 0.1.0.2 -- 2025-09-15
+
+- Compatibility with GHC 9.12:
+  + Enable `DataKinds` to silence warnings
+
+## 0.1.0.1 -- 2024-05-04
+
+- Include `README.md` in the cabal distribution.
+
+## 0.1.0.0 -- 2024-05-04
+
+- First version. Released on an unsuspecting world.

@@ -1,20 +1,20 @@-Copyright (c) 2024 Li-yao Xia--Permission is hereby granted, free of charge, to any person obtaining-a copy of this software and associated documentation files (the-"Software"), to deal in the Software without restriction, including-without limitation the rights to use, copy, modify, merge, publish,-distribute, sublicense, and/or sell copies of the Software, and to-permit persons to whom the Software is furnished to do so, subject to-the following conditions:--The above copyright notice and this permission notice shall be included-in all copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.-IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY-CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,-TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE-SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+Copyright (c) 2024 Li-yao Xia
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -1,200 +1,202 @@-Named algebraic effect handlers in Bluefin-==========================================--This package leverages the delimited continuations primitives added in-GHC 9.6 to implement algebraic effects in the Bluefin effect system.--Algebraic effects are a minimalistic basis for **user-defined effects**.-Using algebraic effects, we can reimplement, from scratch, effects that-were built-in the Bluefin library, and more.--This is an experimental project. There are surprising performance-characteristics which may be problematic for practical applications.-[Details down below.](#quadratic-behavior-of-non-tail-recursion)--## Free monads in `IO`--An algebraic effect library is basically a free monad library with support for-extensible effects.--Effect handlers---the core primitive of algebraic effects---are conceptually-folds of trees, aka.-[`iter` in free](https://hackage.haskell.org/package/free-5.2/docs/Control-Monad-Free.html)-or [`cata` in recursion-schemes](https://hackage.haskell.org/package/recursion-schemes-5.2.2.5/docs/Data-Functor-Foldable.html#v:cata).--Effect systems---such as Bluefin---enable combinations of effects within a-single parameterized monad. Bluefin Algae seamlessly integrates with Bluefin's-infrastructure in order to compose algebraic effects.--The main novelties in Bluefin Algae are:--- computations use the same representation as `IO` (`State# s -> (# State# s, a #)`)-  instead of recursive types or continuation-passing encodings.-  This is possible thanks to the recently available primitives for delimited-  continuations.--- thanks to Bluefin, effects are statically scoped: performing an operation-  requires a handle which identifies a specific handler.--  This enables new forms of abstraction boundaries.-  A function `Eff s a -> Eff s a` cannot handle the operations of its argument.-  The argument must be explicitly parameterized by the handler to allow-  handling by its caller: `(forall z. Handler f z -> Eff (z : s) a) -> Eff s a`.--## Highlights--### Concurrency--In the following example, two threads yield a string back and forth, appending-a suffix every time.--```haskell-import Bluefin.Algae.Coroutine--pingpong :: Eff ss String-pingpong = withCoroutine coThread mainThread-  where-    coThread z0 h = do-      z1 <- yield h (z0 ++ "pong")-      z2 <- yield h (z1 ++ "dong")-      yield h (z2 ++ "bong")-    mainThread h = do-      s1 <- yield h "ping"-      s2 <- yield h (s1 ++ "ding")-      s3 <- yield h (s2 ++ "bing")-      pure s3---- runPureEff pingpong == "pingpongdingdongbingbong"-```--Note that `coThread` and `mainThread` are just `IO` computations under the hood.-And we can interleave their executions without native multithreading. This is the-power of delimited continuations.--### Nondeterminism--With the ability to interrupt and resume operations freely, we can do-backtracking search in the `Eff` monad.--```haskell-import Bluefin.Algae.NonDeterminism as NonDet--pythagoras :: z :> zz => Handler Choice z -> Eff zz (Int, Int, Int)-pythagoras choice = do-  x <- pick choice [1 .. 10]-  y <- pick choice [1 .. 10]-  z <- pick choice [1 .. 10]-  assume choice (x .^ 2 + y .^ 2 == z .^ 2)-  pure (x, y, z)--  where (.^) = (Prelude.^) :: Int -> Int -> Int---- runPureEff (NonDet.toList pythagoras) == [(3,4,5),(4,3,5),(6,8,10),(8,6,10)]-```--#### Backtracking and state--Resuming continuations more than once exposes the impurity of the-implementation of the built-in state effect in `Bluefin.State`.-Here is a program using nondeterminism and state. There are two branches-(`choose`), both modify the state (`incr`).--```haskell-import qualified Bluefin.State as B--nsExampleB :: [Int]-nsExampleB = runPureEff $ NonDet.toList \choice ->-  snd <$> B.runState 0 \state -> do-    _ <- choose choice True False-    B.modify (+ 1) state---- nsExampleB == [1,2]-```--The state handler (`runState`) is under the nondeterminism handler-(`NonDet.toList`), which suggests a state-passing interpetation, where the-original state is restored upon backtracking (both branches return `1`):--```haskell-nsExamplePure :: [Int]-nsExamplePure = runPureEff $ NonDet.toList \choice ->-  let state = 0                          -- initial state-  _ <- choose choice True False-  let state' = state' + 1                -- modify' (+ 1)-  pure state'                            -- (snd <$> runState) returns the final state---- nsExamplePure == [1,1]-```--Because `Bluefin.State` is backed by `IORef`, the mutation persists-through backtracking (the second branch returns `2` in the first example).--In comparison, the state effect defined using algebraic effects-(`Bluefin.Algae.State`) has the state-passing semantics.--```haskell-import qualified Bluefin.Algae.State as A--nsExampleA :: [Int]-nsExampleA = runPureEff $ NonDet.toList \choice ->-  A.execState 0 \state -> do-    _ <- choose choice True False-    A.modify' (+ 1) state---- nsExampleA == [1,1]-```--### Truly scoped exceptions.--The scoped exceptions from `Bluefin.Exception` are not completely scoped because-they can be observed by `bracket`. That is probably the right behavior in practice,-but makes the semantics of Bluefin less clear. For the sake of science,-`Bluefin.Algae.Exception` provides truly scoped exceptions, and implements-"`bracket`-observable" scoped exceptions on top.--## Lowlights--### Quadratic behavior of non-tail recursion.--For example, the following recursive counter will take time quadratic in `n`-because every call of `modify'` traverses the call stack to find its handler-and capture the continuation.--```haskell-leftRecCounter :: z :> zz => Handler (State Int) z -> Int -> Eff zz ()-leftRecCounter _state 0 = pure ()-leftRecCounter state n = do-  leftRecCounter state (n - 1)-  modify' state (+ 1)-```--## Comparison--### Bluefin--The Bluefin effect system provides a well-scoped [handle pattern][handle].-Unlike algebraic effects with which other computational effects can be-user-defined, Bluefin provides a collection of built-in effects-(state, exceptions, coroutines).--Without delimited continuations, only tail-resumptive algebraic effect handlers-are expressible in Bluefin. Those are effect handlers restricted to the-following form, which is equivalent to type `forall r. f r -> Eff ss r`.--```haskell-(\e k -> _ >>= k)-  :: forall r. f r -> (r -> Eff ss a) -> Eff ss a-```--[handle]: https://jaspervdj.be/posts/2018-03-08-handle-pattern.html--## More reading--Named effect handlers are described in the literature in:--- [Binders by day, labels by night](https://maciejpirog.github.io/papers/binders-labels.pdf)-    by Dariusz Biernacki et al.-- [First-class names for effect handlers](https://www.microsoft.com/en-us/research/uploads/prod/2021/05/namedh-tr.pdf)-    by Ningning Xie et al. (impemented in the [Koka](https://koka-lang.github.io/koka/doc/index.html) language)-- [Effects, capabilities, and Boxes](https://dl.acm.org/doi/pdf/10.1145/3527320)-    by Jonathan Brachtäuser et al.+Named algebraic effect handlers in Bluefin
+==========================================
+
+[![Hackage](https://img.shields.io/hackage/v/bluefin-algae.svg)](https://hackage.haskell.org/package/bluefin-algae)
+
+This package leverages the delimited continuations primitives added in
+GHC 9.6 to implement algebraic effects in the Bluefin effect system.
+
+Algebraic effects are a minimalistic basis for **user-defined effects**.
+Using algebraic effects, we can reimplement, from scratch, effects that
+were built-in the Bluefin library, and more.
+
+This is an experimental project. There are surprising performance
+characteristics which may be problematic for practical applications.
+[Details down below.](#quadratic-behavior-of-non-tail-recursion)
+
+## Free monads in `IO`
+
+An algebraic effect library is basically a free monad library with support for
+extensible effects.
+
+Effect handlers—the core primitive of algebraic effects—are conceptually
+folds of trees, aka.
+[`iter` in free](https://hackage.haskell.org/package/free-5.2/docs/Control-Monad-Free.html)
+or [`cata` in recursion-schemes](https://hackage.haskell.org/package/recursion-schemes-5.2.2.5/docs/Data-Functor-Foldable.html#v:cata).
+
+Effect systems—such as Bluefin—enable combinations of effects within a
+single parameterized monad. Bluefin Algae seamlessly integrates with Bluefin's
+infrastructure in order to compose algebraic effects.
+
+The main novelties in Bluefin Algae are:
+
+- computations use the same representation as `IO` (`State# s -> (# State# s, a #)`)
+  instead of recursive types or continuation-passing encodings.
+  This is possible thanks to the recently available primitives for delimited
+  continuations.
+
+- thanks to Bluefin, effects are statically scoped: performing an operation
+  requires a handle which identifies a specific handler.
+
+  This enables new forms of abstraction boundaries.
+  A function `Eff s a -> Eff s a` cannot handle the operations of its argument.
+  The argument must be explicitly parameterized by the handler to allow
+  handling by its caller: `(forall z. Handler f z -> Eff (z : s) a) -> Eff s a`.
+
+## Highlights
+
+### Concurrency
+
+In the following example, two threads yield a string back and forth, appending
+a suffix every time.
+
+```haskell
+import Bluefin.Algae.Coroutine
+
+pingpong :: Eff ss String
+pingpong = withCoroutine coThread mainThread
+  where
+    coThread z0 h = do
+      z1 <- yield h (z0 ++ "pong")
+      z2 <- yield h (z1 ++ "dong")
+      yield h (z2 ++ "bong")
+    mainThread h = do
+      s1 <- yield h "ping"
+      s2 <- yield h (s1 ++ "ding")
+      s3 <- yield h (s2 ++ "bing")
+      pure s3
+
+-- runPureEff pingpong == "pingpongdingdongbingbong"
+```
+
+Note that `coThread` and `mainThread` are just `IO` computations under the hood.
+And we can interleave their executions without native multithreading. This is the
+power of delimited continuations.
+
+### Nondeterminism
+
+With the ability to interrupt and resume operations freely, we can do
+backtracking search in the `Eff` monad.
+
+```haskell
+import Bluefin.Algae.NonDeterminism as NonDet
+
+pythagoras :: z :> zz => Handler Choice z -> Eff zz (Int, Int, Int)
+pythagoras choice = do
+  x <- pick choice [1 .. 10]
+  y <- pick choice [1 .. 10]
+  z <- pick choice [1 .. 10]
+  assume choice (x .^ 2 + y .^ 2 == z .^ 2)
+  pure (x, y, z)
+
+  where (.^) = (Prelude.^) :: Int -> Int -> Int
+
+-- runPureEff (NonDet.toList pythagoras) == [(3,4,5),(4,3,5),(6,8,10),(8,6,10)]
+```
+
+#### Backtracking and state
+
+Resuming continuations more than once exposes the impurity of the
+implementation of the built-in state effect in `Bluefin.State`.
+Here is a program using nondeterminism and state. There are two branches
+(`choose`), both modify the state (`incr`).
+
+```haskell
+import qualified Bluefin.State as B
+
+nsExampleB :: [Int]
+nsExampleB = runPureEff $ NonDet.toList \choice ->
+  snd <$> B.runState 0 \state -> do
+    _ <- choose choice True False
+    B.modify (+ 1) state
+
+-- nsExampleB == [1,2]
+```
+
+The state handler (`runState`) is under the nondeterminism handler
+(`NonDet.toList`), which suggests a state-passing interpetation, where the
+original state is restored upon backtracking (both branches return `1`):
+
+```haskell
+nsExamplePure :: [Int]
+nsExamplePure = runPureEff $ NonDet.toList \choice ->
+  let state = 0                  -- initial state that was passed to runState
+  _ <- choose choice True False
+  let state' = state + 1         -- modify (+ 1)
+  pure state'                    -- (snd <$> runState) returns the final state
+
+-- nsExamplePure == [1,1]
+```
+
+Because `Bluefin.State` is backed by `IORef`, the mutation persists
+through backtracking (the second branch returns `2` in the first example).
+
+In comparison, the state effect defined using algebraic effects
+(`Bluefin.Algae.State`) has the state-passing semantics.
+
+```haskell
+import qualified Bluefin.Algae.State as A
+
+nsExampleA :: [Int]
+nsExampleA = runPureEff $ NonDet.toList \choice ->
+  A.execState 0 \state -> do
+    _ <- choose choice True False
+    A.modify (+ 1) state
+
+-- nsExampleA == [1,1]
+```
+
+### Truly scoped exceptions.
+
+The scoped exceptions from `Bluefin.Exception` are not completely scoped because
+they can be observed by `bracket`. That is probably the right behavior in practice,
+but makes the semantics of Bluefin less clear. For the sake of science,
+`Bluefin.Algae.Exception` provides truly scoped exceptions, and implements
+"`bracket`-observable" scoped exceptions on top.
+
+## Lowlights
+
+### Quadratic behavior of non-tail recursion.
+
+For example, the following recursive counter will take time quadratic in `n`
+because every call of `modify` traverses the call stack to find its handler
+and capture the continuation.
+
+```haskell
+leftRecCounter :: z :> zz => Handler (State Int) z -> Int -> Eff zz ()
+leftRecCounter _state 0 = pure ()
+leftRecCounter state n = do
+  leftRecCounter state (n - 1)
+  modify state (+ 1)
+```
+
+## Comparison
+
+### Bluefin
+
+The Bluefin effect system provides a well-scoped [handle pattern][handle].
+Unlike algebraic effects with which other computational effects can be
+user-defined, Bluefin provides a collection of built-in effects
+(state, exceptions, coroutines).
+
+Without delimited continuations, only tail-resumptive algebraic effect handlers
+are expressible in Bluefin. Those are effect handlers restricted to the
+following form, which is equivalent to type `forall r. f r -> Eff ss r`.
+
+```haskell
+(\e k -> _ >>= k)
+  :: forall r. f r -> (r -> Eff ss a) -> Eff ss a
+```
+
+[handle]: https://jaspervdj.be/posts/2018-03-08-handle-pattern.html
+
+## More reading
+
+Named effect handlers are described in the literature in:
+
+- [Binders by day, labels by night](https://maciejpirog.github.io/papers/binders-labels.pdf)
+    by Dariusz Biernacki et al.
+- [First-class names for effect handlers](https://www.microsoft.com/en-us/research/uploads/prod/2021/05/namedh-tr.pdf)
+    by Ningning Xie et al. (impemented in the [Koka](https://koka-lang.github.io/koka/doc/index.html) language)
+- [Effects, capabilities, and Boxes](https://dl.acm.org/doi/pdf/10.1145/3527320)
+    by Jonathan Brachtäuser et al.

@@ -1,50 +1,50 @@-{-# LANGUAGE-  BangPatterns,-  BlockArguments,-  RankNTypes,-  ScopedTypeVariables,-  TypeOperators #-}---- Algebraic operations require traversing the stack,--- which causes this quadratic behavior in left-recursive functions.--import Test.Tasty.Bench (Benchmark, Benchmarkable, bcompareWithin, bench, bgroup, defaultMain, nf)-import Bluefin.Eff (Eff, type (:>), runPureEff)-import Bluefin.Algae-import Bluefin.Algae.State---- Left recursive counter-leftRecCounter :: z :> zz => Handler (State Int) z -> Int -> Eff zz ()-leftRecCounter _state 0 = pure ()-leftRecCounter state n = do-  leftRecCounter state (n - 1)-  modify state (+ 1)---- Benchmarking harness---- @bcompareQuadratic name tolerance factor f@:--- Assert that @f factor@ runs @factor * factor@ times slower than @f 1@,--- within a relative tolerance interval @[1 - tolerance, 1 + tolerance]@.-bcompareQuadratic :: String -> Double -> Int -> (Int -> Benchmarkable) -> Benchmark-bcompareQuadratic = bcompareAsymptotic (\x -> x * x)---- Compare the benchmarks (f 1) and (f factor) with respect to a given growth function-bcompareAsymptotic :: (Double -> Double) -> String -> Double -> Int -> (Int -> Benchmarkable) -> Benchmark-bcompareAsymptotic growth name tolerance factor f = bgroup name-  [ bench "baseline" (f 1)-  , bcompareWithin lower upper (name ++ ".baseline") $-      bench ("x" ++ show factor) (f factor)-  ] where-    factor2 = growth (fromIntegral factor)-    lower = (1 - tolerance) * factor2-    upper = (1 + tolerance) * factor2--runQuadraticCounter :: Int -> Int-runQuadraticCounter n = runPureEff $ execState 0 \state -> leftRecCounter state n--testQuadraticCounter :: Benchmark-testQuadraticCounter = bcompareQuadratic "quadratic-counter" 0.2 10 (\factor ->-  nf runQuadraticCounter (100 * factor))--main :: IO ()-main = defaultMain [ testQuadraticCounter ]+{-# LANGUAGE
+  BangPatterns,
+  BlockArguments,
+  RankNTypes,
+  ScopedTypeVariables,
+  TypeOperators #-}
+
+-- Algebraic operations require traversing the stack,
+-- which causes this quadratic behavior in left-recursive functions.
+
+import Test.Tasty.Bench (Benchmark, Benchmarkable, bcompareWithin, bench, bgroup, defaultMain, nf)
+import Bluefin.Eff (Eff, type (:>), runPureEff)
+import Bluefin.Algae
+import Bluefin.Algae.State
+
+-- Left recursive counter
+leftRecCounter :: z :> zz => Handler (State Int) z -> Int -> Eff zz ()
+leftRecCounter _state 0 = pure ()
+leftRecCounter state n = do
+  leftRecCounter state (n - 1)
+  modify state (+ 1)
+
+-- Benchmarking harness
+
+-- @bcompareQuadratic name tolerance factor f@:
+-- Assert that @f factor@ runs @factor * factor@ times slower than @f 1@,
+-- within a relative tolerance interval @[1 - tolerance, 1 + tolerance]@.
+bcompareQuadratic :: String -> Double -> Int -> (Int -> Benchmarkable) -> Benchmark
+bcompareQuadratic = bcompareAsymptotic (\x -> x * x)
+
+-- Compare the benchmarks (f 1) and (f factor) with respect to a given growth function
+bcompareAsymptotic :: (Double -> Double) -> String -> Double -> Int -> (Int -> Benchmarkable) -> Benchmark
+bcompareAsymptotic growth name tolerance factor f = bgroup name
+  [ bench "baseline" (f 1)
+  , bcompareWithin lower upper (name ++ ".baseline") $
+      bench ("x" ++ show factor) (f factor)
+  ] where
+    factor2 = growth (fromIntegral factor)
+    lower = (1 - tolerance) * factor2
+    upper = (1 + tolerance) * factor2
+
+runQuadraticCounter :: Int -> Int
+runQuadraticCounter n = runPureEff $ execState 0 \state -> leftRecCounter state n
+
+testQuadraticCounter :: Benchmark
+testQuadraticCounter = bcompareQuadratic "quadratic-counter" 0.2 10 (\factor ->
+  nf runQuadraticCounter (100 * factor))
+
+main :: IO ()
+main = defaultMain [ testQuadraticCounter ]

@@ -1,74 +1,74 @@-cabal-version:      3.4-name:               bluefin-algae-version:            0.1.0.1-synopsis:-  Algebraic effects and named handlers in Bluefin.-description:-  A framework for user-defined effects powered by delimited continuations.-license:            MIT-license-file:       LICENSE-author:             Li-yao Xia-maintainer:         lysxia@gmail.com-copyright:          Li-yao Xia 2024-category:           Control-build-type:         Simple-extra-doc-files:    CHANGELOG.md README.md-tested-with:-  GHC == 9.6.4-  GHC == 9.8.2-  GHC == 9.10.1--common warnings-    ghc-options: -Wall--library-    import:           warnings-    exposed-modules:-      Bluefin.Algae-      Bluefin.Algae.DynExn-      Bluefin.Algae.DelCont-      Bluefin.Exception.Dynamic-      Bluefin.Algae.Reader-      Bluefin.Algae.State-      Bluefin.Algae.Exception-      Bluefin.Algae.Exception.DynExn-      Bluefin.Algae.NonDeterminism-      Bluefin.Algae.Coroutine-    reexported-modules:-      Bluefin.Eff-    build-depends:-      bluefin >= 0.0.6 && < 0.1,-      bluefin-internal < 0.1,-      base >=4.18 && < 4.22-    hs-source-dirs:   src-    default-language: Haskell2010--test-suite main-test-    import:           warnings-    default-language: Haskell2010-    type:             exitcode-stdio-1.0-    hs-source-dirs:   test-    main-is:          Main.hs-    build-depends:-        base,-        tasty,-        tasty-hunit,-        bluefin,-        bluefin-algae--test-suite quadratic-counter-    import:           warnings-    default-language: Haskell2010-    type:             exitcode-stdio-1.0-    hs-source-dirs:   bench-    main-is:          quadratic-counter.hs-    build-depends:-        base,-        tasty,-        tasty-bench,-        bluefin,-        bluefin-algae--source-repository head-  type:     git-  location: https://github.com/Lysxia/bluefin-algae+cabal-version:      3.4
+name:               bluefin-algae
+version:            0.1.0.2
+synopsis:
+  Algebraic effects and named handlers in Bluefin.
+description:
+  A framework for user-defined effects powered by delimited continuations.
+license:            MIT
+license-file:       LICENSE
+author:             Li-yao Xia
+maintainer:         lysxia@gmail.com
+copyright:          Li-yao Xia 2024
+category:           Control
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md README.md
+tested-with:
+  GHC == 9.6.4
+  GHC == 9.8.2
+  GHC == 9.10.1
+  GHC == 9.12.2
+
+common warnings
+    ghc-options: -Wall
+
+library
+    import:           warnings
+    exposed-modules:
+      Bluefin.Algae
+      Bluefin.Algae.DynExn
+      Bluefin.Algae.DelCont
+      Bluefin.Exception.Dynamic
+      Bluefin.Algae.Reader
+      Bluefin.Algae.State
+      Bluefin.Algae.Exception
+      Bluefin.Algae.Exception.DynExn
+      Bluefin.Algae.NonDeterminism
+      Bluefin.Algae.Coroutine
+    reexported-modules:
+      Bluefin.Eff
+    build-depends:
+      bluefin >= 0.0.6 && < 0.1,
+      bluefin-internal < 0.2,
+      base >=4.18 && < 4.22
+    hs-source-dirs:   src
+    default-language: Haskell2010
+
+test-suite main-test
+    import:           warnings
+    default-language: Haskell2010
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   test
+    main-is:          Main.hs
+    build-depends:
+        base,
+        tasty,
+        tasty-hunit,
+        bluefin,
+        bluefin-algae
+
+benchmark quadratic-counter
+    import:           warnings
+    default-language: Haskell2010
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   bench
+    main-is:          quadratic-counter.hs
+    build-depends:
+        base,
+        tasty-bench,
+        bluefin,
+        bluefin-algae
+
+source-repository head
+  type:     git
+  location: https://github.com/Lysxia/bluefin-algae

@@ -1,182 +1,183 @@-{-# LANGUAGE-  BangPatterns,-  GADTs,-  RankNTypes,-  ScopedTypeVariables,-  StandaloneKindSignatures,-  TypeOperators #-}---- | = Algebraic effects and named handlers------ Algebraic effect handlers are a powerful framework for--- user-defined effects with a simple equational intuition.------ Algebraic effect handlers are expressive enough to define various effects--- from scratch. In comparison, the 'Bluefin.State.runState' handler from--- "Bluefin.State" requires mutable references (@IORef@), relying on @IO@'s--- built-in statefulness. In terms of pure expressiveness, delimited--- continuations are all you need.------ An "algebraic effect" is a signature for a set of operations which we--- represent with a GADT. For example, the "state effect" @State s@ contains--- two operations: @Get@ takes no parameter and returns a value of type @s@,--- and @Put@ takes a value of type @s@ and returns @()@. The constructors--- @Get@ and @Put@ are "uninterpreted operations": they only describe the types--- of arguments and results, with no intrinsic meaning.--- --- @--- data 'Bluefin.Algae.State.State' s r where---   Get :: 'Bluefin.Algae.State.State' s s---   Put :: s -> 'Bluefin.Algae.State.State' s ()--- @------ Below is an example of a stateful computation: a term of some type @'Eff' zz a@ with--- a state handler @h :: 'Handler' ('Bluefin.Algae.State.State' s) z@ in scope (@z :> zz@).--- The @State@ operations can be called using 'call' and the state handler @h@.------ @--- -- Increment a counter and return its previous value.--- incr :: z :> zz => 'Handler' ('Bluefin.Algae.State.State' Int) z -> 'Eff' zz Int--- incr h = do---     n <- get---     put (n + 1)---     pure n---   where---     get = 'call' h Get---     put s = 'call' h (Put s)--- @------ We handle the state effect by giving an interpretation of the @Get@ and @Put@--- operations, as a function @f :: 'HandlerBody' (State s) zz a@.------ To 'call' @Get@ or @Put@ is to call the function @f@ supplied by 'handle'.--- The following equations show how 'handle' propagates an interpretation--- @f@ throughout a computation that calls @Get@ and @Put@:------ @--- 'handle' f (\\h -> 'call' h Get     >>= k h) = f Get     ('handle' f (\\h -> k h))--- 'handle' f (\\h -> 'call' h (Put s) >>= k h) = f (Put s) ('handle' f (\\h -> k h))--- 'handle' f (\\h -> pure r) = pure r--- @------ With those equations, @'handle' f@ applied to the above @incr@ simplifies to:------ @--- 'handle' f incr =---   f Get \\n ->---   f (Put (n+1)) \\() ->---   pure n--- @------ === References------ - <https://homepages.inf.ed.ac.uk/gdp/publications/handling-algebraic-effects.pdf Handling Algebraic Effects> (2013) by Gordon D. Plotkin and Matija Pretnar.--- - <https://www.microsoft.com/en-us/research/uploads/prod/2021/05/namedh-tr.pdf First-class names for effect handlers> (2021) by Ningning Xie, Youyou Cong, and Daan Leijen.-module Bluefin.Algae-  ( AEffect--    -- * Simple interface-  , HandlerBody-  , Handler-  , ScopedEff-  , handle-  , call--    -- * Cancellable continuations-    -- $cancel-  , HandlerBody'-  , handle'-  , continue-  , cancel-  ) where--import Data.Kind (Type)-import Bluefin.Eff (Eff, Effects, type (:&), type (:>))-import Bluefin.Algae.DelCont---- | Algebraic effect.-type AEffect = Type -> Type---- | Interpretation of an algebraic effect @f@: a function to handle the operations of @f@.-type HandlerBody :: AEffect -> Effects -> Type -> Type-type HandlerBody f ss a = (forall x. f x -> (x -> Eff ss a) -> Eff ss a)---- | Generalization of 'HandlerBody' with cancellable continuations.-type HandlerBody' :: AEffect -> Effects -> Type -> Type-type HandlerBody' f ss a = (forall ss0 x. f x -> Continuation ss0 ss x a -> Eff ss a)---- | Handler to call operations of the effect @f@.-type Handler :: AEffect -> Effects -> Type-data Handler f s where-  MkHandler :: !(PromptTag ss a s) -> HandlerBody' f ss a -> Handler f s---- | Effectful computation with in scope @ss@ and final result @a@,--- extended with a scoped algebraic effect @f@.------ This type guarantees that the handler of @f@ cannot escape its scope:--- the 'Eff' computation cannot smuggle it out. All of the uses of the handle--- will happen in the span of the 'ScopedEff' computation.-type ScopedEff f ss a = forall s. Handler f s -> Eff (s :& ss) a---- | Handle operations of @f@.------ === Warning for exception-like effects------ If the handler might not call the continuation (like for an exception effect), and--- if the handled computation manages resources (e.g., opening files, transactions)--- prefer 'handle'' to trigger resource clean up with cancellable continuations.-handle ::-  HandlerBody f ss a ->-  ScopedEff f ss a ->-  Eff ss a-handle h = handle' (\f k -> h f (continue k))---- | Generalization of 'handle' with cancellable continuations.-handle' ::-  HandlerBody' f ss a ->-  ScopedEff f ss a ->-  Eff ss a-handle' h act = reset (\p -> act (MkHandler p h))---- | Call an operation of algebraic effect @f@ with a handler.-call :: s :> ss => Handler f s -> f a -> Eff ss a-call (MkHandler p h) op = shift0 p (\k -> h op k)---- $cancel--- Cancellable continuations are useful to work with resource-management schemes--- with exception handlers such as 'Bluefin.Eff.bracket'------ Cancellable continuations should be called exactly once (via 'continue' or 'cancel'):------ - at least once to ensure resources are eventually freed (no leaks);--- - at most once to avoid use-after-free errors.------ Enforcing this requirement with linear types would be a welcome contribution.------ === Example------ ==== Problem------ Given 'Bluefin.Eff.bracket' and a @Fail@ effect,--- the simple 'Bluefin.Algae.handle' may cause resource leaks:------ @--- 'Bluefin.Algae.handle' (\\_e _k -> pure Nothing)---   ('Bluefin.Eff.bracket' ex acquire release (\\_ -> 'call' h Fail))--- @------ 'Bluefin.Eff.bracket' is intended to ensure that the acquired resource is--- released even if the bracketed function throws an exception. However, when--- the @Fail@ operation is called, the handler @(\\_e _k -> pure Nothing)@--- discards the continuation @_k@ which contains the exception handler--- installed by 'Bluefin.Eff.bracket'.--- The resource leaks because @release@ will never be called.------ ==== Solution------ Using 'handle'' instead lets us 'cancel' the continuation.------ @--- 'handle'' (\\_e k -> 'cancel' k >> pure Nothing)---   ('Bluefin.Eff.bracket' acquire release (\\_ -> 'call' h Fail))--- @+{-# LANGUAGE
+  BangPatterns,
+  DataKinds,
+  GADTs,
+  RankNTypes,
+  ScopedTypeVariables,
+  StandaloneKindSignatures,
+  TypeOperators #-}
+
+-- | = Algebraic effects and named handlers
+--
+-- Algebraic effect handlers are a powerful framework for
+-- user-defined effects with a simple equational intuition.
+--
+-- Algebraic effect handlers are expressive enough to define various effects
+-- from scratch. In comparison, the 'Bluefin.State.runState' handler from
+-- "Bluefin.State" requires mutable references (@IORef@), relying on @IO@'s
+-- built-in statefulness. In terms of pure expressiveness, delimited
+-- continuations are all you need.
+--
+-- An "algebraic effect" is a signature for a set of operations which we
+-- represent with a GADT. For example, the "state effect" @State s@ contains
+-- two operations: @Get@ takes no parameter and returns a value of type @s@,
+-- and @Put@ takes a value of type @s@ and returns @()@. The constructors
+-- @Get@ and @Put@ are "uninterpreted operations": they only describe the types
+-- of arguments and results, with no intrinsic meaning.
+-- 
+-- @
+-- data 'Bluefin.Algae.State.State' s r where
+--   Get :: 'Bluefin.Algae.State.State' s s
+--   Put :: s -> 'Bluefin.Algae.State.State' s ()
+-- @
+--
+-- Below is an example of a stateful computation: a term of some type @'Eff' zz a@ with
+-- a state handler @h :: 'Handler' ('Bluefin.Algae.State.State' s) z@ in scope (@z :> zz@).
+-- The @State@ operations can be called using 'call' and the state handler @h@.
+--
+-- @
+-- -- Increment a counter and return its previous value.
+-- incr :: z :> zz => 'Handler' ('Bluefin.Algae.State.State' Int) z -> 'Eff' zz Int
+-- incr h = do
+--     n <- get
+--     put (n + 1)
+--     pure n
+--   where
+--     get = 'call' h Get
+--     put s = 'call' h (Put s)
+-- @
+--
+-- We handle the state effect by giving an interpretation of the @Get@ and @Put@
+-- operations, as a function @f :: 'HandlerBody' (State s) zz a@.
+--
+-- To 'call' @Get@ or @Put@ is to call the function @f@ supplied by 'handle'.
+-- The following equations show how 'handle' propagates an interpretation
+-- @f@ throughout a computation that calls @Get@ and @Put@:
+--
+-- @
+-- 'handle' f (\\h -> 'call' h Get     >>= k h) = f Get     ('handle' f (\\h -> k h))
+-- 'handle' f (\\h -> 'call' h (Put s) >>= k h) = f (Put s) ('handle' f (\\h -> k h))
+-- 'handle' f (\\h -> pure r) = pure r
+-- @
+--
+-- With those equations, @'handle' f@ applied to the above @incr@ simplifies to:
+--
+-- @
+-- 'handle' f incr =
+--   f Get \\n ->
+--   f (Put (n+1)) \\() ->
+--   pure n
+-- @
+--
+-- === References
+--
+-- - <https://homepages.inf.ed.ac.uk/gdp/publications/handling-algebraic-effects.pdf Handling Algebraic Effects> (2013) by Gordon D. Plotkin and Matija Pretnar.
+-- - <https://www.microsoft.com/en-us/research/uploads/prod/2021/05/namedh-tr.pdf First-class names for effect handlers> (2021) by Ningning Xie, Youyou Cong, and Daan Leijen.
+module Bluefin.Algae
+  ( AEffect
+
+    -- * Simple interface
+  , HandlerBody
+  , Handler
+  , ScopedEff
+  , handle
+  , call
+
+    -- * Cancellable continuations
+    -- $cancel
+  , HandlerBody'
+  , handle'
+  , continue
+  , cancel
+  ) where
+
+import Data.Kind (Type)
+import Bluefin.Eff (Eff, Effects, type (:&), type (:>))
+import Bluefin.Algae.DelCont
+
+-- | Algebraic effect.
+type AEffect = Type -> Type
+
+-- | Interpretation of an algebraic effect @f@: a function to handle the operations of @f@.
+type HandlerBody :: AEffect -> Effects -> Type -> Type
+type HandlerBody f ss a = (forall x. f x -> (x -> Eff ss a) -> Eff ss a)
+
+-- | Generalization of 'HandlerBody' with cancellable continuations.
+type HandlerBody' :: AEffect -> Effects -> Type -> Type
+type HandlerBody' f ss a = (forall ss0 x. f x -> Continuation ss0 ss x a -> Eff ss a)
+
+-- | Handler to call operations of the effect @f@.
+type Handler :: AEffect -> Effects -> Type
+data Handler f s where
+  MkHandler :: !(PromptTag ss a s) -> HandlerBody' f ss a -> Handler f s
+
+-- | Effectful computation with in scope @ss@ and final result @a@,
+-- extended with a scoped algebraic effect @f@.
+--
+-- This type guarantees that the handler of @f@ cannot escape its scope:
+-- the 'Eff' computation cannot smuggle it out. All of the uses of the handle
+-- will happen in the span of the 'ScopedEff' computation.
+type ScopedEff f ss a = forall s. Handler f s -> Eff (s :& ss) a
+
+-- | Handle operations of @f@.
+--
+-- === Warning for exception-like effects
+--
+-- If the handler might not call the continuation (like for an exception effect), and
+-- if the handled computation manages resources (e.g., opening files, transactions)
+-- prefer 'handle'' to trigger resource clean up with cancellable continuations.
+handle ::
+  HandlerBody f ss a ->
+  ScopedEff f ss a ->
+  Eff ss a
+handle h = handle' (\f k -> h f (continue k))
+
+-- | Generalization of 'handle' with cancellable continuations.
+handle' ::
+  HandlerBody' f ss a ->
+  ScopedEff f ss a ->
+  Eff ss a
+handle' h act = reset (\p -> act (MkHandler p h))
+
+-- | Call an operation of algebraic effect @f@ with a handler.
+call :: s :> ss => Handler f s -> f a -> Eff ss a
+call (MkHandler p h) op = shift0 p (\k -> h op k)
+
+-- $cancel
+-- Cancellable continuations are useful to work with resource-management schemes
+-- with exception handlers such as 'Bluefin.Eff.bracket'
+--
+-- Cancellable continuations should be called exactly once (via 'continue' or 'cancel'):
+--
+-- - at least once to ensure resources are eventually freed (no leaks);
+-- - at most once to avoid use-after-free errors.
+--
+-- Enforcing this requirement with linear types would be a welcome contribution.
+--
+-- === Example
+--
+-- ==== Problem
+--
+-- Given 'Bluefin.Eff.bracket' and a @Fail@ effect,
+-- the simple 'Bluefin.Algae.handle' may cause resource leaks:
+--
+-- @
+-- 'Bluefin.Algae.handle' (\\_e _k -> pure Nothing)
+--   ('Bluefin.Eff.bracket' ex acquire release (\\_ -> 'call' h Fail))
+-- @
+--
+-- 'Bluefin.Eff.bracket' is intended to ensure that the acquired resource is
+-- released even if the bracketed function throws an exception. However, when
+-- the @Fail@ operation is called, the handler @(\\_e _k -> pure Nothing)@
+-- discards the continuation @_k@ which contains the exception handler
+-- installed by 'Bluefin.Eff.bracket'.
+-- The resource leaks because @release@ will never be called.
+--
+-- ==== Solution
+--
+-- Using 'handle'' instead lets us 'cancel' the continuation.
+--
+-- @
+-- 'handle'' (\\_e k -> 'cancel' k >> pure Nothing)
+--   ('Bluefin.Eff.bracket' acquire release (\\_ -> 'call' h Fail))
+-- @

@@ -1,467 +1,467 @@-{-# LANGUAGE-  BangPatterns,-  DataKinds,-  GADTs,-  KindSignatures,-  RankNTypes,-  ScopedTypeVariables,-  StandaloneKindSignatures,-  TypeOperators #-}---- | = Coroutines: yield as an algebraic effect------ == Iterators------ A simple use case of coroutines is as an expressive way of defining iterators.------ An iterator is just a program which yields values. The following example--- yields the integers 1, 2, 3, 4.------ @--- range1to4 :: z :> zz => Handler (Coroutine Int ()) z -> Eff zz ()--- range1to4 h = do---   'yield' h 1---   'yield' h 2---   'yield' h 3---   'yield' h 4--- @------ The 'forCoroutine' handler is a "for" loop over an iterator,--- running the loop body for every yielded element.--- Here we collect the even values into a list stored in mutable @State@.------ @--- filterEven :: z :> zz => Handler (State [Int]) z -> Eff zz ()--- filterEven h =---   'forCoroutine' range1to4 \\n ->---     if n \`mod\` 2 == 0---     then modify h (n :)---     else pure ()------ filterEvenResult :: [Int]--- filterEvenResult = runPureEff $ execState [] filterEven------ -- 1 and 3 are filtered out, 2 and 4 are pushed into the queue--- in that order, so they appear in reverse order.--- -- filterEvenResult == [4,2]--- @------ == Cooperative concurrency------ Coroutines are "cooperative threads", passing control to other coroutines--- with explicit 'yield' calls.------ In the following example, two threads yield a string back and forth,--- appending a suffix every time.------ @--- pingpong :: Eff ss String--- pingpong = 'withCoroutine' coThread mainThread---   where---     coThread z0 h = do---       z1 <- 'yield' h (z0 ++ "pong")---       z2 <- 'yield' h (z1 ++ "dong")---       'yield' h (z2 ++ "bong")---     mainThread h = do---       s1 <- 'yield' h "ping"---       s2 <- 'yield' h (s1 ++ "ding")---       s3 <- 'yield' h (s2 ++ "bing")---       pure s3------ -- runPureEff pingpong == "pingpongdingdongbingbong"--- @------ More than two coroutines may be interleaved. In the snippet below, four--- users pass a string to each other, extending it with breadcrumbs each time.------ For example, @userLL@ sends a string to @userLR@ (identified using the--- @Left (Right _)@ constructors in the 'yield' argument). When @userLL@--- receives a second string @s'@ (from anywhere, in this case it will come from--- @userRR@), it forwards it to @userRL@.------ @--- echo :: Eff ss String--- echo = 'loopCoPipe' ((userLL |+ userLR) |+ (userRL |+ userRR)) (Left (Left \"S\"))---   where---     userLL = 'toCoPipe' \\s h -> do---       s' <- 'yield' h (Left (Right (s ++ "-LL")))  -- send to userLR---       'yield' h (Right (Left (s' ++ "-LL")))       -- send to userRL---     userLR = 'toCoPipe' \\s h -> do---       s' <- 'yield' h (Right (Left (s ++ "-LR")))  -- send to userRL---       'yield' h (Right (Right (s' ++ "-LR")))      -- send to userRR---     userRL = 'toCoPipe' \\s h -> do---       s' <- 'yield' h (Right (Right (s ++ "-RL"))) -- send to userRR---       'yield' h (Left (Right (s' ++ "-RL")))       -- send to userLR---     userRR = 'toCoPipe' \\s h -> do---       s' <- 'yield' h (Left (Left (s ++ "-RR")))   -- send to userLL---       pure (s' ++ "-RR")                           -- terminate---     (|+) = 'eitherCoPipe' id------ -- runPureEff echo == "S-LL-LR-RL-RR-LL-RL-LR-RR"--- @------ == References------ Coroutines are also known as generators in Javascript and Python.------ - <https://en.wikipedia.org/wiki/Coroutine Coroutine> and---   <https://en.wikipedia.org/wiki/Generator_(computer_programming) Generator>---   on Wikipedia--- - <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements/function*#description Generators in Javascript>--- - <https://docs.python.org/3/reference/expressions.html#yieldexpr Generators in Python>-module Bluefin.Algae.Coroutine-  ( -- * Coroutines--    -- ** Operations-    Coroutine(..)-  , yield--    -- ** Handlers-  , withCoroutine-  , forCoroutine--    -- * Functions-  , (:->)-  , apply-  , withFunction--    -- * Pipes-    -- ** Definition-  , Pipe(..)-  , PipeEvent(..)-  , CoPipe(..)--    -- ** Unwrap-  , stepPipe-  , applyCoPipe-  , next--    -- ** Constructors-  , simpleCoPipe-  , voidCoPipe-  , nothingPipe-  , nothingCoPipe--    -- ** Pipe combinators-  , mapPipe-  , mapCoPipe-  , eitherPipe-  , eitherCoPipe-  , openPipe-  , openCoPipe--    -- ** Destructors-  , runPipe-  , runCoPipe-  , forPipe-  , forCoPipe-  , loopPipe-  , loopCoPipe-  , feedPipe-  , feedCoPipe--    -- ** Handlers involving pipes--    -- | Using the handlers 'toCoPipe' and 'toPipe' as primitives,-    -- we can define the other handlers.-    ---    -- @-    -- 'withCoroutine' g f = 'runPipe' ('toCoPipe' g) ('toPipe' f)-    -- 'forCoroutine' g f = 'runPipe' ('simpleCoPipe' g) ('toPipe' f)-    -- 'withCoPipe' g f = 'runPipe' g ('toPipe' f)-    -- @-  , CoPipeSEff-  , toCoPipe-  , PipeSEff-  , toPipe-  , withCoPipe--    -- ** Interpreting pipes as coroutines-  , CoPipeEff-  , fromCoPipe-  , PipeEff-  , fromPipe-  ) where--import Data.Coerce (coerce)-import Data.Function (fix)-import Data.Functor ((<&>))-import Data.Kind (Type)-import Data.Void (Void, absurd)-import Bluefin.Eff-import Bluefin.Algae---- * Coroutines---- | Coroutine effect with outputs @o@ and inputs @i@.-data Coroutine o i :: AEffect where-  -- | Yield an output and wait for an input.-  Yield :: o -> Coroutine o i i---- | Call the 'Yield' operation.-yield :: z :> zz => Handler (Coroutine o i) z -> o -> Eff zz i-yield h o = call h (Yield o)---- | This type synonym rebrands 'Coroutine' into a generic "function" effect,--- since without the concurrency connotations, the 'Yield' operation looks--- like a simple function call.-type (:->) :: Type -> Type -> AEffect-type (:->) = Coroutine---- | Synonym for 'yield'.-apply :: z :> zz => Handler (a :-> b) z -> a -> Eff zz b-apply = yield---- | Interpret @(':->')@ with a function.-withFunction :: forall a b r zz.-  (a -> Eff zz b) ->-  ScopedEff (a :-> b) zz r ->-  Eff zz r-withFunction f g = forCoroutine g f--- This is morally @flip forCoroutine@ except that it wouldn't type check--- because 'forCoroutine' has a higher-rank type.---- * Pipes---- | Output-first coroutine.------ A 'Pipe' represents a coroutine as a state machine:--- a 'Pipe' yields an output @o@ and waits for an input @i@, or terminates with--- a result @a@.------ @--- +--------------+                  +----------------+--- | 'Pipe' i o m a | ('Yielding' o)---> | 'CoPipe' i o m a |--- |              | <------(input i) |                |--- +--------------+                  +----------------+---        v ('Done')---      +---+---      | a |---      +---+--- @-newtype Pipe i o m a = MkPipe (m (PipeEvent i o m a))---- | Events of 'Pipe'.-data PipeEvent i o m a-  = Done a                       -- ^ Final result @a@-  | Yielding o (CoPipe i o m a)  -- ^ Output @o@ and continue as 'CoPipe'.---- | Input-first coroutine. 'Pipe' continuation.-newtype CoPipe i o m a-  = MkCoPipe (i -> Pipe i o m a)  -- ^ Input @i@ and continue as 'Pipe'.---- | Unwrap 'Pipe'.-stepPipe :: Pipe i o m a -> m (PipeEvent i o m a)-stepPipe (MkPipe p) = p---- | Unwrap 'CoPipe'.-applyCoPipe :: CoPipe i o m a -> i -> Pipe i o m a-applyCoPipe (MkCoPipe k) = k---- | Apply a non-returning 'CoPipe' to yield the next output and 'CoPipe' state.-next :: Functor m => CoPipe i o m Void -> i -> m (o, CoPipe i o m Void)-next (MkCoPipe f) i = go <$> stepPipe (f i) where-  go (Done v) = absurd v-  go (Yielding o k) = (o, k)---- | A 'CoPipe' which runs the same function on every input.-simpleCoPipe :: Functor m => (i -> m o) -> CoPipe i o m void-simpleCoPipe f = fix $ \self -> MkCoPipe (\i -> MkPipe ((\o -> Yielding o self) <$> f i))---- | Transform inputs and outputs of a 'Pipe'.-mapPipe :: Functor m => (i' -> i) -> (o -> o') -> (a -> a') -> Pipe i o m a -> Pipe i' o' m a'-mapPipe fi fo fa = mapPipe_-  where-    mapPipe_ (MkPipe p) = MkPipe (loop <$> p)-    loop (Done a) = Done (fa a)-    loop (Yielding o k) = Yielding (fo o) (mapCoPipe_ k)-    mapCoPipe_ (MkCoPipe k) = MkCoPipe (mapPipe_ . k . fi)---- | Transform the input and output of a 'CoPipe'.-mapCoPipe :: Functor m => (i' -> i) -> (o -> o') -> (a -> a') -> CoPipe i o m a -> CoPipe i' o' m a'-mapCoPipe fi fo fa (MkCoPipe k) = MkCoPipe (mapPipe fi fo fa . k . fi)---- | Run a 'Pipe' with a 'CoPipe' to respond to every output.-runPipe :: Monad m => CoPipe i o m Void -> Pipe o i m a -> m a-runPipe t (MkPipe p) = p >>= \e -> case e of-  Done a -> pure a-  Yielding i k -> do-    (o, t') <- next t i-    runCoPipe t' k o---- | Run a 'CoPipe' with another 'CoPipe' to respond to every input.-runCoPipe :: Monad m => CoPipe i o m Void -> CoPipe o i m a -> o -> m a-runCoPipe t (MkCoPipe k) i = runPipe t (k i)---- | Iterate through a 'Pipe'. Respond to every 'Yielding' event by running the loop body.--- Return the final result of the 'Pipe'.------ @--- 'forPipe' p g = 'runPipe' ('simpleCoPipe' g) p--- @-forPipe :: Monad m =>-  Pipe i o m a ->  -- ^ Iterator-  (o -> m i) ->    -- ^ Loop body-  m a-forPipe p h = stepPipe p >>= loop-  where-    loop (Done a) = pure a-    loop (Yielding o k) = h o >>= \i -> stepPipe (applyCoPipe k i) >>= loop---- | Iterate through a 'CoPipe'.-forCoPipe :: Monad m =>-  CoPipe i o m a ->-  (o -> m i) ->-  i -> m a-forCoPipe (MkCoPipe k) h i = forPipe (k i) h---- | 'CoPipe' with no input.-voidCoPipe :: CoPipe Void o m a-voidCoPipe = MkCoPipe absurd---- | Sum a copipe and a pipe with the same output type,--- branching on the input type.-eitherPipe :: Monad m =>-  (i -> Either i1 i2) ->   -- ^ Dispatch input-  CoPipe i1 o m a ->       -- ^ Left copipe-  Pipe i2 o m a ->         -- ^ Right pipe-  Pipe i o m a-eitherPipe split t0 (MkPipe p) = MkPipe $ p <&> \e -> case e of-  Done a -> Done a-  Yielding o k -> Yielding o (eitherCoPipe split t0 k)---- | Sum two copipes with the same output type, branching on the input type.-eitherCoPipe :: Functor m =>-  (i -> Either i1 i2) ->   -- ^ Dispatch input-  CoPipe i1 o m a ->       -- ^ Left copipe-  CoPipe i2 o m a ->       -- ^ Right copipe-  CoPipe i o m a-eitherCoPipe split = loop-  where-    loop t1 t2 = MkCoPipe (MkPipe . transduce_ t1 t2 . split)-    transduce_ (MkCoPipe t1) t2 (Left i1) = stepPipe (t1 i1) <&> \e -> case e of-      Done a -> Done a-      Yielding o t1' -> Yielding o (loop t1' t2)-    transduce_ t1 (MkCoPipe t2) (Right i2) = stepPipe (t2 i2) <&> \e -> case e of-      Done a -> Done a-      Yielding o t2' -> Yielding  o (loop t1 t2')---- | Loop the output of a pipe back to its input.-loopPipe :: Monad m => Pipe o o m a -> m a-loopPipe (MkPipe p) = p >>= \e -> case e of-  Done a -> pure a-  Yielding o k -> loopCoPipe k o---- | Forward the output of a 'CoPipe' to its input.-loopCoPipe :: Monad m => CoPipe o o m a -> o -> m a-loopCoPipe (MkCoPipe k) o = loopPipe (k o)---- | Convert a returning 'Pipe' into a non-returning 'CoPipe',--- yielding 'Nothing' forever once the end has been reached.-openPipe :: Applicative m => Pipe i o m () -> Pipe i (Maybe o) m void-openPipe (MkPipe p) = MkPipe (p <&> \e -> case e of-  Done _ -> Yielding Nothing nothingCoPipe-  Yielding o k -> Yielding (Just o) (openCoPipe k))---- | Convert a returning 'CoPipe' into a non-returning 'CoPipe',--- yielding 'Nothing' forever once the end has been reached.-openCoPipe :: Applicative m => CoPipe i o m () -> CoPipe i (Maybe o) m void-openCoPipe (MkCoPipe k) = MkCoPipe (openPipe . k)---- | Yield 'Nothing' forever.-nothingPipe :: Applicative m => Pipe i (Maybe o) m void-nothingPipe = MkPipe (pure (Yielding Nothing nothingCoPipe))---- | Yield 'Nothing' forever.-nothingCoPipe :: Applicative m => CoPipe i (Maybe o) m void-nothingCoPipe = MkCoPipe (\_ -> nothingPipe)---- | Representation of 'Pipe' as scoped 'Eff' computations.-type PipeSEff i o zz a = ScopedEff (Coroutine o i) zz a---- | Representation of 'Pipe' as 'Eff' computations.-type PipeEff i o zz a = forall z. z :> zz => Handler (Coroutine o i) z -> Eff zz a---- | Representation of 'CoPipe' as scoped 'Eff' computations.-type CoPipeSEff i o zz a = i -> ScopedEff (Coroutine o i) zz a---- | Representation of 'CoPipe' as 'Eff' computations.-type CoPipeEff i o zz a = forall z. z :> zz => i -> Handler (Coroutine o i) z -> Eff zz a---- | Run a 'Pipe' with a fixed number of inputs.-feedPipe :: Monad m => [i] -> Pipe i o m a -> m [o]-feedPipe is (MkPipe m) = m >>= \e -> case e of-  Done _ -> pure []-  Yielding o k -> (o :) <$> feedCoPipe is k---- | Run a 'CoPipe' with a fixed number of inputs.-feedCoPipe :: Monad m => [i] -> CoPipe i o m a -> m [o]-feedCoPipe [] _ = pure []-feedCoPipe (i : is) (MkCoPipe k) = feedPipe is (k i)---- * Handlers---- | Convert a coroutine that doesn't return into a 'CoPipe'.-toCoPipe :: forall o i a zz.-  CoPipeSEff i o zz a -> CoPipe i o (Eff zz) a-toCoPipe f = MkCoPipe (\i -> toPipe (\h -> f i h))---- | Convert a 'CoPipe' into a coroutine.-fromCoPipe :: CoPipe i o (Eff zz) a -> CoPipeEff i o zz a-fromCoPipe (MkCoPipe k) i h = fromPipe (k i) h---- | Evaluate a coroutine into a 'Pipe'.-toPipe :: forall o i a zz.-  PipeSEff i o zz a ->-  Pipe i o (Eff zz) a-toPipe f = MkPipe (handle coroutineHandler (wrap . f))-  where-    coroutineHandler :: HandlerBody (Coroutine o i) zz (PipeEvent i o (Eff zz) a)-    coroutineHandler (Yield o) k = pure (Yielding o (coerce k))--    wrap :: Eff (z :& zz) a -> Eff (z :& zz) (PipeEvent i o (Eff zz) a)-    wrap = fmap Done---- | Convet a 'Pipe' into a coroutine.-fromPipe :: Pipe i o (Eff zz) a -> PipeEff i o zz a-fromPipe (MkPipe p) h = p >>= \e -> case e of-  Done a -> pure a-  Yielding o k -> yield h o >>= \i -> fromCoPipe k i h---- | Interleave the execution of a copipe and a coroutine.-withCoPipe :: forall o i a zz.-  CoPipe i o (Eff zz) a ->-  ScopedEff (Coroutine i o) zz a ->  -- ^ Starting coroutine-  Eff zz a-withCoPipe g f = with g (handle coroutineHandler (fmap wrap . f))-  where-    coroutineHandler :: HandlerBody (Coroutine i o) zz (CoPipe i o (Eff zz) a -> Eff zz a)-    coroutineHandler (Yield o) k = pure $ \g1 -> do-      stepPipe (applyCoPipe g1 o) >>= \e -> case e of-        Done a -> pure a-        Yielding i g2 -> with g2 (k i)--    wrap :: a -> z -> Eff zz a-    wrap a _ = pure a--    with :: forall g. g -> Eff zz (g -> Eff zz a) -> Eff zz a-    with g' m = m >>= \f' -> f' g'---- | Interleave the execution of two coroutines, feeding each one's output to the other's input.--- Return the result of the first thread to terminate (the other is discarded)-withCoroutine :: forall o i a zz.-  (i -> ScopedEff (Coroutine o i) zz a) ->-  ScopedEff (Coroutine i o) zz a ->         -- ^ Starting coroutine-  Eff zz a-withCoroutine g f = withCoPipe (toCoPipe g) f---- | Iterate through a coroutine:--- execute the loop body @o -> Eff zz i@ for every call to 'Yield' in the coroutine.-forCoroutine :: forall o i a zz.-  ScopedEff (Coroutine o i) zz a ->  -- ^ Iterator-  (o -> Eff zz i) ->  -- ^ Loop body-  Eff zz a-forCoroutine f h = handle coroutineHandler f-  where-    coroutineHandler :: HandlerBody (Coroutine o i) zz a-    coroutineHandler (Yield o) k = h o >>= k+{-# LANGUAGE
+  BangPatterns,
+  DataKinds,
+  GADTs,
+  KindSignatures,
+  RankNTypes,
+  ScopedTypeVariables,
+  StandaloneKindSignatures,
+  TypeOperators #-}
+
+-- | = Coroutines: yield as an algebraic effect
+--
+-- == Iterators
+--
+-- A simple use case of coroutines is as an expressive way of defining iterators.
+--
+-- An iterator is just a program which yields values. The following example
+-- yields the integers 1, 2, 3, 4.
+--
+-- @
+-- range1to4 :: z :> zz => Handler (Coroutine Int ()) z -> Eff zz ()
+-- range1to4 h = do
+--   'yield' h 1
+--   'yield' h 2
+--   'yield' h 3
+--   'yield' h 4
+-- @
+--
+-- The 'forCoroutine' handler is a "for" loop over an iterator,
+-- running the loop body for every yielded element.
+-- Here we collect the even values into a list stored in mutable @State@.
+--
+-- @
+-- filterEven :: z :> zz => Handler (State [Int]) z -> Eff zz ()
+-- filterEven h =
+--   'forCoroutine' range1to4 \\n ->
+--     if n \`mod\` 2 == 0
+--     then modify h (n :)
+--     else pure ()
+--
+-- filterEvenResult :: [Int]
+-- filterEvenResult = runPureEff $ execState [] filterEven
+--
+-- -- 1 and 3 are filtered out, 2 and 4 are pushed into the queue
+-- in that order, so they appear in reverse order.
+-- -- filterEvenResult == [4,2]
+-- @
+--
+-- == Cooperative concurrency
+--
+-- Coroutines are "cooperative threads", passing control to other coroutines
+-- with explicit 'yield' calls.
+--
+-- In the following example, two threads yield a string back and forth,
+-- appending a suffix every time.
+--
+-- @
+-- pingpong :: Eff ss String
+-- pingpong = 'withCoroutine' coThread mainThread
+--   where
+--     coThread z0 h = do
+--       z1 <- 'yield' h (z0 ++ "pong")
+--       z2 <- 'yield' h (z1 ++ "dong")
+--       'yield' h (z2 ++ "bong")
+--     mainThread h = do
+--       s1 <- 'yield' h "ping"
+--       s2 <- 'yield' h (s1 ++ "ding")
+--       s3 <- 'yield' h (s2 ++ "bing")
+--       pure s3
+--
+-- -- runPureEff pingpong == "pingpongdingdongbingbong"
+-- @
+--
+-- More than two coroutines may be interleaved. In the snippet below, four
+-- users pass a string to each other, extending it with breadcrumbs each time.
+--
+-- For example, @userLL@ sends a string to @userLR@ (identified using the
+-- @Left (Right _)@ constructors in the 'yield' argument). When @userLL@
+-- receives a second string @s'@ (from anywhere, in this case it will come from
+-- @userRR@), it forwards it to @userRL@.
+--
+-- @
+-- echo :: Eff ss String
+-- echo = 'loopCoPipe' ((userLL |+ userLR) |+ (userRL |+ userRR)) (Left (Left \"S\"))
+--   where
+--     userLL = 'toCoPipe' \\s h -> do
+--       s' <- 'yield' h (Left (Right (s ++ "-LL")))  -- send to userLR
+--       'yield' h (Right (Left (s' ++ "-LL")))       -- send to userRL
+--     userLR = 'toCoPipe' \\s h -> do
+--       s' <- 'yield' h (Right (Left (s ++ "-LR")))  -- send to userRL
+--       'yield' h (Right (Right (s' ++ "-LR")))      -- send to userRR
+--     userRL = 'toCoPipe' \\s h -> do
+--       s' <- 'yield' h (Right (Right (s ++ "-RL"))) -- send to userRR
+--       'yield' h (Left (Right (s' ++ "-RL")))       -- send to userLR
+--     userRR = 'toCoPipe' \\s h -> do
+--       s' <- 'yield' h (Left (Left (s ++ "-RR")))   -- send to userLL
+--       pure (s' ++ "-RR")                           -- terminate
+--     (|+) = 'eitherCoPipe' id
+--
+-- -- runPureEff echo == "S-LL-LR-RL-RR-LL-RL-LR-RR"
+-- @
+--
+-- == References
+--
+-- Coroutines are also known as generators in Javascript and Python.
+--
+-- - <https://en.wikipedia.org/wiki/Coroutine Coroutine> and
+--   <https://en.wikipedia.org/wiki/Generator_(computer_programming) Generator>
+--   on Wikipedia
+-- - <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements/function*#description Generators in Javascript>
+-- - <https://docs.python.org/3/reference/expressions.html#yieldexpr Generators in Python>
+module Bluefin.Algae.Coroutine
+  ( -- * Coroutines
+
+    -- ** Operations
+    Coroutine(..)
+  , yield
+
+    -- ** Handlers
+  , withCoroutine
+  , forCoroutine
+
+    -- * Functions
+  , (:->)
+  , apply
+  , withFunction
+
+    -- * Pipes
+    -- ** Definition
+  , Pipe(..)
+  , PipeEvent(..)
+  , CoPipe(..)
+
+    -- ** Unwrap
+  , stepPipe
+  , applyCoPipe
+  , next
+
+    -- ** Constructors
+  , simpleCoPipe
+  , voidCoPipe
+  , nothingPipe
+  , nothingCoPipe
+
+    -- ** Pipe combinators
+  , mapPipe
+  , mapCoPipe
+  , eitherPipe
+  , eitherCoPipe
+  , openPipe
+  , openCoPipe
+
+    -- ** Destructors
+  , runPipe
+  , runCoPipe
+  , forPipe
+  , forCoPipe
+  , loopPipe
+  , loopCoPipe
+  , feedPipe
+  , feedCoPipe
+
+    -- ** Handlers involving pipes
+
+    -- | Using the handlers 'toCoPipe' and 'toPipe' as primitives,
+    -- we can define the other handlers.
+    --
+    -- @
+    -- 'withCoroutine' g f = 'runPipe' ('toCoPipe' g) ('toPipe' f)
+    -- 'forCoroutine' g f = 'runPipe' ('simpleCoPipe' g) ('toPipe' f)
+    -- 'withCoPipe' g f = 'runPipe' g ('toPipe' f)
+    -- @
+  , CoPipeSEff
+  , toCoPipe
+  , PipeSEff
+  , toPipe
+  , withCoPipe
+
+    -- ** Interpreting pipes as coroutines
+  , CoPipeEff
+  , fromCoPipe
+  , PipeEff
+  , fromPipe
+  ) where
+
+import Data.Coerce (coerce)
+import Data.Function (fix)
+import Data.Functor ((<&>))
+import Data.Kind (Type)
+import Data.Void (Void, absurd)
+import Bluefin.Eff
+import Bluefin.Algae
+
+-- * Coroutines
+
+-- | Coroutine effect with outputs @o@ and inputs @i@.
+data Coroutine o i :: AEffect where
+  -- | Yield an output and wait for an input.
+  Yield :: o -> Coroutine o i i
+
+-- | Call the 'Yield' operation.
+yield :: z :> zz => Handler (Coroutine o i) z -> o -> Eff zz i
+yield h o = call h (Yield o)
+
+-- | This type synonym rebrands 'Coroutine' into a generic "function" effect,
+-- since without the concurrency connotations, the 'Yield' operation looks
+-- like a simple function call.
+type (:->) :: Type -> Type -> AEffect
+type (:->) = Coroutine
+
+-- | Synonym for 'yield'.
+apply :: z :> zz => Handler (a :-> b) z -> a -> Eff zz b
+apply = yield
+
+-- | Interpret @(':->')@ with a function.
+withFunction :: forall a b r zz.
+  (a -> Eff zz b) ->
+  ScopedEff (a :-> b) zz r ->
+  Eff zz r
+withFunction f g = forCoroutine g f
+-- This is morally @flip forCoroutine@ except that it wouldn't type check
+-- because 'forCoroutine' has a higher-rank type.
+
+-- * Pipes
+
+-- | Output-first coroutine.
+--
+-- A 'Pipe' represents a coroutine as a state machine:
+-- a 'Pipe' yields an output @o@ and waits for an input @i@, or terminates with
+-- a result @a@.
+--
+-- @
+-- +--------------+                  +----------------+
+-- | 'Pipe' i o m a | ('Yielding' o)---> | 'CoPipe' i o m a |
+-- |              | <------(input i) |                |
+-- +--------------+                  +----------------+
+--        v ('Done')
+--      +---+
+--      | a |
+--      +---+
+-- @
+newtype Pipe i o m a = MkPipe (m (PipeEvent i o m a))
+
+-- | Events of 'Pipe'.
+data PipeEvent i o m a
+  = Done a                       -- ^ Final result @a@
+  | Yielding o (CoPipe i o m a)  -- ^ Output @o@ and continue as 'CoPipe'.
+
+-- | Input-first coroutine. 'Pipe' continuation.
+newtype CoPipe i o m a
+  = MkCoPipe (i -> Pipe i o m a)  -- ^ Input @i@ and continue as 'Pipe'.
+
+-- | Unwrap 'Pipe'.
+stepPipe :: Pipe i o m a -> m (PipeEvent i o m a)
+stepPipe (MkPipe p) = p
+
+-- | Unwrap 'CoPipe'.
+applyCoPipe :: CoPipe i o m a -> i -> Pipe i o m a
+applyCoPipe (MkCoPipe k) = k
+
+-- | Apply a non-returning 'CoPipe' to yield the next output and 'CoPipe' state.
+next :: Functor m => CoPipe i o m Void -> i -> m (o, CoPipe i o m Void)
+next (MkCoPipe f) i = go <$> stepPipe (f i) where
+  go (Done v) = absurd v
+  go (Yielding o k) = (o, k)
+
+-- | A 'CoPipe' which runs the same function on every input.
+simpleCoPipe :: Functor m => (i -> m o) -> CoPipe i o m void
+simpleCoPipe f = fix $ \self -> MkCoPipe (\i -> MkPipe ((\o -> Yielding o self) <$> f i))
+
+-- | Transform inputs and outputs of a 'Pipe'.
+mapPipe :: Functor m => (i' -> i) -> (o -> o') -> (a -> a') -> Pipe i o m a -> Pipe i' o' m a'
+mapPipe fi fo fa = mapPipe_
+  where
+    mapPipe_ (MkPipe p) = MkPipe (loop <$> p)
+    loop (Done a) = Done (fa a)
+    loop (Yielding o k) = Yielding (fo o) (mapCoPipe_ k)
+    mapCoPipe_ (MkCoPipe k) = MkCoPipe (mapPipe_ . k . fi)
+
+-- | Transform the input and output of a 'CoPipe'.
+mapCoPipe :: Functor m => (i' -> i) -> (o -> o') -> (a -> a') -> CoPipe i o m a -> CoPipe i' o' m a'
+mapCoPipe fi fo fa (MkCoPipe k) = MkCoPipe (mapPipe fi fo fa . k . fi)
+
+-- | Run a 'Pipe' with a 'CoPipe' to respond to every output.
+runPipe :: Monad m => CoPipe i o m Void -> Pipe o i m a -> m a
+runPipe t (MkPipe p) = p >>= \e -> case e of
+  Done a -> pure a
+  Yielding i k -> do
+    (o, t') <- next t i
+    runCoPipe t' k o
+
+-- | Run a 'CoPipe' with another 'CoPipe' to respond to every input.
+runCoPipe :: Monad m => CoPipe i o m Void -> CoPipe o i m a -> o -> m a
+runCoPipe t (MkCoPipe k) i = runPipe t (k i)
+
+-- | Iterate through a 'Pipe'. Respond to every 'Yielding' event by running the loop body.
+-- Return the final result of the 'Pipe'.
+--
+-- @
+-- 'forPipe' p g = 'runPipe' ('simpleCoPipe' g) p
+-- @
+forPipe :: Monad m =>
+  Pipe i o m a ->  -- ^ Iterator
+  (o -> m i) ->    -- ^ Loop body
+  m a
+forPipe p h = stepPipe p >>= loop
+  where
+    loop (Done a) = pure a
+    loop (Yielding o k) = h o >>= \i -> stepPipe (applyCoPipe k i) >>= loop
+
+-- | Iterate through a 'CoPipe'.
+forCoPipe :: Monad m =>
+  CoPipe i o m a ->
+  (o -> m i) ->
+  i -> m a
+forCoPipe (MkCoPipe k) h i = forPipe (k i) h
+
+-- | 'CoPipe' with no input.
+voidCoPipe :: CoPipe Void o m a
+voidCoPipe = MkCoPipe absurd
+
+-- | Sum a copipe and a pipe with the same output type,
+-- branching on the input type.
+eitherPipe :: Monad m =>
+  (i -> Either i1 i2) ->   -- ^ Dispatch input
+  CoPipe i1 o m a ->       -- ^ Left copipe
+  Pipe i2 o m a ->         -- ^ Right pipe
+  Pipe i o m a
+eitherPipe split t0 (MkPipe p) = MkPipe $ p <&> \e -> case e of
+  Done a -> Done a
+  Yielding o k -> Yielding o (eitherCoPipe split t0 k)
+
+-- | Sum two copipes with the same output type, branching on the input type.
+eitherCoPipe :: Functor m =>
+  (i -> Either i1 i2) ->   -- ^ Dispatch input
+  CoPipe i1 o m a ->       -- ^ Left copipe
+  CoPipe i2 o m a ->       -- ^ Right copipe
+  CoPipe i o m a
+eitherCoPipe split = loop
+  where
+    loop t1 t2 = MkCoPipe (MkPipe . transduce_ t1 t2 . split)
+    transduce_ (MkCoPipe t1) t2 (Left i1) = stepPipe (t1 i1) <&> \e -> case e of
+      Done a -> Done a
+      Yielding o t1' -> Yielding o (loop t1' t2)
+    transduce_ t1 (MkCoPipe t2) (Right i2) = stepPipe (t2 i2) <&> \e -> case e of
+      Done a -> Done a
+      Yielding o t2' -> Yielding  o (loop t1 t2')
+
+-- | Loop the output of a pipe back to its input.
+loopPipe :: Monad m => Pipe o o m a -> m a
+loopPipe (MkPipe p) = p >>= \e -> case e of
+  Done a -> pure a
+  Yielding o k -> loopCoPipe k o
+
+-- | Forward the output of a 'CoPipe' to its input.
+loopCoPipe :: Monad m => CoPipe o o m a -> o -> m a
+loopCoPipe (MkCoPipe k) o = loopPipe (k o)
+
+-- | Convert a returning 'Pipe' into a non-returning 'CoPipe',
+-- yielding 'Nothing' forever once the end has been reached.
+openPipe :: Applicative m => Pipe i o m () -> Pipe i (Maybe o) m void
+openPipe (MkPipe p) = MkPipe (p <&> \e -> case e of
+  Done _ -> Yielding Nothing nothingCoPipe
+  Yielding o k -> Yielding (Just o) (openCoPipe k))
+
+-- | Convert a returning 'CoPipe' into a non-returning 'CoPipe',
+-- yielding 'Nothing' forever once the end has been reached.
+openCoPipe :: Applicative m => CoPipe i o m () -> CoPipe i (Maybe o) m void
+openCoPipe (MkCoPipe k) = MkCoPipe (openPipe . k)
+
+-- | Yield 'Nothing' forever.
+nothingPipe :: Applicative m => Pipe i (Maybe o) m void
+nothingPipe = MkPipe (pure (Yielding Nothing nothingCoPipe))
+
+-- | Yield 'Nothing' forever.
+nothingCoPipe :: Applicative m => CoPipe i (Maybe o) m void
+nothingCoPipe = MkCoPipe (\_ -> nothingPipe)
+
+-- | Representation of 'Pipe' as scoped 'Eff' computations.
+type PipeSEff i o zz a = ScopedEff (Coroutine o i) zz a
+
+-- | Representation of 'Pipe' as 'Eff' computations.
+type PipeEff i o zz a = forall z. z :> zz => Handler (Coroutine o i) z -> Eff zz a
+
+-- | Representation of 'CoPipe' as scoped 'Eff' computations.
+type CoPipeSEff i o zz a = i -> ScopedEff (Coroutine o i) zz a
+
+-- | Representation of 'CoPipe' as 'Eff' computations.
+type CoPipeEff i o zz a = forall z. z :> zz => i -> Handler (Coroutine o i) z -> Eff zz a
+
+-- | Run a 'Pipe' with a fixed number of inputs.
+feedPipe :: Monad m => [i] -> Pipe i o m a -> m [o]
+feedPipe is (MkPipe m) = m >>= \e -> case e of
+  Done _ -> pure []
+  Yielding o k -> (o :) <$> feedCoPipe is k
+
+-- | Run a 'CoPipe' with a fixed number of inputs.
+feedCoPipe :: Monad m => [i] -> CoPipe i o m a -> m [o]
+feedCoPipe [] _ = pure []
+feedCoPipe (i : is) (MkCoPipe k) = feedPipe is (k i)
+
+-- * Handlers
+
+-- | Convert a coroutine that doesn't return into a 'CoPipe'.
+toCoPipe :: forall o i a zz.
+  CoPipeSEff i o zz a -> CoPipe i o (Eff zz) a
+toCoPipe f = MkCoPipe (\i -> toPipe (\h -> f i h))
+
+-- | Convert a 'CoPipe' into a coroutine.
+fromCoPipe :: CoPipe i o (Eff zz) a -> CoPipeEff i o zz a
+fromCoPipe (MkCoPipe k) i h = fromPipe (k i) h
+
+-- | Evaluate a coroutine into a 'Pipe'.
+toPipe :: forall o i a zz.
+  PipeSEff i o zz a ->
+  Pipe i o (Eff zz) a
+toPipe f = MkPipe (handle coroutineHandler (wrap . f))
+  where
+    coroutineHandler :: HandlerBody (Coroutine o i) zz (PipeEvent i o (Eff zz) a)
+    coroutineHandler (Yield o) k = pure (Yielding o (coerce k))
+
+    wrap :: Eff (z :& zz) a -> Eff (z :& zz) (PipeEvent i o (Eff zz) a)
+    wrap = fmap Done
+
+-- | Convet a 'Pipe' into a coroutine.
+fromPipe :: Pipe i o (Eff zz) a -> PipeEff i o zz a
+fromPipe (MkPipe p) h = p >>= \e -> case e of
+  Done a -> pure a
+  Yielding o k -> yield h o >>= \i -> fromCoPipe k i h
+
+-- | Interleave the execution of a copipe and a coroutine.
+withCoPipe :: forall o i a zz.
+  CoPipe i o (Eff zz) a ->
+  ScopedEff (Coroutine i o) zz a ->  -- ^ Starting coroutine
+  Eff zz a
+withCoPipe g f = with g (handle coroutineHandler (fmap wrap . f))
+  where
+    coroutineHandler :: HandlerBody (Coroutine i o) zz (CoPipe i o (Eff zz) a -> Eff zz a)
+    coroutineHandler (Yield o) k = pure $ \g1 -> do
+      stepPipe (applyCoPipe g1 o) >>= \e -> case e of
+        Done a -> pure a
+        Yielding i g2 -> with g2 (k i)
+
+    wrap :: a -> z -> Eff zz a
+    wrap a _ = pure a
+
+    with :: forall g. g -> Eff zz (g -> Eff zz a) -> Eff zz a
+    with g' m = m >>= \f' -> f' g'
+
+-- | Interleave the execution of two coroutines, feeding each one's output to the other's input.
+-- Return the result of the first thread to terminate (the other is discarded)
+withCoroutine :: forall o i a zz.
+  (i -> ScopedEff (Coroutine o i) zz a) ->
+  ScopedEff (Coroutine i o) zz a ->         -- ^ Starting coroutine
+  Eff zz a
+withCoroutine g f = withCoPipe (toCoPipe g) f
+
+-- | Iterate through a coroutine:
+-- execute the loop body @o -> Eff zz i@ for every call to 'Yield' in the coroutine.
+forCoroutine :: forall o i a zz.
+  ScopedEff (Coroutine o i) zz a ->  -- ^ Iterator
+  (o -> Eff zz i) ->  -- ^ Loop body
+  Eff zz a
+forCoroutine f h = handle coroutineHandler f
+  where
+    coroutineHandler :: HandlerBody (Coroutine o i) zz a
+    coroutineHandler (Yield o) k = h o >>= k

@@ -1,186 +1,187 @@-{-# LANGUAGE-  BangPatterns,-  MagicHash,-  RankNTypes,-  ScopedTypeVariables,-  StandaloneKindSignatures,-  TypeOperators,-  UnboxedTuples #-}---- | = Delimited continuations------ Native multi-prompt delimited continuations.--- These primitives let us manipulate slices of the call stack/evaluation--- context delimited by 'reset'.------ This module serves as a foundation for algebraic effect handlers,--- a more structured interface for manipulating continuations and implementing--- user-defined effects.------ The behavior of 'reset' and 'shift0' is summarized by the following equations:------ @--- 'reset' (\\_ -> 'pure' x) = 'pure' x--- 'reset' (\\t -> C ('shift0' t f)) = f (\\x -> 'reset' (\\t -> C x))--- @------ where @C@ is an evaluation context (in which @t@ may occur), i.e.,--- a term of the following form:------ > C x ::= C x >>= k      -- for any function k--- >       | H (\h -> C x)  -- for any handler H ∈ { reset, (`runState` s), ... }--- >       | x--------- This module ensures type safety. The rank-2 type of 'reset'--- guarantees that 'shift0' will always have a maching 'reset' on the stack.------ === References------ - <https://ghc-proposals.readthedocs.io/en/latest/proposals/0313-delimited-continuation-primops.html Delimited continuation primops> (GHC proposal, implemented in GHC 9.6.1).--- - <https://homes.luddy.indiana.edu/ccshan/recur/recur.pdf Shift to Control> (2004) by Chung-chieh Shan. The name 'shift0' follows the nomenclature in that paper.-module Bluefin.Algae.DelCont-  ( PromptTag-  , reset-  , shift0-  , Continuation-  , weakenC1-  , resume-  , continue-  , cancel-  ) where--import Data.Coerce (coerce)-import Data.Functor (void)-import Data.Kind (Type)-import GHC.Exts (State#, RealWorld, PromptTag#, prompt#, control0#, newPromptTag#)-import GHC.IO (IO(IO))-import Bluefin.Internal (Eff(UnsafeMkEff))-import Bluefin.Eff-import qualified Bluefin.Exception as E---- | Tag for a prompt of type @Eff ss a@ and scope @s@.-type PromptTag :: Effects -> Type -> Effects -> Type-data PromptTag ss a s = MkPromptTag (PromptTag# a)---- | Run the enclosed computation under a prompt of type @Eff ss a@.------ @--- f : forall s. 'PromptTag' ss a s -> 'Eff' (s ':&' ss) a--- ---------------------------------------------------- 'reset' (\\t -> f t) : 'Eff' ss a--- @------ The enclosed computation @f@ is given a tag which identifies that prompt--- and remembers its type.--- The scope parameter @s@ prevents the tag from being used outside of the--- computation.------ A prompt ('reset') delimits a slice of the call stack (or evaluation context),--- which can be captured with 'shift0'. This slice, a continuation,--- becomes a function of type @Eff ss0 b -> Eff ss a@ (where @Eff ss0 b@ is the--- result type of 'shift0' at its calling site).--- Calling the continuation restores the slice on the stack.-reset :: forall a ss.-  (forall s. PromptTag ss a s -> Eff (s :& ss) a) ->-  Eff ss a-reset f = unsafeMkEff (\z0 -> case newPromptTag# z0 of-    (# z1, tag #) -> prompt# tag (unsafeRunEff (f (MkPromptTag tag))) z1)---- | Continuations are slices of the call stack, or evaluation context.------ The 'Continuation' type is abstract since not all functions @'Eff' t b -> 'Eff' s a@--- represent evaluation contexts. In particular, 'weakenC1' is not definable for arbitrary--- such functions.------ For example, in------ @--- reset \\tag0 ->---   reset \\tag1 ->---     reset \\tag2 ->---       shift0 tag1 f >>= etc--- @------ 'shift0' captures a continuation, the slice represented by the following--- function:------ @--- MkContinuation \\hole ->---   reset \\tag1 ->---     reset \\tag2 ->---       hole >>= etc--- @------ That continuation has type @'Continuation' t s b a@ where @Eff t b@ is the type of the hole,--- and @Eff s a@ is the type of the result once the hole is plugged.------ The second argument of 'shift0', @f@, is applied to the continuation:------ @--- reset \\tag0 ->---  f (MkContinuation \\hole ->---   reset \\tag1 ->---     reset \\tag2 ->---       hole >>= etc)--- @-newtype Continuation t s b a = MkContinuation (Eff t b -> Eff s a)---- | Extend the context of a continuation.-weakenC1 :: Continuation t s b a -> Continuation (e :& t) (e :& s) b a-weakenC1 = coerce---- | Resume a continuation with a computation under it.-resume :: Continuation t s b a -> Eff t b -> Eff s a-resume (MkContinuation k) = k---- | Resume a cancellable continuation with a result.------ In other words, this converts a cancellable continuation to a simple continuation.-continue :: Continuation t s b a -> b -> Eff s a-continue k = resume k . pure---- | Cancel a continuation: resume by throwing a scoped exception and catch it.------ The continuation SHOULD re-throw unknown exceptions.--- (That is guaranteed if you don't use "Exception.Dynamic".)-cancel :: Continuation t s b a -> Eff s ()-cancel k = E.catch (\ex -> void (resume (weakenC1 k) (E.throw ex ()))) (\_ -> pure ())---- | Capture the continuation up to the tagged prompt.------ @--- _ : s :> ss0--- t : 'PromptTag' ss a s--- f : ('Eff' ss0 b -> 'Eff' ss a) -> 'Eff' ss a--- ------------------------------------------ 'shift0' t (\\k -> f k) : 'Eff' ss0 b--- @------ The prompt ('reset') is reinserted on the stack when the continuation is called:------ @--- 'reset' (\\t -> C ('shift0' t f)) = f (\\x -> 'reset' (\\t -> C x))--- @-shift0 :: forall s a b ss ss0.-  s :> ss0 =>-  PromptTag ss a s ->-  (Continuation ss0 ss b a -> Eff ss a) ->-  Eff ss0 b-shift0 (MkPromptTag tag) f = unsafeMkEff (\z0 ->-  control0# tag (\k# ->-    unsafeRunEff (f (unsafeContinuation# (prompt# tag . k#)))) z0)---- * Internal--type IO# a = State# RealWorld -> (# State# RealWorld , a #)-type Continuation# a b = IO# a -> IO# b--unsafeMkEff :: IO# a -> Eff ss a-unsafeMkEff f = UnsafeMkEff (IO f)--unsafeRunEff :: Eff ss a -> IO# a-unsafeRunEff (UnsafeMkEff (IO f)) = f--unsafeContinuation# :: Continuation# b a -> Continuation t s b a-unsafeContinuation# k = MkContinuation (unsafeMkEff . k . unsafeRunEff)+{-# LANGUAGE
+  BangPatterns,
+  DataKinds,
+  MagicHash,
+  RankNTypes,
+  ScopedTypeVariables,
+  StandaloneKindSignatures,
+  TypeOperators,
+  UnboxedTuples #-}
+
+-- | = Delimited continuations
+--
+-- Native multi-prompt delimited continuations.
+-- These primitives let us manipulate slices of the call stack/evaluation
+-- context delimited by 'reset'.
+--
+-- This module serves as a foundation for algebraic effect handlers,
+-- a more structured interface for manipulating continuations and implementing
+-- user-defined effects.
+--
+-- The behavior of 'reset' and 'shift0' is summarized by the following equations:
+--
+-- @
+-- 'reset' (\\_ -> 'pure' x) = 'pure' x
+-- 'reset' (\\t -> C ('shift0' t f)) = f (\\x -> 'reset' (\\t -> C x))
+-- @
+--
+-- where @C@ is an evaluation context (in which @t@ may occur), i.e.,
+-- a term of the following form:
+--
+-- > C x ::= C x >>= k      -- for any function k
+-- >       | H (\h -> C x)  -- for any handler H ∈ { reset, (`runState` s), ... }
+-- >       | x
+--
+--
+-- This module ensures type safety. The rank-2 type of 'reset'
+-- guarantees that 'shift0' will always have a maching 'reset' on the stack.
+--
+-- === References
+--
+-- - <https://ghc-proposals.readthedocs.io/en/latest/proposals/0313-delimited-continuation-primops.html Delimited continuation primops> (GHC proposal, implemented in GHC 9.6.1).
+-- - <https://homes.luddy.indiana.edu/ccshan/recur/recur.pdf Shift to Control> (2004) by Chung-chieh Shan. The name 'shift0' follows the nomenclature in that paper.
+module Bluefin.Algae.DelCont
+  ( PromptTag
+  , reset
+  , shift0
+  , Continuation
+  , weakenC1
+  , resume
+  , continue
+  , cancel
+  ) where
+
+import Data.Coerce (coerce)
+import Data.Functor (void)
+import Data.Kind (Type)
+import GHC.Exts (State#, RealWorld, PromptTag#, prompt#, control0#, newPromptTag#)
+import GHC.IO (IO(IO))
+import Bluefin.Internal (Eff(UnsafeMkEff))
+import Bluefin.Eff
+import qualified Bluefin.Exception as E
+
+-- | Tag for a prompt of type @Eff ss a@ and scope @s@.
+type PromptTag :: Effects -> Type -> Effects -> Type
+data PromptTag ss a s = MkPromptTag (PromptTag# a)
+
+-- | Run the enclosed computation under a prompt of type @Eff ss a@.
+--
+-- @
+-- f : forall s. 'PromptTag' ss a s -> 'Eff' (s ':&' ss) a
+-- -------------------------------------------------
+-- 'reset' (\\t -> f t) : 'Eff' ss a
+-- @
+--
+-- The enclosed computation @f@ is given a tag which identifies that prompt
+-- and remembers its type.
+-- The scope parameter @s@ prevents the tag from being used outside of the
+-- computation.
+--
+-- A prompt ('reset') delimits a slice of the call stack (or evaluation context),
+-- which can be captured with 'shift0'. This slice, a continuation,
+-- becomes a function of type @Eff ss0 b -> Eff ss a@ (where @Eff ss0 b@ is the
+-- result type of 'shift0' at its calling site).
+-- Calling the continuation restores the slice on the stack.
+reset :: forall a ss.
+  (forall s. PromptTag ss a s -> Eff (s :& ss) a) ->
+  Eff ss a
+reset f = unsafeMkEff (\z0 -> case newPromptTag# z0 of
+    (# z1, tag #) -> prompt# tag (unsafeRunEff (f (MkPromptTag tag))) z1)
+
+-- | Continuations are slices of the call stack, or evaluation context.
+--
+-- The 'Continuation' type is abstract since not all functions @'Eff' t b -> 'Eff' s a@
+-- represent evaluation contexts. In particular, 'weakenC1' is not definable for arbitrary
+-- such functions.
+--
+-- For example, in
+--
+-- @
+-- reset \\tag0 ->
+--   reset \\tag1 ->
+--     reset \\tag2 ->
+--       shift0 tag1 f >>= etc
+-- @
+--
+-- 'shift0' captures a continuation, the slice represented by the following
+-- function:
+--
+-- @
+-- MkContinuation \\hole ->
+--   reset \\tag1 ->
+--     reset \\tag2 ->
+--       hole >>= etc
+-- @
+--
+-- That continuation has type @'Continuation' t s b a@ where @Eff t b@ is the type of the hole,
+-- and @Eff s a@ is the type of the result once the hole is plugged.
+--
+-- The second argument of 'shift0', @f@, is applied to the continuation:
+--
+-- @
+-- reset \\tag0 ->
+--  f (MkContinuation \\hole ->
+--   reset \\tag1 ->
+--     reset \\tag2 ->
+--       hole >>= etc)
+-- @
+newtype Continuation t s b a = MkContinuation (Eff t b -> Eff s a)
+
+-- | Extend the context of a continuation.
+weakenC1 :: Continuation t s b a -> Continuation (e :& t) (e :& s) b a
+weakenC1 = coerce
+
+-- | Resume a continuation with a computation under it.
+resume :: Continuation t s b a -> Eff t b -> Eff s a
+resume (MkContinuation k) = k
+
+-- | Resume a cancellable continuation with a result.
+--
+-- In other words, this converts a cancellable continuation to a simple continuation.
+continue :: Continuation t s b a -> b -> Eff s a
+continue k = resume k . pure
+
+-- | Cancel a continuation: resume by throwing a scoped exception and catch it.
+--
+-- The continuation SHOULD re-throw unknown exceptions.
+-- (That is guaranteed if you don't use "Exception.Dynamic".)
+cancel :: Continuation t s b a -> Eff s ()
+cancel k = E.catch (\ex -> void (resume (weakenC1 k) (E.throw ex ()))) (\_ -> pure ())
+
+-- | Capture the continuation up to the tagged prompt.
+--
+-- @
+-- _ : s :> ss0
+-- t : 'PromptTag' ss a s
+-- f : ('Eff' ss0 b -> 'Eff' ss a) -> 'Eff' ss a
+-- ---------------------------------------
+-- 'shift0' t (\\k -> f k) : 'Eff' ss0 b
+-- @
+--
+-- The prompt ('reset') is reinserted on the stack when the continuation is called:
+--
+-- @
+-- 'reset' (\\t -> C ('shift0' t f)) = f (\\x -> 'reset' (\\t -> C x))
+-- @
+shift0 :: forall s a b ss ss0.
+  s :> ss0 =>
+  PromptTag ss a s ->
+  (Continuation ss0 ss b a -> Eff ss a) ->
+  Eff ss0 b
+shift0 (MkPromptTag tag) f = unsafeMkEff (\z0 ->
+  control0# tag (\k# ->
+    unsafeRunEff (f (unsafeContinuation# (prompt# tag . k#)))) z0)
+
+-- * Internal
+
+type IO# a = State# RealWorld -> (# State# RealWorld , a #)
+type Continuation# a b = IO# a -> IO# b
+
+unsafeMkEff :: IO# a -> Eff ss a
+unsafeMkEff f = UnsafeMkEff (IO f)
+
+unsafeRunEff :: Eff ss a -> IO# a
+unsafeRunEff (UnsafeMkEff (IO f)) = f
+
+unsafeContinuation# :: Continuation# b a -> Continuation t s b a
+unsafeContinuation# k = MkContinuation (unsafeMkEff . k . unsafeRunEff)

@@ -1,86 +1,87 @@-{-# LANGUAGE-  BangPatterns,-  DeriveAnyClass,-  GADTs,-  RankNTypes,-  ScopedTypeVariables,-  StandaloneKindSignatures,-  TypeOperators #-}---- | = Algebraic effects and named handlers------ Variant of "Bluefin.Algae" using dynamic exceptions to cancel continuations.-module Bluefin.Algae.DynExn-  ( AEffect-  , HandlerBody-  , Handler-  , handle-  , call-  , continue-  , discontinue-  , discontinueIO-  , cancel-  , CancelContinuation(..)-  ) where--import Control.Exception (Exception)-import Data.Kind (Type)-import Data.Functor (void)-import Bluefin.Internal (Eff, Effects, type (:&), type (:>), IOE)-import Bluefin.Algae.DelCont (PromptTag, Continuation, reset, shift0, resume, continue)-import Bluefin.Exception.Dynamic-import Bluefin.Algae (AEffect)---- | Interpretation of an algebraic effect @f@: a function to handle the operations of @f@--- with cancellable continuations.-type HandlerBody :: Effects -> AEffect -> Effects -> Type -> Type-type HandlerBody ex f ss a = (forall x ss0. ex :> ss0 => f x -> Continuation ss0 ss x a -> Eff ss a)---- | Handler to call operations of the effect @f@ with cancellable continuations.-type Handler :: Effects -> AEffect -> Effects -> Type-data Handler ex f s where-  MkHandler :: !(PromptTag ss a s) -> HandlerBody ex f ss a -> Handler ex f s---- | Handle operations of @f@ with cancellable continuations.------ The handle for exceptions (first argument) is only there to guide type inference.--- it can be either 'IOE' or 'DynExn'.-handle ::-  h ex ->-  HandlerBody ex f ss a ->-  (forall s. Handler ex f s -> Eff (s :& ss) a) ->-  Eff ss a-handle _ h act = reset (\p -> act (MkHandler p h))---- | Call an operation of @f@ with cancellable continuations.-call :: (ex :> es, s :> es) => Handler ex f s -> f a -> Eff es a-call (MkHandler p h) op = shift0 p (\k -> h op k)---- | Resume by throwing a dynamic exception.------ Note that different outcomes are possible depending on your handled computation.--- Be sure to handle them appropriately.------ - A common situation is that the continuation will rethrow the initial exception,---   then you can just catch it (or use 'cancel').--- - The continuation may throw a different exception, so you should be---   careful to catch the right exception.--- - The continuation may also catch your exception and terminate normally---   with a result of type @a@.-discontinue :: (Exception e, ex :> es0) => DynExn ex -> Continuation es0 es b a -> e -> Eff es a-discontinue ex k e = resume k (throw ex e)---- | Specialization of 'discontinue' to 'IOE'.-discontinueIO :: (Exception e, io :> es0) => IOE io -> Continuation es0 es b a -> e -> Eff es a-discontinueIO io = discontinue (ioeToDynExn io)---- | 'discontinue' a continuation with the v'CancelContinuation' exception and catch it when it--- is re-thrown by the continuation.------ The continuation SHOULD re-throw v'CancelContinuation' if it catches it.-cancel :: (ex :> es0, ex :> es) => DynExn ex -> Continuation es0 es b a -> Eff es ()-cancel ex k = catch ex (void (discontinue ex k CancelContinuation)) (\CancelContinuation -> pure ())---- | Exception thrown by 'cancel'.-data CancelContinuation = CancelContinuation-  deriving (Show, Exception)+{-# LANGUAGE
+  BangPatterns,
+  DataKinds,
+  DeriveAnyClass,
+  GADTs,
+  RankNTypes,
+  ScopedTypeVariables,
+  StandaloneKindSignatures,
+  TypeOperators #-}
+
+-- | = Algebraic effects and named handlers
+--
+-- Variant of "Bluefin.Algae" using dynamic exceptions to cancel continuations.
+module Bluefin.Algae.DynExn
+  ( AEffect
+  , HandlerBody
+  , Handler
+  , handle
+  , call
+  , continue
+  , discontinue
+  , discontinueIO
+  , cancel
+  , CancelContinuation(..)
+  ) where
+
+import Control.Exception (Exception)
+import Data.Kind (Type)
+import Data.Functor (void)
+import Bluefin.Internal (Eff, Effects, type (:&), type (:>), IOE)
+import Bluefin.Algae.DelCont (PromptTag, Continuation, reset, shift0, resume, continue)
+import Bluefin.Exception.Dynamic
+import Bluefin.Algae (AEffect)
+
+-- | Interpretation of an algebraic effect @f@: a function to handle the operations of @f@
+-- with cancellable continuations.
+type HandlerBody :: Effects -> AEffect -> Effects -> Type -> Type
+type HandlerBody ex f ss a = (forall x ss0. ex :> ss0 => f x -> Continuation ss0 ss x a -> Eff ss a)
+
+-- | Handler to call operations of the effect @f@ with cancellable continuations.
+type Handler :: Effects -> AEffect -> Effects -> Type
+data Handler ex f s where
+  MkHandler :: !(PromptTag ss a s) -> HandlerBody ex f ss a -> Handler ex f s
+
+-- | Handle operations of @f@ with cancellable continuations.
+--
+-- The handle for exceptions (first argument) is only there to guide type inference.
+-- it can be either 'IOE' or 'DynExn'.
+handle ::
+  h ex ->
+  HandlerBody ex f ss a ->
+  (forall s. Handler ex f s -> Eff (s :& ss) a) ->
+  Eff ss a
+handle _ h act = reset (\p -> act (MkHandler p h))
+
+-- | Call an operation of @f@ with cancellable continuations.
+call :: (ex :> es, s :> es) => Handler ex f s -> f a -> Eff es a
+call (MkHandler p h) op = shift0 p (\k -> h op k)
+
+-- | Resume by throwing a dynamic exception.
+--
+-- Note that different outcomes are possible depending on your handled computation.
+-- Be sure to handle them appropriately.
+--
+-- - A common situation is that the continuation will rethrow the initial exception,
+--   then you can just catch it (or use 'cancel').
+-- - The continuation may throw a different exception, so you should be
+--   careful to catch the right exception.
+-- - The continuation may also catch your exception and terminate normally
+--   with a result of type @a@.
+discontinue :: (Exception e, ex :> es0) => DynExn ex -> Continuation es0 es b a -> e -> Eff es a
+discontinue ex k e = resume k (throw ex e)
+
+-- | Specialization of 'discontinue' to 'IOE'.
+discontinueIO :: (Exception e, io :> es0) => IOE io -> Continuation es0 es b a -> e -> Eff es a
+discontinueIO io = discontinue (ioeToDynExn io)
+
+-- | 'discontinue' a continuation with the v'CancelContinuation' exception and catch it when it
+-- is re-thrown by the continuation.
+--
+-- The continuation SHOULD re-throw v'CancelContinuation' if it catches it.
+cancel :: (ex :> es0, ex :> es) => DynExn ex -> Continuation es0 es b a -> Eff es ()
+cancel ex k = catch ex (void (discontinue ex k CancelContinuation)) (\CancelContinuation -> pure ())
+
+-- | Exception thrown by 'cancel'.
+data CancelContinuation = CancelContinuation
+  deriving (Show, Exception)

@@ -1,102 +1,102 @@-{-# LANGUAGE-  BangPatterns,-  GADTs,-  KindSignatures,-  RankNTypes,-  ScopedTypeVariables,-  StandaloneKindSignatures,-  TypeOperators #-}---- | = Exceptions as an algebraic effect------ These scoped exceptions are similar to "Bluefin.Exception".------ Algebraic operations in Bluefin are truly scoped:--- they cannot be intercepted by exception handlers, notably 'Bluefin.Eff.bracket'.------ 'catch' and 'try' make an explicit call to 'cancel' to trigger exception handlers.--- This makes them equivalent to "Bluefin.Exception".------ The simpler variants 'catch'' and 'try'' don't use 'cancel', so they are--- faster when there is no 'Bluefin.Eff.bracket' to worry about.-module Bluefin.Algae.Exception-  ( -- * Operations-    Exception(..)-  , throw--    -- * Default handlers-  , catch-  , try--    -- * Variant without cancelling continuations-  , catch'-  , try'-  ) where--import Data.Kind (Type)-import Bluefin.Eff (Eff, type (:&), type (:>))-import Bluefin.Algae---- | Exception interface.-data Exception (e :: Type) :: AEffect where-  -- | Throw an exception.-  Throw :: e -> Exception e r---- | Throw an exception. Call the 'Throw' operation.-throw :: z :> zz => Handler (Exception e) z -> e -> Eff zz a-throw h e = call h (Throw e)---- | Catch an exception.------ Simple version of 'catch' which just discards the continuation--- instead of explicitly cancelling it.------ === Warning: Discarded continuations------ 'catch'' discards the continuation, which may be problematic--- if there are resources to be freed by the continuation (typically--- if 'throw' was called in the middle of a 'Bluefin.Eff.bracket').--- Use 'catch' to free those resources instead.------ Without anything like 'Bluefin.Eff.bracket', 'catch'' does less work.--- 'catch' makes 'throw' traverse the stack twice (first to find the prompt,--- then to 'cancel' the continuation).--- 'catch'' makes 'throw' traverse the stack only once.-catch' :: forall e a zz.-  (forall z. Handler (Exception e) z -> Eff (z :& zz) a) ->  -- ^ Handled computation-  (e -> Eff zz a) ->  -- ^ Exception clause-  Eff zz a-catch' f h = handle exceptionHandler f-  where-    exceptionHandler :: HandlerBody (Exception e) zz a-    exceptionHandler (Throw e) _ = h e---- | Return 'Either' the exception or the result of the handled computation.------ Simple version of 'try' which discards the continuation (like 'catch'').-try' :: forall e a zz.-  (forall z. Handler (Exception e) z -> Eff (z :& zz) a) ->-  Eff zz (Either e a)-try' f = catch' (fmap Right . f) (pure . Left)---- | Catch an exception.------ The continuation is canceled ('cancel') when--- an exception is thrown to this handler.-catch :: forall e a zz.-  (forall z. Handler (Exception e) z -> Eff (z :& zz) a) ->-  (e -> Eff zz a) ->-  Eff zz a-catch f h = handle' exceptionHandler f-  where-    exceptionHandler :: HandlerBody' (Exception e) zz a-    exceptionHandler (Throw e) k = cancel k >> h e---- | Return 'Either' the exception or the result of the handled computation.------ The continuation is canceled ('cancel') when--- an exception is thrown to this handler.-try :: forall e a zz.-  (forall z. Handler (Exception e) z -> Eff (z :& zz) a) ->-  Eff zz (Either e a)-try f = catch (fmap Right . f) (pure . Left)+{-# LANGUAGE
+  BangPatterns,
+  GADTs,
+  KindSignatures,
+  RankNTypes,
+  ScopedTypeVariables,
+  StandaloneKindSignatures,
+  TypeOperators #-}
+
+-- | = Exceptions as an algebraic effect
+--
+-- These scoped exceptions are similar to "Bluefin.Exception".
+--
+-- Algebraic operations in Bluefin are truly scoped:
+-- they cannot be intercepted by exception handlers, notably 'Bluefin.Eff.bracket'.
+--
+-- 'catch' and 'try' make an explicit call to 'cancel' to trigger exception handlers.
+-- This makes them equivalent to "Bluefin.Exception".
+--
+-- The simpler variants 'catch'' and 'try'' don't use 'cancel', so they are
+-- faster when there is no 'Bluefin.Eff.bracket' to worry about.
+module Bluefin.Algae.Exception
+  ( -- * Operations
+    Exception(..)
+  , throw
+
+    -- * Default handlers
+  , catch
+  , try
+
+    -- * Variant without cancelling continuations
+  , catch'
+  , try'
+  ) where
+
+import Data.Kind (Type)
+import Bluefin.Eff (Eff, type (:&), type (:>))
+import Bluefin.Algae
+
+-- | Exception interface.
+data Exception (e :: Type) :: AEffect where
+  -- | Throw an exception.
+  Throw :: e -> Exception e r
+
+-- | Throw an exception. Call the 'Throw' operation.
+throw :: z :> zz => Handler (Exception e) z -> e -> Eff zz a
+throw h e = call h (Throw e)
+
+-- | Catch an exception.
+--
+-- Simple version of 'catch' which just discards the continuation
+-- instead of explicitly cancelling it.
+--
+-- === Warning: Discarded continuations
+--
+-- 'catch'' discards the continuation, which may be problematic
+-- if there are resources to be freed by the continuation (typically
+-- if 'throw' was called in the middle of a 'Bluefin.Eff.bracket').
+-- Use 'catch' to free those resources instead.
+--
+-- Without anything like 'Bluefin.Eff.bracket', 'catch'' does less work.
+-- 'catch' makes 'throw' traverse the stack twice (first to find the prompt,
+-- then to 'cancel' the continuation).
+-- 'catch'' makes 'throw' traverse the stack only once.
+catch' :: forall e a zz.
+  (forall z. Handler (Exception e) z -> Eff (z :& zz) a) ->  -- ^ Handled computation
+  (e -> Eff zz a) ->  -- ^ Exception clause
+  Eff zz a
+catch' f h = handle exceptionHandler f
+  where
+    exceptionHandler :: HandlerBody (Exception e) zz a
+    exceptionHandler (Throw e) _ = h e
+
+-- | Return 'Either' the exception or the result of the handled computation.
+--
+-- Simple version of 'try' which discards the continuation (like 'catch'').
+try' :: forall e a zz.
+  (forall z. Handler (Exception e) z -> Eff (z :& zz) a) ->
+  Eff zz (Either e a)
+try' f = catch' (fmap Right . f) (pure . Left)
+
+-- | Catch an exception.
+--
+-- The continuation is canceled ('cancel') when
+-- an exception is thrown to this handler.
+catch :: forall e a zz.
+  (forall z. Handler (Exception e) z -> Eff (z :& zz) a) ->
+  (e -> Eff zz a) ->
+  Eff zz a
+catch f h = handle' exceptionHandler f
+  where
+    exceptionHandler :: HandlerBody' (Exception e) zz a
+    exceptionHandler (Throw e) k = cancel k >> h e
+
+-- | Return 'Either' the exception or the result of the handled computation.
+--
+-- The continuation is canceled ('cancel') when
+-- an exception is thrown to this handler.
+try :: forall e a zz.
+  (forall z. Handler (Exception e) z -> Eff (z :& zz) a) ->
+  Eff zz (Either e a)
+try f = catch (fmap Right . f) (pure . Left)

@@ -1,45 +1,45 @@-{-# LANGUAGE-  BangPatterns,-  GADTs,-  RankNTypes,-  ScopedTypeVariables,-  StandaloneKindSignatures,-  TypeOperators #-}---- | = Exceptions as an algebraic effect------ Variant of "Bluefin.Algae.Exception" that uses dynamic exceptions to cancel--- continuations.-module Bluefin.Algae.Exception.DynExn-  ( Exception(..)-  , throw-  , catch-  , try-  ) where--import Bluefin.Eff (Eff, type (:&), type (:>))-import Bluefin.Algae.DynExn-import Bluefin.Algae.Exception (Exception(..))-import Bluefin.Exception.Dynamic (DynExn)---- | Catch an exception.-catch :: forall e a ex zz. ex :> zz =>-  DynExn ex ->-  (forall z. Handler ex (Exception e) z -> Eff (z :& zz) a) ->-  (e -> Eff zz a) ->-  Eff zz a-catch ex f h = handle ex exceptionHandler f-  where-    exceptionHandler :: HandlerBody ex (Exception e) zz a-    exceptionHandler (Throw e) k = cancel ex k *> h e---- | Return 'Either' the exception or the result of the handled computation.-try :: forall e a ex zz. ex :> zz =>-  DynExn ex ->-  (forall z. Handler ex (Exception e) z -> Eff (z :& zz) a) ->-  Eff zz (Either e a)-try ex f = catch ex (fmap Right . f) (pure . Left)---- | Throw an exception. Call the 'Throw' operation.-throw :: (ex :> zz, z :> zz) => Handler ex (Exception e) z -> e -> Eff zz a-throw h e = call h (Throw e)+{-# LANGUAGE
+  BangPatterns,
+  GADTs,
+  RankNTypes,
+  ScopedTypeVariables,
+  StandaloneKindSignatures,
+  TypeOperators #-}
+
+-- | = Exceptions as an algebraic effect
+--
+-- Variant of "Bluefin.Algae.Exception" that uses dynamic exceptions to cancel
+-- continuations.
+module Bluefin.Algae.Exception.DynExn
+  ( Exception(..)
+  , throw
+  , catch
+  , try
+  ) where
+
+import Bluefin.Eff (Eff, type (:&), type (:>))
+import Bluefin.Algae.DynExn
+import Bluefin.Algae.Exception (Exception(..))
+import Bluefin.Exception.Dynamic (DynExn)
+
+-- | Catch an exception.
+catch :: forall e a ex zz. ex :> zz =>
+  DynExn ex ->
+  (forall z. Handler ex (Exception e) z -> Eff (z :& zz) a) ->
+  (e -> Eff zz a) ->
+  Eff zz a
+catch ex f h = handle ex exceptionHandler f
+  where
+    exceptionHandler :: HandlerBody ex (Exception e) zz a
+    exceptionHandler (Throw e) k = cancel ex k *> h e
+
+-- | Return 'Either' the exception or the result of the handled computation.
+try :: forall e a ex zz. ex :> zz =>
+  DynExn ex ->
+  (forall z. Handler ex (Exception e) z -> Eff (z :& zz) a) ->
+  Eff zz (Either e a)
+try ex f = catch ex (fmap Right . f) (pure . Left)
+
+-- | Throw an exception. Call the 'Throw' operation.
+throw :: (ex :> zz, z :> zz) => Handler ex (Exception e) z -> e -> Eff zz a
+throw h e = call h (Throw e)

@@ -1,95 +1,95 @@-{-# LANGUAGE-  BangPatterns,-  GADTs,-  KindSignatures,-  RankNTypes,-  ScopedTypeVariables,-  StandaloneKindSignatures,-  TypeOperators #-}---- | Nondeterministic choice as an algebraic effect.------ === Warning: Non-linear continuations------ The handlers 'forAllChoices' and 'toList' call continuations zero or twice.--- Don't use them to handle a computation that must ensure linear usage of resources.-module Bluefin.Algae.NonDeterminism-  ( -- * Operations-    Choice(..)-  , choose-  , nil-  , assume-  , pick-  , removeFrom-    -- * Handlers-  , forAllChoices-  , toList-  , foldChoice-  ) where--import Control.Monad ((>=>), join)-import Bluefin.Internal (insertFirst)-import Bluefin.Eff (Eff, type (:&), type (:>))-import Bluefin.Algae---- | Choice effect.-data Choice :: AEffect where-  -- | Choose one of two alternatives.-  Choose :: a -> a -> Choice a-  -- | No choice.-  Nil :: Choice a---- | Choose one of two alternatives. Call the 'Choose' operation.-choose :: z :> zz => Handler Choice z -> a -> a -> Eff zz a-choose h x y = call h (Choose x y)---- | No choice. Call the 'Nil' operation.-nil :: z :> zz => Handler Choice z -> Eff zz a-nil h = call h Nil---- | Do nothing if @True@. Discard (call 'nil') if @False@.-assume :: z :> zz => Handler Choice z -> Bool -> Eff zz ()-assume _ True = pure ()-assume h False = nil h---- | Pick an element in a list.-pick :: z :> zz => Handler Choice z -> [a] -> Eff zz a-pick h [] = nil h-pick h (x : xs) = join $ choose h (pure x) (pick h xs)---- | Remove an element from a list, returning the resulting list as well.--- The order of elements is preserved.-removeFrom :: z :> zz => Handler Choice z -> [a] -> Eff zz (a, [a])-removeFrom h = loop []-  where-    loop _ [] = nil h-    loop ys (x : xs) = join $ choose h (pure (x, reverse ys ++ xs)) (loop (x : ys) xs)---- | Apply a function to every result of the nondeterministic computation.-forAllChoices :: forall a zz.-  (forall z. Handler Choice z -> Eff (z :& zz) a) ->-  (a -> Eff zz ()) ->-  Eff zz ()-forAllChoices f h = foldChoice h (pure ()) (>>) f---- | Collect the results of a nondeterministic computation in a list.-toList :: forall a zz.-  (forall z. Handler Choice z -> Eff (z :& zz) a) ->-  Eff zz [a]-toList f = unwrap (foldChoice (pure . (:)) (pure id) (liftA2 (.)) f)-  where-    unwrap :: Eff zz ([a] -> [a]) -> Eff zz [a]-    unwrap = fmap ($ [])---- | Generic 'Choice' handler parameterized by a monoid.-foldChoice :: forall a r zz.-  (a -> Eff zz r) ->           -- ^ Injection-  Eff zz r ->                            -- ^ Identity element-  (Eff zz r -> Eff zz r -> Eff zz r) ->  -- ^ Binary operation-  ScopedEff Choice zz a ->-  Eff zz r-foldChoice oneE nilE appendE f = handle choiceHandler (f >=> insertFirst . oneE)-  where-    choiceHandler :: HandlerBody Choice zz r-    choiceHandler (Choose x y) k = appendE (k x) (k y)-    choiceHandler Nil _k = nilE+{-# LANGUAGE
+  BangPatterns,
+  GADTs,
+  KindSignatures,
+  RankNTypes,
+  ScopedTypeVariables,
+  StandaloneKindSignatures,
+  TypeOperators #-}
+
+-- | Nondeterministic choice as an algebraic effect.
+--
+-- === Warning: Non-linear continuations
+--
+-- The handlers 'forAllChoices' and 'toList' call continuations zero or twice.
+-- Don't use them to handle a computation that must ensure linear usage of resources.
+module Bluefin.Algae.NonDeterminism
+  ( -- * Operations
+    Choice(..)
+  , choose
+  , nil
+  , assume
+  , pick
+  , removeFrom
+    -- * Handlers
+  , forAllChoices
+  , toList
+  , foldChoice
+  ) where
+
+import Control.Monad ((>=>), join)
+import Bluefin.Internal (insertFirst)
+import Bluefin.Eff (Eff, type (:&), type (:>))
+import Bluefin.Algae
+
+-- | Choice effect.
+data Choice :: AEffect where
+  -- | Choose one of two alternatives.
+  Choose :: a -> a -> Choice a
+  -- | No choice.
+  Nil :: Choice a
+
+-- | Choose one of two alternatives. Call the 'Choose' operation.
+choose :: z :> zz => Handler Choice z -> a -> a -> Eff zz a
+choose h x y = call h (Choose x y)
+
+-- | No choice. Call the 'Nil' operation.
+nil :: z :> zz => Handler Choice z -> Eff zz a
+nil h = call h Nil
+
+-- | Do nothing if @True@. Discard (call 'nil') if @False@.
+assume :: z :> zz => Handler Choice z -> Bool -> Eff zz ()
+assume _ True = pure ()
+assume h False = nil h
+
+-- | Pick an element in a list.
+pick :: z :> zz => Handler Choice z -> [a] -> Eff zz a
+pick h [] = nil h
+pick h (x : xs) = join $ choose h (pure x) (pick h xs)
+
+-- | Remove an element from a list, returning the resulting list as well.
+-- The order of elements is preserved.
+removeFrom :: z :> zz => Handler Choice z -> [a] -> Eff zz (a, [a])
+removeFrom h = loop []
+  where
+    loop _ [] = nil h
+    loop ys (x : xs) = join $ choose h (pure (x, reverse ys ++ xs)) (loop (x : ys) xs)
+
+-- | Apply a function to every result of the nondeterministic computation.
+forAllChoices :: forall a zz.
+  (forall z. Handler Choice z -> Eff (z :& zz) a) ->
+  (a -> Eff zz ()) ->
+  Eff zz ()
+forAllChoices f h = foldChoice h (pure ()) (>>) f
+
+-- | Collect the results of a nondeterministic computation in a list.
+toList :: forall a zz.
+  (forall z. Handler Choice z -> Eff (z :& zz) a) ->
+  Eff zz [a]
+toList f = unwrap (foldChoice (pure . (:)) (pure id) (liftA2 (.)) f)
+  where
+    unwrap :: Eff zz ([a] -> [a]) -> Eff zz [a]
+    unwrap = fmap ($ [])
+
+-- | Generic 'Choice' handler parameterized by a monoid.
+foldChoice :: forall a r zz.
+  (a -> Eff zz r) ->           -- ^ Injection
+  Eff zz r ->                            -- ^ Identity element
+  (Eff zz r -> Eff zz r -> Eff zz r) ->  -- ^ Binary operation
+  ScopedEff Choice zz a ->
+  Eff zz r
+foldChoice oneE nilE appendE f = handle choiceHandler (f >=> insertFirst . oneE)
+  where
+    choiceHandler :: HandlerBody Choice zz r
+    choiceHandler (Choose x y) k = appendE (k x) (k y)
+    choiceHandler Nil _k = nilE

@@ -1,39 +1,39 @@-{-# LANGUAGE-  DataKinds,-  GADTs,-  KindSignatures,-  RankNTypes,-  ScopedTypeVariables,-  TypeOperators #-}--- | = Reader as an algebraic effect------ Access to a read-only environment.-module Bluefin.Algae.Reader-  ( -- * Operation-    Reader(..)-  , ask--    -- * Handler-  , runReader-  ) where--import Data.Kind (Type)-import Bluefin.Algae-import Bluefin.Eff (Eff, type (:>), type (:&))---- | The reader effect.-data Reader (a :: Type) :: AEffect where-  -- | Ask for a value.-  Ask :: Reader a a---- | Ask for a value. Call the 'Ask' operation.-ask :: s :> ss => Handler (Reader a) s -> Eff ss a-ask h = call h Ask---- | Answer 'Ask' operations of the handled computation with a fixed value.-runReader :: forall a b ss.-  a -> (forall s. Handler (Reader a) s -> Eff (s :& ss) b) -> Eff ss b-runReader a = handle readerHandler-  where-    readerHandler :: Reader a r -> (r -> Eff ss b) -> Eff ss b-    readerHandler Ask k = k a+{-# LANGUAGE
+  DataKinds,
+  GADTs,
+  KindSignatures,
+  RankNTypes,
+  ScopedTypeVariables,
+  TypeOperators #-}
+-- | = Reader as an algebraic effect
+--
+-- Access to a read-only environment.
+module Bluefin.Algae.Reader
+  ( -- * Operation
+    Reader(..)
+  , ask
+
+    -- * Handler
+  , runReader
+  ) where
+
+import Data.Kind (Type)
+import Bluefin.Algae
+import Bluefin.Eff (Eff, type (:>), type (:&))
+
+-- | The reader effect.
+data Reader (a :: Type) :: AEffect where
+  -- | Ask for a value.
+  Ask :: Reader a a
+
+-- | Ask for a value. Call the 'Ask' operation.
+ask :: s :> ss => Handler (Reader a) s -> Eff ss a
+ask h = call h Ask
+
+-- | Answer 'Ask' operations of the handled computation with a fixed value.
+runReader :: forall a b ss.
+  a -> (forall s. Handler (Reader a) s -> Eff (s :& ss) b) -> Eff ss b
+runReader a = handle readerHandler
+  where
+    readerHandler :: Reader a r -> (r -> Eff ss b) -> Eff ss b
+    readerHandler Ask k = k a

@@ -1,100 +1,100 @@-{-# LANGUAGE-  BangPatterns,-  GADTs,-  KindSignatures,-  RankNTypes,-  ScopedTypeVariables,-  StandaloneKindSignatures,-  TypeOperators #-}---- | = State as an algebraic effect------ The 'runState' handler calls each continuation exactly once.--- It is compatible with single-shot continuations.-module Bluefin.Algae.State-  ( -- * Operations-    State(..)-  , get-  , put-  , putL-  , modify-  , modifyL--    -- * Handlers-  , runState-  , evalState-  , execState-  ) where--import Data.Kind (Type)-import Bluefin.Eff (Eff, type (:&), type (:>))-import Bluefin.Algae---- | The state effect.-data State (s :: Type) :: AEffect where-  -- | Get the current state.-  Get :: State s s-  -- | Put a new state.-  Put :: s -> State s ()---- | Get the current state. Call the 'Get' operation.-get :: z :> zz => Handler (State s) z -> Eff zz s-get h = call h Get---- | Put a new state. Call the 'Put' operation.------ This function is strict.-put :: z :> zz => Handler (State s) z -> s -> Eff zz ()-put h !s = call h (Put s)---- | Lazy variant of 'put'.-putL :: z :> zz => Handler (State s) z -> s -> Eff zz ()-putL h s = call h (Put s)---- | Modify the state.------ This function is strict in the modified state.-modify :: z :> zz => Handler (State s) z -> (s -> s) -> Eff zz ()-modify h f = get h >>= put h . f---- | Lazy variant of 'modify'.-modifyL :: z :> zz => Handler (State s) z -> (s -> s) -> Eff zz ()-modifyL h f = get h >>= putL h . f---- | Run a stateful computation from the given starting state.-runState ::-  s ->  -- ^ Initial state-  (forall z. Handler (State s) z -> Eff (z :& zz) a) ->  -- ^ Stateful computation-  Eff zz (a, s)-runState = runStateWith (,)---- | Variant of 'runState' that returns only the result value.-evalState ::-  s ->  -- ^ Initial state-  (forall z. Handler (State s) z -> Eff (z :& zz) a) ->  -- ^ Stateful computation-  Eff zz a-evalState = runStateWith const---- | Variant of 'runState' that returns only the final state.-execState ::-  s ->  -- ^ Initial state-  (forall z. Handler (State s) z -> Eff (z :& zz) a) ->  -- ^ Stateful computation-  Eff zz s-execState = runStateWith (const id)--runStateWith :: forall s a r zz.-  (a -> s -> r) ->  -- ^ Combine the result and final state.-  s ->  -- ^ Initial state-  (forall z. Handler (State s) z -> Eff (z :& zz) a) ->  -- ^ Stateful computation-  Eff zz r-runStateWith finish s0 f = unwrap s0 (handle stateHandler (wrap . f))-  where-    stateHandler :: HandlerBody (State s) zz (s -> Eff zz r)-    stateHandler Get k = pure (\s -> k s >>= \k1 -> k1 s)-    stateHandler (Put s) k = pure (\_ -> k () >>= \k1 -> k1 s)--    wrap :: Eff (z :& zz) a -> Eff (z :& zz) (s -> Eff zz r)-    wrap = fmap (\a s -> pure (finish a s))--    unwrap :: s -> Eff zz (s -> Eff zz r) -> Eff zz r-    unwrap s m = m >>= \k -> k s+{-# LANGUAGE
+  BangPatterns,
+  GADTs,
+  KindSignatures,
+  RankNTypes,
+  ScopedTypeVariables,
+  StandaloneKindSignatures,
+  TypeOperators #-}
+
+-- | = State as an algebraic effect
+--
+-- The 'runState' handler calls each continuation exactly once.
+-- It is compatible with single-shot continuations.
+module Bluefin.Algae.State
+  ( -- * Operations
+    State(..)
+  , get
+  , put
+  , putL
+  , modify
+  , modifyL
+
+    -- * Handlers
+  , runState
+  , evalState
+  , execState
+  ) where
+
+import Data.Kind (Type)
+import Bluefin.Eff (Eff, type (:&), type (:>))
+import Bluefin.Algae
+
+-- | The state effect.
+data State (s :: Type) :: AEffect where
+  -- | Get the current state.
+  Get :: State s s
+  -- | Put a new state.
+  Put :: s -> State s ()
+
+-- | Get the current state. Call the 'Get' operation.
+get :: z :> zz => Handler (State s) z -> Eff zz s
+get h = call h Get
+
+-- | Put a new state. Call the 'Put' operation.
+--
+-- This function is strict.
+put :: z :> zz => Handler (State s) z -> s -> Eff zz ()
+put h !s = call h (Put s)
+
+-- | Lazy variant of 'put'.
+putL :: z :> zz => Handler (State s) z -> s -> Eff zz ()
+putL h s = call h (Put s)
+
+-- | Modify the state.
+--
+-- This function is strict in the modified state.
+modify :: z :> zz => Handler (State s) z -> (s -> s) -> Eff zz ()
+modify h f = get h >>= put h . f
+
+-- | Lazy variant of 'modify'.
+modifyL :: z :> zz => Handler (State s) z -> (s -> s) -> Eff zz ()
+modifyL h f = get h >>= putL h . f
+
+-- | Run a stateful computation from the given starting state.
+runState ::
+  s ->  -- ^ Initial state
+  (forall z. Handler (State s) z -> Eff (z :& zz) a) ->  -- ^ Stateful computation
+  Eff zz (a, s)
+runState = runStateWith (,)
+
+-- | Variant of 'runState' that returns only the result value.
+evalState ::
+  s ->  -- ^ Initial state
+  (forall z. Handler (State s) z -> Eff (z :& zz) a) ->  -- ^ Stateful computation
+  Eff zz a
+evalState = runStateWith const
+
+-- | Variant of 'runState' that returns only the final state.
+execState ::
+  s ->  -- ^ Initial state
+  (forall z. Handler (State s) z -> Eff (z :& zz) a) ->  -- ^ Stateful computation
+  Eff zz s
+execState = runStateWith (const id)
+
+runStateWith :: forall s a r zz.
+  (a -> s -> r) ->  -- ^ Combine the result and final state.
+  s ->  -- ^ Initial state
+  (forall z. Handler (State s) z -> Eff (z :& zz) a) ->  -- ^ Stateful computation
+  Eff zz r
+runStateWith finish s0 f = unwrap s0 (handle stateHandler (wrap . f))
+  where
+    stateHandler :: HandlerBody (State s) zz (s -> Eff zz r)
+    stateHandler Get k = pure (\s -> k s >>= \k1 -> k1 s)
+    stateHandler (Put s) k = pure (\_ -> k () >>= \k1 -> k1 s)
+
+    wrap :: Eff (z :& zz) a -> Eff (z :& zz) (s -> Eff zz r)
+    wrap = fmap (\a s -> pure (finish a s))
+
+    unwrap :: s -> Eff zz (s -> Eff zz r) -> Eff zz r
+    unwrap s m = m >>= \k -> k s

@@ -1,85 +1,86 @@-{-# LANGUAGE-  KindSignatures,-  RankNTypes,-  ScopedTypeVariables,-  TypeOperators #-}--- | = Dynamic exceptions------ This is the vanilla exception mechanism from @IO@.--- Use this module to handle exceptions from external (non-bluefin) APIs.------ Another motivation is to serve as a principled (experimental) framework--- for resource management with 'bracket'.------ The core Bluefin API exposes a 'Bluefin.Eff.bracket' in "Bluefin.Eff"--- which (intentionally) weakens the scoping of scoped exceptions in--- "Bluefin.Exception".------ This module is an experiment for a world where------ - scoped exceptions are truly scoped (unlike "Bluefin.Exception");--- - the capability to catch and throw dynamic exceptions is explicit---   (unlike 'Bluefin.Eff.bracket' in "Bluefin.Eff").-module Bluefin.Exception.Dynamic-  ( DynExn-  , runDynExn-  , ioeToDynExn-  , throw-  , catch-  , bracket-  , finally-  , onException-  , throwIO-  , catchIO-  ) where--import qualified Control.Exception as E-import qualified Bluefin.Internal as B-import Bluefin.Eff (Eff, Effects, type (:>))-import Bluefin.IO (IOE)---- | Capability to catch and throw dynamic exceptions.-data DynExn (ex :: Effects) = UnsafeDynExn---- | Run a computation with only access to dynamic exceptions.-runDynExn :: (forall ex. DynExn ex -> Eff ex a) -> a-runDynExn f = B.runPureEff (f UnsafeDynExn)---- | Refine an 'IOE' capability to a 'DynExn'.-ioeToDynExn :: IOE io -> DynExn io-ioeToDynExn _ = UnsafeDynExn---- | Throw an exception.-throw :: (E.Exception e, ex :> es) => DynExn ex -> e -> Eff es a-throw _ e = B.UnsafeMkEff (E.throwIO e)---- | Catch an exception.-catch :: (E.Exception e, ex :> es) => DynExn ex -> Eff es a -> (e -> Eff es a) -> Eff es a-catch _ m h = B.UnsafeMkEff (E.catch (B.unsafeUnEff m) (B.unsafeUnEff . h))---- | @'bracket' ex acquire release run@: @acquire@ a resource, @run@ a computation depending on it,--- and finally @relase@ the resource even if @run@ threw an exception.-bracket :: ex :> es => DynExn ex -> Eff es a -> (a -> Eff es ()) -> (a -> Eff es b) -> Eff es b-bracket ex acquire release run = do-  a <- acquire-  finally ex (run a) (release a)---- | @'finally' ex run cleanup@: @run@ a computation, then @cleanup@ even if--- @run@ threw an exception.-finally :: ex :> es => DynExn ex -> Eff es a -> Eff es () -> Eff es a-finally ex run cleanup =-  onException ex run cleanup   -- if run throws an exception, then only this cleanup will run-    <* cleanup                 -- if run does not throw, then only this cleanup will run---- | @'onException' ex run cleanup@: @run@ a computation, and if an exception is thrown,--- @cleanup@, then rethrow the exception.-onException :: ex :> es => DynExn ex -> Eff es a -> Eff es () -> Eff es a-onException ex run cleanup = catch ex run (\(e :: E.SomeException) -> cleanup >> throw ex e)---- | 'throw' with an 'IOE' capability.-throwIO :: (E.Exception e, io :> es) => IOE io -> e -> Eff es a-throwIO io = throw (ioeToDynExn io)---- | 'catch' with an 'IOE' capability.-catchIO :: (E.Exception e, io :> es) => IOE io -> Eff es a -> (e -> Eff es a) -> Eff es a-catchIO io = catch (ioeToDynExn io)+{-# LANGUAGE
+  DataKinds,
+  KindSignatures,
+  RankNTypes,
+  ScopedTypeVariables,
+  TypeOperators #-}
+-- | = Dynamic exceptions
+--
+-- This is the vanilla exception mechanism from @IO@.
+-- Use this module to handle exceptions from external (non-bluefin) APIs.
+--
+-- Another motivation is to serve as a principled (experimental) framework
+-- for resource management with 'bracket'.
+--
+-- The core Bluefin API exposes a 'Bluefin.Eff.bracket' in "Bluefin.Eff"
+-- which (intentionally) weakens the scoping of scoped exceptions in
+-- "Bluefin.Exception".
+--
+-- This module is an experiment for a world where
+--
+-- - scoped exceptions are truly scoped (unlike "Bluefin.Exception");
+-- - the capability to catch and throw dynamic exceptions is explicit
+--   (unlike 'Bluefin.Eff.bracket' in "Bluefin.Eff").
+module Bluefin.Exception.Dynamic
+  ( DynExn
+  , runDynExn
+  , ioeToDynExn
+  , throw
+  , catch
+  , bracket
+  , finally
+  , onException
+  , throwIO
+  , catchIO
+  ) where
+
+import qualified Control.Exception as E
+import qualified Bluefin.Internal as B
+import Bluefin.Eff (Eff, Effects, type (:>))
+import Bluefin.IO (IOE)
+
+-- | Capability to catch and throw dynamic exceptions.
+data DynExn (ex :: Effects) = UnsafeDynExn
+
+-- | Run a computation with only access to dynamic exceptions.
+runDynExn :: (forall ex. DynExn ex -> Eff ex a) -> a
+runDynExn f = B.runPureEff (f UnsafeDynExn)
+
+-- | Refine an 'IOE' capability to a 'DynExn'.
+ioeToDynExn :: IOE io -> DynExn io
+ioeToDynExn _ = UnsafeDynExn
+
+-- | Throw an exception.
+throw :: (E.Exception e, ex :> es) => DynExn ex -> e -> Eff es a
+throw _ e = B.UnsafeMkEff (E.throwIO e)
+
+-- | Catch an exception.
+catch :: (E.Exception e, ex :> es) => DynExn ex -> Eff es a -> (e -> Eff es a) -> Eff es a
+catch _ m h = B.UnsafeMkEff (E.catch (B.unsafeUnEff m) (B.unsafeUnEff . h))
+
+-- | @'bracket' ex acquire release run@: @acquire@ a resource, @run@ a computation depending on it,
+-- and finally @relase@ the resource even if @run@ threw an exception.
+bracket :: ex :> es => DynExn ex -> Eff es a -> (a -> Eff es ()) -> (a -> Eff es b) -> Eff es b
+bracket ex acquire release run = do
+  a <- acquire
+  finally ex (run a) (release a)
+
+-- | @'finally' ex run cleanup@: @run@ a computation, then @cleanup@ even if
+-- @run@ threw an exception.
+finally :: ex :> es => DynExn ex -> Eff es a -> Eff es () -> Eff es a
+finally ex run cleanup =
+  onException ex run cleanup   -- if run throws an exception, then only this cleanup will run
+    <* cleanup                 -- if run does not throw, then only this cleanup will run
+
+-- | @'onException' ex run cleanup@: @run@ a computation, and if an exception is thrown,
+-- @cleanup@, then rethrow the exception.
+onException :: ex :> es => DynExn ex -> Eff es a -> Eff es () -> Eff es a
+onException ex run cleanup = catch ex run (\(e :: E.SomeException) -> cleanup >> throw ex e)
+
+-- | 'throw' with an 'IOE' capability.
+throwIO :: (E.Exception e, io :> es) => IOE io -> e -> Eff es a
+throwIO io = throw (ioeToDynExn io)
+
+-- | 'catch' with an 'IOE' capability.
+catchIO :: (E.Exception e, io :> es) => IOE io -> Eff es a -> (e -> Eff es a) -> Eff es a
+catchIO io = catch (ioeToDynExn io)

@@ -1,288 +1,288 @@-{-# LANGUAGE-  BangPatterns,-  BlockArguments,-  DataKinds,-  RankNTypes,-  ScopedTypeVariables,-  TypeApplications,-  TypeOperators #-}-module Main (main) where--import Control.Monad (join)-import Data.Functor (void)-import Data.Void (absurd)-import Test.Tasty (defaultMain, testGroup, TestTree)-import Test.Tasty.HUnit-import Bluefin.Eff (Eff, runPureEff, bracket, type (:&), type (:>))-import qualified Bluefin.State as B-import Bluefin.Algae-import Bluefin.Algae.State-import Bluefin.Algae.Exception-import qualified Bluefin.Algae.Exception.DynExn as EC-import Bluefin.Algae.NonDeterminism as NonDet-import Bluefin.Algae.Coroutine-import qualified Bluefin.Exception as E-import qualified Bluefin.Exception.Dynamic as ED---- * State---- Simple sanity test--incr :: z :> zz => Handler (State Int) z -> Eff zz ()-incr state = modify state (+ 1)---- Distinguishing Bluefin.Algae.State (pure state) from Bluefin.State (IORef)--algaeStateLitmus :: [Int]-algaeStateLitmus = runPureEff $ NonDet.toList \choice ->-  execState 0 \state -> do-    _ <- choose choice True False-    incr state--bluefinStateLitmus :: [Int]-bluefinStateLitmus = runPureEff $ NonDet.toList \choice ->-  snd <$> B.runState 0 \state -> do-    _ <- choose choice True False-    B.modify state (+ 1)--testState :: TestTree-testState = testGroup "State"-  [ testCase "simple" $ runPureEff (runState 0 incr) @?= ((), 1)-  , testCase "litmus-0" $ algaeStateLitmus @?= [1,1]-  , testCase "litmus-1" $ bluefinStateLitmus @?= [1,2]-  ]---- * Exception--onException :: Eff es a -> Eff es () -> Eff es a-onException run post = bracket (pure ()) (\_ -> post) (\_ -> run)--exceptionLitmus :: Int-exceptionLitmus = runPureEff $ snd <$> runState 0 \state ->-  void (try \exn ->-    onException (throw exn ()) (incr state))--exceptionDynLitmus :: Int-exceptionDynLitmus = ED.runDynExn \ex -> snd <$> runState 0 \state ->-  void (EC.try ex \exn ->-    onException (EC.throw exn ()) (incr state))--exceptionNoCancelLitmus :: Int-exceptionNoCancelLitmus = runPureEff $ snd <$> runState 0 \state ->-  void (try' \exn ->-    onException (throw exn ()) (incr state))--exnLitmus :: Int-exnLitmus = runPureEff $ snd <$> runState 0 \state ->-  void (E.try \exn ->-    onException (E.throw exn ()) (incr state))--testException :: TestTree-testException = testGroup "Exception"-  [ testCase "litmus-exception" $ exceptionLitmus @?= 1-  , testCase "litmus-exception-dyn" $ exceptionDynLitmus @?= 1-  , testCase "litmus-exception-no-cancel" $ exceptionNoCancelLitmus @?= 0-  , testCase "litmus-exn" $ exnLitmus @?= 1-  ]---- * Nondeterminism--coinFlip :: z :> zz => Handler Choice z -> Eff zz Bool-coinFlip choice =-  join $ choose choice -- flip coin-    (nil choice)     -- coin falls in gutter-    (join $ choose choice-      (pure True)    -- heads-      (pure False))  -- tails--coinFlipList :: [Bool]-coinFlipList = runPureEff (NonDet.toList coinFlip)--toStream :: z :> zz =>-  (forall z0. Handler Choice z0 -> Eff (z0 :& zz) a) ->-  Handler (Coroutine a ()) z -> Eff zz ()-toStream f h = forAllChoices f (yield h)--permuts :: z :> zz => Handler Choice z -> [a] -> Eff zz [a]-permuts _ [] = pure []-permuts choice xs = do-  (x, ys) <- removeFrom choice xs-  zs <- permuts choice ys-  pure (x : zs)--pythagoras :: z :> zz => Handler Choice z -> Eff zz (Int, Int, Int)-pythagoras choice = do-  x <- pick choice [1 .. 10]-  y <- pick choice [1 .. 10]-  z <- pick choice [1 .. 10]-  assume choice (x .^ 2 + y .^ 2 == z .^ 2)-  pure (x, y, z)-  where (.^) = (Prelude.^) :: Int -> Int -> Int--testNonDet :: TestTree-testNonDet = testGroup "NonDet"-  [ testCase "coin-flip" $ coinFlipList @?= [True, False]-  , testCase "via-stream" $ runPureEff (feedCoroutine [(), ()] (toStream coinFlip)) @?= [True, False]-  , testCase "permutations" $ runPureEff (NonDet.toList (flip permuts [1,2,3::Int]))-      @?= [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]-  , testCase "pythagoras" $ runPureEff (NonDet.toList pythagoras)-      @?= [(3,4,5),(4,3,5),(6,8,10),(8,6,10)]-  ]---- * Streaming--cumulSum :: z :> zz => Handler (Coroutine Int Int) z -> Eff zz a-cumulSum h = loop 0 where-  loop !n = do-    m <- yield h n-    loop (m + n)--feedCoroutine :: [i] -> (forall zz0. ScopedEff (Coroutine o i) zz0 a) -> Eff zz [o]-feedCoroutine is f = do-  r <- try \exn -> runState (is, []) \state ->-    forCoroutine f (coyield state exn)-  pure $ reverse $ case r of-    Left os -> os-    Right (_, (_, os)) -> os--coyield :: (z :> zz, z' :> zz) =>-  Handler (State ([i], [o])) z -> Handler (Exception [o]) z' -> o -> Eff zz i-coyield state exn o = do-  (is, os) <- get state-  case is of-    [] -> throw exn (o : os)-    i : ys -> put state (ys, o : os) >> pure i---- * Concurrency--range1to4 :: z :> zz => Handler (Coroutine Int ()) z -> Eff zz ()-range1to4 h = do-  yield h 1-  yield h 2-  yield h 3-  yield h 4--filterEven :: z :> zz => Handler (State [Int]) z -> Eff zz ()-filterEven h =-  forCoroutine range1to4 \n ->-    if n `mod` 2 == 0-    then modify h (n :)-    else pure ()--filterEvenResult :: Eff zz [Int]-filterEvenResult = execState [] filterEven--pingpong :: Eff ss String-pingpong = withCoroutine coThread mainThread-  where-    coThread z0 h = do-      z1 <- yield h (z0 ++ "pong")-      z2 <- yield h (z1 ++ "dong")-      yield h (z2 ++ "bong")-    mainThread h = do-      s1 <- yield h "ping"-      s2 <- yield h (s1 ++ "ding")-      s3 <- yield h (s2 ++ "bing")-      pure s3--echo :: Eff ss String-echo = loopCoPipe ((userLL |+ userLR) |+ (userRL |+ userRR)) (Left (Left "S"))-  where-    userLL = toCoPipe \s h -> do-      s' <- yield h (Left (Right (s ++ "-LL")))-      yield h (Right (Left (s' ++ "-LL")))-    userLR = toCoPipe \s h -> do-      s' <- yield h (Right (Left (s ++ "-LR")))-      yield h (Right (Right (s' ++ "-LR")))-    userRL = toCoPipe \s h -> do-      s' <- yield h (Right (Right (s ++ "-RL")))-      yield h (Left (Right (s' ++ "-RL")))-    userRR = toCoPipe \s h -> do-      s' <- yield h (Left (Left (s ++ "-RR")))-      pure (s' ++ "-RR")-    (|+) = eitherCoPipe id---- | Coroutine identifier-newtype Cid = Cid Int deriving (Eq, Show)---- | Next coroutine identifier (wraps around at maxCid).-nextCid :: Cid -> Cid-nextCid (Cid c) = Cid (c + 1)--type Yell a = Exception a---- | Hot potato coroutine:------ - receive hot @potato@ (whose value represents the temperature of the potato);--- - if it is too hot (@potato > 0@), pass the potato to the next coroutine,---   the potato cools down slightly at every pass;--- - once the potato is cool enough, the coroutine which owns the potato yells its @Cid@.-hotpotato :: (z :> zz, z' :> zz) =>-  Handler (Yell Cid) z ->  -- ^ the coroutine may yell using this handle-  Cid ->                   -- ^ coroutine ID-  Int ->                   -- ^ hot @potato@-  Handler (Coroutine (Cid, Int) Int) z' ->  -- ^ handle to yield to another coroutine-  Eff zz void              -- ^ does not return (the yell is an exception)-hotpotato yell c potato0 cr = loop potato0 where-  loop potato | potato > 0 = do                  -- if potato is too hot,-    potato' <- yield cr (nextCid c, potato - 1)  -- pass to the next coroutine, the potato cools down,-    loop potato'                                 -- wait for the potato to come back and repeat.-  loop _ | otherwise = throw yell c  -- if potato has cooled down, we won the potato.---- | Four coroutines play the hot potato game.-hotpotatoes :: Eff ss Cid-hotpotatoes = do-  e <- try \yell ->-    -- Wrap Cid into [0 .. 3]-    let wrapCid = mapCoPipe id (\(Cid n, potato) -> (Cid (n `mod` 4), potato)) id in-    loopCoPipe (wrapCid-      (  hotpotato yell (Cid 0)-      +| hotpotato yell (Cid 1)-      +| hotpotato yell (Cid 2)-      +| hotpotato yell (Cid 3)-      +| nobody)) (Cid 3, 42)-  case e of-    Left c -> pure c-    Right o -> absurd o---- | Empty copipe-nobody :: CoPipe (Cid, Int) o (Eff zz) void-nobody = mapCoPipe (\(_, _) -> error "don't call me") id id voidCoPipe--infixr 4 +|---- | Add another hot potato coroutine to the mix.------ The coroutines are numbered sequentially.-(+|) ::-  CoPipeSEff i o zz a ->-  CoPipe (Cid, i) o (Eff zz) a ->-  CoPipe (Cid, i) o (Eff zz) a-(+|) l r = eitherCoPipe split l' r-  where-    l' = mapCoPipe (\(_ :: Cid, potato) -> potato) id id (toCoPipe l)--split :: (Cid, i) -> Either (Cid, i) (Cid, i)-split (Cid 0, potato) = Left (Cid 0, potato)-split (Cid c, potato) = Right (Cid (c-1), potato)--testCoroutine :: TestTree-testCoroutine = testGroup "Coroutine"-  [ testCase "feedPipe-sum" $ runPureEff (feedPipe [1,2,3] (toPipe cumulSum)) @?= [0,1,3,6]-  , testCase "feedCoroutine-sum" $ runPureEff (feedCoroutine [1,2,3] cumulSum) @?= [0,1,3,6]-  , testCase "filterEven" $ runPureEff filterEvenResult @?= [4,2]-  , testCase "pingpong" $ runPureEff pingpong @?= "pingpongdingdongbingbong"-  , testCase "echo" $ runPureEff echo @?= "S-LL-LR-RL-RR-LL-RL-LR-RR"-  , testCase "hotpotato" $ runPureEff hotpotatoes @?= Cid 1-  ]--main :: IO ()-main = defaultMain tests--tests :: TestTree-tests = testGroup "Tests"-  [ testState-  , testException-  , testNonDet-  , testCoroutine-  ]+{-# LANGUAGE
+  BangPatterns,
+  BlockArguments,
+  DataKinds,
+  RankNTypes,
+  ScopedTypeVariables,
+  TypeApplications,
+  TypeOperators #-}
+module Main (main) where
+
+import Control.Monad (join)
+import Data.Functor (void)
+import Data.Void (absurd)
+import Test.Tasty (defaultMain, testGroup, TestTree)
+import Test.Tasty.HUnit
+import Bluefin.Eff (Eff, runPureEff, bracket, type (:&), type (:>))
+import qualified Bluefin.State as B
+import Bluefin.Algae
+import Bluefin.Algae.State
+import Bluefin.Algae.Exception
+import qualified Bluefin.Algae.Exception.DynExn as EC
+import Bluefin.Algae.NonDeterminism as NonDet
+import Bluefin.Algae.Coroutine
+import qualified Bluefin.Exception as E
+import qualified Bluefin.Exception.Dynamic as ED
+
+-- * State
+
+-- Simple sanity test
+
+incr :: z :> zz => Handler (State Int) z -> Eff zz ()
+incr state = modify state (+ 1)
+
+-- Distinguishing Bluefin.Algae.State (pure state) from Bluefin.State (IORef)
+
+algaeStateLitmus :: [Int]
+algaeStateLitmus = runPureEff $ NonDet.toList \choice ->
+  execState 0 \state -> do
+    _ <- choose choice True False
+    incr state
+
+bluefinStateLitmus :: [Int]
+bluefinStateLitmus = runPureEff $ NonDet.toList \choice ->
+  snd <$> B.runState 0 \state -> do
+    _ <- choose choice True False
+    B.modify state (+ 1)
+
+testState :: TestTree
+testState = testGroup "State"
+  [ testCase "simple" $ runPureEff (runState 0 incr) @?= ((), 1)
+  , testCase "litmus-0" $ algaeStateLitmus @?= [1,1]
+  , testCase "litmus-1" $ bluefinStateLitmus @?= [1,2]
+  ]
+
+-- * Exception
+
+onException :: Eff es a -> Eff es () -> Eff es a
+onException run post = bracket (pure ()) (\_ -> post) (\_ -> run)
+
+exceptionLitmus :: Int
+exceptionLitmus = runPureEff $ snd <$> runState 0 \state ->
+  void (try \exn ->
+    onException (throw exn ()) (incr state))
+
+exceptionDynLitmus :: Int
+exceptionDynLitmus = ED.runDynExn \ex -> snd <$> runState 0 \state ->
+  void (EC.try ex \exn ->
+    onException (EC.throw exn ()) (incr state))
+
+exceptionNoCancelLitmus :: Int
+exceptionNoCancelLitmus = runPureEff $ snd <$> runState 0 \state ->
+  void (try' \exn ->
+    onException (throw exn ()) (incr state))
+
+exnLitmus :: Int
+exnLitmus = runPureEff $ snd <$> runState 0 \state ->
+  void (E.try \exn ->
+    onException (E.throw exn ()) (incr state))
+
+testException :: TestTree
+testException = testGroup "Exception"
+  [ testCase "litmus-exception" $ exceptionLitmus @?= 1
+  , testCase "litmus-exception-dyn" $ exceptionDynLitmus @?= 1
+  , testCase "litmus-exception-no-cancel" $ exceptionNoCancelLitmus @?= 0
+  , testCase "litmus-exn" $ exnLitmus @?= 1
+  ]
+
+-- * Nondeterminism
+
+coinFlip :: z :> zz => Handler Choice z -> Eff zz Bool
+coinFlip choice =
+  join $ choose choice -- flip coin
+    (nil choice)     -- coin falls in gutter
+    (join $ choose choice
+      (pure True)    -- heads
+      (pure False))  -- tails
+
+coinFlipList :: [Bool]
+coinFlipList = runPureEff (NonDet.toList coinFlip)
+
+toStream :: z :> zz =>
+  (forall z0. Handler Choice z0 -> Eff (z0 :& zz) a) ->
+  Handler (Coroutine a ()) z -> Eff zz ()
+toStream f h = forAllChoices f (yield h)
+
+permuts :: z :> zz => Handler Choice z -> [a] -> Eff zz [a]
+permuts _ [] = pure []
+permuts choice xs = do
+  (x, ys) <- removeFrom choice xs
+  zs <- permuts choice ys
+  pure (x : zs)
+
+pythagoras :: z :> zz => Handler Choice z -> Eff zz (Int, Int, Int)
+pythagoras choice = do
+  x <- pick choice [1 .. 10]
+  y <- pick choice [1 .. 10]
+  z <- pick choice [1 .. 10]
+  assume choice (x .^ 2 + y .^ 2 == z .^ 2)
+  pure (x, y, z)
+  where (.^) = (Prelude.^) :: Int -> Int -> Int
+
+testNonDet :: TestTree
+testNonDet = testGroup "NonDet"
+  [ testCase "coin-flip" $ coinFlipList @?= [True, False]
+  , testCase "via-stream" $ runPureEff (feedCoroutine [(), ()] (toStream coinFlip)) @?= [True, False]
+  , testCase "permutations" $ runPureEff (NonDet.toList (flip permuts [1,2,3::Int]))
+      @?= [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
+  , testCase "pythagoras" $ runPureEff (NonDet.toList pythagoras)
+      @?= [(3,4,5),(4,3,5),(6,8,10),(8,6,10)]
+  ]
+
+-- * Streaming
+
+cumulSum :: z :> zz => Handler (Coroutine Int Int) z -> Eff zz a
+cumulSum h = loop 0 where
+  loop !n = do
+    m <- yield h n
+    loop (m + n)
+
+feedCoroutine :: [i] -> (forall zz0. ScopedEff (Coroutine o i) zz0 a) -> Eff zz [o]
+feedCoroutine is f = do
+  r <- try \exn -> runState (is, []) \state ->
+    forCoroutine f (coyield state exn)
+  pure $ reverse $ case r of
+    Left os -> os
+    Right (_, (_, os)) -> os
+
+coyield :: (z :> zz, z' :> zz) =>
+  Handler (State ([i], [o])) z -> Handler (Exception [o]) z' -> o -> Eff zz i
+coyield state exn o = do
+  (is, os) <- get state
+  case is of
+    [] -> throw exn (o : os)
+    i : ys -> put state (ys, o : os) >> pure i
+
+-- * Concurrency
+
+range1to4 :: z :> zz => Handler (Coroutine Int ()) z -> Eff zz ()
+range1to4 h = do
+  yield h 1
+  yield h 2
+  yield h 3
+  yield h 4
+
+filterEven :: z :> zz => Handler (State [Int]) z -> Eff zz ()
+filterEven h =
+  forCoroutine range1to4 \n ->
+    if n `mod` 2 == 0
+    then modify h (n :)
+    else pure ()
+
+filterEvenResult :: Eff zz [Int]
+filterEvenResult = execState [] filterEven
+
+pingpong :: Eff ss String
+pingpong = withCoroutine coThread mainThread
+  where
+    coThread z0 h = do
+      z1 <- yield h (z0 ++ "pong")
+      z2 <- yield h (z1 ++ "dong")
+      yield h (z2 ++ "bong")
+    mainThread h = do
+      s1 <- yield h "ping"
+      s2 <- yield h (s1 ++ "ding")
+      s3 <- yield h (s2 ++ "bing")
+      pure s3
+
+echo :: Eff ss String
+echo = loopCoPipe ((userLL |+ userLR) |+ (userRL |+ userRR)) (Left (Left "S"))
+  where
+    userLL = toCoPipe \s h -> do
+      s' <- yield h (Left (Right (s ++ "-LL")))
+      yield h (Right (Left (s' ++ "-LL")))
+    userLR = toCoPipe \s h -> do
+      s' <- yield h (Right (Left (s ++ "-LR")))
+      yield h (Right (Right (s' ++ "-LR")))
+    userRL = toCoPipe \s h -> do
+      s' <- yield h (Right (Right (s ++ "-RL")))
+      yield h (Left (Right (s' ++ "-RL")))
+    userRR = toCoPipe \s h -> do
+      s' <- yield h (Left (Left (s ++ "-RR")))
+      pure (s' ++ "-RR")
+    (|+) = eitherCoPipe id
+
+-- | Coroutine identifier
+newtype Cid = Cid Int deriving (Eq, Show)
+
+-- | Next coroutine identifier (wraps around at maxCid).
+nextCid :: Cid -> Cid
+nextCid (Cid c) = Cid (c + 1)
+
+type Yell a = Exception a
+
+-- | Hot potato coroutine:
+--
+-- - receive hot @potato@ (whose value represents the temperature of the potato);
+-- - if it is too hot (@potato > 0@), pass the potato to the next coroutine,
+--   the potato cools down slightly at every pass;
+-- - once the potato is cool enough, the coroutine which owns the potato yells its @Cid@.
+hotpotato :: (z :> zz, z' :> zz) =>
+  Handler (Yell Cid) z ->  -- ^ the coroutine may yell using this handle
+  Cid ->                   -- ^ coroutine ID
+  Int ->                   -- ^ hot @potato@
+  Handler (Coroutine (Cid, Int) Int) z' ->  -- ^ handle to yield to another coroutine
+  Eff zz void              -- ^ does not return (the yell is an exception)
+hotpotato yell c potato0 cr = loop potato0 where
+  loop potato | potato > 0 = do                  -- if potato is too hot,
+    potato' <- yield cr (nextCid c, potato - 1)  -- pass to the next coroutine, the potato cools down,
+    loop potato'                                 -- wait for the potato to come back and repeat.
+  loop _ | otherwise = throw yell c  -- if potato has cooled down, we won the potato.
+
+-- | Four coroutines play the hot potato game.
+hotpotatoes :: Eff ss Cid
+hotpotatoes = do
+  e <- try \yell ->
+    -- Wrap Cid into [0 .. 3]
+    let wrapCid = mapCoPipe id (\(Cid n, potato) -> (Cid (n `mod` 4), potato)) id in
+    loopCoPipe (wrapCid
+      (  hotpotato yell (Cid 0)
+      +| hotpotato yell (Cid 1)
+      +| hotpotato yell (Cid 2)
+      +| hotpotato yell (Cid 3)
+      +| nobody)) (Cid 3, 42)
+  case e of
+    Left c -> pure c
+    Right o -> absurd o
+
+-- | Empty copipe
+nobody :: CoPipe (Cid, Int) o (Eff zz) void
+nobody = mapCoPipe (\(_, _) -> error "don't call me") id id voidCoPipe
+
+infixr 4 +|
+
+-- | Add another hot potato coroutine to the mix.
+--
+-- The coroutines are numbered sequentially.
+(+|) ::
+  CoPipeSEff i o zz a ->
+  CoPipe (Cid, i) o (Eff zz) a ->
+  CoPipe (Cid, i) o (Eff zz) a
+(+|) l r = eitherCoPipe split l' r
+  where
+    l' = mapCoPipe (\(_ :: Cid, potato) -> potato) id id (toCoPipe l)
+
+split :: (Cid, i) -> Either (Cid, i) (Cid, i)
+split (Cid 0, potato) = Left (Cid 0, potato)
+split (Cid c, potato) = Right (Cid (c-1), potato)
+
+testCoroutine :: TestTree
+testCoroutine = testGroup "Coroutine"
+  [ testCase "feedPipe-sum" $ runPureEff (feedPipe [1,2,3] (toPipe cumulSum)) @?= [0,1,3,6]
+  , testCase "feedCoroutine-sum" $ runPureEff (feedCoroutine [1,2,3] cumulSum) @?= [0,1,3,6]
+  , testCase "filterEven" $ runPureEff filterEvenResult @?= [4,2]
+  , testCase "pingpong" $ runPureEff pingpong @?= "pingpongdingdongbingbong"
+  , testCase "echo" $ runPureEff echo @?= "S-LL-LR-RL-RR-LL-RL-LR-RR"
+  , testCase "hotpotato" $ runPureEff hotpotatoes @?= Cid 1
+  ]
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Tests"
+  [ testState
+  , testException
+  , testNonDet
+  , testCoroutine
+  ]