heftia 0.5.0.0 → 0.6.0.0

raw patch · 14 files changed

+579/−3293 lines, 14 filesdep ~basedep ~data-effectsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, data-effects

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• README.md +88/−78
• heftia.cabal +16/−28
• src/Control/Monad/Hefty.hs +172/−496
• src/Control/Monad/Hefty/Interpret.hs +183/−540
• src/Control/Monad/Hefty/Interpret/State.hs +77/−83
• src/Control/Monad/Hefty/Transform.hs +0/−643
• src/Control/Monad/Hefty/Types.hs +31/−249
• src/Data/Effect/OpenUnion.hs +0/−121
• src/Data/Effect/OpenUnion/Internal.hs +0/−198
• src/Data/Effect/OpenUnion/Internal/FO.hs +0/−442
• src/Data/Effect/OpenUnion/Internal/HO.hs +0/−384
• src/Data/Effect/OpenUnion/Sum.hs +0/−31
• src/Data/FTCQueue.hs +7/−0

@@ -32,3 +32,8 @@  * Fixed a bug in the lookup of keyed effects. * Added missing functions such as `key`, `keyH`, `raiseAll`, and `raiseAllH`.++## 0.6.0.0 -- 2025-04-16++* Introduced the new v4 interface.+    * Unified first-order and higher-order effect interfaces.

@@ -2,14 +2,15 @@  [![Hackage](https://img.shields.io/hackage/v/heftia.svg?logo=haskell&label=heftia)](https://hackage.haskell.org/package/heftia) [![Hackage](https://img.shields.io/hackage/v/heftia-effects.svg?logo=haskell&label=heftia-effects)](https://hackage.haskell.org/package/heftia-effects)-[![Stackage](https://www.stackage.org/package/heftia-effects/badge/nightly?label=Stackage)](https://www.stackage.org/package/heftia-effects)+[![Stackage LTS](https://www.stackage.org/package/heftia-effects/badge/lts)](https://www.stackage.org/lts/package/heftia-effects)+[![Stackage Nightly](https://www.stackage.org/package/heftia-effects/badge/nightly)](https://www.stackage.org/nightly/package/heftia-effects) [![Build status](https://img.shields.io/github/actions/workflow/status/sayo-hs/heftia/haskell.yml?branch=develop)](https://github.com/sayo-hs/heftia/actions)  Heftia is an extensible effects library for Haskell that generalizes "Algebraic Effects and Handlers" to higher-order effects, providing users with maximum flexibility and delivering standard and reasonable speed. In its generalization, the focus is on ensuring predictable results based on simple, consistent semantics, while preserving soundness. -Please refer to the [Haddock documentation](https://hackage.haskell.org/package/heftia-0.5.0.0/docs/Control-Monad-Hefty.html) for usage and semantics.-For information on performance, please refer to [performance.md](https://github.com/sayo-hs/heftia/blob/v0.5.0/benchmark/performance.md).+Please refer to the [Haddock documentation](https://hackage.haskell.org/package/heftia-0.6.0.0/docs/Control-Monad-Hefty.html) for usage and semantics.+For information on performance, please refer to [performance.md](https://github.com/sayo-hs/heftia/blob/v0.6.0/benchmark/performance.md).  This library is inspired by the paper: * Casper Bach Poulsen and Cas van der Rest. 2023. Hefty Algebras: Modular@@ -25,20 +26,26 @@  For example, algebraic effects are essential for managing coroutines, generators, streaming, concurrency, non-deterministic computations, and more in a highly elegant and concise manner. -Algebraic effects provide a consistent and predictable framework for handling side effects, enhancing modularity and flexibility in your code.+Algebraic effects provide a consistent and predictable framework for handling side effects. Research in cutting-edge languages like [Koka](https://koka-lang.github.io/koka/doc/index.html), [Eff lang](https://www.eff-lang.org/), and [OCaml 5](https://ocaml.org/manual/effects.html) is advancing the understanding and implementation of algebraic effects, establishing them as **the programming paradigm of the future**.  Heftia extends this by supporting higher-order algebraic effects, allowing for more expressive and modular effect management.-This leads to more maintainable and extensible applications compared to non-algebraic effect libraries, positioning Heftia at **the forefront of modern effect handling techniques**.+This positions Heftia at **the forefront of modern effect handling techniques**.  Furthermore, **Heftia is functionally a superset of other effect libraries**, especially those based on `ReaderT` over `IO`. In other words, anything that is possible with other libraries is also possible with this library. This is because Heftia supports `MonadUnliftIO` in the form of higher-order effects. -**Heftia should be a good substitute for `mtl`, `polysemy`, `fused-effects`, and `freer-simple`.**-Additionally, if performance is not a top priority, it should also be a good alternative for `effectful`.+`MonadUnliftIO` is a typeclass that ensures safety in exception handling.+Heftia completely resolves runtime-error issues present in certain usages of `MonadUnliftIO` with `effectful` and `bluefin`, thereby demonstrating **stronger safety guarantees**[^8][^9].+Moreover, Heftia delivers **strong performance**.++**Heftia should be a good substitute for `mtl`, `effectful`, `polysemy`, `fused-effects`, and `freer-simple`.** If performance is particularly important, [`effectful`](https://github.com/haskell-effectful/effectful) would be the best alternative to this library. +[^8]: MonadUnliftIO instance allows escape https://github.com/tomjaguarpaw/bluefin/issues/29+[^9]: [heftia-effects/test/Test/UnliftIO.hs](https://github.com/sayo-hs/heftia/blob/v0.6.0/heftia-effects/test/Test/UnliftIO.hs)+ ## Key Features  * **Correct Semantics for Higher-Order Effects & Continuations**@@ -53,43 +60,53 @@     * Higher-order effects         * [`MonadUnliftIO`](https://hackage.haskell.org/package/unliftio)             * to prevent resource leaks due to runtime exceptions-            * [heftia-effects/Example/UnliftIO/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.5.0/heftia-effects/Example/UnliftIO/Main.hs)-            * [heftia-effects/Example/Stream/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.5.0/heftia-effects/Example/Stream/Main.hs)+            * [heftia-effects/Example/UnliftIO/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.6.0/heftia-effects/Example/UnliftIO/Main.hs)+            * [heftia-effects/Example/Stream/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.6.0/heftia-effects/Example/Stream/Main.hs)         * [`Provider`](https://hackage.haskell.org/package/effectful-core-2.5.0.0/docs/Effectful-Provider.html) a.k.a. [`Scoped`](https://hackage.haskell.org/package/polysemy-1.9.2.0/docs/Polysemy-Scoped.html)             * to prevent [resource handles from leaking out of scopes](https://h2.jaguarpaw.co.uk/posts/bluefin-prevents-handles-leaking/)-            * [Control.Monad.Hefty.Concurrent.Subprocess](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-Concurrent-Subprocess.html)-            * [heftia-effects/Example/Subprocess/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.5.0/heftia-effects/Example/Subprocess/Main.hs)-            * [heftia-effects/Example/FileSystemProvider/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.5.0/heftia-effects/Example/FileSystemProvider/Main.hs)+            * [Control.Monad.Hefty.Concurrent.Subprocess](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/Control-Monad-Hefty-Concurrent-Subprocess.html)+            * [heftia-effects/Example/Subprocess/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.6.0/heftia-effects/Example/Subprocess/Main.hs)+            * [heftia-effects/Example/FileSystemProvider/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.6.0/heftia-effects/Example/FileSystemProvider/Main.hs)         * [Applicative-style Parallelism](https://medium.com/@PerrottaFrancisco/learning-cats-effects-parallel-execution-f617f883e390)             * like `cats-effect` in Scala             * [Data.Effect.Concurrent.Parallel](https://hackage.haskell.org/package/data-effects-0.3.0.1/docs/Data-Effect-Concurrent-Parallel.html)-            * [Control.Monad.Hefty.Concurrent.Parallel](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-Concurrent-Parallel.html)-            * [heftia-effects/test/Test/Concurrent.hs](https://github.com/sayo-hs/heftia/blob/v0.5.0/heftia-effects/test/Test/Concurrent.hs)+            * [Control.Monad.Hefty.Concurrent.Parallel](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/Control-Monad-Hefty-Concurrent-Parallel.html)+            * [heftia-effects/test/Test/Concurrent.hs](https://github.com/sayo-hs/heftia/blob/v0.6.0/heftia-effects/test/Test/Concurrent.hs)      All of these interact through a simple, consistent, and predictable semantics based on algebraic effects.  * **Easy and Concise Implementation for Custom Effect Interpreters** -    As you can see from the implementations of basic effect interpreters such as [State](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/src/Control.Monad.Hefty.State.html#runState), [Throw/Catch](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/src/Control.Monad.Hefty.Except.html#runThrow), [Writer](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/src/Control.Monad.Hefty.Writer.html#runTell), [NonDet](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/src/Control.Monad.Hefty.NonDet.html#runNonDet), and [Coroutine](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/src/Control.Monad.Hefty.Coroutine.html#runCoroutine), they can be implemented in just a few lines, or even a single line. Even for effects like NonDet and Coroutine, which involve continuations and might seem difficult to implement at first glance, this is exactly how simple it can be. This is the power of algebraic effects. Users can quickly define experimental and innovative custom effects using continuations.+    As you can see from the implementations of basic effect interpreters such as [State](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/src/Control.Monad.Hefty.State.html#runState), [Throw/Catch](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/src/Control.Monad.Hefty.Except.html#runThrow), [Writer](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/src/Control.Monad.Hefty.Writer.html#runTell), [NonDet](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/src/Control.Monad.Hefty.NonDet.html#runNonDet), and [Coroutine](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/src/Control.Monad.Hefty.Coroutine.html#runCoroutine), they can be implemented in just a few lines, or even a single line. Even for effects like NonDet and Coroutine, which involve continuations and might seem difficult to implement at first glance, this is exactly how simple it can be. This is the power of algebraic effects. Users can quickly define experimental and innovative custom effects using continuations.  * **Standard and Reasonable Performance** -    It operates at a speed positioned roughly in the middle between faster libraries (like `effectful` or `eveff`) and relatively slower ones (like `polysemy` or `fused-effects`): [performance.md](https://github.com/sayo-hs/heftia/blob/v0.5.0/benchmark/performance.md).+    It operates at a speed positioned roughly in the middle between faster libraries (like `effectful` or `eveff`) and relatively slower ones (like `polysemy` or `fused-effects`): [performance.md](https://github.com/sayo-hs/heftia/blob/v0.6.0/benchmark/performance.md). -* **Purity**+* **Type Safety and Purity**      * Does not depend on the IO monad and can use any monad as the base monad.     * Semantics are isolated from the IO monad, meaning that aspects like asynchronous exceptions and threads do not affect the behavior of effects.-    * The constructors of the `Eff` monad are [exposed](https://hackage.haskell.org/package/heftia-0.5.0.0/docs/Control-Monad-Hefty.html#t:Eff), and users can manipulate them directly without any safety concerns. Still, the semantics remain intact.+    * The constructors of the `Eff` monad are [exposed](https://hackage.haskell.org/package/heftia-0.6.0.0/docs/Control-Monad-Hefty.html#t:Eff), and users can manipulate them directly without any safety concerns. Still, the semantics remain intact.     * These are in contrast to libraries like `effectful` and `eff`, making this library more **Haskell-ish and purely functional**.+    * **This design effectively prevents obscure behaviors and potential runtime errors.** +* **Approach to Inter-Library Compatibility**++    * Built on the [`data-effects`](https://github.com/sayo-hs/data-effects) effect framework, `heftia` is designed so that it can integrate smoothly with other effect libraries that are built upon the same framework.+    * Conversion between different libraries' `Eff` monads.+    * `interpret` functions that works independently of any particular library.+    * At present, only `heftia` is based on this framework.+    * This represents an initial attempt to resolve the issues of incompatibility and lack of interoperability caused by the proliferation of effect libraries in Haskell.+    * In addition to monads, an effect system built on Applicative and Functor is also available.+ ## Downsides  This library has notable semantic differences, particularly compared to libraries like `effectful`, `polysemy`, and `fused-effects`. The semantics of this library are almost equivalent to those of `freer-simple` and are also similar to Alexis King's `eff` library. This type of semantics is often referred to as *continuation-based semantics*. Additionally, unlike recent libraries such as `effectful`, which have an IO-fused effect system, the semantics of this library are separated from IO.-Due to these differences, people who are already familiar with the semantics of other major libraries may find it challenging to transition to this library due to the mental model differences.+People who are already familiar with the behaviors of other major libraries might potentially find it somewhat challenging to transition to this library, due to differences in their mental models.  For those who have not used an extensible effects library in Haskell before, this should not be a problem. Particularly, if you are already somewhat familiar with the semantics of algebraic effects through languages like `koka` or `eff-lang`,@@ -107,7 +124,7 @@     ```console     $ cabal update     ```-2. Add `heftia-effects ^>= 0.4` and `ghc-typelits-knownnat ^>= 0.7` to the build dependencies. Enable the [ghc-typelits-knownnat](https://hackage.haskell.org/package/ghc-typelits-knownnat) plugin, `GHC2021`, and the following language extensions as needed:+2. Add `heftia-effects ^>= 0.6` to the build dependencies. Enable the `GHC2021` and the following language extensions as needed:      * `LambdaCase`     * `DerivingStrategies`@@ -125,8 +142,7 @@ ...     build-depends:         ...-        heftia-effects ^>= 0.4,-        ghc-typelits-knownnat ^>= 0.7,+        heftia-effects ^>= 0.6,      default-language: GHC2021 @@ -150,24 +166,26 @@ If you encounter an error like the following, add the pragma:  ```haskell-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}+{-# OPTIONS_GHC -fconstraint-solver-iterations=16 #-} ```  to the header of your source file. -    Could not deduce ‘GHC.TypeNats.KnownNat (1 GHC.TypeNats.+ ...)’+    solveWanteds: too many iterations (limit = 4) -The supported versions are GHC 9.4.1 and later.-This library has been tested with GHC 9.4.1, 9.6.6 and 9.8.2.+Here, the number 16 should be set to the maximum number of effects you want to stack.+The default in GHC is 4, which is quite low, so it's a good idea to set it to around 16 globally, rather than specifying the pragma in each file individually. +The supported versions are GHC 9.6.2 and later.+ ## Example -### Coroutine-based Composable Concurrent Stream (since v0.5)+### Coroutine-based Composable Concurrent Stream  Below is an example of using concurrent streams (pipes).  ```haskell-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}+{-# OPTIONS_GHC -fconstraint-solver-iterations=16 #-}  import Control.Monad.Hefty import Control.Monad.Hefty.Concurrent.Stream@@ -180,7 +198,7 @@ import UnliftIO (bracket_)  -- | Generates a sequence of 1, 2, 3, 4 at 0.5-second intervals.-produce :: (Output Int <| ef, Timer <| ef) => Eff '[] ef ()+produce :: (Output Int :> es, Timer :> es, FOEs es) => Eff es () produce = void . runThrow @() $     for_ [1 ..] \(i :: Int) -> do         when (i == 5) $ throw ()@@ -188,14 +206,14 @@         sleep 0.5  -- | Receives the sequence at 0.5-second intervals and prints it.-consume :: (Input Int <| ef, Timer <| ef, IO <| ef) => Eff eh ef ()+consume :: (Input Int :> es, Timer :> es, Emb IO :> es) => Eff es () consume = forever do     liftIO . print =<< input @Int     sleep 0.5  -- | Transforms by receiving the sequence as input at 0.5-second intervals, --   adds 100, and outputs it.-plus100 :: (Input Int <| ef, Output Int <| ef, Timer <| ef, IO <| ef) => Eff eh ef ()+plus100 :: (Input Int :> es, Output Int :> es, Timer :> es, Emb IO :> es) => Eff es () plus100 = forever do     i <- input @Int     let o = i + 100@@ -209,7 +227,7 @@             bracket_                 (liftIO $ putStrLn "Start")                 (liftIO $ putStrLn "End")-                (raiseAllH produce)+                (onlyFOEs produce)      runMachineryIO_ $         Unit @() @Int do@@ -247,24 +265,21 @@  * `End` is displayed just after the first sequence ends and before the second sequence starts. This demonstrates that the `bracket_` function based on `MonadUnliftIO` for safe resource release works in such a way that resources are released immediately at the correct timing—even if the stream is still in progress—rather than waiting until the entire stream (including the second sequence) has completed. Existing stream libraries like [`pipes`](https://hackage.haskell.org/package/pipes) and [`conduit`](https://hackage.haskell.org/package/conduit) have the issue that immediate resource release like this is not possible. This problem was first addressed by the effect system library [`bluefin`](https://github.com/tomjaguarpaw/bluefin). For more details, please refer to [Bluefin streams finalize promptly](https://h2.jaguarpaw.co.uk/posts/bluefin-streams-finalize-promptly/). -The complete code example can be found at [heftia-effects/Example/Stream/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.5.0/heftia-effects/Example/Stream/Main.hs).+The complete code example can be found at [heftia-effects/Example/Stream/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.6.0/heftia-effects/Example/Stream/Main.hs).  ### Aggregating File Sizes Using Non-Deterministic Computation -The following is an extract of the main parts from an example of non-deterministic computation. For the full code, please refer to [heftia-effects/Example/NonDet/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.5.0/heftia-effects/Example/NonDet/Main.hs).+The following is an extract of the main parts from an example of non-deterministic computation. For the full code, please refer to [heftia-effects/Example/NonDet/Main.hs](https://github.com/sayo-hs/heftia/blob/v0.6.0/heftia-effects/Example/NonDet/Main.hs).  ```haskell -- | Aggregate the sizes of all files under the given path-totalFileSize-    :: (Choose <| ef, Empty <| ef, FileSystem <| ef, Throw NotADir <| ef, IO <| ef)+fileSizes+    :: (Choose :> es, Empty :> es, FileSystem :> es, Throw NotADir :> es, Emb IO :> es)     => FilePath-    -> Eff '[] ef (Sum Integer)-totalFileSize path = do+    -> Eff es (Sum Integer)+fileSizes path = do     entities :: [FilePath] <- listDirectory path & joinEither--    -- Non-deterministically *pick* one item from the list-    entity :: FilePath <- choice entities-+    entity :: FilePath <- choice entities -- Non-deterministically /pick/ one item from the list     let path' = path </> entity      liftIO $ putStrLn $ "Found " <> path'@@ -274,7 +289,7 @@             liftIO $ putStrLn $ " ... " <> show size <> " bytes"             pure $ Sum size         Left NotAFile -> do-            totalFileSize path'+            fileSizes path'  main :: IO () main = runEff@@ -282,22 +297,22 @@     . runThrowIO @NotADir     . runDummyFS exampleRoot     $ do-        total <- runNonDetMonoid pure (totalFileSize ".")+        total <- runNonDetMonoid pure (fileSizes ".")         liftIO $ print total  -- | Effect for file system operations-data FileSystem a where-    ListDirectory :: FilePath -> FileSystem (Either NotADir [FilePath])-    GetFileSize :: FilePath -> FileSystem (Either NotAFile Integer)+data FileSystem :: Effect where+    ListDirectory :: FilePath -> FileSystem f (Either NotADir [FilePath])+    GetFileSize :: FilePath -> FileSystem f (Either NotAFile Integer)  {- | Interpreter for the FileSystem effect that virtualizes the file system in memory based on a given FSTree, instead of performing actual IO. -} runDummyFS-    :: (Throw EntryNotFound <| ef, Throw NotADir <| ef)+    :: (Throw EntryNotFound `In` es, Throw NotADir `In` es)     => FSTree-    -> Eff eh (FileSystem ': ef) ~> Eff eh ef+    -> Eff (FileSystem ': es) ~> Eff es runDummyFS root = interpret \case     ListDirectory path ->         lookupFS path root <&> \case@@ -325,8 +340,8 @@ ```  ## Documentation-A detailed explanation of usage and semantics is available in [Haddock](https://hackage.haskell.org/package/heftia-0.5.0.0/docs/Control-Monad-Hefty.html).-The example codes are located in the [heftia-effects/Example/](https://github.com/sayo-hs/heftia/tree/v0.5.0/heftia-effects/Example) directory.+A detailed explanation of usage and semantics is available in [Haddock](https://hackage.haskell.org/package/heftia-0.6.0.0/docs/Control-Monad-Hefty.html).+The example codes are located in the [heftia-effects/Example/](https://github.com/sayo-hs/heftia/tree/v0.6.0/heftia-effects/Example) directory. Also, the following *HeftWorld* example (outdated): https://github.com/sayo-hs/HeftWorld  About the internal *elaboration* mechanism: https://sayo-hs.github.io/jekyll/update/2024/09/04/how-the-heftia-extensible-effects-library-works.html@@ -349,23 +364,25 @@  | Library or Language | Higher-Order Effects | Delimited Continuation | Effect System | Purely Monadic                    | Dynamic Effect Rewriting | Semantics                        | | ------------------- | -------------------- | ---------------------- | --------------| --------------------------------- | ------------------------ | -------------------------------- |-| `heftia`            | Yes                  | Multi-shot             | Yes           | Yes                               | Yes                      | Algebraic Effects                |-| `freer-simple`      | No                   | Multi-shot             | Yes           | Yes                               | Yes                      | Algebraic Effects                |-| `polysemy`          | Yes                  | No                     | Yes           | Yes                               | Yes                      | Weaving-based (functorial state) |-| `effectful`         | Yes                  | No                     | Yes           | No (based on the `IO` monad)      | Yes                      | IO-fused                         |-| `bluefin`           | Yes                  | No                     | Yes           | No (based on the `IO` monad)      | Yes                      | IO-fused                         |-| `eff`               | Yes                  | Multi-shot             | Yes           | No (based on the `IO` monad)      | Yes                      | Algebraic Effects & IO-fused [^6]|-| `speff`             | Yes                  | Multi-shot (restriction: [^4]) | Yes   | No (based on the `IO` monad)      | Yes                      | Algebraic Effects & IO-fused     |-| `in-other-words`    | Yes                  | Multi-shot?            | Yes           | Yes                               | No?                      | Carrier dependent                |-| `mtl`               | Yes                  | Multi-shot (`ContT`)   | Yes           | Yes                               | No                       | Carrier dependent                |-| `fused-effects`     | Yes                  | No?                    | Yes           | Yes                               | No                       | Carrier dependent & Weaving-based (functorial state) |-| Koka-lang           | No                   | Multi-shot             | Yes           | No (language built-in)            | Yes                      | Algebraic Effects                |-| Eff-lang            | No                   | Multi-shot             | Yes           | No (language built-in)            | Yes                      | Algebraic Effects                |-| OCaml-lang 5        | ?                    | One-shot               | No [^3]       | No (language built-in)            | ?                        | Algebraic Effects                |+| `heftia`            | ✅                   | Multi-shot             | ✅            | ✅ (also `Applicative` and others)| ✅                       | Algebraic Effects                |+| `freer-simple`      | ❌                   | Multi-shot             | ✅            | ✅                                | ✅                       | Algebraic Effects                |+| `polysemy`          | ✅                   | ❌                     | ✅            | ✅                                | ✅                       | Weaving-based (functorial state) |+| `effectful`         | ✅                   | ❌                     | ✅            | ❌ (based on the `IO` monad)      | ✅                       | IO-fused                         |+| `bluefin`           | ❌[^7]               | ❌                     | ✅            | ❌ (based on the `IO` monad)      | [^5]                     | IO-fused                         |+| `eff`               | ✅                   | Multi-shot             | ✅            | ❌ (based on the `IO` monad)      | ✅                       | Algebraic Effects & IO-fused [^6]|+| `speff`             | ✅                   | Multi-shot (restriction: [^4]) | ✅    | ❌ (based on the `IO` monad)      | ✅                       | Algebraic Effects & IO-fused     |+| `mtl`               | ✅                   | Multi-shot (`ContT`)   | ✅            | ✅                                | ❌                       | Carrier dependent                |+| `fused-effects`     | ✅                   | ❌?                    | ✅            | ✅                                | ❌                       | Carrier dependent & Weaving-based (functorial state) |+| `in-other-words`    | ✅                   | Multi-shot?            | ✅            | ✅                                | ❌?                      | Carrier dependent                |+| Koka-lang           | ❌                   | Multi-shot             | ✅            | ❌ (language built-in)            | ✅                       | Algebraic Effects                |+| Eff-lang            | ❌                   | Multi-shot             | ✅            | ❌ (language built-in)            | ✅                       | Algebraic Effects                |+| OCaml-lang 5        | ?                    | One-shot               | ❌ [^3]       | ❌ (language built-in)            | ?                        | Algebraic Effects                |  [^3]: Effects do not appear in the type signature and can potentially cause unhandled errors at runtime [^4]: Scoped Resumption only. e.g. Coroutines are not supported.+[^5]: https://discourse.haskell.org/t/bluefin-compared-to-effectful-video/10723/27?u=ymdfield [^6]: https://github.com/hasura/eff/issues/12+[^7]: https://discourse.haskell.org/t/what-is-a-higher-order-effect/10744  Heftia can simply be described as a higher-order version of `freer-simple`. This is indeed true in terms of its internal mechanisms as well.@@ -385,7 +402,7 @@ Overall, the performance of this library is positioned roughly in the middle between the fast (`effectful`, `eveff`, etc.) and slow (`polysemy`, `fused-effects`, etc.) libraries, and can be considered average. In all benchmarks, the speed is nearly equivalent to `freer-simple`, only slightly slower. -For more details, please refer to [performance.md](https://github.com/sayo-hs/heftia/blob/v0.5.0/benchmark/performance.md).+For more details, please refer to [performance.md](https://github.com/sayo-hs/heftia/blob/v0.6.0/benchmark/performance.md).  ### Interoperability with other libraries @@ -406,32 +423,25 @@  * It is generally recommended to use effects defined with automatic derivation provided by [data-effects-th](https://hackage.haskell.org/package/data-effects-th). -* The representation of first-order effects is compatible with `freer-simple`.-    Therefore, effects defined for `freer-simple` can be used as is in this library.-    However, to avoid confusion between redundantly defined effects,-    it is recommended to use the effects defined in `data-effects`.+* The data structures used to represent effects are equivalent to those in `polysemy`, `cleff`, and `fused-effects`. However, in `heftia`, in order for operations to work, various type classes and type families (such as `HFunctor` and `OrderOf`) must also be defined for the effect types. Although it is possible to define them manually, doing so can be quite boilerplate, and to avoid the confusion caused by duplicate definitions of effects, it is recommended to use the effect types already defined in `data-effects`, and for new definitions, to use derivation via `data-effects-th`. -* GADTs for higher-order effects are formally similar to `polysemy` and `fused-effects`,-    but they need to be instances of the [`HFunctor`](https://hackage.haskell.org/package/compdata-0.13.1/docs/Data-Comp-Multi-HFunctor.html#t:HFunctor) type class.-    While it's not impossible to manually derive `HFunctor` for effect types based on these libraries and use them,-    it's inconvenient, so it's better to use `data-effects`.-    Also, it is not compatible with `effectful` and `eff`.+* It is not compatible with the structures of `effectful` and `bluefin`. A structural conversion between `effectful` and `heftia` is currently underway.  ## Future Plans * Increase effects and nurture the ecosystem-    * file system, POSIX, and so on...+    * File systems, shell scripting, POSIX, networking, Web, markup processing/template engines, multimedia, etc.+* Further speedup * Write practical software using Heftia-* Support for Applicative effects * (Support for [Linear](https://hackage.haskell.org/package/linear-base) effects?)  ## License-The license is MPL 2.0. Please refer to the [NOTICE](https://github.com/sayo-hs/heftia/blob/v0.5.0/NOTICE).+The license is MPL 2.0. Please refer to the [NOTICE](https://github.com/sayo-hs/heftia/blob/v0.6.0/NOTICE). Additionally, the code from `freer-simple` has been modified and used internally within this library. Therefore, some modules are licensed under both `MPL-2.0 AND BSD-3-Clause`. For details on licenses and copyrights, please refer to the module's Haddock documentation.  ## Your contributions are welcome!-Please see [CONTRIBUTING.md](https://github.com/sayo-hs/heftia/blob/v0.5.0/CONTRIBUTING.md).+Please see [CONTRIBUTING.md](https://github.com/sayo-hs/heftia/blob/v0.6.0/CONTRIBUTING.md).  ## Acknowledgements, citations, and related work The following is a non-exhaustive list of people and works that have had a significant impact, directly or indirectly, on Heftia’s design and implementation:

@@ -1,6 +1,6 @@-cabal-version:      2.4+cabal-version:      3.0 name:               heftia-version:            0.5.0.0+version:            0.6.0.0  -- A short (one-line) description of the package. synopsis: higher-order algebraic effects done right@@ -8,21 +8,21 @@ -- A longer description of the package. description:     This is the core package for [heftia-effects](https://hackage.haskell.org/package/heftia-effects).-    .+     Heftia is an extensible effects library that generalizes "Algebraic Effects and Handlers" to higher-order effects, providing users with maximum flexibility and delivering standard and reasonable speed.     In its generalization, the focus is on ensuring predictable results based on simple, consistent semantics, while preserving soundness.-    .+     Please refer to the [Haddock documentation](https://hackage.haskell.org/package/heftia-0.5.0.0/docs/Control-Monad-Hefty.html) for usage and semantics.     For information on performance, please refer to [performance.md](https://github.com/sayo-hs/heftia/blob/v0.5.0/benchmark/performance.md).-    .+     This library is inspired by the paper:-    .+     * Casper Bach Poulsen and Cas van der Rest. 2023. Hefty Algebras: Modular         Elaboration of Higher-Order Algebraic Effects. Proc. ACM Program. Lang. 7,         POPL, Article 62 (January 2023), 31 pages. <https://doi.org/10.1145/3571255>-    .+     The /elaboration/ approach proposed in the above paper allows for a straightforward treatment of higher-order effects.-    .+     Heftia's data structure is an extension of the Freer monad, designed to be theoretically straightforward by eliminating ad-hoc elements.  @@ -32,12 +32,12 @@ -- The license under which the package is released. license:            MPL-2.0 license-file:       LICENSE-author:             Sayo Koyoneda <ymdfield@outlook.jp>-maintainer:         Sayo Koyoneda <ymdfield@outlook.jp>+author:             Sayo contributors <ymdfield@outlook.jp>+maintainer:         ymdfield <ymdfield@outlook.jp>  -- A copyright notice. copyright:-    2023-2024 Sayo Koyoneda+    2023-2025 Sayo contributors     2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King category: Control, Monads @@ -46,15 +46,12 @@     NOTICE     README.md -tested-with:-    GHC == 9.8.2-    GHC == 9.6.6-    GHC == 9.4.1+tested-with: GHC == {9.6.2, 9.8.4, 9.10.1, 9.12.2}  source-repository head     type: git     location: https://github.com/sayo-hs/heftia-    tag: v0.5.0+    tag: v0.6.0     subdir: heftia  library@@ -63,26 +60,17 @@         Control.Monad.Hefty.Types         Control.Monad.Hefty.Interpret         Control.Monad.Hefty.Interpret.State-        Control.Monad.Hefty.Transform-        Data.Effect.OpenUnion-        Data.Effect.OpenUnion.Internal-        Data.Effect.OpenUnion.Internal.FO-        Data.Effect.OpenUnion.Internal.HO-        Data.Effect.OpenUnion.Sum         Data.FTCQueue      reexported-modules:         Data.Effect,         Data.Effect.TH,         Data.Effect.Tag,-        Data.Effect.Key,-        Data.Effect.Key.TH,         Data.Effect.HFunctor,         Data.Effect.HFunctor.HCont,         Data.Effect.HFunctor.TH,+        Data.Effect.OpenUnion,         Control.Effect,-        Control.Effect.Tag,-        Control.Effect.Key,      -- Modules included in this executable, other than Main.     -- other-modules:@@ -90,8 +78,8 @@     -- LANGUAGE extensions used by modules in this package.     -- other-extensions:     build-depends:-        base                          >= 4.17 && < 4.21,-        data-effects                  ^>= 0.3.0.1,+        base                          >= 4.17 && < 4.22,+        data-effects                  ^>= 0.4,         mtl                           >= 2.2.2 && < 2.4,         unliftio                      ^>= 0.2, 

@@ -3,7 +3,7 @@ -- SPDX-License-Identifier: MPL-2.0  {- |-Copyright   :  (c) 2024 Sayo Koyoneda+Copyright   :  (c) 2024-2025 Sayo contributors License     :  MPL-2.0 (see the LICENSE file) Maintainer  :  ymdfield@outlook.jp @@ -13,7 +13,7 @@ In its generalization, the focus is on ensuring predictable results based on simple, consistent semantics, while preserving soundness. -= Basic Usage+= Basic Usage #basic-usage#  The following is an example of defining, using, and interpreting the first-order effect @Log@ for logging and the higher-order effect @Span@ for representing@@ -26,19 +26,19 @@ import "Control.Monad.Hefty" import Prelude hiding (log, span) -data Log a where+data Log :: t'Effect' where     Log :: String -> Log ()-'makeEffectF' [''Log]+'makeEffectF' ''Log -data Span m (a :: Type) where+data Span :: t'Effect' where     Span :: String -> m a -> Span m a-'makeEffectH' [''Span]+'makeEffectH' ''Span -runLog :: ('IO' t'Data.Effect.OpenUnion.<|' ef) => 'Eff' eh (Log ': ef) t'Control.Effect.~>' 'Eff' eh ef+runLog :: (@t'Emb'@ 'IO' t'Data.Effect.OpenUnion.:>' es) => 'Eff' (Log ': es) t'Control.Effect.~>' 'Eff' es runLog = 'interpret' \\(Log msg) -> liftIO $ putStrLn $ "[LOG] " <> msg -runSpan :: ('IO' t'Data.Effect.OpenUnion.<|' ef) => 'Eff' (Span ': eh) ef t'Control.Effect.~>' 'Eff' eh ef-runSpan = 'interpretH' \\(Span name m) -> do+runSpan :: (@t'Emb'@ 'IO' t'Data.Effect.OpenUnion.:>' es) => 'Eff' (Span ': es) t'Control.Effect.~>' 'Eff' es+runSpan = 'interpret' \\(Span name m) -> do     'liftIO' $ 'putStrLn' $ "[Start span '" <> name <> "']"     r <- m     'liftIO' $ 'putStrLn' $ "[End span '" <> name <> "']"@@ -68,95 +68,55 @@   * When defining effects, you use the Template Haskell functions 'makeEffectF' and 'makeEffectH'.-* The first 'Eff' type parameter is a type-level list of higher-order effects, the second is for first-order effects. -= Glossary--[Handler]: Interpreter for first-order effects.--[Elaborator]:-    Interpreter for higher-order effects.--    Elaboration is generally performed by editing first-order (or higher-order) effectful operations within the computation held by the higher-order effect being elaborated.--    @-    [runCatch](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-Except.html#v:runCatch) :: (@t'Data.Effect.Except.Throw'@ e t'Data.Effect.OpenUnion.<|' ef) => 'Eff' '[@t'Data.Effect.Except.Catch'@ e] ef t'Control.Effect.~>' 'Eff' '[] ef-    runCatch = 'interpretH' elabCatch--    [elabCatch](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-Except.html#v:elabCatch) :: (@t'Data.Effect.Except.Throw'@ e t'Data.Effect.OpenUnion.<|' ef) => t'Data.Effect.Except.Catch' e t'Control.Monad.Hefty.~~>' 'Eff' '[] ef-    elabCatch (@v'Data.Effect.Except.Catch'@ action hdl) = action & 'interposeWith' \\(@v'Data.Effect.Except.Throw'@ e) _ -> hdl e-    @--    Here, @elabCatch@ is the elaborator for the t'Data.Effect.Except.Catch' effect.--[Interpretation \/ Handling \/ Elaboration]:-    The act of performing interpretation, or the process thereof.--    Also, an /interpreter function/ refers to a function represented by a natural transformation t'Control.Effect.~>' or of type 'Interpreter', that is, one that takes an effectful operation as an argument.-    On the other hand, when we say /interpretation function/, we mean a function of the form @'Eff' eh ef ~> 'Eff' eh' ef'@, that is, one that takes the 'Eff' monad as an argument.-    In the previous example, @elabCatch@ is the /interpreter function/ for the t'Data.Effect.Except.Catch' effect, and @runCatch@ is the /interpretation function/ for the t'Data.Effect.Except.Catch' effect.--    The interpretation function may also be called an /interpreter/.--[Continuational stateful interpreter]:-    An interpreter function that realizes features related to the continuation in algebraic effects.--    It is a function that takes two arguments: an effectful operation and a continuation, which is the continuation of the computation from that operation, and returns the computation up to the end of the computation being interpreted.--    By ignoring the continuation argument, it allows for global escapes like the 'Data.Effect.Except.Throw' effect.+= Algebraic Handler #algebraic-handler# -    @-    [runThrow](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-Except.html#v:runThrow) :: 'Eff' '[] (@t'Data.Effect.Except.Throw'@ e ': r) a -> 'Eff' '[] r ('Either' e a)-    runThrow = 'interpretBy' ('pure' '.' 'Right') handleThrow+An interpreter function that realizes features related to the continuation in algebraic effects. -    [handleThrow](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-Except.html#v:handleThrow) :: 'Interpreter' (@t'Data.Effect.Except.Throw'@ e) ('Eff' '[] r) ('Either' e a)-    handleThrow (@v'Data.Effect.Except.Throw'@ e) _ = 'pure' $ 'Left' e-    @+It is a function that takes two arguments: an effectful operation and a continuation, which is the continuation of the computation from that operation, and returns the computation up to the end of the computation being interpreted. -    Here, @handleThrow@ is the continuational stateful handler for the t'Data.Effect.Except.Throw' effect.+By ignoring the continuation argument, it allows for global escapes like the 'Data.Effect.Except.Throw' effect. -    By calling the continuation argument multiple times, it allows for non-deterministic computations like the "Data.Effect.NonDet" effect.+@+[runThrow](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/Control-Monad-Hefty-Except.html#v:runThrow) :: ('FOEs' es) => 'Eff' (@t'Data.Effect.Except.Throw'@ e ': es) a -> 'Eff' es ('Either' e a)+runThrow = 'interpretBy' ('pure' '.' 'Right') handleThrow -    @-    [runNonDet](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-NonDet.html#v:runNonDet)-        :: forall f ef a-        . ('Alternative' f)-        => 'Eff' '[] (@t'Data.Effect.NonDet.Choose'@ ': t'Data.Effect.NonDet.Empty' ': ef) a-        -> 'Eff' '[] ef (f a)-    runNonDet =-        'bundleN' \@2-            '>>>' 'interpretBy'-                ('pure' . 'pure')-                ( (\\@v'Data.Effect.NonDet.Choose'@ k -> 'liftA2' ('<|>') (k 'False') (k 'True'))-                    '!+' (\\@v'Data.Effect.NonDet.Empty'@ _ -> 'pure' 'empty')-                    '!+' 'nil'-                )-    @+[handleThrow](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/Control-Monad-Hefty-Except.html#v:handleThrow) :: 'Applicative' g => 'AlgHandler' (@t'Data.Effect.Except.Throw'@ e) f g ('Either' e a)+handleThrow (@v'Data.Effect.Except.Throw'@ e) _ = 'pure' $ 'Left' e+@ -    The function passed as the second argument to 'interpretBy' is the continuational stateful handler.+Here, @handleThrow@ is the algebraic handler for the t'Data.Effect.Except.Throw' effect. -    Additionally, what is passed as the first argument to 'interpretBy' is called a /value handler/.-    This extends the continuation in the computation being interpreted.+By calling the continuation argument multiple times, it allows for non-deterministic computations like the "Data.Effect.NonDet" effect. -[Continuational state]:-    The state of the computation that appears through interpretation, behaving based on [continuation-based semantics](https://github.com/lexi-lambda/eff/blob/master/notes/semantics-zoo.md).+@+[runNonDet](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/Control-Monad-Hefty-NonDet.html#v:runNonDet)+    :: ('Alternative' f)+    => 'Eff' (@t'Data.Effect.NonDet.Choose'@ ': t'Data.Effect.NonDet.Empty' ': es) a+    -> 'Eff' es (f a)+runNonDet =+    'interpretsBy'+        ('pure' . 'pure')+        $ (\\@v'Data.Effect.NonDet.Choose'@ k -> 'liftA2' ('<|>') (k 'False') (k 'True'))+            '!:' (\\@v'Data.Effect.NonDet.Empty'@ _ -> 'pure' 'empty')+            '!:' 'nil'+@ -= Naming Rules for Interpretation Functions+The function passed as the second argument to 'interpretBy'\/'interpretsBy' is the algebraic handler. -* Functions with an @H@, such as 'interpretH', are for higher-order effects, while those without are for first-order effects.+Additionally, what is passed as the first argument to 'interpretBy'\/'interpretsBy' is called a /value handler/.+This extends the continuation in the computation being interpreted. -    @-    'interpret' :: e t'Control.Effect.~>' 'Eff' eh ef -> 'Eff' (e ': eh) ef ~> 'Eff' eh ef-    'interpretH' :: e ('Eff' eh ef) t'Control.Effect.~>' 'Eff' eh ef -> 'Eff' (e ': eh) ef t'Control.Effect.~>' 'Eff' eh ef-    @+We shall call the state of computation that emerges through algebraic interpretation and behaves according to [continuation-based semantics](https://github.com/lexi-lambda/eff/blob/master/notes/semantics-zoo.md)+a \"algebraic state\". -    Note: t'Control.Effect.~>' binds more tightly than @->@.+= Naming Rules for Interpretation Functions #naming-rules-for-interpretation-functions#  * Functions may additionally have @With@ or @By@ at the end of their names.      * These provide functionality equivalent to "Algebraic Effects and Handlers," meaning they offer access to delimited continuations during interpretation. -    * Functions in the @By@ family take two arguments: a value handler and a continuational stateful effect interpreter. They are the most generalized form.+    * Functions in the @By@ family take two arguments: a value handler and a algebraic effect handler. They are the most generalized form.      * Functions in the @With@ family omit the value handler and take only the effect interpreter as an argument. @@ -168,52 +128,31 @@         therefore, you cannot maintain internal state or perform behaviors like         global escapes or non-deterministic computations during interpretation. -* Functions that perform recursive continuational stateful interpretation have @Rec@ additionally added.--    * Non-recursive continuational stateful interpretation functions like 'interpretWith' cannot be used unless the higher-order effects are empty:--        @-        'interpretWith' :: e t'Control.Effect.~>' 'Eff' '[] ef -> 'Eff' '[] (e ': ef) t'Control.Effect.~>' 'Eff' '[] ef-        @--    * The @Rec@ versions can be used even when @eh@ is not empty.--        @-        'interpretRecWith' :: e t'Control.Effect.~>' 'Eff' eh ef -> 'Eff' eh (e ': ef) t'Control.Effect.~>' 'Eff' eh ef-        @--    * When using this type of function, pay attention to their /reset semantics/. This is discussed later.--    * In principle, they cannot take value handlers, so there is no combination with @By@.--Function names combine the above three attributes.-Examples of complex combinations include 'interpretHBy' and 'interpretRecHWith'.--= Semantics of effects+= Semantics of effects #semantics-of-effects#  Consider the following example.  @-data SomeEff a where-    SomeAction :: SomeEff String-'makeEffectF' [''SomeEff]+data SomeEff :: Effect where+    SomeAction :: SomeEff m a+'makeEffectF' ''SomeEff  -- | Throws an exception when \'SomeAction\' is encountered-runSomeEff :: (@t'Data.Effect.Except.Throw'@ String t'Data.Effect.OpenUnion.<|' ef) => 'Eff' eh (SomeEff ': ef) t'Control.Effect.~>' 'Eff' eh ef+runSomeEff :: (@t'Data.Effect.Except.Throw'@ String t'Data.Effect.OpenUnion.:>' es) => 'Eff' (SomeEff ': es) t'Control.Effect.~>' 'Eff' es runSomeEff = 'interpret' \\SomeAction -> v'Data.Effect.Except.throw' "not caught"  -- | Catches the exception if \'someAction\' results in one-action :: (SomeEff t'Data.Effect.OpenUnion.<|' ef, t'Data.Effect.Except.Catch' String t'Data.Effect.OpenUnion.<<|' eh, t'Data.Effect.Except.Throw' String '<|' ef) => Eff eh ef+action :: (SomeEff t'Data.Effect.OpenUnion.:>' es, t'Data.Effect.Except.Catch' String t'Data.Effect.OpenUnion.:>' es, t'Data.Effect.Except.Throw' String t'Data.Effect.OpenUnion.:>' es) => Eff es String action = someAction \`@v'Data.Effect.Except.catch'@\` \\(_ :: String) -> 'pure' "caught"  prog1 :: IO ()-prog1 = 'runPure' . runThrow \@String . runCatch \@String . runSomeEff $ action+prog1 = 'runPure' . runThrow . runCatch . runSomeEff $ action  >>> prog1 Right "caught"  prog2 :: IO ()-prog2 = 'runPure' . runThrow \@String . runSomeEff . runCatch \@String $ action+prog2 = 'runPure' . runThrow . runSomeEff . runCatch $ action  >>> prog2 Left "not caught"@@ -228,15 +167,15 @@ Let's revisit the definition of @runCatch@:  @-[runCatch](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-Except.html#v:runCatch) :: (@t'Data.Effect.Except.Throw'@ e t'Data.Effect.OpenUnion.<|' ef) => 'Eff' '[@t'Data.Effect.Except.Catch'@ e] ef t'Control.Effect.~>' 'Eff' '[] ef-runCatch = 'interpretH' elabCatch+[runCatch](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/Control-Monad-Hefty-Except.html#v:runCatch) :: (@t'Data.Effect.Except.Throw'@ e `@t'Data.Effect.OpenUnion.In'@` es, 'FOEs' es) => 'Eff' (@t'Data.Effect.Except.Catch'@ e ': es) t'Control.Effect.~>' 'Eff' es+runCatch = 'interpret' elabCatch -[elabCatch](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-Except.html#v:elabCatch) :: (@t'Data.Effect.Except.Throw'@ e t'Data.Effect.OpenUnion.<|' ef) => t'Data.Effect.Except.Catch' e t'Control.Monad.Hefty.~~>' 'Eff' '[] ef-elabCatch (@v'Data.Effect.Except.Catch'@ action hdl) = action & 'interposeWith' \\(@v'Data.Effect.Except.Throw'@ e) _ -> hdl e+[handleCatch](https://hackage.haskell.org/package/heftia-effects-0.6.0.0/docs/Control-Monad-Hefty-Except.html#v:handleCatch) :: (@t'Data.Effect.Except.Throw'@ e `@t'Data.Effect.OpenUnion.In'@` es, 'FOEs' es) => t'Data.Effect.Except.Catch' e t'Control.Monad.Hefty.~~>' 'Eff' es+handleCatch (@v'Data.Effect.Except.Catch'@ action hdl) = action & 'interposeWith' \\(@v'Data.Effect.Except.Throw'@ e) _ -> hdl e @  When @runCatch@ encounters code like @... (action \`catch\` hdl) ...@ in the program, it rewrites that part to @... ('interposeWith' (\\(@v'Data.Effect.Except.Throw'@ e) _ -> hdl e) action) ...@.-In general, functions like 'interpretH' and 'interposeH' behave this way—they recursively rewrite the target higher-order effects according to the given elaborator.+In general, functions like 'interpret' and 'interpose' behave this way—they recursively rewrite the target higher-order effects according to the given handler. Rewriting proceeds from the deepest scope toward the outer scopes.  The same applies to first-order effects. Handling an effect means rewriting the effects that appear in the program.@@ -257,7 +196,7 @@ Next, when @runCatch@ is applied to this, it evaluates to:  @-    runCatch \@String $ v'Data.Effect.Except.throw' "not caught" \`@v'Data.Effect.Except.catch'@\` \\(_ :: String) -> 'pure' "caught"+    runCatch $ v'Data.Effect.Except.throw' "not caught" \`@v'Data.Effect.Except.catch'@\` \\(_ :: String) -> 'pure' "caught" ==> 'interposeWith' (\\(@v'Data.Effect.Except.Throw'@ e) _ -> 'pure' "caught") $ v'Data.Effect.Except.throw' "not caught" ==> 'pure' "caught" @@@ -267,8 +206,8 @@ On the other hand, in @prog2@, when @runCatch@ is applied to @action@:  @-    runCatch \@String action- =  runCatch \@String $ someAction \`@v'Data.Effect.Except.catch'@\` \\(_ :: String) -> 'pure' "caught"+    runCatch action+ =  runCatch $ someAction \`@v'Data.Effect.Except.catch'@\` \\(_ :: String) -> 'pure' "caught" ==> 'interposeWith' (\\(@v'Data.Effect.Except.Throw'@ e) _ -> 'pure' "caught") $ someAction @ @@ -295,7 +234,7 @@  This is all there is to the reduction semantics of algebraic effects. -== Independence from IO Semantics+== Independence from IO Semantics #independence-from-io-semantics#  As seen in the initial example with logs and spans, 'IO' operations are embedded as effects. Not limited to 'IO', any monad can be embedded as an effect.@@ -304,9 +243,9 @@ Rather than thinking "Haskell represents side effects via a type-level tag called 'IO'", it's better to think:  * Haskell is a purely functional language where you cannot write anything other than pure functions.-* 'IO' is just an opaque algebraic data type whose definition you cannot see, no different from others.+* 'IO' is just an opaque algebraic data type whose definition you cannot see, but no different from others. * The runtime system treats the value @main@ as a sequence of instructions to be executed on the CPU.-* Programming with side effects in Haskell is meta-programming where you write a pure function program that outputs 'IO' type instruction scripts.+* Programming with side effects in Haskell is meta-programming where you write a pure function program that outputs 'IO'-typed instruction scripts.  In fact, the semantics of effects in Heftia are completely isolated from the level of 'IO'. Considerations at the 'IO' level, such as "asynchronous exceptions might be thrown",@@ -317,169 +256,69 @@  This is a significant difference from 'IO'-fused effect system libraries like [effectful](https://hackage.haskell.org/package/effectful) and [cleff](https://hackage.haskell.org/package/cleff). -= Reset Semantics in Recursive Continuational Stateful Interpretation--When performing recursive continuational stateful interpretation, that is, when using functions with @Rec@, it's necessary to understand their semantics.-If you are not using @Rec@ functions, you don't need to pay particular attention to this section.--[@evalStateRec@](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-State.html#v:evalStateRec) is a variant of- [@evalState@](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-State.html#v:evalState),-a handler for the @State@ effect that can be used even when higher-order effects are unelaborated:--@-[@evalStateRec@](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-State.html#v:evalStateRec) :: s -> 'Eff' eh (@t'Data.Effect.State.State'@ s ': ef) t'Control.Effect.~>' 'Eff' eh ef-[@evalState@](https://hackage.haskell.org/package/heftia-effects-0.5.0.0/docs/Control-Monad-Hefty-State.html#v:evalState) :: s -> 'Eff' '[] (@t'Data.Effect.State.State'@ s ': ef) t'Control.Effect.~>' 'Eff' '[] ef-@--@evalStateRec@ uses @Rec@ functions internally. When a function uses @Rec@ functions internally, it's best to reflect that in its naming.--Now, if you perform @evalStateRec@ before elaborating higher-order effects, the following occurs.-Note that we are using the @Log@ and @Span@ effects introduced in the first example.--@-import Prelude hiding (log, span)--prog :: IO ()-prog = 'runEff' do-    runLog . runSpan . evalStateRec \@[Int] [] $ do--        v'Data.Effect.State.modify' \@[Int] (++ [1])-        log . show =<< v'Data.Effect.State.get' \@[Int]--        span \"A\" do-            v'Data.Effect.State.modify' \@[Int] (++ [2])-            log . show =<< v'Data.Effect.State.get' \@[Int]--        v'Data.Effect.State.modify' \@[Int] (++ [3])-        log . show =<< v'Data.Effect.State.get' \@[Int]--    'pure' ()-->>> prog-[LOG] [1]-[Start span 'A']-[LOG] [1,2]-[End span 'A']-[LOG] [1,3]-@--After exiting span @A@, the added @2@ has disappeared. As shown, state changes within the scope may not be preserved after exiting the scope.--This is a fundamental limitation of state preservation.-When attempting to perform continuational stateful interpretation of an effect,-if there are unelaborated higher-order effects remaining, resets of this continuational state occur for each scope of those higher-order effects.-For higher-order effects that have already been elaborated and removed from the list at that point, there is naturally no impact.--This is simply because @evalStateRec@ (generally all @Rec@ functions) recursively applies @evalState@ to the scopes of unelaborated higher-order effects.-Interpretation occurs independently for each scope, and the state is not carried over.--From the perspective of @shift/reset@ delimited continuations, this phenomenon can be seen as @reset@s being inserted at the scopes of unelaborated higher-order effects.--Whether this behavior occurs can be determined in advance.-This reset behavior occurs only when using @Rec@ functions and when the program passed to that function performs unelaborated higher-order effects internally.-The reset behavior occurs locally only at the points where those effects are performed.-Whether an unelaborated higher-order effect @e@ is performed internally can generally be determined by looking at the type signature of the effectful program.-Given an effectful program @p@, if its type signature includes @e@ in the list of higher-order effects,-or if the constraint part includes @e t'Data.Effect.OpenUnion.<<|' eh@ or @e t'Control.Effect.<<:' m@, then you know that higher-order effect is being used.-If not, @e@ cannot be performed internally in the function @p@.--If you do not desire this reset behavior, you can avoid it by elaborating all higher-order effects first and emptying them when performing continuational stateful interpretation without using @Rec@ functions:--@-import Prelude hiding (log, span)--prog :: IO ()-prog = 'runEff' do-    runLog . evalState \@[Int] [] . runSpan $ do--        v'Data.Effect.State.modify' \@[Int] (++ [1])-        log . show =<< v'Data.Effect.State.get' \@[Int]--        span \"A\" do-            v'Data.Effect.State.modify' \@[Int] (++ [2])-            log . show =<< v'Data.Effect.State.get' \@[Int]--        v'Data.Effect.State.modify' \@[Int] (++ [3])-        log . show =<< v'Data.Effect.State.get' \@[Int]--    'pure' ()-->>> prog-[LOG] [1]-[Start span 'A']-[LOG] [1,2]-[Ene span 'A']-[LOG] [1,2,3]-@--= Interpreting Multiple Effects Simultaneously+= Interpreting Multiple Effects Simultaneously #interpreting-multiple-effects-simultaneously#  For example, consider a situation where you want to use multiple t'Data.Effect.Except.Catch' effects simultaneously. The following is a case where both @String@ and @Int@ appear as exception types:  @-prog :: 'Eff' '[@t'Data.Effect.Except.Catch'@ String, @t'Data.Effect.Except.Catch'@ Int] '[@t'Data.Effect.Except.Throw'@ String, @t'Data.Effect.Except.Throw'@ Int] ()+prog :: 'Eff' '[@t'Data.Effect.Except.Catch'@ String, @t'Data.Effect.Except.Catch'@ Int, @t'Data.Effect.Except.Throw'@ String, @t'Data.Effect.Except.Throw'@ Int] () @  In this case, you may get stuck trying to use @runCatch@. This is because @runCatch@ has the following type signature:  @-runCatch :: (@t'Data.Effect.Except.Throw'@ e t'Data.Effect.OpenUnion.<|' ef) => 'Eff' '[@t'Data.Effect.Except.Catch'@ e] ef t'Control.Effect.~>' 'Eff' '[] ef+runCatch :: (@t'Data.Effect.Except.Throw'@ e `@t'Data.Effect.OpenUnion.In'@` es, 'FOEs' es) => 'Eff' (@t'Data.Effect.Except.Catch'@ e ': es) t'Control.Effect.~>' 'Eff' es @ -You cannot write @runCatch \@Int . runCatch \@String@. It requires the higher-order effects to be empty after interpretation:+You cannot write @runCatch . runCatch@. It requires the higher-order effects to be exhausted after interpretation:  ->runCatch @String . runCatch @Int $ prog->                   ^^^^^^^^^^^^^+>     runCatch . runCatch $ prog+>                ^^^^^^^^ >->• Couldn't match type: '[]->                 with: '[Catch String]->  Expected: Eff '[Catch Int] ef x -> Eff '[Catch String] ef x->    Actual: Eff '[Catch Int] ef x -> Eff '[] ef x->• In the second argument of ‘(.)’, namely ‘runCatch @Int’->  In the first argument of ‘($)’, namely->    ‘runCatch @String . runCatch @Int’->  In the expression: runCatch @String . runCatch @Int $ prog+>   • No instance for ‘Data.Effect.FirstOrder (Catch Int)’+>       arising from a use of ‘runCatch’+>   • In the second argument of ‘(.)’, namely ‘runCatch’+>     In the first argument of ‘($)’, namely ‘runCatch . runCatch’+>     In the expression: runCatch . runCatch $ prog -In situations like this, where you want to perform continuational stateful elaboration on multiple higher-order effects simultaneously,+In situations like this, where you want to perform algebraic interpretation on multiple higher-order effects simultaneously, you generally cannot reduce the higher-order effect list step by step or via multi-staging.-Instead, you need to elaborate /all of them at once simultaneously/.+Instead, you need to interpret /all of them at once simultaneously/. -This is possible by pattern matching on the open union of higher-order effects using the '!!+' operator.+This is possible by 'interprets' family and pattern matching on the open union using the '!:' operator.  @-prog' :: 'Eff' '[] '[@t'Data.Effect.Except.Throw'@ String, @t'Data.Effect.Except.Throw'@ Int] ()-prog' = 'interpretH' (elabCatch \@String '!!+' elabCatch \@Int '!!+' 'nilH') . 'bundleAllH' $ prog+prog' :: 'Eff' '[@t'Data.Effect.Except.Throw'@ String, @t'Data.Effect.Except.Throw'@ Int] ()+prog' = 'interprets' (handleCatch '!:' handleCatch '!:' 'nil') prog @--'bundleAllH' collects the entire list of higher-order effects into a single higher-order effect using an open union.--Similarly, this can be done for first-order effects using '!+', 'nil', and 'bundleAll'. -} module Control.Monad.Hefty (     -- * Basics-    Eff (Op, Val),-    type (:!!),-    type (!!),-    type (+),-    type (:+:),+    Eff,+    Freer (Op, Val),     type ($),     type ($$),-    Interpreter,-    Elaborator,+    AlgHandler,+    type (~>),     type (~~>),+    FOEs,+    type (:>),+    type In,+    type Has,+    type (++),+    (!:),+    (!++),+    nil,+    perform,+    perform',+    perform'',     send,-    sendH,-    send0,-    send0H,-    sendN,-    sendNH,-    sendUnion,-    sendUnionBy,-    sendUnionH,-    sendUnionHBy,+    sendAt,+    sendFor,+    emb,      -- * Interpreting effects @@ -488,332 +327,169 @@     runPure,      -- ** Standard functions--    -- *** For first-order effects     interpret,+    interprets,     interpretWith,     interpretBy,-    interpretRecWith,--    -- *** For higher-order effects-    interpretH,-    interpretHWith,-    interpretHBy,-    interpretRecHWith,+    interpretsBy,      -- ** Reinterpretation functions--    -- *** For first-order effects     reinterpret,-    reinterpretN,+    reinterprets,     reinterpretBy,-    reinterpretNBy,+    reinterpretsBy,     reinterpretWith,-    reinterpretNWith,-    reinterpretRecWith,-    reinterpretRecNWith, -    -- *** For higher-order effects-    reinterpretH,-    reinterpretNH,-    reinterpretHWith,-    reinterpretNHWith,-    reinterpretHBy,-    reinterpretNHBy,-    reinterpretRecHWith,-    reinterpretRecNHWith,-     -- ** Interposition functions--    -- *** For first-order effects     interpose,-    interposeWith,+    interposeOn,+    interposeIn,     interposeBy,-    interposeRecWith,--    -- *** For higher-order effects-    interposeH,-    interposeRecHWith,+    interposeOnBy,+    interposeInBy,+    interposeWith,+    interposeOnWith,+    interposeInWith,+    interposeFor,+    interposeForWith,+    interposeForBy,      -- ** Transformation to monads-    iterEffBy,-    iterEffHBy,-    iterEffRecH,-    iterEffRecHWith,-    iterEffRecHFWith,-    iterEffHFBy,-    iterAllEffHF,-    iterAllEffHFBy,--    -- ** Layer manipulation-    splitLayer,-    mergeLayer,+    iterAllEff,      -- ** Utilities     stateless,+    interpretAll,      -- ** Ad-hoc stateful interpretation      -- | Theses entities provides an ad-hoc specialized version to accelerate interpretations that have a     -- single state type @s@, especially for effects like t'Data.Effect.State.State' or     --  [@Writer@]("Data.Effect.Writer").-    StateElaborator,-    StateInterpreter,+    StateHandler,      -- *** Interpretation functions     interpretStateBy,     reinterpretStateBy,-    interpretStateRecWith,-    reinterpretStateRecWith,      -- *** Interposition functions     interposeStateBy,--    -- *** Transformation to monads-    iterStateAllEffHFBy,+    interposeStateInBy,+    interposeStateForBy,      -- * Transforming effects      -- ** Rewriting effectful operations     transform,-    transformH,     translate,-    translateH,+    translateOn,+    translateIn,+    translateFor,     rewrite,-    rewriteH,-    transEff,-    transEffH,-    transEffHF,+    rewriteOn,+    rewriteIn,+    rewriteFor,      -- ** Manipulating the effect list (without rewriting effectful operations)      -- *** Insertion functions     raise,     raises,-    raiseN,-    raiseAll,-    raiseUnder,     raisesUnder,-    raiseNUnder,-    raiseH,-    raisesH,-    raiseNH,-    raiseAllH,-    raiseUnderH,-    raiseNUnderH,--    -- *** Merging functions+    raiseUnder,+    Suffix,+    SuffixUnder,+    onlyFOEs,+    WeakenHOEs,+    RemoveHOEs,+    raisePrefix,+    raiseSuffix,+    raisePrefix1,     subsume,-    subsumes,-    subsumeN,     subsumeUnder,-    subsumesUnder,-    subsumeNUnder,-    subsumeH,-    subsumesH,-    subsumeNH,-    subsumeUnderH,-    subsumeNUnderH, -    -- ** Bundling functions-    bundle,-    bundleN,-    unbundle,-    unbundleN,-    bundleUnder,-    unbundleUnder,-    bundleAll,-    unbundleAll,-    bundleH,-    unbundleH,-    bundleUnderH,-    unbundleUnderH,-    bundleAllH,-    unbundleAllH,--    -- *** Manipulating Tags & Keys+    -- *** Manipulating Tags     tag,     untag,-    retag,-    tagH,-    untagH,-    retagH,-    key,-    unkey,-    rekey,-    keyH,-    unkeyH,-    rekeyH,      -- * Misc-    HFunctor,-    ReaderKey,-    WriterKey,-    StateKey,-    ErrorKey,+    KnownOrder,     Type,     liftIO,-    module Data.Effect.OpenUnion,     module Data.Effect,     module Data.Effect.Tag,-    module Data.Effect.Key,     module Data.Effect.TH,     module Data.Effect.HFunctor.TH,-    module Data.Effect.Key.TH,     module Control.Effect, ) where +import Control.Effect hiding (Eff)+import Control.Effect.Interpret (interposeIn, interposeOn, interprets, reinterprets)+import Control.Effect.Transform (+    onlyFOEs,+    raise,+    raisePrefix,+    raisePrefix1,+    raiseSuffix,+    raiseUnder,+    raises,+    raisesUnder,+    rewrite,+    rewriteFor,+    rewriteIn,+    rewriteOn,+    subsume,+    subsumeUnder,+    tag,+    transform,+    translate,+    translateFor,+    translateIn,+    translateOn,+    untag,+ ) import Control.Monad.Hefty.Interpret (     interpose,     interposeBy,-    interposeH,-    interposeRecHWith,-    interposeRecWith,+    interposeFor,+    interposeForBy,+    interposeForWith,+    interposeInBy,+    interposeInWith,+    interposeOnBy,+    interposeOnWith,     interposeWith,     interpret,+    interpretAll,     interpretBy,-    interpretH,-    interpretHBy,-    interpretHWith,-    interpretRecHWith,-    interpretRecWith,     interpretWith,-    iterAllEffHF,-    iterAllEffHFBy,-    iterEffBy,-    iterEffHBy,-    iterEffHFBy,-    iterEffRecH,-    iterEffRecHFWith,-    iterEffRecHWith,-    mergeLayer,+    interpretsBy,+    iterAllEff,     reinterpret,     reinterpretBy,-    reinterpretH,-    reinterpretHBy,-    reinterpretHWith,-    reinterpretN,-    reinterpretNBy,-    reinterpretNH,-    reinterpretNHBy,-    reinterpretNHWith,-    reinterpretNWith,-    reinterpretRecHWith,-    reinterpretRecNHWith,-    reinterpretRecNWith,-    reinterpretRecWith,     reinterpretWith,+    reinterpretsBy,     runEff,     runPure,-    splitLayer,     stateless,  )- import Control.Monad.Hefty.Interpret.State (-    StateElaborator,-    StateInterpreter,+    StateHandler,     interposeStateBy,+    interposeStateForBy,+    interposeStateInBy,     interpretStateBy,-    interpretStateRecWith,-    iterStateAllEffHFBy,     reinterpretStateBy,-    reinterpretStateRecWith,  )-import Control.Monad.Hefty.Transform (-    bundle,-    bundleAll,-    bundleAllH,-    bundleH,-    bundleN,-    bundleUnder,-    bundleUnderH,-    key,-    keyH,-    raise,-    raiseAll,-    raiseAllH,-    raiseH,-    raiseN,-    raiseNH,-    raiseNUnder,-    raiseNUnderH,-    raiseUnder,-    raiseUnderH,-    raises,-    raisesH,-    raisesUnder,-    rekey,-    rekeyH,-    retag,-    retagH,-    rewrite,-    rewriteH,-    subsume,-    subsumeH,-    subsumeN,-    subsumeNH,-    subsumeNUnder,-    subsumeNUnderH,-    subsumeUnder,-    subsumeUnderH,-    subsumes,-    subsumesH,-    subsumesUnder,-    tag,-    tagH,-    transEff,-    transEffH,-    transEffHF,-    transform,-    transformH,-    translate,-    translateH,-    unbundle,-    unbundleAll,-    unbundleAllH,-    unbundleH,-    unbundleN,-    unbundleUnder,-    unbundleUnderH,-    unkey,-    unkeyH,-    untag,-    untagH,- )--import Control.Effect import Control.Monad.Hefty.Types (-    Eff (..),-    Elaborator,-    ErrorKey,-    Interpreter,-    ReaderKey,-    StateKey,-    WriterKey,-    send,-    send0,-    send0H,-    sendH,-    sendN,-    sendNH,-    sendUnion,-    sendUnionBy,-    sendUnionH,-    sendUnionHBy,-    type (!!),-    type ($),-    type ($$),-    type (:!!),-    type (~~>),+    AlgHandler,+    Eff,+    Freer (..),  ) import Control.Monad.IO.Class (liftIO) import Data.Effect-import Data.Effect.HFunctor (HFunctor) import Data.Effect.HFunctor.TH-import Data.Effect.Key-import Data.Effect.Key.TH-import Data.Effect.OpenUnion-import Data.Effect.OpenUnion.Sum (type (:+:))+import Data.Effect.OpenUnion (FOEs, Has, In, KnownOrder, RemoveHOEs, Suffix, SuffixUnder, WeakenHOEs, nil, (!++), (!:), (:>), type (++)) import Data.Effect.TH import Data.Effect.Tag import Data.Kind (Type)

@@ -2,613 +2,256 @@  -- SPDX-License-Identifier: MPL-2.0 AND BSD-3-Clause --- This Source Code Form is subject to the terms of the Mozilla Public--- License, v. 2.0. If a copy of the MPL was not distributed with this--- file, You can obtain one at https://mozilla.org/MPL/2.0/.- {- |-Copyright   :  (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King; 2024 Sayo Koyoneda-License     :  MPL-2.0 (see the LICENSE file) AND BSD-3-Clause (see the LICENSE.BSD3 file)+Copyright   :  (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King; 2024 Sayo contributors+License     :  MPL-2.0 AND BSD-3-Clause (see the LICENSE and LICENSE.BSD3 files) Maintainer  :  ymdfield@outlook.jp  This module provides functions for interpretation. Please refer to the documentation of the [top-level module]("Control.Monad.Hefty"). -}-module Control.Monad.Hefty.Interpret where+module Control.Monad.Hefty.Interpret (+    module Control.Monad.Hefty.Interpret,+    module Control.Effect.Interpret,+)+where -import Control.Arrow ((>>>))-import Control.Effect (type (~>))-import Control.Monad ((>=>))+import Control.Effect (unEff, type (~>))+import Control.Effect qualified as D+import Control.Effect.Interpret hiding (runEff, runPure)+import Control.Effect.Interpret qualified as D import Control.Monad.Hefty.Types (-    Eff (Op, Val),-    Elaborator,-    Interpreter,-    send0,-    sendUnion,-    sendUnionBy,-    sendUnionH,-    sendUnionHBy,-    type (~~>),+    AlgHandler,+    Eff,+    Freer (Op, Val),+    qApp,  )-import Data.Effect.HFunctor (HFunctor, hfmap)-import Data.Effect.OpenUnion.Internal (IsSuffixOf, WeakenN)-import Data.Effect.OpenUnion.Internal.FO (-    Member (prj),+import Data.Effect (Emb)+import Data.Effect.OpenUnion (+    FOEs,+    Has,+    In,+    KnownLength,+    KnownOrder,+    Membership,+    Suffix,     Union,-    extract,+    coerceFOEs,+    identityMembership,+    keyMembership,+    labelMembership,     nil,-    weakenN,+    project,     weakens,-    (!+),-    type (<|),- )-import Data.Effect.OpenUnion.Internal.HO (-    MemberH (prjH),-    UnionH,-    extractH,-    hfmapUnion,-    nilH,-    weakenNH,-    weakensH,-    (!!+),-    type (<<|),+    (!++),+    (!:),+    (:>),+    type (++),  )-import Data.FTCQueue (FTCQueue, ViewL (TOne, (:|)), tviewl, (><))+import Data.Effect.Tag (unTag)+import Data.FTCQueue (tsingleton)+import Data.Function ((&))  -- * Running t`Eff`  -- | Lowers the computation into a monad @m@ by treating the effect as a monad.-runEff :: (Monad m) => Eff '[] '[m] ~> m-runEff = iterEffBy pure $ stateless id+runEff :: (Monad m) => Eff '[Emb m] ~> m+runEff = D.runEff {-# INLINE runEff #-}  -- | Extracts the value from a computation that contains only pure values without any effect.-runPure :: Eff '[] '[] a -> a-runPure = \case-    Val x -> x-    Op u _ -> case u of-        Left u' -> nilH u'-        Right u' -> nil u'+runPure :: Eff '[] a -> a+runPure (D.Eff m) =+    case m of+        Val x -> x+        Op r _ -> nil r {-# INLINE runPure #-} --- * Standard interpretation functions---- ** For first-order effects---- | Interprets the first-order effect @e@ at the head of the list using the provided natural transformation style handler.-interpret-    :: forall e ef eh-     . (e ~> Eff eh ef)-    -- ^ Effect handler-    -> Eff eh (e ': ef) ~> Eff eh ef-interpret = reinterpret-{-# INLINE interpret #-}+-- * Standard continuational interpretation functions --- | Interprets the first-order effect @e@ at the head of the list using the provided continuational stateful handler.+-- | Interprets the effect @e@ at the head of the list using the provided algebraic handler. interpretWith-    :: forall e ef a-     . Interpreter e (Eff '[] ef) a-    -- ^ Effect handler-    -> Eff '[] (e ': ef) a-    -> Eff '[] ef a+    :: forall e es a+     . (KnownOrder e, FOEs es)+    => AlgHandler e (Eff (e ': es)) (Eff es) a+    -> Eff (e ': es) a+    -> Eff es a interpretWith = reinterpretWith {-# INLINE interpretWith #-} --- | Interprets the first-order effect @e@ at the head of the list using the provided value handler and continuational stateful handler.+-- | Interprets the effect @e@ at the head of the list using the provided value handler and algebraic handler. interpretBy-    :: forall e ef ans a-     . (a -> Eff '[] ef ans)-    -- ^ Value handler-    -> Interpreter e (Eff '[] ef) ans-    -- ^ Effect handler-    -> Eff '[] (e ': ef) a-    -> Eff '[] ef ans+    :: forall e es ans a+     . (KnownOrder e, FOEs es)+    => (a -> Eff es ans)+    -> AlgHandler e (Eff (e ': es)) (Eff es) ans+    -> Eff (e ': es) a+    -> Eff es ans interpretBy = reinterpretBy {-# INLINE interpretBy #-} -{- | Interprets the first-order effect @e@ at the head of the list using the provided continuational stateful handler.--Interpretation is performed recursively with respect to the scopes of unelaborated higher-order effects @eh@.-Note that during interpretation, the continuational state is reset (delimited) and does not persist beyond scopes.--}-interpretRecWith-    :: forall e ef eh a-     . (forall ans. Interpreter e (Eff eh ef) ans)-    -- ^ Effect handler-    -> Eff eh (e ': ef) a-    -> Eff eh ef a-interpretRecWith = reinterpretRecWith-{-# INLINE interpretRecWith #-}---- ** For higher-order effects---- | Interprets the higher-order effect @e@ at the head of the list using the provided natural transformation style elaborator.-interpretH-    :: forall e eh ef-     . (HFunctor e)-    => e ~~> Eff eh ef-    -- ^ Effect elaborator-    -> Eff (e ': eh) ef ~> Eff eh ef-interpretH = reinterpretH-{-# INLINE interpretH #-}---- | Interprets the single higher-order effect @e@ using the provided continuational stateful elaborator.-interpretHWith-    :: forall e eh ef a-     . (HFunctor e)-    => Interpreter (e (Eff '[e] ef)) (Eff eh ef) a-    -- ^ Effect elaborator-    -> Eff '[e] ef a-    -> Eff eh ef a-interpretHWith = reinterpretHWith-{-# INLINE interpretHWith #-}---- | Interprets the single higher-order effect @e@ using the provided value handler and continuational stateful elaborator.-interpretHBy-    :: forall e eh ef ans a-     . (HFunctor e)-    => (a -> Eff eh ef ans)-    -- ^ Value handler-    -> Interpreter (e (Eff '[e] ef)) (Eff eh ef) ans-    -- ^ Effect elaborator-    -> Eff '[e] ef a-    -> Eff eh ef ans-interpretHBy = reinterpretHBy-{-# INLINE interpretHBy #-}--{- | Interprets the higher-order effect @e@ at the head of the list using the provided continuational stateful elaborator.--Interpretation is performed recursively with respect to the scopes of unelaborated higher-order effects @eh@.-Note that during interpretation, the continuational state is reset (delimited) and does not persist beyond scopes.--}-interpretRecHWith-    :: forall e eh ef a-     . (HFunctor e)-    => (forall ans. Elaborator e (Eff eh ef) ans)-    -- ^ Effect elaborator-    -> Eff (e ': eh) ef a-    -> Eff eh ef a-interpretRecHWith = reinterpretRecHWith-{-# INLINE interpretRecHWith #-}---- * Reinterpretation functions---- ** For first-order effects--reinterpret-    :: forall e ef' ef eh-     . (ef `IsSuffixOf` ef')-    => (e ~> Eff eh ef')-    -> Eff eh (e ': ef) ~> Eff eh ef'-reinterpret f = reinterpretRecWith (stateless f)-{-# INLINE reinterpret #-}--reinterpretN-    :: forall n e ef' ef eh-     . (WeakenN n ef ef')-    => (e ~> Eff eh ef')-    -> Eff eh (e ': ef) ~> Eff eh ef'-reinterpretN f = reinterpretRecNWith @n (stateless f)-{-# INLINE reinterpretN #-}+interpretsBy+    :: forall es r ans a+     . (FOEs r, KnownLength es)+    => (a -> Eff r ans)+    -> AlgHandler (Union es) (Eff (es ++ r)) (Eff r) ans+    -> Eff (es ++ r) a+    -> Eff r ans+interpretsBy = reinterpretsBy @_ @r+{-# INLINE interpretsBy #-}  reinterpretWith-    :: forall e ef' ef eh a-     . (ef `IsSuffixOf` ef')-    => Interpreter e (Eff eh ef') a-    -> Eff '[] (e ': ef) a-    -> Eff eh ef' a+    :: forall e es' es a+     . (Suffix es es', KnownOrder e, FOEs es)+    => AlgHandler e (Eff (e ': es)) (Eff es') a+    -> Eff (e ': es) a+    -> Eff es' a reinterpretWith = reinterpretBy pure {-# INLINE reinterpretWith #-} -reinterpretNWith-    :: forall n e ef' ef eh a-     . (WeakenN n ef ef')-    => Interpreter e (Eff eh ef') a-    -> Eff '[] (e ': ef) a-    -> Eff eh ef' a-reinterpretNWith = reinterpretNBy @n pure-{-# INLINE reinterpretNWith #-}- reinterpretBy-    :: forall e ef' ef eh ans a-     . (ef `IsSuffixOf` ef')-    => (a -> Eff eh ef' ans)-    -> Interpreter e (Eff eh ef') ans-    -> Eff '[] (e ': ef) a-    -> Eff eh ef' ans-reinterpretBy ret hdl = iterAllEffHFBy ret nilH (hdl !+ flip sendUnionBy . weakens)-{-# INLINE reinterpretBy #-}--reinterpretNBy-    :: forall n e ef' ef eh ans a-     . (WeakenN n ef ef')-    => (a -> Eff eh ef' ans)-    -> Interpreter e (Eff eh ef') ans-    -> Eff '[] (e ': ef) a-    -> Eff eh ef' ans-reinterpretNBy ret hdl = iterAllEffHFBy ret nilH (hdl !+ flip sendUnionBy . weakenN @n)-{-# INLINE reinterpretNBy #-}--reinterpretRecWith-    :: forall e ef' ef eh a-     . (ef `IsSuffixOf` ef')-    => (forall ans. Interpreter e (Eff eh ef') ans)-    -> Eff eh (e ': ef) a-    -> Eff eh ef' a-reinterpretRecWith hdl = loop-  where-    loop :: Eff eh (e ': ef) ~> Eff eh ef'-    loop = iterAllEffHFBy pure (flip sendUnionHBy . hfmapUnion loop) (hdl !+ flip sendUnionBy . weakens)-{-# INLINE reinterpretRecWith #-}--reinterpretRecNWith-    :: forall n e ef' ef eh a-     . (WeakenN n ef ef')-    => (forall ans. Interpreter e (Eff eh ef') ans)-    -> Eff eh (e ': ef) a-    -> Eff eh ef' a-reinterpretRecNWith hdl = loop-  where-    loop :: Eff eh (e ': ef) ~> Eff eh ef'-    loop = iterAllEffHFBy pure (flip sendUnionHBy . hfmapUnion loop) (hdl !+ flip sendUnionBy . weakenN @n)-{-# INLINE reinterpretRecNWith #-}---- ** For higher-order effects--reinterpretH-    :: forall e eh eh' ef-     . (HFunctor e, eh `IsSuffixOf` eh')-    => e ~~> Eff eh' ef-    -> Eff (e ': eh) ef ~> Eff eh' ef-reinterpretH elb = reinterpretRecHWith (stateless elb)-{-# INLINE reinterpretH #-}--reinterpretNH-    :: forall n e eh eh' ef-     . (HFunctor e, WeakenN n eh eh')-    => e ~~> Eff eh' ef-    -> Eff (e ': eh) ef ~> Eff eh' ef-reinterpretNH elb = reinterpretRecNHWith @n (stateless elb)-{-# INLINE reinterpretNH #-}--reinterpretHWith-    :: forall e eh ef a-     . (HFunctor e)-    => Interpreter (e (Eff '[e] ef)) (Eff eh ef) a-    -> Eff '[e] ef a-    -> Eff eh ef a-reinterpretHWith = reinterpretHBy pure-{-# INLINE reinterpretHWith #-}--reinterpretNHWith-    :: forall n e eh ef a-     . (HFunctor e, WeakenN n '[] eh)-    => Interpreter (e (Eff '[e] ef)) (Eff eh ef) a-    -> Eff '[e] ef a-    -> Eff eh ef a-reinterpretNHWith = reinterpretHWith-{-# INLINE reinterpretNHWith #-}--reinterpretHBy-    :: forall e eh ef ans a-     . (HFunctor e)-    => (a -> Eff eh ef ans)-    -> Interpreter (e (Eff '[e] ef)) (Eff eh ef) ans-    -> Eff '[e] ef a-    -> Eff eh ef ans-reinterpretHBy ret elb = iterAllEffHFBy ret (elb . extractH) (flip sendUnionBy)-{-# INLINE reinterpretHBy #-}--reinterpretNHBy-    :: forall n e eh ef ans a-     . (HFunctor e, WeakenN n '[] eh)-    => (a -> Eff eh ef ans)-    -> Interpreter (e (Eff '[e] ef)) (Eff eh ef) ans-    -> Eff '[e] ef a-    -> Eff eh ef ans-reinterpretNHBy = reinterpretHBy-{-# INLINE reinterpretNHBy #-}--reinterpretRecHWith-    :: forall e eh eh' ef a-     . (HFunctor e, eh `IsSuffixOf` eh')-    => (forall ans. Elaborator e (Eff eh' ef) ans)-    -> Eff (e ': eh) ef a-    -> Eff eh' ef a-reinterpretRecHWith elb = loop+    :: forall e es es' ans a+     . (KnownOrder e, FOEs es, Suffix es es')+    => (a -> Eff es' ans)+    -> AlgHandler e (Eff (e ': es)) (Eff es') ans+    -> Eff (e ': es) a+    -> Eff es' ans+reinterpretBy ret hdl = loop   where-    loop :: Eff (e ': eh) ef ~> Eff eh' ef-    loop =-        iterAllEffHFBy-            pure-            (elb . hfmap loop !!+ flip sendUnionHBy . weakensH . hfmapUnion loop)-            (flip sendUnionBy)-{-# INLINE reinterpretRecHWith #-}+    loop (D.Eff m) = case m of+        Val x -> ret x+        Op u q ->+            let k = loop . D.Eff . qApp q+             in u & (`hdl` k) !: D.Eff . (`Op` tsingleton (unEff . k)) . weakens . coerceFOEs+{-# INLINE reinterpretBy #-} -reinterpretRecNHWith-    :: forall n e eh eh' ef a-     . (HFunctor e, WeakenN n eh eh')-    => (forall ans. Elaborator e (Eff eh' ef) ans)-    -> Eff (e ': eh) ef a-    -> Eff eh' ef a-reinterpretRecNHWith elb = loop+reinterpretsBy+    :: forall es r r' ans a+     . (FOEs r, Suffix r r', KnownLength es)+    => (a -> Eff r' ans)+    -> AlgHandler (Union es) (Eff (es ++ r)) (Eff r') ans+    -> Eff (es ++ r) a+    -> Eff r' ans+reinterpretsBy ret hdl = loop   where-    loop :: Eff (e ': eh) ef ~> Eff eh' ef-    loop =-        iterAllEffHFBy-            pure-            (elb . hfmap loop !!+ flip sendUnionHBy . weakenNH @n . hfmapUnion loop)-            (flip sendUnionBy)-{-# INLINE reinterpretRecNHWith #-}+    loop :: Eff (es ++ r) a -> Eff r' ans+    loop (D.Eff m) = case m of+        Val x -> ret x+        Op u q ->+            let k = loop . D.Eff . qApp q+             in u & (`hdl` k) !++ D.Eff . (`Op` tsingleton (unEff . k)) . weakens @r . coerceFOEs+{-# INLINE reinterpretsBy #-}  -- * Interposition functions --- ** For first-order effects--{- | Reinterprets (hooks) the first-order effect @e@ in the list using the provided natural transformation style handler.--If multiple instances of @e@ exist in the list, the one closest to the head (with the smallest index) will be targeted.--}-interpose-    :: forall e ef eh-     . (e <| ef)-    => (e ~> Eff eh ef)-    -- ^ Effect handler-    -> Eff eh ef ~> Eff eh ef-interpose f = interposeRecWith (stateless f)-{-# INLINE interpose #-}--{- | Reinterprets (hooks) the first-order effect @e@ in the list using the provided continuational stateful handler.--If multiple instances of @e@ exist in the list, the one closest to the head (with the smallest index) will be targeted.--}-interposeWith-    :: forall e ef a-     . (e <| ef)-    => Interpreter e (Eff '[] ef) a-    -- ^ Effect handler-    -> Eff '[] ef a-    -> Eff '[] ef a-interposeWith = interposeBy pure-{-# INLINE interposeWith #-}--{- | Reinterprets (hooks) the first-order effect @e@ in the list using the provided value handler and continuational stateful handler.--If multiple instances of @e@ exist in the list, the one closest to the head (with the smallest index) will be targeted.--}+-- | Reinterprets (hooks) the effect @e@ in the list using the provided value handler and algebraic handler. interposeBy-    :: forall e ef eh ans a-     . (e <| ef)-    => (a -> Eff eh ef ans)+    :: forall e es ans a+     . (e :> es, FOEs es)+    => (a -> Eff es ans)     -- ^ Value handler-    -> Interpreter e (Eff eh ef) ans+    -> AlgHandler e (Eff es) (Eff es) ans     -- ^ Effect handler-    -> Eff '[] ef a-    -> Eff eh ef ans-interposeBy ret f = iterAllEffHFBy ret nilH \u -> maybe (`sendUnionBy` u) f (prj @e u)+    -> Eff es a+    -> Eff es ans+interposeBy = interposeForBy labelMembership {-# INLINE interposeBy #-} -{- | Reinterprets (hooks) the first-order effect @e@ in the list using the provided continuational stateful handler.--Interpretation is performed recursively with respect to the scopes of unelaborated higher-order effects @eh@.-Note that during interpretation, the continuational state is reset (delimited) and does not persist beyond scopes.--If multiple instances of @e@ exist in the list, the one closest to the head (with the smallest index) will be targeted.--}-interposeRecWith-    :: forall e ef eh a-     . (e <| ef)-    => (forall ans. Interpreter e (Eff eh ef) ans)+-- | Reinterprets (hooks) the effect @e@ in the list using the provided algebraic handler.+interposeWith+    :: forall e es a+     . (e :> es, FOEs es)+    => AlgHandler e (Eff es) (Eff es) a     -- ^ Effect handler-    -> Eff eh ef a-    -> Eff eh ef a-interposeRecWith f = loop-  where-    loop :: Eff eh ef ~> Eff eh ef-    loop = iterAllEffHFBy-        pure-        (flip sendUnionHBy . hfmapUnion loop)-        \u -> maybe (`sendUnionBy` u) f (prj @e u)-{-# INLINE interposeRecWith #-}---- ** For higher-order effects--{- | Reinterprets (hooks) the higher-order effect @e@ in the list using the provided natural transformation style elaborator.--If multiple instances of @e@ exist in the list, the one closest to the head (with the smallest index) will be targeted.--}-interposeH-    :: forall e eh ef-     . (e <<| eh, HFunctor e)-    => e ~~> Eff eh ef-    -- ^ Effect elaborator-    -> Eff eh ef ~> Eff eh ef-interposeH f = interposeRecHWith (stateless f)-{-# INLINE interposeH #-}--{- | Reinterprets (hooks) the higher-order effect @e@ in the list using the provided continuational stateful elaborator.--Interpretation is performed recursively with respect to the scopes of unelaborated higher-order effects @eh@.-Note that during interpretation, the continuational state is reset (delimited) and does not persist beyond scopes.--If multiple instances of @e@ exist in the list, the one closest to the head (with the smallest index) will be targeted.--}-interposeRecHWith-    :: forall e eh ef a-     . (e <<| eh, HFunctor e)-    => (forall ans. Elaborator e (Eff eh ef) ans)-    -- ^ Effect elaborator-    -> Eff eh ef a-    -> Eff eh ef a-interposeRecHWith f = loop-  where-    loop :: Eff eh ef ~> Eff eh ef-    loop =-        iterAllEffHFBy-            pure-            (hfmapUnion loop >>> \u -> maybe (`sendUnionHBy` u) f (prjH @e u))-            (flip sendUnionBy)-{-# INLINE interposeRecHWith #-}---- * Transformation to monads+    -> Eff es a+    -> Eff es a+interposeWith = interposeForWith labelMembership+{-# INLINE interposeWith #-} --- | Traverses a computation containing only a single first-order effect @e@ using the provided value handler and continuational stateful handler, transforming it into a monad @m@.-iterEffBy-    :: forall e m ans a-     . (Monad m)-    => (a -> m ans)+-- | Reinterprets (hooks) the effect @e@ in the list using the provided value handler and algebraic handler.+interposeOnBy+    :: forall key e es ans a+     . (Has key e es, FOEs es)+    => (a -> Eff es ans)     -- ^ Value handler-    -> Interpreter e m ans+    -> AlgHandler e (Eff es) (Eff es) ans     -- ^ Effect handler-    -> Eff '[] '[e] a-    -> m ans-iterEffBy ret hdl = iterAllEffHFBy ret nilH (hdl . extract)-{-# INLINE iterEffBy #-}+    -> Eff es a+    -> Eff es ans+interposeOnBy ret hdl = interposeForBy (keyMembership @key) ret (hdl . unTag)+{-# INLINE interposeOnBy #-} --- | Traverses a computation containing only a single higher-order effect @e@ using the provided value handler and continuational stateful elaborator, transforming it into a monad @m@.-iterEffHBy-    :: forall e m ans a-     . (Monad m, HFunctor e)-    => (a -> m ans)-    -- ^ Value handler-    -> Interpreter (e (Eff '[e] '[])) m ans+-- | Reinterprets (hooks) the effect @e@ in the list using the provided algebraic handler.+interposeOnWith+    :: forall key e es a+     . (Has key e es, FOEs es)+    => AlgHandler e (Eff es) (Eff es) a     -- ^ Effect handler-    -> Eff '[e] '[] a-    -> m ans-iterEffHBy ret elb = iterAllEffHFBy ret (elb . extractH) nil-{-# INLINE iterEffHBy #-}--{- | Traverses a computation containing only a single higher-order effect @e@ using the provided natural transformation elaborator, transforming it into a monad @m@.--Traversal is performed recursively with respect to the scope of the higher-order effect @e@.-Note that during traversal, the continuational state is reset (delimited) and does not persist beyond scopes.--}-iterEffRecH-    :: forall e m-     . (Monad m, HFunctor e)-    => e ~~> m-    -- ^ Effect elaborator-    -> Eff '[e] '[] ~> m-iterEffRecH elb = iterEffRecHWith $ stateless elb-{-# INLINE iterEffRecH #-}--{- | Traverses a computation containing only a single higher-order effect @e@ using the provided continuational stateful elaborator, transforming it into a monad @m@.--Traversal is performed recursively with respect to the scope of the higher-order effect @e@.-Note that during traversal, the continuational state is reset (delimited) and does not persist beyond scopes.--}-iterEffRecHWith-    :: forall e m-     . (Monad m, HFunctor e)-    => (forall ans. Elaborator e m ans)-    -- ^ Effect elaborator-    -> Eff '[e] '[] ~> m-iterEffRecHWith elb = loop-  where-    loop :: Eff '[e] '[] ~> m-    loop = iterEffHBy pure (elb . hfmap loop)-{-# INLINE iterEffRecHWith #-}--{- | Traverses a computation containing only higher-order effects @eh@ and first-order effects @ef@ using the provided continuational stateful elaborator, transforming it into a monad @m@.+    -> Eff es a+    -> Eff es a+interposeOnWith hdl = interposeForWith (keyMembership @key) (hdl . unTag)+{-# INLINE interposeOnWith #-} -Traversal is performed recursively with respect to the scopes of higher-order effects.-Note that during traversal, the continuational state is reset (delimited) and does not persist beyond scopes.--}-iterEffRecHFWith-    :: forall eh ef m-     . (Monad m, HFunctor eh)-    => (forall ans. Elaborator eh m ans)-    -- ^ Effect elaborator-    -> (forall ans. Interpreter ef m ans)+-- | Reinterprets (hooks) the effect @e@ in the list using the provided value handler and algebraic handler.+interposeInBy+    :: forall e es ans a+     . (e `In` es, FOEs es)+    => (a -> Eff es ans)+    -- ^ Value handler+    -> AlgHandler e (Eff es) (Eff es) ans     -- ^ Effect handler-    -> Eff '[eh] '[ef] ~> m-iterEffRecHFWith fh ff = loop-  where-    loop :: Eff '[eh] '[ef] ~> m-    loop = iterEffHFBy pure (fh . hfmap loop) ff-{-# INLINE iterEffRecHFWith #-}+    -> Eff es a+    -> Eff es ans+interposeInBy = interposeForBy identityMembership+{-# INLINE interposeInBy #-} -{- | Traverses a computation containing only higher-order effects @eh@ and first-order effects @ef@ using the provided value handler,-continuational stateful elaborator, and handler, transforming it into a monad @m@.--}-iterEffHFBy-    :: forall eh ef m ans a-     . (Monad m, HFunctor eh)-    => (a -> m ans)-    -- ^ Value handler-    -> Interpreter (eh (Eff '[eh] '[ef])) m ans-    -- ^ Effect elaborator-    -> Interpreter ef m ans+-- | Reinterprets (hooks) the effect @e@ in the list using the provided algebraic handler.+interposeInWith+    :: forall e es a+     . (e `In` es, FOEs es)+    => AlgHandler e (Eff es) (Eff es) a     -- ^ Effect handler-    -> Eff '[eh] '[ef] a-    -> m ans-iterEffHFBy ret elb hdl = iterAllEffHFBy ret (elb . extractH) (hdl . extract)-{-# INLINE iterEffHFBy #-}+    -> Eff es a+    -> Eff es a+interposeInWith = interposeForWith identityMembership+{-# INLINE interposeInWith #-} --- | Traverses all effects using the provided value handler, continuational stateful elaborator, and handler, transforming them into a monad @m@.-iterAllEffHFBy-    :: forall eh ef m ans a-     . (Monad m)-    => (a -> m ans)+interposeForBy+    :: forall e es ans a+     . (KnownOrder e, FOEs es)+    => Membership e es+    -> (a -> Eff es ans)     -- ^ Value handler-    -> Interpreter (UnionH eh (Eff eh ef)) m ans-    -- ^ Effect elaborator-    -> Interpreter (Union ef) m ans+    -> AlgHandler e (Eff es) (Eff es) ans     -- ^ Effect handler-    -> Eff eh ef a-    -> m ans-iterAllEffHFBy ret fh ff = loop+    -> Eff es a+    -> Eff es ans+interposeForBy i ret hdl = loop   where-    loop = \case+    loop (D.Eff a) = case a of         Val x -> ret x-        Op u q -> either fh ff u k-          where-            k = loop . qApp q-{-# INLINE iterAllEffHFBy #-}+        Op u q ->+            let k = loop . D.Eff . qApp q+             in case project i u of+                    Just e -> hdl e k+                    Nothing -> D.Eff $ Op u (tsingleton $ unEff . k)+{-# INLINE interposeForBy #-} --- | Traverses all effects using the provided natural-transformation style elaborator and handler, transforming them into a monad @m@.-iterAllEffHF-    :: forall eh ef m-     . (Monad m)-    => UnionH eh ~~> m-    -- ^ Effect elaborator-    -> Union ef ~> m+-- | Reinterprets (hooks) the effect @e@ in the list using the provided algebraic handler.+interposeForWith+    :: forall e es a+     . (KnownOrder e, FOEs es)+    => Membership e es+    -> AlgHandler e (Eff es) (Eff es) a     -- ^ Effect handler-    -> Eff eh ef ~> m-iterAllEffHF fh ff = loop-  where-    loop :: Eff eh ef ~> m-    loop = \case-        Val x -> pure x-        Op u q -> either (fh . hfmapUnion loop >=> k) (ff >=> k) u-          where-            k = loop . qApp q-{-# INLINE iterAllEffHF #-}---- * Layer manipulation--splitLayer :: Eff '[] ef ~> Eff eh '[Eff '[] ef]-splitLayer =-    iterAllEffHFBy pure nilH (\u k -> send0 (sendUnion u) >>= k)--mergeLayer :: Eff eh '[Eff eh ef] ~> Eff eh ef-mergeLayer =-    iterAllEffHFBy-        pure-        (\u k -> sendUnionH (hfmapUnion mergeLayer u) >>= k)-        (\u k -> extract u >>= k)+    -> Eff es a+    -> Eff es a+interposeForWith i = interposeForBy i pure+{-# INLINE interposeForWith #-}  -- * Utilities --- | Lifts a natural transformation into a continuational stateful interpreter.-stateless :: forall e m ans. (Monad m) => (e ~> m) -> Interpreter e m ans+-- | Lifts a stateless handler into a algebraic handler.+stateless :: forall e m n ans. (Monad n) => (e m ~> n) -> AlgHandler e m n ans stateless i e k = i e >>= k {-# INLINE stateless #-}---- | Applies a value to a Kleisli arrow in 'FTCQueue' representation.-qApp :: FTCQueue (Eff eh ef) a b -> a -> Eff eh ef b-qApp q' x = case tviewl q' of-    TOne k -> k x-    k :| t -> case k x of-        Val y -> qApp t y-        Op u q -> Op u (q >< t)

@@ -1,12 +1,8 @@ -- SPDX-License-Identifier: MPL-2.0 AND BSD-3-Clause --- This Source Code Form is subject to the terms of the Mozilla Public--- License, v. 2.0. If a copy of the MPL was not distributed with this--- file, You can obtain one at https://mozilla.org/MPL/2.0/.- {- |-Copyright   :  (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King; 2024 Sayo Koyoneda-License     :  MPL-2.0 (see the LICENSE file) AND BSD-3-Clause (see the LICENSE.BSD3 file)+Copyright   :  (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King; 2024 Sayo contributors+License     :  MPL-2.0 AND BSD-3-Clause (see the LICENSE and LICENSE.BSD3 files) Maintainer  :  ymdfield@outlook.jp  This module provides an ad-hoc specialized version of@@ -16,104 +12,102 @@ -} module Control.Monad.Hefty.Interpret.State where -import Control.Effect (type (~>))-import Control.Monad.Hefty.Interpret (qApp)-import Control.Monad.Hefty.Types (Eff (Op, Val), sendUnionBy, sendUnionHBy)-import Data.Effect.OpenUnion.Internal (IsSuffixOf)-import Data.Effect.OpenUnion.Internal.FO (Union, prj, weakens, (!+), type (<|))-import Data.Effect.OpenUnion.Internal.HO (UnionH, hfmapUnion, nilH)+import Control.Effect (unEff)+import Control.Effect qualified as D+import Control.Monad.Hefty.Types (Eff, Freer (Op, Val), qApp)+import Data.Effect.OpenUnion (+    FOEs,+    In,+    KnownOrder,+    Membership,+    Suffix,+    coerceFOEs,+    identityMembership,+    labelMembership,+    project,+    weakens,+    (!:),+    (:>),+ )+import Data.FTCQueue (tsingleton)+import Data.Function ((&)) import Data.Kind (Type) --- | An ad-hoc stateful version of t'Control.Monad.Hefty.Types.Interpreter' for performance.-type StateInterpreter s e m (ans :: Type) = forall x. e x -> s -> (s -> x -> m ans) -> m ans---- | An ad-hoc stateful version of t'Control.Monad.Hefty.Types.Elaborator' for performance.-type StateElaborator s e m ans = StateInterpreter s (e m) m ans+-- | An ad-hoc stateful version of t'Control.Monad.Hefty.Types.Handler' for performance.+type StateHandler s e m n (ans :: Type) = forall x. e m x -> s -> (s -> x -> n ans) -> n ans  -- * Interpretation functions  interpretStateBy-    :: forall s e ef ans a-     . s-    -> (s -> a -> Eff '[] ef ans)-    -> StateInterpreter s e (Eff '[] ef) ans-    -> Eff '[] (e ': ef) a-    -> Eff '[] ef ans+    :: forall s e es ans a+     . (KnownOrder e, FOEs es)+    => s+    -> (s -> a -> Eff es ans)+    -> StateHandler s e (Eff (e ': es)) (Eff es) ans+    -> Eff (e ': es) a+    -> Eff es ans interpretStateBy = reinterpretStateBy {-# INLINE interpretStateBy #-}  reinterpretStateBy-    :: forall s e ef' ef ans a-     . (ef `IsSuffixOf` ef')-    => s-    -> (s -> a -> Eff '[] ef' ans)-    -> StateInterpreter s e (Eff '[] ef') ans-    -> Eff '[] (e ': ef) a-    -> Eff '[] ef' ans-reinterpretStateBy s0 ret hdl =-    iterStateAllEffHFBy s0 ret nilH (hdl !+ \u s k -> sendUnionBy (k s) (weakens u))-{-# INLINE reinterpretStateBy #-}--interpretStateRecWith-    :: forall s e ef eh a-     . s-    -> (forall ans. StateInterpreter s e (Eff eh ef) ans)-    -> Eff eh (e ': ef) a-    -> Eff eh ef a-interpretStateRecWith = reinterpretStateRecWith-{-# INLINE interpretStateRecWith #-}--reinterpretStateRecWith-    :: forall s e ef' ef eh a-     . (ef `IsSuffixOf` ef')+    :: forall s e es' es ans a+     . (Suffix es es', KnownOrder e, FOEs es)     => s-    -> (forall ans. StateInterpreter s e (Eff eh ef') ans)-    -> Eff eh (e ': ef) a-    -> Eff eh ef' a-reinterpretStateRecWith s0 hdl = loop s0+    -> (s -> a -> Eff es' ans)+    -> StateHandler s e (Eff (e ': es)) (Eff es') ans+    -> Eff (e ': es) a+    -> Eff es' ans+reinterpretStateBy s0 ret hdl = loop s0   where-    loop :: s -> Eff eh (e ': ef) ~> Eff eh ef'-    loop s =-        iterStateAllEffHFBy-            s-            (const pure)-            (\u s' k -> sendUnionHBy (k s') $ hfmapUnion (loop s') u)-            (hdl !+ \u s' k -> sendUnionBy (k s') (weakens u))-{-# INLINE reinterpretStateRecWith #-}+    loop s (D.Eff m) = case m of+        Val x -> ret s x+        Op u q ->+            let k s' = loop s' . D.Eff . qApp q+             in u & (\e -> hdl e s k) !: D.Eff . (`Op` (tsingleton $ unEff . k s)) . weakens . coerceFOEs+{-# INLINE reinterpretStateBy #-}  -- * Interposition functions  interposeStateBy-    :: forall s e ef ans a-     . (e <| ef)+    :: forall s e es ans a+     . (e :> es, FOEs es)     => s-    -> (s -> a -> Eff '[] ef ans)-    -> StateInterpreter s e (Eff '[] ef) ans-    -> Eff '[] ef a-    -> Eff '[] ef ans-interposeStateBy s0 ret f =-    iterStateAllEffHFBy s0 ret nilH \u s k ->-        maybe (sendUnionBy (k s) u) (\e -> f e s k) (prj @e u)+    -> (s -> a -> Eff es ans)+    -> StateHandler s e (Eff es) (Eff es) ans+    -> Eff es a+    -> Eff es ans+interposeStateBy = interposeStateForBy labelMembership {-# INLINE interposeStateBy #-} --- * Transformation to monads--iterStateAllEffHFBy-    :: forall s eh ef m ans a-     . (Monad m)+interposeStateInBy+    :: forall s e es ans a+     . (e `In` es, FOEs es)     => s-    -> (s -> a -> m ans)-    -> StateInterpreter s (UnionH eh (Eff eh ef)) m ans-    -> StateInterpreter s (Union ef) m ans-    -> Eff eh ef a-    -> m ans-iterStateAllEffHFBy s0 ret fh ff = loop s0+    -> (s -> a -> Eff es ans)+    -> StateHandler s e (Eff es) (Eff es) ans+    -> Eff es a+    -> Eff es ans+interposeStateInBy = interposeStateForBy identityMembership+{-# INLINE interposeStateInBy #-}++interposeStateForBy+    :: forall s e es ans a+     . (KnownOrder e, FOEs es)+    => Membership e es+    -> s+    -> (s -> a -> Eff es ans)+    -> StateHandler s e (Eff es) (Eff es) ans+    -> Eff es a+    -> Eff es ans+interposeStateForBy i s0 ret hdl = loop s0   where-    loop s = \case+    loop s (D.Eff m) = case m of         Val x -> ret s x-        Op u q -> either (`fh` s) (`ff` s) u k-          where-            k s' = loop s' . qApp q-{-# INLINE iterStateAllEffHFBy #-}+        Op u q ->+            let k s' = loop s' . D.Eff . qApp q+             in case project i u of+                    Just e -> hdl e s k+                    Nothing -> D.Eff $ Op u (tsingleton $ unEff . k s)+{-# INLINE interposeStateForBy #-}  -- TODO: add other pattern functions.

@@ -1,643 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}---- SPDX-License-Identifier: MPL-2.0--{- |-Copyright   :  (c) 2024 Sayo Koyoneda-License     :  MPL-2.0 (see the LICENSE file)-Maintainer  :  ymdfield@outlook.jp--This module provides functions for transforming effects.-Please refer to the documentation of the [top-level module]("Control.Monad.Hefty").--}-module Control.Monad.Hefty.Transform where--import Control.Effect (type (~>))-import Control.Monad.Hefty.Interpret (iterAllEffHFBy)-import Control.Monad.Hefty.Types (Eff, sendUnionBy, sendUnionHBy)-import Data.Effect.HFunctor (HFunctor)-import Data.Effect.Key (Key (Key, unKey), KeyH (KeyH, unKeyH), type (##>), type (#>))-import Data.Effect.OpenUnion.Internal (-    BundleUnder,-    Drop,-    IsSuffixOf,-    Split,-    Strengthen,-    StrengthenN,-    StrengthenNUnder,-    StrengthenUnder,-    Take,-    WeakenN,-    WeakenNUnder,-    WeakenUnder,- )-import Data.Effect.OpenUnion.Internal.FO (-    Union,-    bundleAllUnion,-    bundleUnion,-    bundleUnionN,-    bundleUnionUnder,-    decomp,-    inj,-    nil,-    prj,-    strengthen,-    strengthenN,-    strengthenNUnder,-    strengthenUnder,-    strengthens,-    strengthensUnder,-    unbundleAllUnion,-    unbundleUnion,-    unbundleUnionN,-    unbundleUnionUnder,-    weaken,-    weakenN,-    weakenNUnder,-    weakenUnder,-    weakens,-    weakensUnder,-    type (<|),- )-import Data.Effect.OpenUnion.Internal.HO (-    UnionH,-    bundleAllUnionH,-    bundleUnionH,-    bundleUnionUnderH,-    decompH,-    hfmapUnion,-    injH,-    nilH,-    prjH,-    strengthenH,-    strengthenNH,-    strengthenNUnderH,-    strengthenUnderH,-    strengthensH,-    unbundleAllUnionH,-    unbundleUnionH,-    unbundleUnionUnderH,-    weakenH,-    weakenNH,-    weakenNUnderH,-    weakenUnderH,-    weakensH,-    type (<<|),- )-import Data.Effect.Tag (Tag (Tag, unTag), TagH (TagH, unTagH), type (#), type (##))-import GHC.TypeNats (KnownNat)---- * Rewriting effectful operations--{- | Transforms the first-order effect @e@ at the head of the list into another-first-order effect @e'@.--}-transform-    :: forall e e' ef eh-     . (e ~> e')-    -> Eff eh (e ': ef) ~> Eff eh (e' ': ef)-transform f = transEff (either weaken (inj . f) . decomp)-{-# INLINE transform #-}--{- | Transforms the higher-order effect @e@ at the head of the list into another-higher-order effect @e'@.--}-transformH-    :: forall e e' eh ef-     . (HFunctor e)-    => (e (Eff (e' ': eh) ef) ~> e' (Eff (e' ': eh) ef))-    -> Eff (e ': eh) ef ~> Eff (e' ': eh) ef-transformH f = transEffH (either weakenH (injH . f) . decompH)-{-# INLINE transformH #-}--{- | Transforms the first-order effect @e@ at the head of the list into another-first-order effect @e'@ and embeds it into the list.--If multiple instances of @e'@ exist in the list, the one closest to the head-(with the smallest index) will be targeted.--}-translate-    :: forall e e' ef eh-     . (e' <| ef)-    => (e ~> e')-    -> Eff eh (e ': ef) ~> Eff eh ef-translate f = transEff (either id (inj . f) . decomp)-{-# INLINE translate #-}--{- | Transforms the higher-order effect @e@ at the head of the list into another-higher-order effect @e'@ and embeds it into the list.--If multiple instances of @e'@ exist in the list, the one closest to the head-(with the smallest index) will be targeted.--}-translateH-    :: forall e e' eh ef-     . (e' <<| eh, HFunctor e)-    => (e (Eff eh ef) ~> e' (Eff eh ef))-    -> Eff (e ': eh) ef ~> Eff eh ef-translateH f = transEffH (either id (injH . f) . decompH)-{-# INLINE translateH #-}--{- | Rewrites the first-order effect @e@ in the list.--If multiple instances of @e@ exist in the list, the one closest to the head-(with the smallest index) will be targeted.--}-rewrite-    :: forall e ef eh-     . (e <| ef)-    => (e ~> e)-    -> Eff eh ef ~> Eff eh ef-rewrite f = transEff \u -> maybe u (inj . f) $ prj @e u-{-# INLINE rewrite #-}--{- | Rewrites the higher-order effect @e@ in the list.--If multiple instances of @e@ exist in the list, the one closest to the head-(with the smallest index) will be targeted.--}-rewriteH-    :: forall e eh ef-     . (e <<| eh, HFunctor e)-    => (e (Eff eh ef) ~> e (Eff eh ef))-    -> Eff eh ef ~> Eff eh ef-rewriteH f = transEffH \u -> maybe u (injH . f) $ prjH @e u-{-# INLINE rewriteH #-}---- | Transforms all first-order effects in the open union at once.-transEff-    :: forall ef ef' eh-     . (Union ef ~> Union ef')-    -> Eff eh ef ~> Eff eh ef'-transEff = transEffHF id-{-# INLINE transEff #-}---- | Transforms all higher-order effects in the open union at once.-transEffH-    :: forall eh eh' ef-     . (UnionH eh (Eff eh' ef) ~> UnionH eh' (Eff eh' ef))-    -> Eff eh ef ~> Eff eh' ef-transEffH f = transEffHF f id-{-# INLINE transEffH #-}--{- | Transforms all higher-order and first-order effects in the open union at-once.--}-transEffHF-    :: forall eh eh' ef ef'-     . (UnionH eh (Eff eh' ef') ~> UnionH eh' (Eff eh' ef'))-    -> (Union ef ~> Union ef')-    -> Eff eh ef ~> Eff eh' ef'-transEffHF fh ff = loop-  where-    loop :: Eff eh ef ~> Eff eh' ef'-    loop =-        iterAllEffHFBy-            pure-            (flip sendUnionHBy . fh . hfmapUnion loop)-            (flip sendUnionBy . ff)-{-# INLINE transEffHF #-}---- * Manipulating the effect list (without rewriting effectful operations)---- ** Insertion functions---- | Adds an arbitrary first-order effect @e@ to the head of the list.-raise :: forall e ef eh. Eff eh ef ~> Eff eh (e ': ef)-raise = transEff weaken-{-# INLINE raise #-}---- | Adds multiple arbitrary first-order effects to the head of the list.-raises :: (ef `IsSuffixOf` ef') => Eff eh ef ~> Eff eh ef'-raises = transEff weakens-{-# INLINE raises #-}--{- | Adds a specified number @len@ of arbitrary first-order effects to the head-of the list.--}-raiseN-    :: forall len ef ef' eh-     . (WeakenN len ef ef')-    => Eff eh ef ~> Eff eh ef'-raiseN = transEff (weakenN @len)-{-# INLINE raiseN #-}---- | Raises an empty first-order effect list to an arbitrary effect list.-raiseAll :: Eff eh '[] ~> Eff eh ef-raiseAll = transEff nil-{-# INLINE raiseAll #-}--{- | Inserts an arbitrary first-order effect @e2@ just below the head of the-list.--}-raiseUnder-    :: forall e1 e2 ef eh-     . Eff eh (e1 ': ef) ~> Eff eh (e1 ': e2 ': ef)-raiseUnder = transEff weakenUnder-{-# INLINE raiseUnder #-}--{- | Inserts multiple arbitrary first-order effects at a position @offset@ steps-below the head of the list.--}-raisesUnder-    :: forall offset ef ef' eh-     . (WeakenUnder offset ef ef')-    => Eff eh ef ~> Eff eh ef'-raisesUnder = transEff (weakensUnder @offset)-{-# INLINE raisesUnder #-}--{- | Inserts @len@ arbitrary first-order effects at a position @offset@ steps-below the head of the list.--}-raiseNUnder-    :: forall len offset ef ef' eh-     . (WeakenNUnder len offset ef ef')-    => Eff eh ef ~> Eff eh ef'-raiseNUnder = transEff (weakenNUnder @len @offset)-{-# INLINE raiseNUnder #-}--{- | Adds a specified number @len@ of arbitrary higher-order effects to the head-of the list.--}-raiseH :: forall e eh ef. Eff eh ef ~> Eff (e ': eh) ef-raiseH = transEffH weakenH-{-# INLINE raiseH #-}--{- | Inserts an arbitrary higher-order effect @e2@ just below the head of the-list.--}-raisesH :: (eh `IsSuffixOf` eh') => Eff eh ef ~> Eff eh' ef-raisesH = transEffH weakensH-{-# INLINE raisesH #-}--{- | Adds a specified number @len@ of arbitrary higher-order effects to the head-of the list.--}-raiseNH-    :: forall len eh eh' ef-     . (WeakenN len eh eh')-    => Eff eh ef ~> Eff eh' ef-raiseNH = transEffH (weakenNH @len)-{-# INLINE raiseNH #-}---- | Raises an empty first-order effect list to an arbitrary effect list.-raiseAllH :: Eff '[] ef ~> Eff eh ef-raiseAllH = transEffH nilH-{-# INLINE raiseAllH #-}--{- | Inserts an arbitrary higher-order effect @e2@ just below the head of the-list.--}-raiseUnderH-    :: forall e1 e2 eh ef-     . Eff (e1 ': eh) ef ~> Eff (e1 ': e2 ': eh) ef-raiseUnderH = transEffH weakenUnderH-{-# INLINE raiseUnderH #-}--{- | Inserts @len@ arbitrary higher-order effects at a position @offset@ steps-below the head of the list.--}-raiseNUnderH-    :: forall len offset eh eh' ef-     . (WeakenNUnder len offset eh eh')-    => Eff eh ef ~> Eff eh' ef-raiseNUnderH = transEffH (weakenNUnderH @len @offset)-{-# INLINE raiseNUnderH #-}---- ** Merging functions--{- | Merges the first first-order effect @e@ at the head of the list into the-same type of effect @e@ that is below it.--If multiple candidates of @e@ exist in the list, the one closest to the head-(with the smallest index) will be targeted.--}-subsume-    :: forall e ef eh-     . (e <| ef)-    => Eff eh (e ': ef) ~> Eff eh ef-subsume = transEff strengthen-{-# INLINE subsume #-}--{- | Merges multiple first-order effects at the head of the list into effects of-the same types that are below them.--}-subsumes-    :: forall ef ef' eh-     . (Strengthen ef ef')-    => Eff eh ef ~> Eff eh ef'-subsumes = transEff strengthens-{-# INLINE subsumes #-}--{- | Merges a specified number @len@ of first-order effects at the head of the-list into effects of the same types that are below them.--}-subsumeN-    :: forall len ef ef' eh-     . (StrengthenN len ef ef')-    => Eff eh ef ~> Eff eh ef'-subsumeN = transEff (strengthenN @len)-{-# INLINE subsumeN #-}--{- | Merges the first-order effect @e2@ located just below the head into the-same type of effect @e2@ that is below it.--}-subsumeUnder-    :: forall e2 e1 ef eh-     . (e2 <| ef)-    => Eff eh (e1 ': e2 ': ef) ~> Eff eh (e1 ': ef)-subsumeUnder = transEff strengthenUnder-{-# INLINE subsumeUnder #-}--{- | Merges multiple first-order effects at an @offset@ below the head into-effects of the same types that are below them.--}-subsumesUnder-    :: forall offset ef ef' eh-     . (StrengthenUnder offset ef ef')-    => Eff eh ef ~> Eff eh ef'-subsumesUnder = transEff (strengthensUnder @offset)-{-# INLINE subsumesUnder #-}--{- | Merges @len@ first-order effects at an @offset@ below the head into effects-of the same types that are below them.--}-subsumeNUnder-    :: forall len offset ef ef' eh-     . (StrengthenNUnder len offset ef ef')-    => Eff eh ef ~> Eff eh ef'-subsumeNUnder = transEff (strengthenNUnder @len @offset)-{-# INLINE subsumeNUnder #-}--{- | Merges the first higher-order effect @e@ at the head of the list into the-same type of effect @e@ that is below it.--If multiple candidates of @e@ exist in the list, the one closest to the head-(with the smallest index) will be targeted.--}-subsumeH-    :: forall e eh ef-     . (e <<| eh)-    => Eff (e ': eh) ef ~> Eff eh ef-subsumeH = transEffH strengthenH-{-# INLINE subsumeH #-}--{- | Merges multiple higher-order effects at the head of the list into effects of-the same types that are below them.--}-subsumesH-    :: forall eh eh' ef-     . (Strengthen eh eh')-    => Eff eh ef ~> Eff eh' ef-subsumesH = transEffH strengthensH-{-# INLINE subsumesH #-}--{- | Merges a specified number @len@ of higher-order effects at the head of the-list into effects of the same types that are below them.--}-subsumeNH-    :: forall len eh eh' ef-     . (StrengthenN len eh eh')-    => Eff eh ef ~> Eff eh' ef-subsumeNH = transEffH (strengthenNH @len)-{-# INLINE subsumeNH #-}--{- | Merges the higher-order effect @e2@ located just below the head into the-same type of effect @e2@ that is below it.--}-subsumeUnderH-    :: forall e2 e1 eh ef-     . (e2 <<| eh)-    => Eff (e1 ': e2 ': eh) ef ~> Eff (e1 ': eh) ef-subsumeUnderH = transEffH strengthenUnderH-{-# INLINE subsumeUnderH #-}--{- | Merges @len@ higher-order effects at an @offset@ below the head into effects-of the same types that are below them.--}-subsumeNUnderH-    :: forall len offset eh eh' ef-     . (StrengthenNUnder len offset eh eh')-    => Eff eh ef ~> Eff eh' ef-subsumeNUnderH = transEffH (strengthenNUnderH @len @offset)-{-# INLINE subsumeNUnderH #-}---- ** Bundling functions--{- | Bundles several effects at the head of the list into a single element using-an open union.--}-bundle-    :: forall ef bundle rest eh-     . (Split ef bundle rest)-    => Eff eh ef ~> Eff eh (Union bundle ': rest)-bundle = transEff bundleUnion-{-# INLINE bundle #-}--{- | Bundles the first @len@ effects at the head of the list into a single-element using an open union.--}-bundleN-    :: forall len ef eh-     . (KnownNat len)-    => Eff eh ef ~> Eff eh (Union (Take len ef) ': Drop len ef)-bundleN = transEff (bundleUnionN @len)-{-# INLINE bundleN #-}---- | Expands effects that have been bundled into an open union.-unbundle-    :: forall ef bundle rest eh-     . (Split ef bundle rest)-    => Eff eh (Union bundle ': rest) ~> Eff eh ef-unbundle = transEff unbundleUnion-{-# INLINE unbundle #-}---- | Expands the first @len@ effects that have been bundled into an open union.-unbundleN-    :: forall len ef eh-     . (KnownNat len)-    => Eff eh (Union (Take len ef) ': Drop len ef) ~> Eff eh ef-unbundleN = transEff (unbundleUnionN @len)-{-# INLINE unbundleN #-}--{- | Expands effects at an @offset@ below the head of the list into a single-element using an open union.--}-bundleUnder-    :: forall offset bundle ef ef' eh-     . (BundleUnder Union offset ef ef' bundle)-    => Eff eh ef ~> Eff eh ef'-bundleUnder = transEff (bundleUnionUnder @offset)-{-# INLINE bundleUnder #-}---- TODO: add *bundle*N(H) functions--{- | Expands effects that have been bundled into an open union at an @offset@-below the head of the list.--}-unbundleUnder-    :: forall offset bundle ef ef' eh-     . (BundleUnder Union offset ef ef' bundle)-    => Eff eh ef' ~> Eff eh ef-unbundleUnder = transEff (unbundleUnionUnder @offset)-{-# INLINE unbundleUnder #-}---- | Bundles all first-order effects into a single open union.-bundleAll :: Eff eh ef ~> Eff eh '[Union ef]-bundleAll = transEff bundleAllUnion-{-# INLINE bundleAll #-}---- | Expands all first-order effects from a single open union.-unbundleAll :: Eff eh '[Union ef] ~> Eff eh ef-unbundleAll = transEff unbundleAllUnion-{-# INLINE unbundleAll #-}--{- | Bundles several effects at the head of the list into a single element using-an open union.--}-bundleH-    :: forall eh bundle rest ef-     . (Split eh bundle rest)-    => Eff eh ef ~> Eff (UnionH bundle ': rest) ef-bundleH = transEffH bundleUnionH-{-# INLINE bundleH #-}---- | Expands effects that have been bundled into an open union.-unbundleH-    :: forall eh bundle rest ef-     . (Split eh bundle rest)-    => Eff (UnionH bundle ': rest) ef ~> Eff eh ef-unbundleH = transEffH unbundleUnionH-{-# INLINE unbundleH #-}--{- | Expands effects at an @offset@ below the head of the list into a single-element using an open union.--}-bundleUnderH-    :: forall offset bundle eh eh' ef-     . (BundleUnder UnionH offset eh eh' bundle)-    => Eff eh ef ~> Eff eh' ef-bundleUnderH = transEffH (bundleUnionUnderH @offset)-{-# INLINE bundleUnderH #-}--{- | Expands effects that have been bundled into an open union at an @offset@-below the head of the list.--}-unbundleUnderH-    :: forall offset bundle eh eh' ef-     . (BundleUnder UnionH offset eh eh' bundle)-    => Eff eh' ef ~> Eff eh ef-unbundleUnderH = transEffH (unbundleUnionUnderH @offset)-{-# INLINE unbundleUnderH #-}---- | Bundles all higher-order effects into a single open union.-bundleAllH :: Eff eh ef ~> Eff '[UnionH eh] ef-bundleAllH = transEffH bundleAllUnionH-{-# INLINE bundleAllH #-}---- | Expands all higher-order effects from a single open union.-unbundleAllH :: Eff '[UnionH eh] ef ~> Eff eh ef-unbundleAllH = transEffH unbundleAllUnionH-{-# INLINE unbundleAllH #-}---- ** Manipulating Tags & Keys---- | Attaches the @tag@ to the first-order effect at the head of the list.-tag-    :: forall tag e ef eh-     . Eff eh (e ': ef) ~> Eff eh (e # tag ': ef)-tag = transform Tag-{-# INLINE tag #-}---- | Removes the @tag@ from the tagged first-order effect at the head of the list.-untag-    :: forall tag e ef eh-     . Eff eh (e # tag ': ef) ~> Eff eh (e ': ef)-untag = transform unTag-{-# INLINE untag #-}--{- | Changes the @tag@ of the tagged first-order effect at the head of the list-to another tag @tag'@.--}-retag-    :: forall tag' tag e ef eh-     . Eff eh (e # tag ': ef) ~> Eff eh (e # tag' ': ef)-retag = transform $ Tag . unTag-{-# INLINE retag #-}---- | Attaches the @tag@ to the higher-order effect at the head of the list.-tagH-    :: forall tag e ef eh-     . (HFunctor e)-    => Eff (e ': eh) ef ~> Eff (e ## tag ': eh) ef-tagH = transformH TagH-{-# INLINE tagH #-}--{- | Removes the @tag@ from the tagged higher-order effect at the head of the- list.--}-untagH-    :: forall tag e eh ef-     . (HFunctor e)-    => Eff (e ## tag ': eh) ef ~> Eff (e ': eh) ef-untagH = transformH unTagH-{-# INLINE untagH #-}--{- | Changes the @tag@ of the tagged higher-order effect at the head of the list-to another tag @tag'@.--}-retagH-    :: forall tag' tag e eh ef-     . (HFunctor e)-    => Eff (e ## tag ': eh) ef ~> Eff (e ## tag' ': eh) ef-retagH = transformH $ TagH . unTagH-{-# INLINE retagH #-}---- | Attaches the @key@ to the first-order effect at the head of the list.-key-    :: forall key e ef eh-     . Eff eh (e ': ef) ~> Eff eh (key #> e ': ef)-key = transform Key-{-# INLINE key #-}---- | Removes the @key@ from the keyed first-order effect at the head of the list.-unkey-    :: forall key e ef eh-     . Eff eh (key #> e ': ef) ~> Eff eh (e ': ef)-unkey = transform unKey-{-# INLINE unkey #-}--{- | Changes the @key@ of the keyed first-order effect at the head of the list-to another key @key'@.--}-rekey-    :: forall key' key e ef eh-     . Eff eh (key #> e ': ef) ~> Eff eh (key' #> e ': ef)-rekey = transform $ Key . unKey-{-# INLINE rekey #-}---- | Attaches the @key@ to the higher-order effect at the head of the list.-keyH-    :: forall key e ef eh-     . (HFunctor e)-    => Eff (e ': eh) ef ~> Eff (key ##> e ': eh) ef-keyH = transformH KeyH-{-# INLINE keyH #-}---- | Removes the @key@ from the keyed higher-order effect at the head of the list.-unkeyH-    :: forall key e eh ef-     . (HFunctor e)-    => Eff (key ##> e ': eh) ef ~> Eff (e ': eh) ef-unkeyH = transformH unKeyH-{-# INLINE unkeyH #-}--{- | Changes the @key@ of the keyed higher-order effect at the head of the list-to another key @key'@.--}-rekeyH-    :: forall key' key e eh ef-     . (HFunctor e)-    => Eff (key ##> e ': eh) ef ~> Eff (key' ##> e ': eh) ef-rekeyH = transformH $ KeyH . unKeyH-{-# INLINE rekeyH #-}

@@ -1,10 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DerivingVia #-} {-# LANGUAGE UndecidableInstances #-}  -- SPDX-License-Identifier: MPL-2.0  {- |-Copyright   :  (c) 2024 Sayo Koyoneda+Copyright   :  (c) 2024 Sayo contributors License     :  MPL-2.0 (see the LICENSE file) Maintainer  :  ymdfield@outlook.jp @@ -13,153 +14,32 @@ -} module Control.Monad.Hefty.Types where -import Control.Applicative (Alternative, empty, (<|>))-import Control.Effect (SendFOE, SendHOE, sendFOE, sendHOE, type (~>))-import Control.Effect.Key (ByKey (ByKey), SendFOEBy, SendHOEBy, key, sendFOEBy, sendHOEBy)-import Control.Monad (MonadPlus)-import Control.Monad.Error.Class (MonadError, catchError, throwError)-import Control.Monad.Fix (MonadFix, mfix)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.RWS (MonadRWS)-import Control.Monad.Reader.Class (MonadReader, ask, local)-import Control.Monad.State.Class (MonadState, get, put)-import Control.Monad.Writer.Class (MonadWriter, listen, pass, tell)-import Data.Effect.Except (Catch, Throw, catch'', throw'')-import Data.Effect.Fail (Fail)-import Data.Effect.Fail qualified as E-import Data.Effect.Fix (Fix)-import Data.Effect.Fix qualified as E-import Data.Effect.Key (Key (Key), KeyH (KeyH))-import Data.Effect.NonDet (ChooseH, Empty, chooseH)-import Data.Effect.NonDet qualified as E-import Data.Effect.OpenUnion.Internal (ElemAt)-import Data.Effect.OpenUnion.Internal.FO (MemberBy, Union, inj, inj0, injN, type (<|))-import Data.Effect.OpenUnion.Internal.HO (MemberHBy, UnionH, inj0H, injH, injNH, type (<<|))-import Data.Effect.OpenUnion.Sum (SumToRecUnionList)-import Data.Effect.Reader (Ask, Local, ask'', local'')-import Data.Effect.State (State, get'', put'')-import Data.Effect.Unlift (UnliftIO)-import Data.Effect.Unlift qualified as E-import Data.Effect.Writer (Tell, WriterH, listen'', tell'')-import Data.FTCQueue (FTCQueue, tsingleton, (|>))-import Data.Function ((&))+import Control.Effect (Free)+import Control.Effect qualified as D+import Data.Effect (Effect)+import Data.FTCQueue (FTCQueue, ViewL (..), tsingleton, tviewl, (><), (|>)) import Data.Kind (Type)-import Data.Tuple (swap)-import GHC.TypeNats (KnownNat)-import UnliftIO (MonadUnliftIO, withRunInIO) -{- | The 'Eff' monad represents computations with effects.-It supports higher-order effects @eh@ and first-order effects @ef@.--}-data Eff eh ef a+data Freer f a     = -- | A pure value.       Val a-    | -- | An effectful operation, which can be either a higher-order effect or a first-order effect.+    | -- | An effectful operation.       forall x. Op-        (Either (UnionH eh (Eff eh ef) x) (Union ef x))-        (FTCQueue (Eff eh ef) x a)+        (f x)+        (FTCQueue (Freer f) x a)         -- ^ the continuation of the operation. -infixr 4 :!!--{- | Type-level infix operator for 'Eff'.-Allows writing @eh :!! ef@ instead of @Eff eh ef@.--}-type (:!!) = Eff--infixr 5 !!--{- | An infix operator version of t`Eff` for sum notation.--Example:--@Span t'Control.Monad.Hefty.Types.!!' FileSystem t'Data.Effect.OpenUnion.Sum.+' Time t'Data.Effect.OpenUnion.Sum.+' Log t'Data.Effect.OpenUnion.Sum.+' t'IO' t'Control.Effect.~>' t'IO'@--}-type eh !! ef = SumToRecUnionList UnionH eh :!! SumToRecUnionList Union ef--infixr 3 $-infixr 4 $$---- | Type-level infix applcation for functors.-type (f :: Type -> Type) $ a = f a---- | Type-level infix applcation for higher-order functors.-type (h :: (Type -> Type) -> Type -> Type) $$ f = h f--{- | Type alias for an interpreter function.--@Interpreter e m ans@ transforms an effect @e@ into a computation in @m@ where the result type (answer type) is @ans@.--}-type Interpreter e m (ans :: Type) = forall x. e x -> (x -> m ans) -> m ans--{- | Type alias for an elaborator function.--An 'Elaborator' is an interpreter for higher-order effects.--}-type Elaborator e m ans = Interpreter (e m) m ans--infix 2 ~~>---- | Type alias for a natural transformation style elaborator.-type e ~~> f = e f ~> f---- | Send a first-order effect @e@ to the t`Eff` carrier.-send :: (e <| ef) => e ~> Eff eh ef-send = sendUnion . inj-{-# INLINE send #-}---- | Send a higher-order effect @e@ to the t`Eff` carrier.-sendH :: (e <<| eh) => e (Eff eh ef) ~> Eff eh ef-sendH = sendUnionH . injH-{-# INLINE sendH #-}---- | Send the first-order effect @e@ at the head of the list to the t`Eff` carrier.-send0 :: e ~> Eff eh (e ': ef)-send0 = sendUnion . inj0-{-# INLINE send0 #-}---- | Send the higher-order effect @e@ at the head of the list to the t`Eff` carrier.-send0H :: e (Eff (e ': eh) ef) ~> Eff (e ': eh) ef-send0H = sendUnionH . inj0H-{-# INLINE send0H #-}---- | Send the @i@-th first-order effect in the list to the t`Eff` carrier.-sendN :: forall i ef eh. (KnownNat i) => ElemAt i ef ~> Eff eh ef-sendN = sendUnion . injN @i-{-# INLINE sendN #-}---- | Send the @i@-th higher-order effect in the list to the t`Eff` carrier.-sendNH :: forall i eh ef. (KnownNat i) => ElemAt i eh (Eff eh ef) ~> Eff eh ef-sendNH = sendUnionH . injNH @i-{-# INLINE sendNH #-}---- | Send an open union of all first-order effects to the t`Eff` carrier.-sendUnion :: Union ef a -> Eff eh ef a-sendUnion = sendUnionBy pure-{-# INLINE sendUnion #-}---- | Send an open union of all first-order effects, along with its continuation, to the t`Eff` carrier.-sendUnionBy :: (a -> Eff eh ef ans) -> Union ef a -> Eff eh ef ans-sendUnionBy k u = Op (Right u) (tsingleton k)-{-# INLINE sendUnionBy #-}---- | Send an open union of all higher-order effects to the t`Eff` carrier.-sendUnionH :: UnionH eh (Eff eh ef) a -> Eff eh ef a-sendUnionH = sendUnionHBy pure-{-# INLINE sendUnionH #-}+type Eff = D.Eff Freer --- | Send an open union of all higher-order effects, along with its continuation, to the t`Eff` carrier.-sendUnionHBy :: (a -> Eff eh ef ans) -> UnionH eh (Eff eh ef) a -> Eff eh ef ans-sendUnionHBy k u = Op (Left u) (tsingleton k)-{-# INLINE sendUnionHBy #-}+type AlgHandler (e :: Effect) m n (ans :: Type) = forall x. e m x -> (x -> n ans) -> n ans -instance Functor (Eff eh ef) where+instance Functor (Freer f) where     fmap f = \case         Val x -> Val (f x)         Op u q -> Op u (q |> (Val . f))     {-# INLINE fmap #-} -instance Applicative (Eff eh ef) where+instance Applicative (Freer f) where     pure = Val     {-# INLINE pure #-} @@ -168,125 +48,27 @@     Op u q <*> m = Op u (q |> (<$> m))     {-# INLINE (<*>) #-} -instance Monad (Eff eh ef) where+instance Monad (Freer f) where     m >>= k = case m of         Val x -> k x         Op e q -> Op e (q |> k)     {-# INLINE (>>=) #-} -instance (e <| ef) => SendFOE e (Eff eh ef) where-    sendFOE = send-    {-# INLINE sendFOE #-}--instance (e <<| eh) => SendHOE e (Eff eh ef) where-    sendHOE = sendH-    {-# INLINE sendHOE #-}--instance (MemberBy key e ef) => SendFOEBy key e (Eff eh ef) where-    sendFOEBy = send . Key @key-    {-# INLINE sendFOEBy #-}--instance (MemberHBy key e eh) => SendHOEBy key e (Eff eh ef) where-    sendHOEBy = sendH . KeyH @key-    {-# INLINE sendHOEBy #-}--instance-    ( SendFOEBy ReaderKey (Ask r) (Eff eh ef)-    , SendHOEBy ReaderKey (Local r) (Eff eh ef)-    )-    => MonadReader r (Eff eh ef)-    where-    ask = ask'' @ReaderKey-    local = local'' @ReaderKey-    {-# INLINE ask #-}-    {-# INLINE local #-}--{- | A key to be attached to the effect targeted by the t`MonadReader` instance.--Since t`MonadReader` has a functional dependency on @r@, this is needed to uniquely specify @r@.--}-data ReaderKey--instance-    ( SendFOEBy WriterKey (Tell w) (Eff eh ef)-    , SendHOEBy WriterKey (WriterH w) (Eff eh ef)-    , Monoid w-    )-    => MonadWriter w (Eff eh ef)-    where-    tell = tell'' @WriterKey-    listen = fmap swap . listen'' @WriterKey-    pass m = pass (ByKey m) & key @WriterKey-    {-# INLINE tell #-}-    {-# INLINE listen #-}--{- | A key to be attached to the effect targeted by the t'Control.Monad.Writer.Class.MonadWriter' instance.--Since t'Control.Monad.Writer.Class.MonadWriter' has a functional dependency on @w@, this is needed to uniquely specify @w@.--}-data WriterKey--instance-    (SendFOEBy StateKey (State s) (Eff eh ef))-    => MonadState s (Eff eh ef)-    where-    get = get'' @StateKey-    put = put'' @StateKey-    {-# INLINE get #-}-    {-# INLINE put #-}--{- | A key to be attached to the effect targeted by the t`MonadState` instance.--Since t`MonadState` has a functional dependency on @s@, this is needed to uniquely specify @s@.--}-data StateKey--instance-    ( SendFOEBy ErrorKey (Throw e) (Eff eh ef)-    , SendHOEBy ErrorKey (Catch e) (Eff eh ef)-    )-    => MonadError e (Eff eh ef)-    where-    throwError = throw'' @ErrorKey-    catchError = catch'' @ErrorKey-    {-# INLINE throwError #-}-    {-# INLINE catchError #-}--{- | A key to be attached to the effect targeted by the t`Control.Monad.Error.Class.MonadError` instance.--Since t`Control.Monad.Error.Class.MonadError` has a functional dependency on @e@, this is needed to uniquely specify @e@.--}-data ErrorKey--instance-    ( SendFOEBy ReaderKey (Ask r) (Eff eh ef)-    , SendHOEBy ReaderKey (Local r) (Eff eh ef)-    , SendFOEBy WriterKey (Tell w) (Eff eh ef)-    , SendHOEBy WriterKey (WriterH w) (Eff eh ef)-    , SendFOEBy StateKey (State s) (Eff eh ef)-    , Monoid w-    )-    => MonadRWS r w s (Eff eh ef)--instance (Empty <| ef, ChooseH <<| eh) => Alternative (Eff eh ef) where-    empty = E.empty-    a <|> b = chooseH a b-    {-# INLINE empty #-}-    {-# INLINE (<|>) #-}--instance (Empty <| ef, ChooseH <<| eh) => MonadPlus (Eff eh ef)--instance (IO <| ef) => MonadIO (Eff eh ef) where-    liftIO = send-    {-# INLINE liftIO #-}--instance (Fail <| ef) => MonadFail (Eff eh ef) where-    fail = E.fail-    {-# INLINE fail #-}+instance Free Monad Freer where+    liftFree f = Op f (tsingleton pure)+    runFree i = loop+      where+        loop = \case+            Val x -> pure x+            Op f q -> i f >>= loop . qApp q -instance (Fix <<| eh) => MonadFix (Eff eh ef) where-    mfix = E.mfix+    {-# INLINE liftFree #-}+    {-# INLINE runFree #-} -instance (UnliftIO <<| eh, IO <| ef) => MonadUnliftIO (Eff eh ef) where-    withRunInIO = E.withRunInIO-    {-# INLINE withRunInIO #-}+-- | Applies a value to a Kleisli arrow in 'FTCQueue' representation.+qApp :: FTCQueue (Freer f) a b -> a -> Freer f b+qApp q' x = case tviewl q' of+    TOne k -> k x+    k :| t -> case k x of+        Val y -> qApp t y+        Op u q -> Op u (q >< t)

@@ -1,121 +0,0 @@--- SPDX-License-Identifier: MPL-2.0--{- |-Copyright   :  (c) 2024 Sayo Koyoneda-License     :  MPL-2.0 (see the LICENSE file)-Maintainer  :  ymdfield@outlook.jp--}-module Data.Effect.OpenUnion (-    module Data.Effect.OpenUnion.Internal,-    module Data.Effect.OpenUnion.Internal.HO,-    module Data.Effect.OpenUnion.Internal.FO,-    module Data.Effect.OpenUnion.Sum,-) where--import Data.Effect.OpenUnion.Internal (-    BundleUnder,-    Drop,-    ElemAt,-    IsSuffixOf,-    KnownLength,-    Length,-    Reverse,-    Split,-    Strengthen,-    StrengthenN,-    StrengthenNUnder,-    StrengthenUnder,-    Take,-    WeakenN,-    WeakenNUnder,-    WeakenUnder,-    type (++),- )-import Data.Effect.OpenUnion.Internal.FO (-    Lookup,-    Member,-    MemberBy,-    Union,-    bundleAllUnion,-    bundleUnion,-    bundleUnionUnder,-    decomp,-    decomp0,-    extract,-    flipAllUnion,-    flipUnion,-    flipUnionUnder,-    inj,-    inj0,-    injN,-    nil,-    prefixUnion,-    prefixUnionUnder,-    prj,-    prjN,-    strengthen,-    strengthenN,-    strengthenNUnder,-    strengthenUnder,-    suffixUnion,-    suffixUnionOverN,-    unbundleAllUnion,-    unbundleUnion,-    unbundleUnionUnder,-    weaken,-    weakenN,-    weakenNUnder,-    weakenUnder,-    weakens,-    weakensUnder,-    (!+),-    type (<|),- )-import Data.Effect.OpenUnion.Internal.HO (-    LookupH,-    MemberH,-    MemberHBy,-    UnionH,-    bundleAllUnionH,-    bundleUnionH,-    bundleUnionUnderH,-    decomp0H,-    decompH,-    extractH,-    flipAllUnionH,-    flipUnionH,-    flipUnionUnderH,-    hfmapUnion,-    inj0H,-    injH,-    injNH,-    nilH,-    prefixUnionH,-    prefixUnionUnderH,-    prjH,-    prjNH,-    strengthenNH,-    strengthenNUnderH,-    suffixUnionH,-    suffixUnionOverNH,-    unbundleAllUnionH,-    unbundleUnionH,-    unbundleUnionUnderH,-    weakenH,-    weakenNH,-    weakenNUnderH,-    weakenUnderH,-    weakensH,-    weakensUnderH,-    (!!+),-    type (<<|),- )-import Data.Effect.OpenUnion.Sum (-    SumToRecUnion,-    SumToRecUnionList,-    U,-    UL,-    type (+),- )---- TODO: add move/swap/insert/rotate functions.

@@ -1,198 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE UndecidableInstances #-}---- SPDX-License-Identifier: MPL-2.0 AND BSD-3-Clause---- This Source Code Form is subject to the terms of the Mozilla Public--- License, v. 2.0. If a copy of the MPL was not distributed with this--- file, You can obtain one at https://mozilla.org/MPL/2.0/.--{- |-Copyright   :  (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King; 2024 Sayo Koyoneda-License     :  MPL-2.0 (see the LICENSE file) AND BSD-3-Clause (see the LICENSE.BSD3 file)-Maintainer  :  ymdfield@outlook.jp-Description :  Open unions (type-indexed co-products) for extensible effects.--}-module Data.Effect.OpenUnion.Internal where--import Data.Effect.Key (type (##>), type (#>))-import Data.Proxy (Proxy (Proxy))-import Data.Type.Equality (type (==))-import GHC.TypeError (ErrorMessage (ShowType, Text, (:$$:), (:<>:)), TypeError)-import GHC.TypeNats (KnownNat, natVal, type (+), type (-))--{- |-Represents position of element @e :: k@ in a type list @es :: [k]@.--}-newtype P (e :: k) (es :: [k]) = P {unP :: Word}--type FindElem e es = KnownNat (ElemIndex e es)--elemNo :: forall e es. (FindElem e es) => P e es-elemNo = P $ wordVal @(ElemIndex e es)-{-# INLINE elemNo #-}--type family ElemIndex e es where-    ElemIndex e (e ': es) = 0-    ElemIndex e (_ ': es) = 1 + ElemIndex e es--type family ElemAt i es where-    ElemAt 0 (e ': _) = e-    ElemAt n (_ ': es) = ElemAt (n - 1) es--{- | Instance resolution for this class fails with a custom type error-if @e :: k@ is not in the list @w :: [k]@.--}-class IfNotFound (e :: k) (r :: [k]) (w :: [k])--{- | If we reach an empty list, that’s a failure, since it means the type isn’t-in the list.--}-instance-    ( TypeError-        ( 'Text "‘"-            ':<>: 'ShowType e-            ':<>: 'Text "’ is not a member of the type-level list"-            ':$$: 'Text "  ‘" ':<>: 'ShowType w ':<>: 'Text "’"-        )-    )-    => IfNotFound e '[] w--instance IfNotFound e (e ': r) w-instance {-# OVERLAPPABLE #-} (IfNotFound e r w) => IfNotFound e (e' ': r) w--{- |-Pass if @r@ is uninstantiated. The incoherence here is safe, since picking-this instance doesn’t cause any variation in behavior, except possibly the-production of an inferior error message. For more information, see-lexi-lambda/freer-simple#3, which describes the motivation in more detail.--}-instance {-# INCOHERENT #-} IfNotFound e r w--class IfKeyNotFound (key :: k) (r :: [e]) (w :: [e])--instance-    ( TypeError-        ( 'Text "The key ‘"-            ':<>: 'ShowType key-            ':<>: 'Text "’ does not exist in the type-level list"-            ':$$: 'Text "  ‘" ':<>: 'ShowType w ':<>: 'Text "’"-        )-    )-    => IfKeyNotFound key '[] w--instance IfKeyNotFound key (key #> e ': r) w-instance IfKeyNotFound key (key ##> e ': r) w-instance {-# OVERLAPPABLE #-} (IfKeyNotFound key r w) => IfKeyNotFound key (e ': r) w--instance {-# INCOHERENT #-} IfKeyNotFound e r w--infixr 5 ++-type family xs ++ ys where-    '[] ++ ys = ys-    (x ': xs) ++ ys = x ': (xs ++ ys)--wordVal :: forall n. (KnownNat n) => Word-wordVal = fromIntegral $ natVal @n Proxy-{-# INLINE wordVal #-}--class IsSuffixOf es es' where-    prefixLen :: Word--instance IsSuffixOf es es where-    prefixLen = 0--instance {-# INCOHERENT #-} (IsSuffixOf es es') => IsSuffixOf es (e ': es') where-    prefixLen = prefixLen @es @es' + 1--type family Length es where-    Length '[] = 0-    Length (e ': es) = 1 + Length es--class (KnownNat (Length es)) => KnownLength es-instance (KnownNat (Length es)) => KnownLength es--reifyLength :: forall es. (KnownLength es) => Word-reifyLength = wordVal @(Length es)-{-# INLINE reifyLength #-}--type family PrefixLength es es' where-    PrefixLength es es = 0-    PrefixLength es (e ': es') = 1 + PrefixLength es es'---- fixme: Use type class with functional dependencies instaed of type family for readable compile error and compile speed.--type WeakenN len es es' = (es ~ Drop len es', KnownNat len)--type WeakenUnder offset es es' =-    (WeakenNUnder (PrefixLength es es') offset es es', KnownNat (PrefixLength es es'))--type WeakenNUnder len offset es es' =-    (WeakenN len (Drop offset es) (Drop offset es'), KnownNat offset)--type Strengthen es es' =-    (StrengthenMap (PrefixLength es' es) es es', KnownNat (PrefixLength es' es))--type StrengthenN len es es' = (StrengthenMap len es es', KnownNat len)--type StrengthenUnder offset es es' =-    (StrengthenNUnder (PrefixLength es' es) offset es es')--type StrengthenNUnder len offset es es' =-    (StrengthenMap len (Drop offset es) (Drop offset es'), KnownNat len, KnownNat offset)--type StrengthenMap len es es' = (StrengthenMap_ (len == 0) len es es')--class-    (isLenZero ~ (len == 0)) =>-    StrengthenMap_ isLenZero len (es :: [k]) (es' :: [k])-    where-    strengthenMap :: Word -> Word--instance StrengthenMap_ 'True 0 es es where-    strengthenMap = id-    {-# INLINE strengthenMap #-}--instance-    (StrengthenMap (len - 1) es es', FindElem e es, (len == 0) ~ 'False)-    => StrengthenMap_ 'False len (e ': es) es'-    where-    strengthenMap = \case-        0 -> wordVal @(ElemIndex e es)-        n -> strengthenMap @_ @_ @(len - 1) @es @es' $ n - 1-    {-# INLINE strengthenMap #-}--strengthenMapUnder :: forall len offset es es'. (StrengthenNUnder len offset es es') => Word -> Word-strengthenMapUnder = strengthenMap @_ @_ @len @(Drop offset es) @(Drop offset es')-{-# INLINE strengthenMapUnder #-}--type BundleUnder u offset es es' bundle =-    ( es' ~ Take offset es ++ (u bundle ': Drop (Length bundle) (Drop offset es))-    , es ~ Take offset es' ++ bundle ++ Drop 1 (Drop offset es')-    , bundle ~ Take (PrefixLength (Drop 1 (Drop offset es')) (Drop offset es)) (Drop offset es)-    , KnownLength bundle-    , KnownNat offset-    , Length bundle ~ PrefixLength (Drop 1 (Drop offset es')) (Drop offset es)-    )--type Split es init tail =-    ( es ~ init ++ tail-    , init ~ Take (PrefixLength tail es) es-    , tail ~ Drop (Length init) es-    , KnownLength init-    , Length init ~ PrefixLength tail es-    )--type family Take n es where-    Take 0 es = '[]-    Take n (e ': es) = e ': Take (n - 1) es--type family Drop n es where-    Drop 0 es = es-    Drop n (e ': es) = Drop (n - 1) es--type Reverse es = Reverse_ '[] es--type family Reverse_ acc es where-    Reverse_ acc '[] = acc-    Reverse_ acc (e ': es) = Reverse_ (e ': acc) es

@@ -1,442 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE UndecidableInstances #-}---- SPDX-License-Identifier: MPL-2.0 AND BSD-3-Clause---- This Source Code Form is subject to the terms of the Mozilla Public--- License, v. 2.0. If a copy of the MPL was not distributed with this--- file, You can obtain one at https://mozilla.org/MPL/2.0/.--{- |-Copyright   :  (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King; 2024 Sayo Koyoneda-License     :  MPL-2.0 (see the LICENSE file) AND BSD-3-Clause (see the LICENSE.BSD3 file)-Maintainer  :  ymdfield@outlook.jp-Description :  Open unions (type-indexed co-products) for extensible first-order effects.--Implementation of an open union for first-order effects.--Importing this module allows unsafe access to the data structure of the open-union, so it should not usually be imported directly.--Based on [the open union in freer-simple](https://hackage.haskell.org/package/freer-simple-1.2.1.2/docs/Data-OpenUnion-Internal.html).--}-module Data.Effect.OpenUnion.Internal.FO where--import Data.Coerce (coerce)-import Data.Effect (EffectF)-import Data.Effect.Key (type (#>))-import Data.Effect.OpenUnion.Internal (-    BundleUnder,-    Drop,-    ElemAt,-    ElemIndex,-    FindElem,-    IfKeyNotFound,-    IfNotFound,-    IsSuffixOf,-    KnownLength,-    Length,-    P (unP),-    PrefixLength,-    Reverse,-    Split,-    Strengthen,-    StrengthenN,-    StrengthenNUnder,-    StrengthenUnder,-    Take,-    WeakenN,-    WeakenNUnder,-    WeakenUnder,-    elemNo,-    prefixLen,-    reifyLength,-    strengthenMap,-    strengthenMapUnder,-    wordVal,-    type (++),- )-import Data.Kind (Type)-import GHC.TypeNats (KnownNat, type (-))-import Unsafe.Coerce (unsafeCoerce)---- | Open union for first-order effects.-data Union (es :: [EffectF]) (a :: Type) where-    Union-        :: {-# UNPACK #-} !Word-        -- ^ A natural number tag to identify the element of the union.-        -> e a-        -- ^ The data of the higher-order effect that is an element of the union.-        -> Union es a--{- | Takes a request of type @e :: 'EffectF'@, and injects it into the 'Union'.--Summand is assigning a specified 'Word' value, which is a position in the-type-list @(e ': es) :: 'EffectF'@.--__This function is unsafe.__--/O(1)/--}-unsafeInj :: Word -> e a -> Union es a-unsafeInj = Union-{-# INLINE unsafeInj #-}--{- | Project a value of type @'Union' (e ': es) :: 'EffectF'@ into a possible-summand of the type @e :: 'EffectF'@. 'Nothing' means that @e :: 'EffectF'@ is not-the value stored in the @'Union' (e ': es) :: 'EffectF'@.--It is assumed that summand is stored in the 'Union' when the 'Word' value is-the same value as is stored in the 'Union'.--__This function is unsafe.__--/O(1)/--}-unsafePrj :: Word -> Union es a -> Maybe (e a)-unsafePrj n (Union n' e)-    | n == n' = Just (unsafeCoerce e)-    | otherwise = Nothing-{-# INLINE unsafePrj #-}--{- | A constraint that requires that a particular effect, @e@, is a member of-the type-level list @es@. This is used to parameterize an-'Control.Monad.Hefty.Eff' computation over an arbitrary list of first-order effects, so-long as @e@ is /somewhere/ in the list.--For example, a computation that only needs access to a cell of mutable state-containing an 'Integer' would likely use the following type:--@-'Data.Effect.State.State' 'Integer' t'Data.Effect.OpenUnion.<|' ef => 'Control.Monad.Hefty.Eff' eh ef ()-@--}-class (FindElem e es) => Member (e :: EffectF) es where-    -- This type class is used for two following purposes:-    ----    -- * As a @Constraint@ it guarantees that @e :: 'EffectF'@ is a member of a--    --   type-list @es :: ['EffectF']@.-    ----    -- * Provides a way how to inject\/project @e :: 'EffectF'@ into\/from a 'Union',--    --   respectively.-    ---    -- Following law has to hold:-    ---    -- @-    -- 'prj' . 'inj' === 'Just'-    -- @--    -- | Takes a request of type @e :: 'EffectF'@, and injects it into the-    -- 'Union'.-    ---    -- /O(1)/-    inj :: e a -> Union es a--    -- | Project a value of type @'Union' (e ': es) :: 'EffectF'@ into a possible-    -- summand of the type @e :: 'EffectF'@. 'Nothing' means that @e :: 'EffectF'@ is-    -- not the value stored in the @'Union' (e ': es) :: 'EffectF'@.-    ---    -- /O(1)/-    prj :: Union es a -> Maybe (e a)--instance (FindElem e es, IfNotFound e es es) => Member e es where-    inj = unsafeInj $ unP (elemNo :: P e es)-    {-# INLINE inj #-}--    prj = unsafePrj $ unP (elemNo :: P e es)-    {-# INLINE prj #-}--infix 3 <|-type (<|) = Member--type MemberBy key e es = (key #> e <| es, Lookup key es ~ key #> e, IfKeyNotFound key es es)--type family Lookup (key :: k) r :: EffectF where-    Lookup key (key #> e ': _) = key #> e-    Lookup key (_ ': r) = Lookup key r--{- | Orthogonal decomposition of a @'Union' (e ': es) :: 'EffectF'@. 'Right' value-is returned if the @'Union' (e ': es) :: 'EffectF'@ contains @e :: 'EffectF'@, and-'Left' when it doesn't. Notice that 'Left' value contains-@'Union' es :: 'EffectF'@, i.e. it can not contain @e :: 'EffectF'@.--/O(1)/--}-decomp :: Union (e ': es) a -> Either (Union es a) (e a)-decomp (Union 0 a) = Right $ unsafeCoerce a-decomp (Union n a) = Left $ Union (n - 1) a-{-# INLINE [2] decomp #-}--{- | Specialized version of 'decomp' for efficiency.--/O(1)/--}---- TODO: Check that it actually adds on efficiency.-decomp0 :: Union '[e] a -> Either (Union '[] a) (e a)-decomp0 (Union _ a) = Right $ unsafeCoerce a-{-# INLINE decomp0 #-}--{-# RULES "decomp/singleton" decomp = decomp0 #-}--infixr 5 !+-(!+) :: (e a -> r) -> (Union es a -> r) -> Union (e : es) a -> r-(f !+ g) u = case decomp u of-    Left x -> g x-    Right x -> f x-{-# INLINE (!+) #-}--{- | Specialised version of 'prj'\/'decomp' that works on an-@'Union' '[e] :: 'EffectF'@ which contains only one specific summand. Hence the-absence of 'Maybe', and 'Either'.--/O(1)/--}-extract :: Union '[e] a -> e a-extract (Union _ a) = unsafeCoerce a-{-# INLINE extract #-}--inj0 :: forall e es a. e a -> Union (e ': es) a-inj0 = Union 0-{-# INLINE inj0 #-}--injN :: forall i es a. (KnownNat i) => ElemAt i es a -> Union es a-injN = Union (wordVal @i)-{-# INLINE injN #-}--prjN :: forall i es a. (KnownNat i) => Union es a -> Maybe (ElemAt i es a)-prjN (Union n a)-    | n == wordVal @i = Just $ unsafeCoerce a-    | otherwise = Nothing-{-# INLINE prjN #-}--{- | Inject whole @'Union' es@ into a weaker @'Union' (any ': es)@ that has one-more summand.--/O(1)/--}-weaken :: forall any es a. Union es a -> Union (any ': es) a-weaken (Union n a) = Union (n + 1) a-{-# INLINE weaken #-}--weakens :: forall es es' a. (es `IsSuffixOf` es') => Union es a -> Union es' a-weakens (Union n a) = Union (n + prefixLen @es @es') a-{-# INLINE weakens #-}--weakenN :: forall len es es' a. (WeakenN len es es') => Union es a -> Union es' a-weakenN (Union n a) = Union (n + wordVal @len) a-{-# INLINE weakenN #-}--weakenUnder :: forall any e es a. Union (e ': es) a -> Union (e ': any ': es) a-weakenUnder u@(Union n a)-    | n == 0 = coerce u-    | otherwise = Union (n + 1) a-{-# INLINE weakenUnder #-}--weakensUnder :: forall offset es es' a. (WeakenUnder offset es es') => Union es a -> Union es' a-weakensUnder = weakenNUnder @(PrefixLength es es') @offset-{-# INLINE weakensUnder #-}--weakenNUnder-    :: forall len offset es es' a-     . (WeakenNUnder len offset es es')-    => Union es a-    -> Union es' a-weakenNUnder u@(Union n a)-    | n < wordVal @offset = coerce u-    | otherwise = Union (n + wordVal @len) a-{-# INLINE weakenNUnder #-}--strengthen :: forall e es a. (e <| es) => Union (e ': es) a -> Union es a-strengthen (Union n a)-    | n == 0 = Union (wordVal @(ElemIndex e es)) a-    | otherwise = Union (n - 1) a-{-# INLINE strengthen #-}--strengthens :: forall es es' a. (Strengthen es es') => Union es a -> Union es' a-strengthens = strengthenN @(PrefixLength es' es)-{-# INLINE strengthens #-}--strengthenN :: forall len es es' a. (StrengthenN len es es') => Union es a -> Union es' a-strengthenN (Union n a) = Union (strengthenMap @_ @_ @len @es @es' n) a-{-# INLINE strengthenN #-}--strengthenUnder :: forall e2 e1 es a. (e2 <| es) => Union (e1 ': e2 ': es) a -> Union (e1 ': es) a-strengthenUnder u@(Union n a)-    | n == 0 = coerce u-    | n == 1 = Union (1 + wordVal @(ElemIndex e2 es)) a-    | otherwise = Union (n - 1) a-{-# INLINE strengthenUnder #-}--strengthensUnder :: forall offset es es' a. (StrengthenUnder offset es es') => Union es a -> Union es' a-strengthensUnder = strengthenNUnder @(PrefixLength es' es) @offset-{-# INLINE strengthensUnder #-}--strengthenNUnder-    :: forall len offset es es' a-     . (StrengthenNUnder len offset es es')-    => Union es a-    -> Union es' a-strengthenNUnder u@(Union n a)-    | n < off = coerce u-    | otherwise = Union (off + strengthenMapUnder @len @offset @es @es' (n - off)) a-  where-    off = wordVal @offset-{-# INLINE strengthenNUnder #-}--bundleUnion-    :: forall es bundle rest a-     . (Split es bundle rest)-    => Union es a-    -> Union (Union bundle ': rest) a-bundleUnion = bundleUnionN @(Length bundle)--bundleUnionN-    :: forall len es a-     . (KnownNat len)-    => Union es a-    -> Union (Union (Take len es) ': Drop len es) a-bundleUnionN (Union n a)-    | n < len = Union 0 $ Union n a-    | otherwise = Union (n - len + 1) a-  where-    len = wordVal @len-{-# INLINE bundleUnionN #-}--unbundleUnion-    :: forall es bundle rest a-     . (Split es bundle rest)-    => Union (Union bundle ': rest) a-    -> Union es a-unbundleUnion = unbundleUnionN @(Length bundle)-{-# INLINE unbundleUnion #-}--unbundleUnionN-    :: forall len es a-     . (KnownNat len)-    => Union (Union (Take len es) ': Drop len es) a-    -> Union es a-unbundleUnionN (Union n a)-    | n == 0 = unsafeCoerce a-    | otherwise = Union (n - 1 + wordVal @len) a-{-# INLINE unbundleUnionN #-}--bundleUnionUnder-    :: forall offset bundle es es' a-     . (BundleUnder Union offset es es' bundle)-    => Union es a-    -> Union es' a-bundleUnionUnder = bundleUnionNUnder @(Length bundle) @offset-{-# INLINE bundleUnionUnder #-}--bundleUnionNUnder-    :: forall len offset es a-     . (KnownNat len, KnownNat offset)-    => Union es a-    -> Union (Take offset es ++ (Union (Take len (Drop offset es)) ': Drop len (Drop offset es))) a-bundleUnionNUnder u@(Union n a)-    | n < off = coerce u-    | n' < len = Union 0 $ Union n' a-    | otherwise = Union (n - len + 1) a-  where-    off = wordVal @offset-    len = wordVal @len-    n' = n - off-{-# INLINE bundleUnionNUnder #-}--unbundleUnionUnder-    :: forall offset bundle es es' a-     . (BundleUnder Union offset es es' bundle)-    => Union es' a-    -> Union es a-unbundleUnionUnder = unbundleUnionNUnder @(Length bundle) @offset-{-# INLINE unbundleUnionUnder #-}--unbundleUnionNUnder-    :: forall len offset es a-     . (KnownNat len, KnownNat offset)-    => Union (Take offset es ++ (Union (Take len (Drop offset es)) ': Drop len (Drop offset es))) a-    -> Union es a-unbundleUnionNUnder u@(Union n a)-    | n < off = coerce u-    | n == off =-        case unsafeCoerce a of-            Union n' a' -> Union (off + n') a'-    | otherwise = Union (n - 1 + len) a-  where-    off = wordVal @offset-    len = wordVal @len-{-# INLINE unbundleUnionNUnder #-}--bundleAllUnion :: Union es a -> Union '[Union es] a-bundleAllUnion = Union 0-{-# INLINE bundleAllUnion #-}--unbundleAllUnion :: Union '[Union es] a -> Union es a-unbundleAllUnion = extract-{-# INLINE unbundleAllUnion #-}--prefixUnion :: forall any es a. (KnownLength any) => Union es a -> Union (any ++ es) a-prefixUnion (Union n a) = Union (n + reifyLength @any) a-{-# INLINE prefixUnion #-}--prefixUnionUnder-    :: forall any offset es a-     . (KnownLength any, KnownNat offset)-    => Union es a-    -> Union (Take offset es ++ any ++ Drop offset es) a-prefixUnionUnder u@(Union n a)-    | n < wordVal @offset = coerce u-    | otherwise = Union (n + reifyLength @any) a-{-# INLINE prefixUnionUnder #-}--suffixUnion :: forall any es a. Union es a -> Union (es ++ any) a-suffixUnion = coerce-{-# INLINE suffixUnion #-}--suffixUnionOverN-    :: forall any offset es a-     . (KnownLength any, KnownNat offset, KnownLength es)-    => Union es a-    -> Union (Take (Length es - offset) es ++ any ++ Drop (Length es - offset) es) a-suffixUnionOverN u@(Union n a)-    | n < reifyLength @es - wordVal @offset = coerce u-    | otherwise = Union (n + reifyLength @any) a-{-# INLINE suffixUnionOverN #-}--flipAllUnion :: forall es a. (KnownLength es) => Union es a -> Union (Reverse es) a-flipAllUnion (Union n a) = Union (reifyLength @es - n) a-{-# INLINE flipAllUnion #-}--flipUnion-    :: forall len es a-     . (KnownNat len)-    => Union es a-    -> Union (Reverse (Take len es) ++ Drop len es) a-flipUnion u@(Union n a)-    | n < len = Union (len - n) a-    | otherwise = coerce u-  where-    len = wordVal @len-{-# INLINE flipUnion #-}--flipUnionUnder-    :: forall len offset es a-     . (KnownNat len, KnownNat offset)-    => Union es a-    -> Union (Take offset es ++ Reverse (Take len (Drop offset es)) ++ Drop len (Drop offset es)) a-flipUnionUnder u@(Union n a)-    | n >= off && n' < len = Union (off + len - n') a-    | otherwise = coerce u-  where-    off = wordVal @offset-    len = wordVal @len-    n' = n - off-{-# INLINE flipUnionUnder #-}--nil :: Union '[] a -> r-nil _ = error "Effect system internal error: nil - An empty effect union, which should not be possible to create, has been created."

@@ -1,384 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}--{-# HLINT ignore "Eta reduce" #-}---- SPDX-License-Identifier: MPL-2.0 AND BSD-3-Clause---- This Source Code Form is subject to the terms of the Mozilla Public--- License, v. 2.0. If a copy of the MPL was not distributed with this--- file, You can obtain one at https://mozilla.org/MPL/2.0/.--{- |-Copyright   :  (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King; 2024 Sayo Koyoneda-License     :  MPL-2.0 (see the LICENSE file) AND BSD-3-Clause (see the LICENSE.BSD3 file)-Maintainer  :  ymdfield@outlook.jp-Description :  Open unions (type-indexed co-products) for extensible higher-order effects.--Implementation of an open union for higher-order effects.--Importing this module allows unsafe access to the data structure of the open-union, so it should not usually be imported directly.--Based on [the open union in freer-simple](https://hackage.haskell.org/package/freer-simple-1.2.1.2/docs/Data-OpenUnion-Internal.html).--}-module Data.Effect.OpenUnion.Internal.HO where--import Control.Effect (type (~>))-import Data.Coerce (coerce)-import Data.Effect (EffectH)-import Data.Effect.HFunctor (HFunctor, hfmap)-import Data.Effect.Key (type (##>))-import Data.Effect.OpenUnion.Internal (-    BundleUnder,-    Drop,-    ElemAt,-    ElemIndex,-    FindElem,-    IfKeyNotFound,-    IfNotFound,-    IsSuffixOf,-    KnownLength,-    Length,-    P (unP),-    PrefixLength,-    Reverse,-    Split,-    Strengthen,-    StrengthenN,-    StrengthenNUnder,-    StrengthenUnder,-    Take,-    WeakenN,-    WeakenNUnder,-    WeakenUnder,-    elemNo,-    prefixLen,-    reifyLength,-    strengthenMap,-    strengthenMapUnder,-    wordVal,-    type (++),- )-import Data.Kind (Type)-import GHC.TypeNats (KnownNat, type (-))-import Unsafe.Coerce (unsafeCoerce)---- | Open union for higher-order effects.-data UnionH (es :: [EffectH]) (f :: Type -> Type) (a :: Type) where-    UnionH-        :: {-# UNPACK #-} !Word-        -- ^ A natural number tag to identify the element of the union.-        -> e g a-        -- ^ The data of the higher-order effect that is an element of the union.-        -> (g ~> f)-        -- ^ Continuation of interpretation.-        -- Due to this component, v'hfmap' for t'UnionH' becomes faster (because-        -- it no longer requires the t'HFunctor' dictionary), thus improving overall performance.-        -> UnionH es f a--hfmapUnion :: (f ~> g) -> UnionH es f a -> UnionH es g a-hfmapUnion phi (UnionH n e koi) = UnionH n e (phi . koi)-{-# INLINE hfmapUnion #-}--instance HFunctor (UnionH es) where-    hfmap f = hfmapUnion f-    {-# INLINE hfmap #-}--unsafeInjH :: Word -> e f a -> UnionH es f a-unsafeInjH n e = UnionH n e id-{-# INLINE unsafeInjH #-}--unsafePrjH :: (HFunctor e) => Word -> UnionH es f a -> Maybe (e f a)-unsafePrjH n (UnionH n' e koi)-    | n == n' = Just (hfmap koi $ unsafeCoerce e)-    | otherwise = Nothing-{-# INLINE unsafePrjH #-}--class (FindElem e es) => MemberH (e :: EffectH) es where-    injH :: e f a -> UnionH es f a-    prjH :: (HFunctor e) => UnionH es f a -> Maybe (e f a)--instance (FindElem e es, IfNotFound e es es) => MemberH e es where-    injH = unsafeInjH $ unP (elemNo :: P e es)-    {-# INLINE injH #-}--    prjH = unsafePrjH $ unP (elemNo :: P e es)-    {-# INLINE prjH #-}--infix 3 <<|-type (<<|) = MemberH--type MemberHBy key e es = (key ##> e <<| es, LookupH key es ~ key ##> e, IfKeyNotFound key es es)--type family LookupH (key :: k) r :: EffectH where-    LookupH key (key ##> e ': _) = key ##> e-    LookupH key (_ ': r) = LookupH key r--decompH :: (HFunctor e) => UnionH (e ': es) f a -> Either (UnionH es f a) (e f a)-decompH (UnionH 0 a koi) = Right $ hfmap koi $ unsafeCoerce a-decompH (UnionH n a koi) = Left $ UnionH (n - 1) a koi-{-# INLINE [2] decompH #-}--decomp0H :: (HFunctor e) => UnionH '[e] f a -> Either (UnionH '[] f a) (e f a)-decomp0H (UnionH _ a koi) = Right $ hfmap koi $ unsafeCoerce a-{-# INLINE decomp0H #-}-{-# RULES "decomp/singleton" decompH = decomp0H #-}--infixr 5 !!+-(!!+) :: (HFunctor e) => (e f a -> r) -> (UnionH es f a -> r) -> UnionH (e : es) f a -> r-(f !!+ g) u = case decompH u of-    Left x -> g x-    Right x -> f x-{-# INLINE (!!+) #-}--extractH :: (HFunctor e) => UnionH '[e] f a -> e f a-extractH (UnionH _ a koi) = hfmap koi $ unsafeCoerce a-{-# INLINE extractH #-}--inj0H :: forall e es f a. e f a -> UnionH (e ': es) f a-inj0H a = UnionH 0 a id-{-# INLINE inj0H #-}--injNH :: forall i es f a. (KnownNat i) => ElemAt i es f a -> UnionH es f a-injNH a = UnionH (wordVal @i) a id-{-# INLINE injNH #-}--prjNH-    :: forall i es f a-     . (KnownNat i, HFunctor (ElemAt i es))-    => UnionH es f a-    -> Maybe (ElemAt i es f a)-prjNH (UnionH n a koi)-    | n == wordVal @i = Just $ hfmap koi $ unsafeCoerce a-    | otherwise = Nothing-{-# INLINE prjNH #-}--weakenH :: forall any es f a. UnionH es f a -> UnionH (any ': es) f a-weakenH (UnionH n a koi) = UnionH (n + 1) a koi-{-# INLINE weakenH #-}--weakensH :: forall es es' f a. (es `IsSuffixOf` es') => UnionH es f a -> UnionH es' f a-weakensH (UnionH n a koi) = UnionH (n + prefixLen @es @es') a koi-{-# INLINE weakensH #-}--weakenNH :: forall len es es' f a. (WeakenN len es es') => UnionH es f a -> UnionH es' f a-weakenNH (UnionH n a koi) = UnionH (n + wordVal @len) a koi-{-# INLINE weakenNH #-}--weakenUnderH :: forall any e es f a. UnionH (e ': es) f a -> UnionH (e ': any ': es) f a-weakenUnderH u@(UnionH n a koi)-    | n == 0 = coerce u-    | otherwise = UnionH (n + 1) a koi-{-# INLINE weakenUnderH #-}--weakensUnderH :: forall offset es es' f a. (WeakenUnder offset es es') => UnionH es f a -> UnionH es' f a-weakensUnderH = weakenNUnderH @(PrefixLength es es') @offset-{-# INLINE weakensUnderH #-}--weakenNUnderH-    :: forall len offset es es' f a-     . (WeakenNUnder len offset es es')-    => UnionH es f a-    -> UnionH es' f a-weakenNUnderH u@(UnionH n a koi)-    | n < wordVal @offset = coerce u-    | otherwise = UnionH (n + wordVal @len) a koi-{-# INLINE weakenNUnderH #-}--strengthenH :: forall e es f a. (e <<| es) => UnionH (e ': es) f a -> UnionH es f a-strengthenH (UnionH n a koi)-    | n == 0 = UnionH (wordVal @(ElemIndex e es)) a koi-    | otherwise = UnionH (n - 1) a koi-{-# INLINE strengthenH #-}--strengthensH :: forall es es' f a. (Strengthen es es') => UnionH es f a -> UnionH es' f a-strengthensH = strengthenNH @(PrefixLength es' es)-{-# INLINE strengthensH #-}--strengthenNH :: forall len es es' f a. (StrengthenN len es es') => UnionH es f a -> UnionH es' f a-strengthenNH (UnionH n a koi) = UnionH (strengthenMap @_ @_ @len @es @es' n) a koi-{-# INLINE strengthenNH #-}--strengthenUnderH :: forall e2 e1 es f a. (e2 <<| es) => UnionH (e1 ': e2 ': es) f a -> UnionH (e1 ': es) f a-strengthenUnderH u@(UnionH n a koi)-    | n == 0 = coerce u-    | n == 1 = UnionH (1 + wordVal @(ElemIndex e2 es)) a koi-    | otherwise = UnionH (n - 1) a koi-{-# INLINE strengthenUnderH #-}--strengthensUnderH-    :: forall offset es es' f a-     . (StrengthenUnder offset es es')-    => UnionH es f a-    -> UnionH es' f a-strengthensUnderH = strengthenNUnderH @(PrefixLength es' es) @offset-{-# INLINE strengthensUnderH #-}--strengthenNUnderH-    :: forall len offset es es' f a-     . (StrengthenNUnder len offset es es')-    => UnionH es f a-    -> UnionH es' f a-strengthenNUnderH u@(UnionH n a koi)-    | n < off = coerce u-    | otherwise = UnionH (off + strengthenMapUnder @len @offset @es @es' (n - off)) a koi-  where-    off = wordVal @offset-{-# INLINE strengthenNUnderH #-}--bundleUnionH-    :: forall bundle es rest f a-     . (Split es bundle rest)-    => UnionH es f a-    -> UnionH (UnionH bundle ': rest) f a-bundleUnionH = bundleUnionNH @(Length bundle)-{-# INLINE bundleUnionH #-}--bundleUnionNH-    :: forall len es f a-     . (KnownNat len)-    => UnionH es f a-    -> UnionH (UnionH (Take len es) ': Drop len es) f a-bundleUnionNH (UnionH n a koi)-    | n < len = UnionH 0 (UnionH n a koi) id-    | otherwise = UnionH (n - len + 1) a koi-  where-    len = wordVal @len-{-# INLINE bundleUnionNH #-}--unbundleUnionH-    :: forall bundle es rest f a-     . (Split es bundle rest)-    => UnionH (UnionH bundle ': rest) f a-    -> UnionH es f a-unbundleUnionH = unbundleUnionNH @(Length bundle)-{-# INLINE unbundleUnionH #-}--unbundleUnionNH-    :: forall len es f a-     . (KnownNat len)-    => UnionH (UnionH (Take len es) ': Drop len es) f a-    -> UnionH es f a-unbundleUnionNH (UnionH n a koi)-    | n == 0 = case unsafeCoerce a of-        UnionH n' a' koi' -> UnionH n' a' (koi . koi')-    | otherwise = UnionH (n - 1 + wordVal @len) a koi-{-# INLINE unbundleUnionNH #-}--bundleUnionUnderH-    :: forall offset bundle es es' f a-     . (BundleUnder UnionH offset es es' bundle)-    => UnionH es f a-    -> UnionH es' f a-bundleUnionUnderH = bundleUnionNUnderH @(Length bundle) @offset-{-# INLINE bundleUnionUnderH #-}--bundleUnionNUnderH-    :: forall len offset es f a-     . (KnownNat len, KnownNat offset)-    => UnionH es f a-    -> UnionH (Take offset es ++ (UnionH (Take len (Drop offset es)) ': Drop len (Drop offset es))) f a-bundleUnionNUnderH u@(UnionH n a koi)-    | n < off = coerce u-    | n' < len = UnionH 0 (UnionH n' a koi) id-    | otherwise = UnionH (n - len + 1) a koi-  where-    off = wordVal @offset-    len = wordVal @len-    n' = n - off-{-# INLINE bundleUnionNUnderH #-}--unbundleUnionUnderH-    :: forall offset bundle es es' f a-     . (BundleUnder UnionH offset es es' bundle)-    => UnionH es' f a-    -> UnionH es f a-unbundleUnionUnderH = unbundleUnionNUnderH @(Length bundle) @offset-{-# INLINE unbundleUnionUnderH #-}--unbundleUnionNUnderH-    :: forall len offset es f a-     . (KnownNat len, KnownNat offset)-    => UnionH (Take offset es ++ (UnionH (Take len (Drop offset es)) ': Drop len (Drop offset es))) f a-    -> UnionH es f a-unbundleUnionNUnderH u@(UnionH n a koi)-    | n < off = coerce u-    | n == off =-        case unsafeCoerce a of-            UnionH n' a' koi' -> UnionH (off + n') a' (koi . koi')-    | otherwise = UnionH (n - 1 + len) a koi-  where-    off = wordVal @offset-    len = wordVal @len-{-# INLINE unbundleUnionNUnderH #-}--bundleAllUnionH :: UnionH es f a -> UnionH '[UnionH es] f a-bundleAllUnionH u = UnionH 0 u id-{-# INLINE bundleAllUnionH #-}--unbundleAllUnionH :: UnionH '[UnionH es] f a -> UnionH es f a-unbundleAllUnionH = extractH-{-# INLINE unbundleAllUnionH #-}--prefixUnionH :: forall any es f a. (KnownLength any) => UnionH es f a -> UnionH (any ++ es) f a-prefixUnionH (UnionH n a koi) = UnionH (n + reifyLength @any) a koi-{-# INLINE prefixUnionH #-}--prefixUnionUnderH-    :: forall any offset es f a-     . (KnownLength any, KnownNat offset)-    => UnionH es f a-    -> UnionH (Take offset es ++ any ++ Drop offset es) f a-prefixUnionUnderH u@(UnionH n a koi)-    | n < wordVal @offset = coerce u-    | otherwise = UnionH (n + reifyLength @any) a koi-{-# INLINE prefixUnionUnderH #-}--suffixUnionH :: forall any es f a. UnionH es f a -> UnionH (es ++ any) f a-suffixUnionH = coerce-{-# INLINE suffixUnionH #-}--suffixUnionOverNH-    :: forall any offset es f a-     . (KnownLength any, KnownNat offset, KnownLength es)-    => UnionH es f a-    -> UnionH (Take (Length es - offset) es ++ any ++ Drop (Length es - offset) es) f a-suffixUnionOverNH u@(UnionH n a koi)-    | n < reifyLength @es - wordVal @offset = coerce u-    | otherwise = UnionH (n + reifyLength @any) a koi-{-# INLINE suffixUnionOverNH #-}--flipAllUnionH :: forall es f a. (KnownLength es) => UnionH es f a -> UnionH (Reverse es) f a-flipAllUnionH (UnionH n a koi) = UnionH (reifyLength @es - n) a koi-{-# INLINE flipAllUnionH #-}--flipUnionH-    :: forall len es f a-     . (KnownNat len)-    => UnionH es f a-    -> UnionH (Reverse (Take len es) ++ Drop len es) f a-flipUnionH u@(UnionH n a koi)-    | n < len = UnionH (len - n) a koi-    | otherwise = coerce u-  where-    len = wordVal @len-{-# INLINE flipUnionH #-}--flipUnionUnderH-    :: forall len offset es f a-     . (KnownNat len, KnownNat offset)-    => UnionH es f a-    -> UnionH (Take offset es ++ Reverse (Take len (Drop offset es)) ++ Drop len (Drop offset es)) f a-flipUnionUnderH u@(UnionH n a koi)-    | n >= off && n' < len = UnionH (off + len - n') a koi-    | otherwise = coerce u-  where-    off = wordVal @offset-    len = wordVal @len-    n' = n - off-{-# INLINE flipUnionUnderH #-}--nilH :: UnionH '[] f a -> r-nilH _ = error "Effect system internal error: nilH - An empty effect union, which should not be possible to create, has been created."

@@ -1,31 +0,0 @@--- SPDX-License-Identifier: MPL-2.0--module Data.Effect.OpenUnion.Sum where--import Data.Effect (EffectF, EffectH, LNop, Nop)-import Data.Effect.HFunctor qualified as H-import Data.Effect.OpenUnion.Internal.FO (Union)-import Data.Effect.OpenUnion.Internal.HO (UnionH)-import GHC.Generics qualified as G--infixr 5 +---- | Sum for first-order effects.-type (+) = (G.:+:) :: EffectF -> EffectF -> EffectF---- | Sum for higher-order effects.-type (:+:) = (H.:+:) :: EffectH -> EffectH -> EffectH--type U u e = SumToRecUnion u e-type UL u e = SumToRecUnionList u e--type SumToRecUnion u e = u (SumToRecUnionList u e)--type SumToRecUnionList :: forall k. ([k] -> k) -> k -> [k]-type family SumToRecUnionList u e where-    SumToRecUnionList Union Nop = '[]-    SumToRecUnionList Union (e + r) = e ': SumToRecUnionList Union r-    SumToRecUnionList Union e = '[e]-    SumToRecUnionList UnionH LNop = '[]-    SumToRecUnionList UnionH (e :+: r) = e ': SumToRecUnionList UnionH r-    SumToRecUnionList UnionH e = '[e]

@@ -29,12 +29,19 @@     tviewl, ) where +import Control.Category (Category ((.)), id)+import Prelude hiding ((.))+ {- | Non-empty tree. Deconstruction operations make it more and more left-leaning -} data FTCQueue m a b where     Leaf :: (a -> m b) -> FTCQueue m a b     Node :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b++instance (Applicative f) => Category (FTCQueue f) where+    id = Leaf pure+    (.) = flip Node  -- | Build a leaf from a single operation. [O(1)] tsingleton :: (a -> m b) -> FTCQueue m a b