heftia-effects 0.5.0.0 → 0.6.0.0

raw patch · 50 files changed

+873/−1544 lines, 50 filesdep −extradep −ghc-typelits-knownnatdep ~basedep ~data-effectsdep ~heftianew-component:exe:DatabaseProvidernew-component:exe:KeyTeletypePVP ok

version bump matches the API change (PVP)

Dependencies removed: extra, ghc-typelits-knownnat

Dependency ranges changed: base, data-effects, heftia, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Example/Continuation/Main.hs +12/−13
• Example/DatabaseProvider/Main.hs +92/−0
• Example/FileSystemProvider/Main.hs +0/−85
• Example/KeyTeletype/Main.hs +54/−0
• Example/KeyedEffects/Main.hs +0/−52
• Example/Logging/Main.hs +43/−53
• Example/NonDet/Main.hs +21/−20
• Example/SemanticsZoo/Main.hs +16/−21
• Example/ShiftReset/Main.hs +0/−114
• Example/Stream/Main.hs +7/−7
• Example/Subprocess/Main.hs +4/−14
• Example/Teletype/Main.hs +18/−21
• Example/UnliftIO/Main.hs +24/−23
• Example/Writer/Main.hs +4/−6
• README.md +88/−78
• bench/BenchCatch.hs +3/−3
• bench/BenchCoroutine.hs +4/−3
• bench/BenchCountdown.hs +7/−8
• bench/BenchLocal.hs +14/−13
• bench/BenchPyth.hs +15/−2
• bench/Main.hs +10/−6
• heftia-effects.cabal +24/−42
• src/Control/Monad/Hefty/CC.hs +31/−0
• src/Control/Monad/Hefty/Concurrent/Parallel.hs +7/−111
• src/Control/Monad/Hefty/Concurrent/Stream.hs +104/−102
• src/Control/Monad/Hefty/Concurrent/Subprocess.hs +17/−20
• src/Control/Monad/Hefty/Concurrent/Timer.hs +10/−39
• src/Control/Monad/Hefty/Coroutine.hs +7/−13
• src/Control/Monad/Hefty/Except.hs +18/−35
• src/Control/Monad/Hefty/Fail.hs +3/−15
• src/Control/Monad/Hefty/Fresh.hs +10/−10
• src/Control/Monad/Hefty/Input.hs +4/−17
• src/Control/Monad/Hefty/KVStore.hs +10/−23
• src/Control/Monad/Hefty/Log.hs +1/−18
• src/Control/Monad/Hefty/NonDet.hs +37/−115
• src/Control/Monad/Hefty/Output.hs +10/−23
• src/Control/Monad/Hefty/Provider.hs +2/−118
• src/Control/Monad/Hefty/Reader.hs +5/−45
• src/Control/Monad/Hefty/Resource.hs +0/−41
• src/Control/Monad/Hefty/Shift.hs +32/−0
• src/Control/Monad/Hefty/ShiftReset.hs +0/−66
• src/Control/Monad/Hefty/State.hs +15/−69
• src/Control/Monad/Hefty/Unlift.hs +12/−18
• src/Control/Monad/Hefty/Writer.hs +29/−37
• test/Test/Concurrent.hs +4/−4
• test/Test/Coroutine.hs +3/−3
• test/Test/Semantics.hs +14/−15
• test/Test/UnliftIO.hs +20/−0
• test/Test/Writer.hs +3/−3

@@ -35,3 +35,8 @@ * Renamed `Control.Monad.Hefty.Writer.listen` -> `intercept` * Reexported `Data.Effect.*` from the interpreters module `Control.Monad.Hefty.*`. * Generalized `runUnliftIO` to use any monad that is an instance of `MonadUnliftIO`.++## 0.6.0.0 -- 2025-04-16++* Introduced the new v4 interface.+    * Unified first-order and higher-order effect interfaces.

@@ -1,41 +1,40 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TemplateHaskell #-} --- 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/.+-- SPDX-License-Identifier: MPL-2.0  module Main where  import Control.Monad.Hefty (+    Eff,+    Effect,+    FOEs,     interposeBy,     interpret,-    interpretH,     liftIO,     makeEffectF,     makeEffectH,     runEff,     (&),-    type (:!!),-    type (<|),+    (:>),     type (~>),     type (~~>),  )  type ForkID = Int -data Fork a where-    Fork :: Fork ForkID-makeEffectF [''Fork]+data Fork :: Effect where+    Fork :: Fork f ForkID+makeEffectF ''Fork -runForkSingle :: eh :!! Fork ': r ~> eh :!! r+runForkSingle :: Eff (Fork ': es) ~> Eff es runForkSingle = interpret \Fork -> pure 0  data ResetFork f a where     ResetFork :: (Monoid w) => f w -> ResetFork f w-makeEffectH [''ResetFork]+makeEffectH ''ResetFork -applyResetFork :: (Fork <| r) => Int -> ResetFork ~~> '[] :!! r+applyResetFork :: (Fork :> es, FOEs es) => Int -> ResetFork ~~> Eff es applyResetFork numberOfFork (ResetFork m) =     m & interposeBy pure \Fork resume -> do         r <- mapM resume [1 .. numberOfFork]@@ -45,7 +44,7 @@ main =     runEff         . runForkSingle-        . interpretH (applyResetFork 4)+        . interpret (applyResetFork 4)         $ do             liftIO . putStrLn . (("[out of scope] " ++) . show) =<< fork             s <- resetFork do

@@ -0,0 +1,92 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TemplateHaskell #-}++-- SPDX-License-Identifier: MPL-2.0++module Main where++import Control.Monad.Hefty (+    Eff,+    Effect,+    Emb,+    Freer,+    interprets,+    liftIO,+    makeEffectF,+    makeEffectH,+    nil,+    runEff,+    (!:),+    type (:>),+    type (~>),+ )+import Control.Monad.Hefty.Provider (Provider, provide_, runProvider_)+import Data.Functor.Identity (Identity)++data DatabaseF :: Effect where+    ReadDB :: FilePath -> DatabaseF f String+    WriteDB :: FilePath -> String -> DatabaseF f ()++data DatabaseH :: Effect where+    TransactDB :: m a -> DatabaseH m a+makeEffectF ''DatabaseF+makeEffectH ''DatabaseH++type DBProvider es = Provider Freer Identity FilePath '[DatabaseH, DatabaseF] es++runDummyDBProvider :: (Emb IO :> es) => Eff (DBProvider es ': es) ~> Eff es+runDummyDBProvider =+    runProvider_ \workDir ->+        interprets $+            ( \(TransactDB m) -> do+                liftIO $ putStrLn $ "[DUMMY DB " <> workDir <> "] START TRANSACTION"+                r <- m+                liftIO $ putStrLn $ "[DUMMY DB " <> workDir <> "] END TRANSACTION"+                pure r+            )+                !: ( \case+                        ReadDB path -> do+                            liftIO $ putStrLn $ "[DUMMY DB " <> workDir <> "] readDB " <> show path+                            pure $ "DUMMY CONTENT on " <> workDir <> path+                        WriteDB path s -> do+                            liftIO $ putStrLn $ "[DUMMY DB " <> workDir <> "] writeDB " <> show path <> " " <> show s+                   )+                !: nil++main :: IO ()+main =+    runEff . runDummyDBProvider $+        provide_ "/db1" \_ -> do+            provide_ "/db2" \outer -> do+                outer do+                    s1 <- readDB "/a/b/c"+                    liftIO $ putStrLn $ "content: " <> show s1+                    writeDB "/d/e/f" "foobar"++                liftIO $ putStrLn "-----"++                s2 <- readDB "/a/b/c"+                liftIO $ putStrLn $ "content: " <> show s2+                writeDB "/d/e/f" "foobar"++                liftIO $ putStrLn "-----"++                transactDB do+                    outer $ transactDB do+                        liftIO $ print "hello"++{-+[DUMMY DB /db1] readDB "/a/b/c"+content: "DUMMY CONTENT on /db1/a/b/c"+[DUMMY DB /db1] writeDB "/d/e/f" "foobar"+-----+[DUMMY DB /db2] readDB "/a/b/c"+content: "DUMMY CONTENT on /db2/a/b/c"+[DUMMY DB /db2] writeDB "/d/e/f" "foobar"+-----+[DUMMY DB /db2] START TRANSACTION+[DUMMY DB /db1] START TRANSACTION+"hello"+[DUMMY DB /db1] END TRANSACTION+[DUMMY DB /db2] END TRANSACTION+-}

@@ -1,85 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}---- SPDX-License-Identifier: MPL-2.0--module Main where--import Control.Arrow ((>>>))-import Control.Monad.Hefty (-    Eff,-    Type,-    interpret,-    interpretH,-    liftIO,-    makeEffect,-    runEff,-    type (<|),-    type (~>),- )-import Control.Monad.Hefty.Provider (Provide_, runProvider_, scope_)--data FileSystemF a where-    ReadFS :: FilePath -> FileSystemF String-    WriteFS :: FilePath -> String -> FileSystemF ()--data FileSystemH m (a :: Type) where-    TransactFS :: m a -> FileSystemH m a-makeEffect [''FileSystemF] [''FileSystemH]--type FSProvider eh ef = Provide_ FilePath FileSystemH FileSystemF eh ef--runDummyFSProvider :: (IO <| ef) => Eff (FSProvider eh ef ': eh) ef ~> Eff eh ef-runDummyFSProvider =-    runProvider_ \workDir ->-        interpretH \case-            TransactFS m -> do-                liftIO $ putStrLn $ "[DUMMY FS " <> workDir <> "] START TRANSACTION"-                r <- m-                liftIO $ putStrLn $ "[DUMMY FS " <> workDir <> "] END TRANSACTION"-                pure r-            >>> interpret \case-                ReadFS path -> do-                    liftIO $ putStrLn $ "[DUMMY FS " <> workDir <> "] readFS " <> show path-                    pure $ "DUMMY CONTENT on " <> workDir <> path-                WriteFS path s -> do-                    liftIO $ putStrLn $ "[DUMMY FS " <> workDir <> "] writeFS " <> show path <> " " <> show s--main :: IO ()-main =-    runEff . runDummyFSProvider $-        scope_ @"fs1" "/fs1" \_ -> do-            scope_ @"fs2" "/fs2" \outer -> do-                outer do-                    s1 <- readFS'' @"fs1" "/a/b/c"-                    liftIO $ putStrLn $ "content: " <> show s1-                    writeFS'' @"fs1" "/d/e/f" "foobar"--                liftIO $ putStrLn "-----"--                s2 <- readFS'' @"fs2" "/a/b/c"-                liftIO $ putStrLn $ "content: " <> show s2-                writeFS'' @"fs2" "/d/e/f" "foobar"--                liftIO $ putStrLn "-----"--                transactFS'' @"fs2" do-                    outer $ transactFS'' @"fs1" do-                        liftIO $ print "hello"--{--[DUMMY FS /fs1] readFS "/a/b/c"-content: "DUMMY CONTENT on /fs1/a/b/c"-[DUMMY FS /fs1] writeFS "/d/e/f" "foobar"-------[DUMMY FS /fs2] readFS "/a/b/c"-content: "DUMMY CONTENT on /fs2/a/b/c"-[DUMMY FS /fs2] writeFS "/d/e/f" "foobar"-------[DUMMY FS /fs2] START TRANSACTION-[DUMMY FS /fs1] START TRANSACTION-"hello"-[DUMMY FS /fs1] END TRANSACTION-[DUMMY FS /fs2] END TRANSACTION--}

@@ -0,0 +1,54 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TemplateHaskell #-}++-- SPDX-License-Identifier: MPL-2.0++{- |+The original of this example can be found at polysemy.+<https://hackage.haskell.org/package/polysemy>+-}+module Main where++import Control.Monad.Hefty (+    Eff,+    Effect,+    Emb,+    Has,+    interposeOn,+    interpret,+    liftIO,+    makeEffectF,+    runEff,+    untag,+    (:>),+    type (~>),+ )++data Teletype :: Effect where+    ReadTTY :: Teletype f String+    WriteTTY :: String -> Teletype f ()++makeEffectF ''Teletype++teletypeToIO :: (Emb IO :> es) => Eff (Teletype ': es) ~> Eff es+teletypeToIO = interpret \case+    ReadTTY -> liftIO getLine+    WriteTTY msg -> liftIO $ putStrLn msg++echo :: (Has "tty1" Teletype es) => Eff es ()+echo = do+    i <- readTTY' @"tty1"+    case i of+        "" -> pure ()+        _ -> writeTTY' @"tty1" i >> echo++strong :: (Has "tty1" Teletype es) => Eff es ~> Eff es+strong =+    interposeOn @"tty1" \case+        ReadTTY -> readTTY' @"tty1"+        WriteTTY msg -> writeTTY' @"tty1" $ msg <> "!"++main :: IO ()+main = runEff do+    liftIO $ putStrLn "Please enter something..."+    teletypeToIO . untag @"tty1" . strong . strong $ echo

@@ -1,52 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE TemplateHaskell #-}---- 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/.--module Main where--import Control.Effect.Key (SendFOEBy)-import Control.Monad.Hefty (-    MemberBy,-    interpose,-    interpret,-    liftIO,-    makeEffectF,-    runEff,-    unkey,-    type (:!!),-    type (<|),-    type (~>),- )-import Data.Effect.Key (unKey, type (#>))--data Teletype a where-    ReadTTY :: Teletype String-    WriteTTY :: String -> Teletype ()--makeEffectF [''Teletype]--teletypeToIO :: (IO <| r) => eh :!! Teletype ': r ~> eh :!! r-teletypeToIO = interpret \case-    ReadTTY -> liftIO getLine-    WriteTTY msg -> liftIO $ putStrLn msg--echo :: (SendFOEBy "tty1" Teletype m, Monad m) => m ()-echo = do-    i <- readTTY'' @"tty1"-    case i of-        "" -> pure ()-        _ -> writeTTY'' @"tty1" i >> echo--strong :: (MemberBy "tty1" Teletype ef) => eh :!! ef ~> eh :!! ef-strong =-    interpose @("tty1" #> _) \e -> case unKey e of-        ReadTTY -> readTTY'' @"tty1"-        WriteTTY msg -> writeTTY'' @"tty1" $ msg <> "!"--main :: IO ()-main = runEff do-    liftIO $ putStrLn "Please enter something..."-    teletypeToIO . unkey @"tty1" . strong . strong $ echo

@@ -1,45 +1,35 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} --- 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/.+-- SPDX-License-Identifier: MPL-2.0  module Main where  import Control.Arrow ((>>>))+import Control.Effect.Transform (subsumeUnder) import Control.Monad (when) import Control.Monad.Hefty (-    Type,+    Eff,+    Effect,+    Emb,+    FOEs,     interpose,-    interposeH,     interpret,-    interpretH,     liftIO,     makeEffectF,     makeEffectH,     raise,-    raiseH,     raiseUnder,-    reinterpretH,+    reinterpret,     runEff,-    subsume,     (&),-    type (!!),-    type (+),-    type (:!!),-    type (<:),-    type (<<:),-    type (<<|),-    type (<|),+    type (:>),     type (~>),     type (~~>),  ) import Control.Monad.Hefty.Reader (runReader) import Control.Monad.Hefty.State (evalState)-import Control.Monad.IO.Class (MonadIO) import Data.Effect.Reader (Ask, Local, ask, local) import Data.Effect.State (get, modify) import Data.Text (Text)@@ -48,21 +38,21 @@ import Data.Time (UTCTime, getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime) -data Log a where-    Logging :: Text -> Log ()-makeEffectF [''Log]+data Log :: Effect where+    Logging :: Text -> Log f ()+makeEffectF ''Log -logToIO :: (IO <| r) => eh :!! Log ': r ~> eh :!! r+logToIO :: (Emb IO :> es) => Eff (Log ': es) ~> Eff es logToIO = interpret \(Logging msg) -> liftIO $ T.putStrLn msg -data Time a where-    CurrentTime :: Time UTCTime-makeEffectF [''Time]+data Time :: Effect where+    CurrentTime :: Time f UTCTime+makeEffectF ''Time -timeToIO :: (IO <| r) => eh :!! Time ': r ~> eh :!! r+timeToIO :: (Emb IO :> es) => Eff (Time ': es) ~> Eff es timeToIO = interpret \CurrentTime -> liftIO getCurrentTime -logWithTime :: (Log <| ef, Time <| ef) => eh :!! ef ~> eh :!! ef+logWithTime :: (Log :> es, Time :> es) => Eff es ~> Eff es logWithTime = interpose \(Logging msg) -> do     t <- currentTime     logging $ "[" <> iso8601 t <> "] " <> msg@@ -71,25 +61,25 @@ iso8601 t = T.take 23 (T.pack $ formatTime defaultTimeLocale "%FT%T.%q" t) <> "Z"  -- | An effect that introduces a scope that represents a chunk of logs.-data LogChunk f (a :: Type) where+data LogChunk :: Effect where     LogChunk         :: Text         -- ^ chunk name         -> f a         -> LogChunk f a -makeEffectH [''LogChunk]+makeEffectH ''LogChunk  -- | Ignore chunk names and output logs in log chunks as they are.-runLogChunk :: LogChunk ': eh :!! ef ~> eh :!! ef-runLogChunk = interpretH \(LogChunk _ m) -> m+runLogChunk :: Eff (LogChunk ': es) ~> Eff es+runLogChunk = interpret \(LogChunk _ m) -> m -data FileSystem a where-    Mkdir :: FilePath -> FileSystem ()-    WriteToFile :: FilePath -> Text -> FileSystem ()-makeEffectF [''FileSystem]+data FileSystem :: Effect where+    Mkdir :: FilePath -> FileSystem f ()+    WriteToFile :: FilePath -> Text -> FileSystem f ()+makeEffectF ''FileSystem -runDummyFS :: (IO <| r) => eh :!! FileSystem ': r ~> eh :!! r+runDummyFS :: (Emb IO :> es) => Eff (FileSystem ': es) ~> Eff es runDummyFS = interpret \case     Mkdir path ->         liftIO $ putStrLn $ "<runDummyFS> mkdir " <> path@@ -98,22 +88,22 @@  -- | Create directories according to the log-chunk structure and save one log in one file. saveLogChunk-    :: forall eh ef-     . (LogChunk <<| eh, Log <| ef, FileSystem <| ef, Time <| ef)-    => eh :!! ef ~> eh :!! ef+    :: forall es+     . (LogChunk :> es, Log :> es, FileSystem :> es, Time :> es)+    => Eff es ~> Eff es saveLogChunk =     raise-        >>> raiseH+        >>> raise         >>> hookCreateDirectory         >>> hookWriteFile         >>> runReader @FilePath "./log/"   where     hookCreateDirectory         , hookWriteFile-            :: (Local FilePath ': eh :!! Ask FilePath ': ef)-                ~> (Local FilePath ': eh :!! Ask FilePath ': ef)+            :: Eff (Local FilePath ': Ask FilePath ': es)+                ~> Eff (Local FilePath ': Ask FilePath ': es)     hookCreateDirectory =-        interposeH \(LogChunk chunkName a) -> logChunk chunkName do+        interpose \(LogChunk chunkName a) -> logChunk chunkName do             chunkBeginAt <- currentTime             let dirName = T.unpack $ iso8601 chunkBeginAt <> "-" <> chunkName             local @FilePath (++ dirName ++ "/") do@@ -129,15 +119,15 @@             logging msg  -- | Limit the number of logs in a log chunk to the first @n@ logs.-limitLogChunk :: (Log <| ef) => Int -> '[LogChunk] :!! Log ': ef ~> '[LogChunk] :!! Log ': ef-limitLogChunk n = reinterpretH $ elabLimitLogChunk n+limitLogChunk :: forall es. (Log :> es, FOEs es) => Int -> Eff (LogChunk ': Log ': es) ~> Eff (LogChunk ': Log ': es)+limitLogChunk n = reinterpret $ handleLimitLogChunk n -elabLimitLogChunk :: (Log <| ef) => Int -> LogChunk ~~> '[LogChunk] :!! Log ': ef-elabLimitLogChunk n (LogChunk name a) =+handleLimitLogChunk :: (Log :> es, FOEs es) => Int -> LogChunk ~~> Eff (LogChunk ': Log ': es)+handleLimitLogChunk n (LogChunk name a) =     logChunk name do-        raise . raiseH $ limitLog $ runLogChunk $ limitLogChunk n a+        raise . raise $ limitLog $ runLogChunk $ limitLogChunk n a   where-    limitLog :: (Log <| ef) => '[] :!! Log ': ef ~> '[] :!! ef+    limitLog :: (Log :> es, FOEs es) => Eff (Log ': es) ~> Eff es     limitLog a' =         evalState @Int 0 $             raiseUnder a' & interpret \(Logging msg) -> do@@ -149,7 +139,7 @@                      modify @Int (+ 1) -logExample :: (LogChunk <<: m, Log <: m, MonadIO m) => m ()+logExample :: (LogChunk :> es, Log :> es, Emb IO :> es) => Eff es () logExample = do     logging "out of chunk scope 1"     logging "out of chunk scope 2"@@ -182,18 +172,18 @@     logExample         & saveLogChunk         & limitLogChunk 2-        & subsume @Log+        & subsumeUnder         & runApp  limitThenSave :: IO () limitThenSave =     logExample         & limitLogChunk 2-        & subsume @Log+        & subsumeUnder         & saveLogChunk         & runApp -runApp :: LogChunk !! FileSystem + Time + Log + IO ~> IO+runApp :: Eff '[LogChunk, FileSystem, Time, Log, Emb IO] ~> IO runApp =     runLogChunk         >>> runDummyFS

@@ -1,7 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}  -- SPDX-License-Identifier: MPL-2.0 @@ -9,16 +8,18 @@  import Control.Monad.Hefty (     Eff,+    Effect,+    Emb,+    In,     interpret,     liftIO,     makeEffectF,     runEff,     (&),-    type (<:),-    type (<|),+    type (:>),     type (~>),  )-import Control.Monad.Hefty.Except (Throw, joinEither, runThrowIO, throw)+import Control.Monad.Hefty.Except (Throw, joinEither, runThrowIO, throw'_) import Control.Monad.Hefty.NonDet (Choose, Empty, choice, runNonDetMonoid) import Data.Function (fix) import Data.Functor ((<&>))@@ -29,9 +30,9 @@ import UnliftIO (Exception)  -- | 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)  -- | Exception for when a directory was expected but found a file data NotAFile = NotAFile@@ -41,7 +42,7 @@     deriving (Show)     deriving anyclass (Exception) -makeEffectF [''FileSystem]+makeEffectF ''FileSystem  -- | Exception for when an entry does not exist at the specified path data EntryNotFound = EntryNotFound@@ -49,11 +50,11 @@     deriving anyclass (Exception)  -- | 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     entity :: FilePath <- choice entities -- Non-deterministically /pick/ one item from the list     let path' = path </> entity@@ -65,7 +66,7 @@             liftIO $ putStrLn $ " ... " <> show size <> " bytes"             pure $ Sum size         Left NotAFile -> do-            totalFileSize path'+            fileSizes path'  main :: IO () main = runEff@@ -73,7 +74,7 @@     . runThrowIO @NotADir     . runDummyFS exampleRoot     $ do-        total <- runNonDetMonoid pure (totalFileSize ".")+        total <- runNonDetMonoid pure (fileSizes ".")         liftIO $ print total  {-@@ -129,9 +130,9 @@ 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@@ -144,10 +145,10 @@  -- | Lookup the directory structure by path lookupFS-    :: (Throw EntryNotFound <: m, Throw NotADir <: m, Monad m)+    :: (Throw EntryNotFound `In` es, Throw NotADir `In` es)     => FilePath     -> FSTree-    -> m FSTree+    -> Eff es FSTree lookupFS path =     splitDirectories path & fix \dive -> \case         [] -> pure@@ -155,5 +156,5 @@             Dir currentDir -> do                 case currentDir Map.!? dirName of                     Just restTree -> dive restPath restTree-                    Nothing -> throw EntryNotFound-            File _ -> throw NotADir+                    Nothing -> throw'_ EntryNotFound+            File _ -> throw'_ NotADir

@@ -1,9 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TemplateHaskell #-} --- 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/.+-- SPDX-License-Identifier: MPL-2.0  {- | [lexi-lambda's semantics-zoo.md](https://github.com/lexi-lambda/eff/blob/master/notes/semantics-zoo.md).@@ -14,13 +12,12 @@  import Control.Applicative ((<|>)) import Control.Monad.Hefty (+    Eff,+    Effect,     interpret,     makeEffectF,     runPure,-    type ($),-    type (:!!),-    type (<<|),-    type (<|),+    type (:>),     type (~>),  ) import Control.Monad.Hefty.Except (runCatch, runThrow)@@ -36,7 +33,7 @@  statePlusExcept :: IO () statePlusExcept = do-    let action :: (State Bool <| ef, Throw () <| ef, Catch () <<| eh) => (eh :!! ef) Bool+    let action :: (State Bool :> es, Throw () :> es, Catch () :> es) => Eff es Bool         action = do             (put True *> throw ()) `catch` \() -> pure ()             get@@ -48,16 +45,14 @@  nonDetPlusExcept :: IO () nonDetPlusExcept = do-    let action1-            , action2-                :: (Empty <| ef, ChooseH <<| eh, Throw () <| ef, Catch () <<| eh) => eh :!! ef $ Bool+    let action1, action2 :: (Empty :> es, ChooseH :> es, Throw () :> es, Catch () :> es) => Eff es Bool         action1 = (pure True <|> throw ()) `catch` \() -> pure False         action2 = (throw () <|> pure True) `catch` \() -> pure False          testAllPattern-            :: ( forall eh ef-                  . (Empty <| ef, ChooseH <<| eh, Throw () <| ef, Catch () <<| eh)-                 => (eh :!! ef) Bool+            :: ( forall es+                  . (Empty :> es, ChooseH :> es, Throw () :> es, Catch () :> es)+                 => Eff es Bool                )             -> String             -> IO ()@@ -78,8 +73,8 @@ nonDetPlusWriter :: IO () nonDetPlusWriter = do     let action-            :: (Empty <| ef, ChooseH <<| eh, Tell (Sum Int) <| ef, WriterH (Sum Int) <<| eh)-            => eh :!! ef $ (Sum Int, Bool)+            :: (Empty :> es, ChooseH :> es, Tell (Sum Int) :> es, WriterH (Sum Int) :> es)+            => Eff es (Sum Int, Bool)         action = listen $ add 1 *> (add 2 $> True <|> add 3 $> False)           where             add = tell . Sum @Int@@ -94,16 +89,16 @@         runTell @(Sum Int) . runNonDet @[] . runWriterHPre @(Sum Int) . runChooseH $             action -data SomeEff a where-    SomeAction :: SomeEff String-makeEffectF [''SomeEff]+data SomeEff :: Effect where+    SomeAction :: SomeEff f String+makeEffectF ''SomeEff  theIssue12 :: IO () theIssue12 = do-    let action :: (Catch String <<| eh, Throw String <| ef, SomeEff <| ef) => eh :!! ef $ String+    let action :: (Catch String :> es, SomeEff :> es) => Eff es String         action = someAction `catch` \(_ :: String) -> pure "caught" -        runSomeEff :: (Throw String <| ef) => eh :!! SomeEff ': ef ~> eh :!! ef+        runSomeEff :: (Throw String :> es) => Eff (SomeEff ': es) ~> Eff es         runSomeEff = interpret \SomeAction -> throw "not caught"      putStr "interpret SomeEff then runCatch : ( runThrow . runCatch . runSomeEff $ action ) = "

@@ -1,114 +0,0 @@--- 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/.--module Main where--import Control.Effect.Key (key)-import Control.Monad.Extra (whenM)-import Control.Monad.Hefty (-    Eff,-    liftIO,-    raiseH,-    runEff,-    send,-    sendN,-    unkey,-    (&),-    type (!!),-    type ($),-    type (+),-    type (:+:),- )-import Control.Monad.Hefty.Reader (runReader)-import Control.Monad.Hefty.ShiftReset (Shift, ShiftEff (ShiftEff), evalShift, runShift_)-import Control.Monad.Hefty.State (evalState)-import Data.Effect.Key (type (#>))-import Data.Effect.Reader (Ask, Local, ask, local)-import Data.Effect.ShiftReset (Shift_, getCC, getCC_)-import Data.Effect.State (State, get'', modify)-import Data.Functor ((<&>))--main :: IO ()-main = do-    putStrLn "[handleReaderThenShift]"-    handleReaderThenShift--    putStrLn ""-    putStrLn "[handleShiftThenReader]"-    handleShiftThenReader--{--===== result =====--[handleReaderThenShift]-[local scope outer] env = 1-[local scope inner] env = 2-[local scope outer] env = 1-[local scope inner] env = 2-[local scope outer] env = 1-[local scope inner] env = 2-[local scope outer] env = 1-[local scope inner] env = 2-[local scope outer] env = 1-[local scope inner] env = 2-[local scope outer] env = 1--[handleShiftThenReader]-[local scope outer] env = 1-[local scope inner] env = 2-[local scope outer] env = 2-[local scope inner] env = 4-[local scope outer] env = 4-[local scope inner] env = 8-[local scope outer] env = 8-[local scope inner] env = 16-[local scope outer] env = 16-[local scope inner] env = 32-[local scope outer] env = 32--}--handleReaderThenShift :: IO ()-handleReaderThenShift =-    prog-        & runReader 1-        & runEff-        & evalShift-        & (evalState 0 . unkey)-        & runEff-  where-    prog-        :: (r ~ '["counter" #> State Int, IO])-        => Eff '[Local Int] '[Ask Int, Eff '[Shift () '[] r] r] ()-    prog = do-        ShiftEff k <- sendN @1 $ getCC-        env <- ask @Int-        sendN @1 $ liftIO $ putStrLn $ "[local scope outer] env = " ++ show env-        local @Int (* 2) do-            whenM (sendN @1 (get'' @"counter") <&> (< 5)) do-                sendN @1 $ modify (+ 1) & key @"counter"-                env' <- ask @Int-                sendN @1 $ liftIO $ putStrLn $ "[local scope inner] env = " ++ show env'-                send k--handleShiftThenReader :: IO ()-handleShiftThenReader = do-    prog-        & runShift_-        & runReader 1-        & (evalState 0 . unkey)-        & runEff-  where-    prog-        :: (r ~ (Ask Int + "counter" #> State Int + IO))-        => Shift_ (Local Int !! r) :+: Local Int !! r $ ()-    prog = do-        k <- getCC_-        env <- ask @Int-        liftIO $ putStrLn $ "[local scope outer] env = " ++ show env-        local @Int (* 2) do-            whenM (get'' @"counter" <&> (< 5)) do-                modify (+ 1) & key @"counter"-                env' <- ask @Int-                liftIO $ putStrLn $ "[local scope inner] env = " ++ show env'-                raiseH k

@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}+{-# OPTIONS_GHC -fconstraint-solver-iterations=16 #-}  -- SPDX-License-Identifier: MPL-2.0 @@ -7,7 +7,7 @@  import Control.Arrow ((>>>)) import Control.Monad (forever, void, when)-import Control.Monad.Hefty (Eff, liftIO, raiseAllH, type (<:), type (<|))+import Control.Monad.Hefty (Eff, Emb, FOEs, liftIO, onlyFOEs, type (:>)) import Control.Monad.Hefty.Concurrent.Parallel (runParallelIO) import Control.Monad.Hefty.Concurrent.Stream (     Input,@@ -21,7 +21,6 @@ import Control.Monad.Hefty.Concurrent.Timer (Timer, runTimerIO, sleep) import Control.Monad.Hefty.Except (runThrow, throw) import Control.Monad.Hefty.Unlift (runUnliftIO)-import Control.Monad.IO.Class (MonadIO) import Data.Foldable (for_) import UnliftIO (bracket_) @@ -38,19 +37,19 @@         sleep 0.5 @ -}-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 ()         output i         sleep 0.5 -consume :: (Input Int <: m, Timer <: m, MonadIO m) => m ()+consume :: (Input Int :> es, Timer :> es, Emb IO :> es) => Eff es () consume = forever do     liftIO . print =<< input @Int     sleep 0.5 -plus100 :: (Input Int <: m, Output Int <: m, Timer <: m, MonadIO m) => m ()+plus100 :: (Input Int :> es, Output Int :> es, Timer :> es, Emb IO :> es) => Eff es () plus100 = forever do     i <- input @Int     let o = i + 100@@ -84,7 +83,7 @@             bracket_                 (liftIO $ putStrLn "Acquiring resource")                 (liftIO $ putStrLn "Releasing resource")-                (raiseAllH produce)+                (onlyFOEs produce)      runMachineryIO_ $         Unit @() @Int do@@ -94,6 +93,7 @@             >>> Unit @Int @() consume  {-+[Parallel effect-based (purer & non-IO-fused) machinery interpretation example] Transform 1 to 101 101 Transform 2 to 102

@@ -3,23 +3,13 @@ module Main where  import Control.Monad.Hefty (liftIO, (&))-import Control.Monad.Hefty.Concurrent.Subprocess (-    CreateProcess (stdout),-    StdStream (CreatePipe),-    SubprocResult,-    readStdout'',-    runSubprocIO,-    scope,-    shell,- )+import Control.Monad.Hefty.Concurrent.Subprocess (CreateProcess (stdout), StdStream (CreatePipe), SubprocResult, readStdout, runSubprocIO, scoped, shell) import Control.Monad.Hefty.Unlift (runUnliftIO)  main :: IO () main = runUnliftIO . runSubprocIO $ do-    r <- scope @"echo" @SubprocResult (shell "echo a b c") {stdout = CreatePipe} \_ -> do-        readStdout'' @"echo"+    r <- scoped @SubprocResult (shell "echo a b c") {stdout = CreatePipe} \_ -> do+        readStdout     print r & liftIO -{--SubprocScopeResult ExitSuccess "a b c\n"--}+-- SubprocScopeResult ExitSuccess "a b c\n"

@@ -1,9 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TemplateHaskell #-} --- 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/.+-- SPDX-License-Identifier: MPL-2.0  {- | The original of this example can be found at polysemy.@@ -12,44 +10,43 @@ module Main where  import Control.Monad.Hefty (+    Eff,+    Effect,+    Emb,     interpose,     interpret,     liftIO,     makeEffectF,     runEff,-    untag,-    type (:!!),-    type (<:),-    type (<|),+    (:>),     type (~>),  )-import Data.Effect.Tag (Tag (unTag), type (#)) -data Teletype a where-    ReadTTY :: Teletype String-    WriteTTY :: String -> Teletype ()+data Teletype :: Effect where+    ReadTTY :: Teletype f String+    WriteTTY :: String -> Teletype f () -makeEffectF [''Teletype]+makeEffectF ''Teletype -teletypeToIO :: (IO <| r) => eh :!! Teletype ': r ~> eh :!! r+teletypeToIO :: (Emb IO :> es) => Eff (Teletype ': es) ~> Eff es teletypeToIO = interpret \case     ReadTTY -> liftIO getLine     WriteTTY msg -> liftIO $ putStrLn msg -echo :: (Teletype # "tty1" <: m, Monad m) => m ()+echo :: (Teletype :> es) => Eff es () echo = do-    i <- readTTY' @"tty1"+    i <- readTTY     case i of         "" -> pure ()-        _ -> writeTTY' @"tty1" i >> echo+        _ -> writeTTY i >> echo -strong :: (Teletype # "tty1" <| ef) => eh :!! ef ~> eh :!! ef+strong :: (Teletype :> es) => Eff es ~> Eff es strong =-    interpose @(_ # "tty1") \e -> case unTag e of-        ReadTTY -> readTTY' @"tty1"-        WriteTTY msg -> writeTTY' @"tty1" $ msg <> "!"+    interpose \case+        ReadTTY -> readTTY+        WriteTTY msg -> writeTTY $ msg <> "!"  main :: IO () main = runEff do     liftIO $ putStrLn "Please enter something..."-    teletypeToIO . untag @"tty1" . strong . strong $ echo+    teletypeToIO . strong . strong $ echo

@@ -1,61 +1,62 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}  -- SPDX-License-Identifier: MPL-2.0  module Main where  import Control.Applicative ((<|>))-import Control.Arrow ((>>>)) import Control.Monad.Hefty (     Eff,+    Effect,+    Emb,     Type,-    interpret,-    interpretH,+    UnliftIO,+    interprets,     liftIO,     makeEffectF,     makeEffectH,-    raiseAllH,-    type (<<|),-    type (<|),+    nil,+    onlyFOEs,+    (!:),+    type (:>),     type (~>),  )-import Control.Monad.Hefty.Coroutine (Status (Continue, Done), runCoroutine, yield_)+import Control.Monad.Hefty.Coroutine (Status (Continue, Done), runCoroutine, yield) import Control.Monad.Hefty.NonDet (runChooseH, runNonDetMonoid)-import Control.Monad.Hefty.Resource (runResourceIO) import Control.Monad.Hefty.Unlift (runUnliftIO)-import Data.Effect.Resource (Resource, bracket_)+import UnliftIO (bracket_) -data DBF (a :: Type) where-    InsertDB :: Int -> DBF ()-makeEffectF [''DBF]+data DBF :: Effect where+    InsertDB :: Int -> DBF f ()+makeEffectF ''DBF  data DBH m (a :: Type) where     Transact :: m a -> DBH m a-makeEffectH [''DBH]+makeEffectH ''DBH -runDummyDB :: (Resource <<| eh, IO <| ef) => Eff (DBH ': eh) (DBF ': ef) ~> Eff eh ef+runDummyDB :: (UnliftIO :> es, Emb IO :> es) => Eff (DBH ': DBF ': es) ~> Eff es runDummyDB =-    interpretH \case-        Transact m ->+    interprets $+        ( \(Transact m) ->             bracket_                 (liftIO $ putStrLn "[DummyDB] Start transaction.")                 (liftIO $ putStrLn "[DummyDB] End transaction.")                 m-        >>> interpret \case-            InsertDB x -> liftIO $ putStrLn $ "[DummyDB] insertDB " <> show x+        )+            !: (\(InsertDB x) -> liftIO $ putStrLn $ "[DummyDB] insertDB " <> show x)+            !: nil  main :: IO () main =-    runUnliftIO . runResourceIO . runDummyDB $ do+    runUnliftIO . runDummyDB $ do         insertDB 42          transact do             insertDB 123             insertDB 456 -            raiseAllH do+            onlyFOEs do                 -- Even within the scope of UnliftIO, you can combine                 -- non-deterministic computations...                 runNonDetMonoid (const $ pure ()) . runChooseH $ do@@ -64,7 +65,7 @@                 -- ...or even use coroutines.                 do                     status <- runCoroutine do-                        yield_ @Int $ -10+                        yield $ -10                         insertDB $ -20                      case status of@@ -74,7 +75,7 @@                             insertDB x                             pure () -                -- Note that UnliftIO is disabled within the scope of 'raiseAllH'.+                -- Note that UnliftIO is disabled within the scope of 'onlyFOEs'.                 -- Fitst-order 'IO' operations are still possible.                 liftIO $ putStrLn "The transaction is being finalized..." 

@@ -1,19 +1,17 @@--- 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/.+-- SPDX-License-Identifier: MPL-2.0  module Main where -import Control.Monad.Hefty (liftIO, runEff, type (<:), type (<<:))+import Control.Monad.Hefty (Eff, liftIO, runEff, type (:>)) import Control.Monad.Hefty.Writer (runTell, runWriterHPost, runWriterHPre) import Data.Effect.Writer (Tell, WriterH, censor, tell) -hello :: (Tell String <: m, Monad m) => m ()+hello :: (Tell String :> es) => Eff es () hello = do     tell "Hello"     tell " world!" -censorHello :: (Tell String <: m, WriterH String <<: m, Monad m) => m ()+censorHello :: (Tell String :> es, WriterH String :> es) => Eff es () censorHello =     censor         ( \s ->

@@ -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,5 +1,5 @@ -- SPDX-License-Identifier: BSD-3-Clause--- (c) 2022 Xy Ren; 2024 Sayo Koyoneda+-- (c) 2022 Xy Ren; 2024 Sayo contributors  -- Benchmarking higher-order effects #1: Catching errors @@ -21,7 +21,7 @@ import Polysemy.Reader qualified as P import "eff" Control.Effect qualified as E -programHeftia :: (H.Member (H.Throw ()) ef, H.MemberH (H.Catch ()) eh) => Int -> H.Eff eh ef a+programHeftia :: (H.Throw () H.:> es, H.Catch () H.:> es) => Int -> H.Eff es a programHeftia = \case     0 -> H.throw ()     n -> H.catch (programHeftia (n - 1)) \() -> H.throw ()@@ -38,7 +38,7 @@ catchHeftiaDeep4 n = H.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runThrow $ hrun $ H.runCatch @() $ hrun $ hrun $ hrun $ hrun $ programHeftia n catchHeftiaDeep5 n = H.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runThrow $ H.runCatch @() $ hrun $ hrun $ hrun $ hrun $ hrun $ programHeftia n -hrun :: H.Eff eh (H.Ask () ': ef) a -> H.Eff eh ef a+hrun :: H.Eff (H.Ask () ': es) a -> H.Eff es a hrun = H.runAsk ()  programSem :: (P.Error () `P.Member` es) => Int -> P.Sem es a

@@ -1,5 +1,5 @@ -- SPDX-License-Identifier: BSD-3-Clause--- (c) 2022 Xy Ren; 2024 Sayo Koyoneda+-- (c) 2022 Xy Ren; 2024 Sayo contributors  module BenchCoroutine where @@ -33,12 +33,12 @@   where     run = FS.runReader () -programHeftia :: (H.Member (H.Yield Int Int) es) => Int -> H.Eff '[] es [Int]+programHeftia :: (H.Yield Int Int H.:> es) => Int -> H.Eff es [Int] programHeftia upbound =     forM [1 .. upbound] H.yield {-# NOINLINE programHeftia #-} -loopStatusHeftia :: H.Status (H.Eff '[] ef) Int Int r -> H.Eff '[] ef r+loopStatusHeftia :: H.Status (H.Eff es) Int Int r -> H.Eff es r loopStatusHeftia = \case     H.Done r -> pure r     H.Continue i f -> loopStatusHeftia =<< f (i + 100)@@ -50,6 +50,7 @@ coroutineHeftiaDeep :: Int -> [Int] coroutineHeftiaDeep n = H.runPure $ run $ run $ run $ run $ run $ loopStatusHeftia =<< H.runCoroutine (run $ run $ run $ run $ run $ programHeftia n)   where+    run :: H.Eff (H.Ask () ': es) a -> H.Eff es a     run = H.runAsk ()  programEff :: (E.Coroutine Int Int E.:< es) => Int -> E.Eff es [Int]

@@ -1,5 +1,5 @@ -- SPDX-License-Identifier: BSD-3-Clause--- (c) 2022 Xy Ren; 2024 Sayo Koyoneda+-- (c) 2022 Xy Ren; 2024 Sayo contributors  -- Benchmarking effect invocation and monadic bind module BenchCountdown where@@ -25,7 +25,7 @@ import Polysemy.State qualified as P import "eff" Control.Effect qualified as EF -programHeftia :: (H.Member (H.State Int) es) => H.Eff '[] es Int+programHeftia :: (H.State Int H.:> es) => H.Eff es Int programHeftia = do     x <- H.get @Int     if x == 0@@ -39,17 +39,16 @@ countdownHeftia n = H.runPure $ H.runState n programHeftia  countdownHeftiaDeep :: Int -> (Int, Int)-countdownHeftiaDeep n = H.runPure $ runR $ runR $ runR $ runR $ runR $ H.runState n $ runR $ runR $ runR $ runR $ runR $ programHeftia-  where-    runR = H.runAsk ()+countdownHeftiaDeep n = H.runPure $ hrunR $ hrunR $ hrunR $ hrunR $ hrunR $ H.runState n $ hrunR $ hrunR $ hrunR $ hrunR $ hrunR $ programHeftia  countdownHeftiaNaive :: Int -> (Int, Int) countdownHeftiaNaive n = H.runPure $ H.runStateNaive n programHeftia  countdownHeftiaNaiveDeep :: Int -> (Int, Int)-countdownHeftiaNaiveDeep n = H.runPure $ runR $ runR $ runR $ runR $ runR $ H.runStateNaive n $ runR $ runR $ runR $ runR $ runR $ programHeftia-  where-    runR = H.runAsk ()+countdownHeftiaNaiveDeep n = H.runPure $ hrunR $ hrunR $ hrunR $ hrunR $ hrunR $ H.runStateNaive n $ hrunR $ hrunR $ hrunR $ hrunR $ hrunR $ programHeftia++hrunR :: H.Eff (H.Ask () ': es) a -> H.Eff es a+hrunR = H.runAsk ()  programFreer :: (FS.Member (FS.State Int) es) => FS.Eff es Int programFreer = do

@@ -1,5 +1,5 @@ -- SPDX-License-Identifier: BSD-3-Clause--- (c) 2022 Xy Ren; 2024 Sayo Koyoneda+-- (c) 2022 Xy Ren; 2024 Sayo contributors  -- Benchmarking higher-order effects #2: Local environments @@ -7,31 +7,32 @@  import Control.Carrier.Reader qualified as F import Control.Monad.Hefty qualified as H-import Control.Monad.Hefty.Reader qualified as H+import Data.Effect.Reader qualified as H import Effectful qualified as EL import Effectful.Reader.Dynamic qualified as EL import Polysemy qualified as P import Polysemy.Reader qualified as P+import "data-effects" Control.Effect.Interpret qualified as HD import "eff" Control.Effect qualified as E -programHeftia :: (H.Member (H.Ask Int) ef, H.MemberH (H.Local Int) eh) => Int -> H.Eff eh ef Int+programHeftia :: (H.Ask Int `H.In` es, H.Local Int `H.In` es) => Int -> H.Eff es Int programHeftia = \case-    0 -> H.ask-    n -> H.local @Int (+ 1) (programHeftia (n - 1))+    0 -> H.ask'_+    n -> H.local'_ @Int (+ 1) (programHeftia (n - 1)) {-# NOINLINE programHeftia #-}  localHeftia :: Int -> Int-localHeftia n = H.runPure $ H.runAsk @Int 0 $ H.runLocal @Int $ programHeftia n+localHeftia n = HD.runPure $ H.runAsk @Int 0 $ H.runLocal @Int $ programHeftia n  localHeftiaDeep0, localHeftiaDeep1, localHeftiaDeep2, localHeftiaDeep3, localHeftiaDeep4, localHeftiaDeep5 :: Int -> Int-localHeftiaDeep0 n = H.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runLocal @Int $ programHeftia n-localHeftiaDeep1 n = H.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ hrun $ hrun $ hrun $ hrun $ H.runLocal @Int $ hrun $ programHeftia n-localHeftiaDeep2 n = H.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ hrun $ hrun $ hrun $ H.runLocal @Int $ hrun $ hrun $ programHeftia n-localHeftiaDeep3 n = H.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ hrun $ hrun $ H.runLocal @Int $ hrun $ hrun $ hrun $ programHeftia n-localHeftiaDeep4 n = H.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ hrun $ H.runLocal @Int $ hrun $ hrun $ hrun $ hrun $ programHeftia n-localHeftiaDeep5 n = H.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ H.runLocal @Int $ hrun $ hrun $ hrun $ hrun $ hrun $ programHeftia n+localHeftiaDeep0 n = HD.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runLocal @Int $ programHeftia n+localHeftiaDeep1 n = HD.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ hrun $ hrun $ hrun $ hrun $ H.runLocal @Int $ hrun $ programHeftia n+localHeftiaDeep2 n = HD.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ hrun $ hrun $ hrun $ H.runLocal @Int $ hrun $ hrun $ programHeftia n+localHeftiaDeep3 n = HD.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ hrun $ hrun $ H.runLocal @Int $ hrun $ hrun $ hrun $ programHeftia n+localHeftiaDeep4 n = HD.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ hrun $ H.runLocal @Int $ hrun $ hrun $ hrun $ hrun $ programHeftia n+localHeftiaDeep5 n = HD.runPure $ hrun $ hrun $ hrun $ hrun $ hrun $ H.runAsk @Int 0 $ H.runLocal @Int $ hrun $ hrun $ hrun $ hrun $ hrun $ programHeftia n -hrun :: H.Eff eh (H.Ask () ': ef) a -> H.Eff eh ef a+hrun :: H.Eff (H.Ask () ': es) a -> H.Eff es a hrun = H.runAsk ()  programSem :: (P.Reader Int `P.Member` es) => Int -> P.Sem es Int

@@ -1,5 +1,5 @@ -- SPDX-License-Identifier: BSD-3-Clause--- (c) 2022 Xy Ren; 2024 Sayo Koyoneda+-- (c) 2022 Xy Ren; 2024 Sayo contributors  -- Benchmarking yield-intensive code module BenchPyth where@@ -17,11 +17,13 @@ import Control.Monad.Hefty qualified as H import Control.Monad.Hefty.NonDet qualified as H import Control.Monad.Hefty.Reader qualified as H+import Control.Monad.Hefty.Shift qualified as H import Control.Monad.Identity qualified as M import Control.Monad.Logic qualified as M import Control.Monad.Reader qualified as M import Control.Mp.Eff qualified as Mp import Control.Mp.Util qualified as Mp+import Data.List (singleton) import "eff" Control.Effect qualified as EF  programFreer :: (FS.Member FS.NonDet es) => Int -> FS.Eff es (Int, Int, Int)@@ -43,13 +45,14 @@   where     run = FS.runReader () -programHeftia :: (H.Member H.Choose es, H.Member H.Empty es) => Int -> H.Eff '[] es (Int, Int, Int)+programHeftia :: (H.Choose H.:> es, H.Empty H.:> es) => Int -> H.Eff es (Int, Int, Int) programHeftia upbound = do     x <- choice upbound     y <- choice upbound     z <- choice upbound     if x * x + y * y == z * z then return (x, y, z) else H.empty   where+    choice :: (H.Choose H.:> es, H.Empty H.:> es) => Int -> H.Eff es Int     choice 0 = H.empty     choice n = choice (n - 1) `H.branch` pure n {-# NOINLINE programHeftia #-}@@ -60,6 +63,16 @@ pythHeftiaDeep :: Int -> [(Int, Int, Int)] pythHeftiaDeep n = H.runPure $ run $ run $ run $ run $ run $ H.runNonDet $ run $ run $ run $ run $ run $ programHeftia n   where+    run :: H.Eff (H.Ask () ': es) a -> H.Eff es a+    run = H.runAsk ()++pythHeftiaShift :: Int -> [(Int, Int, Int)]+pythHeftiaShift n = H.runPure $ H.evalShift $ H.runNonDetShift $ singleton <$> programHeftia n++pythHeftiaShiftDeep :: Int -> [(Int, Int, Int)]+pythHeftiaShiftDeep n = H.runPure $ H.evalShift $ run $ run $ run $ run $ run $ H.runNonDetShift $ run $ run $ run $ run $ run $ singleton <$> programHeftia n+  where+    run :: H.Eff (H.Ask () ': es) a -> H.Eff es a     run = H.runAsk ()  programFused :: (Monad m, Alternative m) => Int -> m (Int, Int, Int)

@@ -1,5 +1,5 @@ -- SPDX-License-Identifier: BSD-3-Clause--- (c) 2022 Xy Ren; 2024 Sayo Koyoneda+-- (c) 2022 Xy Ren; 2024 Sayo contributors  module Main where @@ -19,7 +19,8 @@                 bgroup                     (show x)                     [ bench "heftia" $ nf countdownHeftia x-                    , bench "freer" $ nf countdownFreer x+                    , -- , bench "heftia.naive" $ nf countdownHeftiaNaive x -- no optimization+                      bench "freer" $ nf countdownFreer x                     , bench "polyemy" $ nf countdownSem x                     , bench "fused" $ nf countdownFused x                     , bench "effectful" $ nf countdownEffectful x@@ -32,7 +33,8 @@                 bgroup                     (show x)                     [ bench "heftia.5+5" $ nf countdownHeftiaDeep x-                    , bench "freer.5+5" $ nf countdownFreerDeep x+                    , -- , bench "heftia.naive.5+5" $ nf countdownHeftiaNaiveDeep x -- no optimization+                      bench "freer.5+5" $ nf countdownFreerDeep x                     , bench "polysemy.5+5" $ nf countdownSemDeep x                     , bench "fused.5+5" $ nf countdownFusedDeep x                     , bench "effectful.5+5" $ nf countdownEffectfulDeep x@@ -41,7 +43,7 @@                     , bench "mtl.5+5" $ nf countdownMtlDeep x                     ]         , bgroup "catch.shallow" $-            [10000] <&> \x ->+            [1000] <&> \x ->                 bgroup                     (show x)                     [ bench "heftia" $ nf catchHeftia x@@ -101,7 +103,8 @@                 bgroup                     (show x)                     [ bench "heftia" $ nf pythHeftia x-                    , bench "freer" $ nf pythFreer x+                    , -- , bench "heftia.shift" $ nf pythHeftiaShift x -- tricky method+                      bench "freer" $ nf pythFreer x                     , bench "fused" $ nf pythFused x                     , bench "ev" $ nf pythEv x                     , bench "mp" $ nf pythMp x@@ -113,7 +116,8 @@                 bgroup                     (show x)                     [ bench "heftia.5+5" $ nf pythHeftiaDeep x-                    , bench "freer.5+5" $ nf pythFreerDeep x+                    , -- , bench "heftia.shift.5+5" $ nf pythHeftiaShiftDeep x -- tricky method+                      bench "freer.5+5" $ nf pythFreerDeep x                     , bench "fused.5+5" $ nf pythFusedDeep x                     , bench "ev.5+5" $ nf pythEvDeep x                     , bench "mp.5+5" $ nf pythMpDeep x

@@ -1,6 +1,6 @@-cabal-version:      2.4+cabal-version:      3.0 name:               heftia-effects-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@@ -16,11 +16,11 @@ -- 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+copyright: 2023-2025 Sayo contributors category: Control, Effect, Monads  extra-doc-files:@@ -28,19 +28,16 @@     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-effects  common common-base-    ghc-options:      -Wall+    ghc-options:      -Wall -Wredundant-constraints     default-language: GHC2021      default-extensions:@@ -55,21 +52,18 @@         PatternSynonyms      build-depends:-        base >= 4.17 && < 4.21,-        data-effects ^>= 0.3.0.1,-        heftia ^>= 0.5,+        base >= 4.17 && < 4.22,+        data-effects ^>= 0.4,+        heftia ^>= 0.6,         time >= 1.11.1 && < 1.15,         unliftio ^>= 0.2,         unbounded-delays ^>= 0.1.1,-        ghc-typelits-knownnat ^>= 0.7,         containers > 0.6.5 && < 0.8,         co-log-core ^>= 0.3.2,         process ^>= 1.6.15,         bytestring >= 0.11.1 && < 0.13,         text >= 1.2.5 && < 2.2, -    ghc-options: -Wall- library     import: common-base @@ -78,12 +72,12 @@         Control.Monad.Hefty.Writer         Control.Monad.Hefty.State         Control.Monad.Hefty.Except-        Control.Monad.Hefty.ShiftReset+        Control.Monad.Hefty.CC+        Control.Monad.Hefty.Shift         Control.Monad.Hefty.NonDet         Control.Monad.Hefty.Coroutine         Control.Monad.Hefty.Input         Control.Monad.Hefty.Output-        Control.Monad.Hefty.Resource         Control.Monad.Hefty.Unlift         Control.Monad.Hefty.Provider         Control.Monad.Hefty.KVStore@@ -96,29 +90,24 @@         Control.Monad.Hefty.Log      reexported-modules:-        Control.Monad.Hefty,-        Data.Effect.OpenUnion,+        -- Control.Monad.Hefty,         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,         Control.Effect,-        Control.Effect.Tag,-        Control.Effect.Key,         Data.Effect.Reader,         Data.Effect.Writer,         Data.Effect.State,         Data.Effect.Except,-        Data.Effect.ShiftReset,+        Data.Effect.CC,+        Data.Effect.Shift,         Data.Effect.NonDet,         Data.Effect.Coroutine,         Data.Effect.Input,         Data.Effect.Output,-        Data.Effect.Resource,         Data.Effect.Unlift,         Data.Effect.Provider,         Data.Effect.KVStore,@@ -147,6 +136,7 @@         Test.Pyth         Test.Coroutine         Test.Concurrent+        Test.UnliftIO      hs-source-dirs: test @@ -162,7 +152,6 @@      type: exitcode-stdio-1.0 - executable Teletype     import: common-base @@ -171,11 +160,11 @@     build-depends:         heftia-effects, -executable KeyedEffects+executable KeyTeletype     import: common-base      main-is: Main.hs-    hs-source-dirs: Example/KeyedEffects+    hs-source-dirs: Example/KeyTeletype     build-depends:         heftia-effects, @@ -197,15 +186,6 @@     build-depends:         heftia-effects, -executable ShiftReset-    import: common-base--    main-is: Main.hs-    hs-source-dirs: Example/ShiftReset-    build-depends:-        heftia-effects,-        extra >= 1.7.14 && < 1.9,- executable Writer     import: common-base @@ -222,11 +202,11 @@     build-depends:         heftia-effects, -executable FileSystemProvider+executable DatabaseProvider     import: common-base      main-is: Main.hs-    hs-source-dirs: Example/FileSystemProvider+    hs-source-dirs: Example/DatabaseProvider     build-depends:         heftia-effects, @@ -275,7 +255,6 @@      build-depends:         heftia-effects,-        freer-simple ^>= 1.2,         polysemy ^>= 1.9,         fused-effects ^>= 1.1,         effectful >= 2.3 && < 2.6,@@ -287,6 +266,9 @@      if impl(ghc >= 9.6) && impl(ghc < 9.10)        build-depends: eff++    if impl(ghc < 9.10)+       build-depends: freer-simple ^>= 1.2      default-extensions:         PackageImports

@@ -0,0 +1,31 @@+-- SPDX-License-Identifier: MPL-2.0++{- |+Copyright   :  (c) 2024-2025 Sayo contributors+License     :  MPL-2.0 (see the LICENSE file)+Maintainer  :  ymdfield@outlook.jp+-}+module Control.Monad.Hefty.CC (+    module Control.Monad.Hefty.CC,+    module Data.Effect.CC,+)+where++import Control.Monad.Hefty (AlgHandler, Eff, interpretBy)+import Data.Effect.CC+import Data.Effect.OpenUnion (FOEs)+import Data.Functor.Contravariant (Op (Op))++runCC :: (FOEs es) => (a -> Eff es ans) -> Eff (CC (Op (Eff es ans)) ': es) a -> Eff es ans+runCC k = interpretBy k handleCC+{-# INLINE runCC #-}++handleCC :: AlgHandler (CC (Op (g ans))) f g ans+handleCC = \case+    SubFork -> \exit -> exit . Left . Op $ exit . Right+    Jump (Op exit) x -> \_ -> exit x+{-# INLINE handleCC #-}++evalCC :: (FOEs es) => Eff (CC (Op (Eff es a)) ': es) a -> Eff es a+evalCC = runCC pure+{-# INLINE evalCC #-}

@@ -1,10 +1,9 @@ {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}  -- 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 @@ -20,123 +19,20 @@ #if ( __GLASGOW_HASKELL__ < 906 ) import Control.Applicative (liftA2) #endif-import Control.Monad (forever)-import Control.Monad.Hefty (-    Eff,-    interpret,-    interpretH,-    raiseAllH,-    transform,-    type (<<|),-    type (<|),-    type (~>),-    type (~~>),- )+import Control.Effect.Transform (onlyFOEs)+import Control.Monad.Hefty (Eff, transform, (:>)) import Control.Monad.Hefty.Coroutine (inputToYield, runCoroutine)-import Control.Monad.Hefty.Unlift (UnliftIO) import Data.Effect.Concurrent.Parallel import Data.Effect.Coroutine (Status (Continue, Done)) import Data.Effect.Input-import Data.Function (fix)-import UnliftIO (-    MonadIO,-    MonadUnliftIO,-    atomically,-    liftIO,-    mask,-    newEmptyTMVarIO,-    putTMVar,-    readTMVar,-    tryReadTMVar,-    uninterruptibleMask_,-    withRunInIO,- )-import UnliftIO.Concurrent (forkIO, killThread, threadDelay)--runConcurrentIO-    :: (UnliftIO <<| eh, IO <| ef)-    => Eff (Parallel ': Race ': Poll ': eh) (Halt ': ef) ~> Eff eh ef-runConcurrentIO = runHaltIO . runPollIO . runRaceIO . runParallelIO--runParallelIO :: (UnliftIO <<| eh, IO <| ef) => Eff (Parallel ': eh) ef ~> Eff eh ef-runParallelIO = interpretH parallelToIO--parallelToIO :: (MonadUnliftIO m) => Parallel ~~> m-parallelToIO (LiftP2 f a b) =-    withRunInIO \run -> do-        var <- newEmptyTMVarIO-        mask \restore -> do-            t <- forkIO do-                x <- restore $ run a-                atomically $ putTMVar var x--            y <- restore $ run b--            atomically do-                x <- readTMVar var-                pure $ f x y-                <* uninterruptibleMask_ (killThread t)-{-# INLINE parallelToIO #-}--runPollIO :: (IO <| ef, UnliftIO <<| eh) => Eff (Poll ': eh) ef ~> Eff eh ef-runPollIO = interpretH pollToIO--runRaceIO :: (IO <| ef, UnliftIO <<| eh) => Eff (Race ': eh) ef ~> Eff eh ef-runRaceIO = interpretH raceToIO--runHaltIO :: (IO <| ef) => Eff eh (Halt ': ef) ~> Eff eh ef-runHaltIO = interpret haltToIO--raceToIO :: (MonadUnliftIO m) => Race ~~> m-raceToIO (Race a b) =-    withRunInIO \run -> do-        var <- newEmptyTMVarIO-        mask \restore -> do-            let runThread m = forkIO do-                    x <- restore $ run m-                    atomically $ putTMVar var x--            t1 <- runThread a-            t2 <- runThread b--            atomically (readTMVar var)-                <* uninterruptibleMask_ (killThread t1 *> killThread t2)--pollToIO :: (MonadUnliftIO m) => Poll ~~> m-pollToIO (Poldl f a b) =-    withRunInIO \run -> do-        var <- newEmptyTMVarIO-        mask \restore -> do-            t <- forkIO do-                x <- restore $ run b-                atomically $ putTMVar var x--            restore (run a) >>= fix \next acc -> do-                poll <- atomically $ tryReadTMVar var-                restore (run $ f acc poll) >>= \case-                    Left r -> do-                        uninterruptibleMask_ $ killThread t-                        pure r-                    Right acc' -> next acc'--haltToIO :: (MonadIO m) => Halt ~> m-haltToIO Halt = liftIO $ forever $ threadDelay maxBound--runParallelAsSequential :: Eff (Parallel ': eh) ef ~> Eff eh ef-runParallelAsSequential = interpretH parallelToSequential--parallelToSequential :: Parallel ~~> Eff eh ef-parallelToSequential (LiftP2 f a b) = liftA2 f a b+import Data.Effect.OpenUnion (RemoveHOEs, WeakenHOEs) -polling :: (Poll <<| eh) => Eff eh ef a -> Eff '[] (Input (Maybe a) ': ef) r -> Eff eh ef r+polling :: (Poll :> es, WeakenHOEs es) => Eff es a -> Eff (Input (Maybe a) ': RemoveHOEs es) b -> Eff es b polling pollee poller =     poldl         ( \case             Done r -> const $ pure $ Left r-            Continue () k -> fmap Right . raiseAllH . k+            Continue () k -> fmap Right . onlyFOEs . k         )-        (raiseAllH $ runCoroutine $ transform inputToYield poller)+        (onlyFOEs $ runCoroutine $ transform inputToYield poller)         pollee--runForAsParallel :: (Parallel <<| eh, Traversable t) => Eff (For t ': eh) ef ~> Eff eh ef-runForAsParallel = interpretH forToParallel

@@ -1,7 +1,9 @@-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}+{-# 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 @@ -20,18 +22,20 @@ import Control.Monad (forM_, forever) import Control.Monad.Hefty (     Eff,-    bundleN,+    Emb,+    FOEs,+    RemoveHOEs,+    WeakenHOEs,     interpret,-    interpretBy,+    interpretsBy,     nil,+    onlyFOEs,     raise,-    raiseAllH,-    reinterpret,-    unkey,-    (!+),+    reinterprets,+    untag,+    (!:),     (&),-    type (<<|),-    type (<|),+    (:>),     type (~>),  ) import Control.Monad.Hefty.Concurrent.Parallel (Parallel, liftP2)@@ -54,19 +58,19 @@  ) import UnliftIO.Concurrent (forkIO, killThread) -data Machinery eh ef ans i o where+data Machinery es ans i o where     Unit-        :: forall i o ans eh ef-         . Eff eh (Input i ': Output o ': ef) ans-        -> Machinery eh ef ans i o+        :: forall i o ans es+         . Eff (Input i ': Output o ': es) ans+        -> Machinery es ans i o     Connect-        :: forall a b c ans eh ef-         . Machinery eh ef ans a b-        -> Machinery eh ef ans b c-        -> Machinery eh ef ans a c+        :: forall a b c ans es+         . Machinery es ans a b+        -> Machinery es ans b c+        -> Machinery es ans a c -instance Category (Machinery eh ef ans) where-    id :: forall a. Machinery eh ef ans a a+instance Category (Machinery es ans) where+    id :: forall a. Machinery es ans a a     id =         Unit . forever $             input @a >>= output@@ -76,15 +80,15 @@     {-# INLINE id #-}     {-# INLINE (.) #-} -instance Arrow (Machinery '[] ef ans) where+instance (FOEs es) => Arrow (Machinery es ans) where     arr (f :: b -> c) =         Unit . forever $             input @b >>= output . f      first         :: forall b c d-         . Machinery '[] ef ans b c-        -> Machinery '[] ef ans (b, d) (c, d)+         . Machinery es ans b c+        -> Machinery es ans (b, d) (c, d)     first = \case         Unit m -> Unit $ evalState (Left Seq.Empty) $ buffering m         Connect a b -> Connect (first a) (first b)@@ -93,44 +97,43 @@     {-# INLINE first #-}  buffering-    :: forall b c d ans eh ef-     . Eff eh (Input b ': Output c ': ef) ans-    -> Eff eh (State (Either (Seq c) d) ': Input (b, d) ': Output (c, d) ': ef) ans+    :: forall b c d ans es+     . Eff (Input b ': Output c ': es) ans+    -> Eff (State (Either (Seq c) d) ': Input (b, d) ': Output (c, d) ': es) ans buffering =-    bundleN @2-        >>> reinterpret-            ( ( \Input -> do-                    (b, d) <- input+    reinterprets+        ( ( \Input -> do+                (b, d) <- input -                    get'' @"buffer" >>= \case-                        Right _ -> pure ()-                        Left outputQueue -> forM_ outputQueue \c -> output (c, d)+                get'' @"buffer" >>= \case+                    Right _ -> pure ()+                    Left outputQueue -> forM_ outputQueue \c -> output (c, d) -                    put'' @"buffer" $ Right d+                put'' @"buffer" $ Right d -                    pure b-              )-                !+ ( \(Output c) ->-                        get'' @"buffer" >>= \case-                            Right d -> output (c, d)-                            Left outputQueue -> put'' @"buffer" $ Left $ outputQueue :|> c-                   )-                !+ nil-            )-        >>> unkey @"buffer"+                pure b+          )+            !: ( \(Output c) ->+                    get'' @"buffer" >>= \case+                        Right d -> output (c, d)+                        Left outputQueue -> put'' @"buffer" $ Left $ outputQueue :|> c+               )+            !: nil+        )+        >>> untag @"buffer" -instance ArrowChoice (Machinery '[] ef ans) where+instance (FOEs es) => ArrowChoice (Machinery es ans) where     left = leftMachinery     {-# INLINE left #-}  leftMachinery-    :: forall b c d ans eh ef-     . Machinery eh ef ans b c-    -> Machinery eh ef ans (Either b d) (Either c d)+    :: forall b c d ans es+     . Machinery es ans b c+    -> Machinery es ans (Either b d) (Either c d) leftMachinery = \case     Unit m ->-        bundleN @2 m-            & reinterpret+        m+            & reinterprets                 ( ( \Input -> fix \next ->                         input @(Either b d) >>= \case                             Left x -> pure x@@ -138,8 +141,8 @@                                 output @(Either c d) $ Right o                                 next                   )-                    !+ (\(Output o) -> output @(Either c d) $ Left o)-                    !+ nil+                    !: (\(Output o) -> output @(Either c d) $ Left o)+                    !: nil                 )             & Unit     Connect a b -> Connect (leftMachinery a) (leftMachinery b)@@ -152,30 +155,29 @@     | Waiting (i -> Machine f ans i o)     | Produced o (Machine f ans i o) -machine :: Eff '[] (Input i ': Output o ': ef) ans -> Machine (Eff eh ef) ans i o+machine :: (WeakenHOEs es) => Eff (Input i ': Output o ': RemoveHOEs es) ans -> Machine (Eff es) ans i o machine =-    bundleN @2-        >>> interpretBy-            (pure . Terminated)-            ( (\Input k -> pure $ Waiting $ Machine . raiseAllH . k)-                !+ (\(Output o) k -> pure $ Produced o $ Machine $ raiseAllH $ k ())-                !+ nil-            )-        >>> raiseAllH+    interpretsBy+        (pure . Terminated)+        ( (\Input k -> pure $ Waiting $ Machine . onlyFOEs . k)+            !: (\(Output o) k -> pure $ Produced o $ Machine $ onlyFOEs $ k ())+            !: nil+        )+        >>> onlyFOEs         >>> Machine  runMachinery-    :: forall i o ans eh ef-     . (Parallel <<| eh, Semigroup ans)-    => Machinery '[] ef ans i o-    -> Eff eh ef (MachineStatus (Eff eh ef) ans i o)+    :: forall i o ans es+     . (Parallel :> es, Semigroup ans, WeakenHOEs es)+    => Machinery (RemoveHOEs es) ans i o+    -> Eff es (MachineStatus (Eff es) ans i o) runMachinery = runMachineryL . mviewl  runMachineryL-    :: forall i o ans eh ef-     . (Parallel <<| eh, Semigroup ans)-    => MachineryViewL '[] ef ans i o-    -> Eff eh ef (MachineStatus (Eff eh ef) ans i o)+    :: forall i o ans es+     . (Parallel :> es, Semigroup ans, WeakenHOEs es)+    => MachineryViewL (RemoveHOEs es) ans i o+    -> Eff es (MachineStatus (Eff es) ans i o) runMachineryL = \case     MOne m -> runMachine $ machine m     MCons m ms -> do@@ -196,15 +198,15 @@             (Terminated ans, Waiting _) -> pure $ Terminated ans             (Produced _ _, Terminated ans) -> pure $ Terminated ans -newtype MachineryIO eh ef ans i o = MachineryIO {unMachineryIO :: Machinery eh ef ans i o}+newtype MachineryIO es ans i o = MachineryIO {unMachineryIO :: Machinery es ans i o}     deriving newtype (Category) -instance (IO <| ef) => Arrow (MachineryIO eh ef ans) where+instance (Emb IO :> es) => Arrow (MachineryIO es ans) where     arr (f :: b -> c) =         MachineryIO . Unit . forever $             input @b >>= output . f -    first :: forall b c d. MachineryIO eh ef ans b c -> MachineryIO eh ef ans (b, d) (c, d)+    first :: forall b c d. MachineryIO es ans b c -> MachineryIO es ans (b, d) (c, d)     first =         unMachineryIO             >>> MachineryIO . \case@@ -218,26 +220,26 @@     {-# INLINE arr #-}     {-# INLINE first #-} -instance (IO <| ef) => ArrowChoice (MachineryIO eh ef ans) where+instance (Emb IO :> es) => ArrowChoice (MachineryIO es ans) where     left = MachineryIO . leftMachinery . unMachineryIO     {-# INLINE left #-}  runMachineryIO-    :: forall i o ans eh ef-     . (UnliftIO <<| eh, IO <| ef)-    => Eff eh ef i-    -> (o -> Eff eh ef ())-    -> Machinery eh ef ans i o-    -> Eff eh ef ans+    :: forall i o ans es+     . (UnliftIO :> es, Emb IO :> es)+    => Eff es i+    -> (o -> Eff es ())+    -> Machinery es ans i o+    -> Eff es ans runMachineryIO i o = runMachineryIOL i o . mviewl  runMachineryIOL-    :: forall i o ans eh ef-     . (UnliftIO <<| eh, IO <| ef)-    => Eff eh ef i-    -> (o -> Eff eh ef ())-    -> MachineryViewL eh ef ans i o-    -> Eff eh ef ans+    :: forall i o ans es+     . (UnliftIO :> es, Emb IO :> es)+    => Eff es i+    -> (o -> Eff es ())+    -> MachineryViewL es ans i o+    -> Eff es ans runMachineryIOL i o = \case     MOne m -> runUnit o m     MCons a b ->@@ -255,17 +257,17 @@                 atomically (readTMVar ans)                     <* uninterruptibleMask_ (killThread t1 *> killThread t2)   where-    runUnit :: (o' -> Eff eh ef ()) -> Eff eh (Input i ': Output o' ': ef) ~> Eff eh ef+    runUnit :: (o' -> Eff es ()) -> Eff (Input i ': Output o' ': es) ~> Eff es     runUnit o' m =         m             & interpret (\Input -> raise i)             & interpret (\(Output x) -> o' x)  runMachineryIO_-    :: forall ans eh ef-     . (UnliftIO <<| eh, IO <| ef)-    => Machinery eh ef ans () ()-    -> Eff eh ef ans+    :: forall ans es+     . (UnliftIO :> es, Emb IO :> es)+    => Machinery es ans () ()+    -> Eff es ans runMachineryIO_ = runMachineryIO (pure ()) (const $ pure ()) {-# INLINE runMachineryIO_ #-} @@ -276,26 +278,26 @@  This allows the number of generated threads to be reduced to the number of machine units. -}-data MachineryViewL eh ef ans i o where+data MachineryViewL es ans i o where     MOne-        :: forall i o ans eh ef-         . Eff eh (Input i ': Output o ': ef) ans-        -> MachineryViewL eh ef ans i o+        :: forall i o ans es+         . Eff (Input i ': Output o ': es) ans+        -> MachineryViewL es ans i o     MCons-        :: forall a b c ans eh ef-         . Eff eh (Input a ': Output b ': ef) ans-        -> Machinery eh ef ans b c-        -> MachineryViewL eh ef ans a c+        :: forall a b c ans es+         . Eff (Input a ': Output b ': es) ans+        -> Machinery es ans b c+        -> MachineryViewL es ans a c  -- | Left view deconstruction for Machinery Pipeline. [average O(1)]-mviewl :: Machinery eh ef ans i o -> MachineryViewL eh ef ans i o+mviewl :: Machinery es ans i o -> MachineryViewL es ans i o mviewl = \case     Unit m -> MOne m     Connect a b -> connect a b   where     connect-        :: Machinery eh ef ans a b-        -> Machinery eh ef ans b c-        -> MachineryViewL eh ef ans a c+        :: Machinery es ans a b+        -> Machinery es ans b c+        -> MachineryViewL es ans a c     connect (Unit m) r = m `MCons` r     connect (Connect a b) r = connect a (Connect b r)

@@ -1,11 +1,10 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}  -- SPDX-License-Identifier: MPL-2.0 AND BSD-3-Clause  {- |-Copyright   :  (c) 2024 Sayo Koyoneda+Copyright   :  (c) 2024 Sayo contributors                (c) The University of Glasgow 2004-2008 License     :  MPL-2.0 (see the LICENSE file) AND BSD-3-Clause Maintainer  :  ymdfield@outlook.jp@@ -16,7 +15,7 @@     module Control.Monad.Hefty.Concurrent.Subprocess,     module Control.Monad.Hefty.Provider,     module System.Process,-    module System.Posix.Types,+    module System.Process.Internals,     module System.IO,     module System.Exit,     module Data.ByteString,@@ -28,15 +27,14 @@ import Control.Monad (liftM2) import Control.Monad.Hefty (     Eff,-    LNop,+    Effect,+    Emb,+    Freer,     interpret,-    interpretH,     liftIO,     makeEffectF,     (&),-    type (<<|),-    type (<|),-    type (~>),+    (:>),  ) import Control.Monad.Hefty.Provider import Control.Monad.Hefty.Unlift (UnliftIO, withRunInIO)@@ -46,28 +44,28 @@ import Data.Maybe (fromJust, isNothing) import System.Exit (ExitCode) import System.IO (Handle)-import System.Posix.Types (GroupID, UserID) import System.Process (CmdSpec (RawCommand, ShellCommand)) import System.Process qualified as Raw+import System.Process.Internals (GroupID, UserID) import UnliftIO (TMVar, atomically, finally, mask, newEmptyTMVarIO, putTMVar, readTMVar, tryReadTMVar, uninterruptibleMask_) import UnliftIO.Concurrent (ThreadId, killThread) import UnliftIO.Process (terminateProcess, waitForProcess) -data Subprocess p a where-    WriteStdin :: ByteString -> Subprocess ('SubprocMode 'Piped o e lp 'Kill) ()-    TryWriteStdin :: ByteString -> Subprocess ('SubprocMode 'Piped o e lp ls) Bool-    ReadStdout :: Subprocess ('SubprocMode i 'Piped e lp ls) ByteString-    ReadStderr :: Subprocess ('SubprocMode i o 'Piped lp ls) ByteString-    PollSubproc :: Subprocess ('SubprocMode i o e lp 'Wait) (Maybe ExitCode)+data Subprocess p :: Effect where+    WriteStdin :: ByteString -> Subprocess ('SubprocMode 'Piped o e lp 'Kill) f ()+    TryWriteStdin :: ByteString -> Subprocess ('SubprocMode 'Piped o e lp ls) f Bool+    ReadStdout :: Subprocess ('SubprocMode i 'Piped e lp ls) f ByteString+    ReadStderr :: Subprocess ('SubprocMode i o 'Piped lp ls) f ByteString+    PollSubproc :: Subprocess ('SubprocMode i o e lp 'Wait) f (Maybe ExitCode)  data SubprocMode = SubprocMode StreamMode StreamMode StreamMode Lifecycle Lifecycle  data StreamMode = Piped | NoPipe data Lifecycle = Kill | Wait -makeEffectF [''Subprocess]+makeEffectF ''Subprocess -type SubprocProvider eh ef = Provide SubprocResult CreateProcess (Const2 LNop) Subprocess eh ef+type SubprocProvider es = Scoped Freer SubprocResult CreateProcess '[Subprocess] es  data SubprocResult p a where     RaceResult :: Either ExitCode a -> SubprocResult ('SubprocMode i o e 'Kill 'Kill) a@@ -78,9 +76,9 @@ deriving stock instance (Show a) => Show (SubprocResult p a) deriving stock instance (Eq a) => Eq (SubprocResult p a) -runSubprocIO :: (UnliftIO <<| eh, IO <| ef) => Eff (SubprocProvider eh ef ': eh) ef ~> Eff eh ef+runSubprocIO :: (UnliftIO :> es, Emb IO :> es) => Eff (SubprocProvider es ': es) a -> Eff es a runSubprocIO =-    runProvider \cp@CreateProcess {subprocLifecycle, scopeLifecycle} m ->+    runScoped \cp@CreateProcess {subprocLifecycle, scopeLifecycle} m ->         withRunInIO \run -> do             (hi, ho, he, ph) <- Raw.createProcess (toRawCreateProcess cp) & liftIO             procStatus <- newEmptyTMVarIO@@ -92,7 +90,6 @@                  tScope <- runThread scopeStatus $ restore . run $ do                     m-                        & interpretH \case {}                         & interpret \case                             WriteStdin s -> hPut (fromJust hi) s & liftIO                             TryWriteStdin s -> do

@@ -1,9 +1,7 @@-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}- -- 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 @@ -15,18 +13,14 @@ ) where -import Control.Concurrent.Thread.Delay qualified as Thread import Control.Monad.Hefty (-    interpose,+    Eff,+    FOEs,     interpret,-    liftIO,     raise,     raiseUnder,-    send,     (&),-    type (:!!),-    type (<|),-    type (~>),+    (:>),  ) import Control.Monad.Hefty.Coroutine (runCoroutine) import Control.Monad.Hefty.State (evalState)@@ -34,43 +28,20 @@ import Data.Effect.Coroutine (Status (Continue, Done)) import Data.Effect.State (get, put) import Data.Time (DiffTime)-import Data.Time.Clock (diffTimeToPicoseconds, picosecondsToDiffTime) import Data.Void (Void, absurd)-import GHC.Clock (getMonotonicTimeNSec) -runTimerIO-    :: forall eh ef-     . (IO <| ef)-    => eh :!! Timer ': ef ~> eh :!! ef-runTimerIO =-    interpret \case-        Clock -> do-            t <- getMonotonicTimeNSec & liftIO-            pure $ picosecondsToDiffTime $ fromIntegral t * 1000-        Sleep t ->-            Thread.delay (diffTimeToPicoseconds t `quot` 1000_000) & liftIO- runCyclicTimer-    :: forall ef-     . (Timer <| ef)-    => '[] :!! CyclicTimer ': ef ~> '[] :!! ef+    :: forall a es+     . (Timer :> es, FOEs es)+    => Eff (CyclicTimer ': es) a+    -> Eff es a runCyclicTimer a = do-    timer0 :: Status ('[] :!! ef) () DiffTime Void <- runCoroutine cyclicTimer+    timer0 :: Status (Eff es) () DiffTime Void <- runCoroutine cyclicTimer     a         & raiseUnder         & interpret \case             Wait delta ->-                get @(Status ('[] :!! ef) () DiffTime Void) >>= \case+                get @(Status (Eff es) () DiffTime Void) >>= \case                     Done x -> absurd x                     Continue () k -> put =<< raise (k delta)         & evalState timer0---- | Re-zeros the clock time in the local scope.-restartClock :: (Timer <| ef) => eh :!! ef ~> eh :!! ef-restartClock a = do-    t0 <- clock-    a & interpose \case-        Clock -> do-            t <- clock-            pure $ t - t0-        other -> send other

@@ -1,7 +1,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 @@ -15,22 +15,16 @@ ) where -import Control.Monad.Hefty (Eff, interpretBy, type (~>))+import Control.Monad.Hefty (Eff, FOEs, interpretBy) import Data.Effect.Coroutine import Data.Effect.Input import Data.Effect.Output  -- | Interpret the [coroutine]("Data.Effect.Coroutine")'s t'Yield' effect. runCoroutine-    :: forall a b ans ef-     . Eff '[] (Yield a b ': ef) ans-    -> Eff '[] ef (Status (Eff '[] ef) a b ans)+    :: forall ans a b es+     . (FOEs es)+    => Eff (Yield a b ': es) ans+    -> Eff es (Status (Eff es) a b ans) runCoroutine = interpretBy (pure . Done) (\(Yield a) k -> pure $ Continue a k)---- | Converts the t'Input' effect into the [coroutine]("Data.Effect.Coroutine")'s t'Yield' effect.-inputToYield :: Input i ~> Yield () i-inputToYield Input = Yield ()---- | Converts the t'Output' effect into the [coroutine]("Data.Effect.Coroutine")'s t'Yield' effect.-outputToYield :: Output o ~> Yield o ()-outputToYield (Output o) = Yield o+{-# INLINE runCoroutine #-}

@@ -1,7 +1,7 @@ -- SPDX-License-Identifier: MPL-2.0  {- |-Copyright   :  (c) 2023 Sayo Koyoneda+Copyright   :  (c) 2023 Sayo contributors License     :  MPL-2.0 (see the LICENSE file) Maintainer  :  ymdfield@outlook.jp @@ -13,57 +13,40 @@ ) where -import Control.Exception (Exception) import Control.Monad.Hefty (+    AlgHandler,     Eff,-    Interpreter,-    interposeWith,+    FOEs,+    In,+    interposeInWith,     interpret,     interpretBy,-    interpretH,     (&),-    type (<<|),-    type (<|),-    type (~>),     type (~~>),  ) import Data.Effect.Except-import Data.Effect.Unlift (UnliftIO)-import UnliftIO (throwIO)-import UnliftIO qualified as IO  -- | Interpret the t'Throw'/t'Catch' effects.-runExcept :: Eff '[Catch e] (Throw e ': r) a -> Eff '[] r (Either e a)+runExcept :: forall e es a. (FOEs es) => Eff (Catch e ': Throw e ': es) a -> Eff es (Either e a) runExcept = runThrow . runCatch+{-# INLINE runExcept #-}  -- | Interpret the t'Throw' effect.-runThrow :: Eff '[] (Throw e ': r) a -> Eff '[] r (Either e a)+runThrow :: forall e es a. (FOEs es) => Eff (Throw e ': es) a -> Eff es (Either e a) runThrow = interpretBy (pure . Right) handleThrow+{-# INLINE runThrow #-}  -- | Interpret the t'Catch' effect.-runCatch :: (Throw e <| ef) => Eff '[Catch e] ef ~> Eff '[] ef-runCatch = interpretH elabCatch+runCatch :: forall e es a. (Throw e `In` es, FOEs es) => Eff (Catch e ': es) a -> Eff es a+runCatch = interpret handleCatch+{-# INLINE runCatch #-} --- | A handler function for the t'Throw' effect.-handleThrow :: Interpreter (Throw e) (Eff '[] r) (Either e a)+-- | A handler for the t'Throw' effect.+handleThrow :: forall e f g a. (Applicative g) => AlgHandler (Throw e) f g (Either e a) handleThrow (Throw e) _ = pure $ Left e {-# INLINE handleThrow #-} --- | A elaborator function for the t'Catch' effect.-elabCatch :: (Throw e <| ef) => Catch e ~~> Eff '[] ef-elabCatch (Catch action hdl) = action & interposeWith \(Throw e) _ -> hdl e-{-# INLINE elabCatch #-}---- | Interpret the t'Throw' effect based on an IO-fused semantics using IO-level exceptions.-runThrowIO-    :: forall e eh ef-     . (IO <| ef, Exception e)-    => Eff eh (Throw e ': ef) ~> Eff eh ef-runThrowIO = interpret \(Throw e) -> throwIO e---- | Interpret the t'Catch' effect based on an IO-fused semantics using IO-level exceptions.-runCatchIO-    :: forall e eh ef-     . (UnliftIO <<| eh, IO <| ef, Exception e)-    => Eff (Catch e ': eh) ef ~> Eff eh ef-runCatchIO = interpretH \(Catch action hdl) -> IO.catch action hdl+-- | A handler for the t'Catch' effect.+handleCatch :: forall e es. (Throw e `In` es, FOEs es) => Catch e ~~> Eff es+handleCatch (Catch action hdl) = action & interposeInWith \(Throw e) _ -> hdl e+{-# INLINE handleCatch #-}

@@ -1,22 +1,10 @@--- 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/.+-- 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-Portability :  portable -}-module Control.Monad.Hefty.Fail (-    module Control.Monad.Hefty.Fail,-    module Data.Effect.Fail,-)-where+module Control.Monad.Hefty.Fail (module Data.Effect.Fail) where -import Control.Monad.Fail qualified as IO-import Control.Monad.Hefty (Eff, interpret, liftIO, type (<|), type (~>)) import Data.Effect.Fail--runFailIO :: (IO <| ef) => Eff eh (Fail ': ef) ~> Eff eh ef-runFailIO = interpret \(Fail s) -> liftIO $ IO.fail s

@@ -1,12 +1,9 @@--- 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/.+-- 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-Portability :  portable -} module Control.Monad.Hefty.Fresh (     module Control.Monad.Hefty.Fresh,@@ -14,18 +11,21 @@ ) where  import Control.Arrow ((>>>))-import Control.Monad.Hefty (Eff, interpret, raiseUnder, type (<|), type (~>))+import Control.Monad.Hefty (Eff, FOEs, interpret, raiseUnder, (:>)) import Control.Monad.Hefty.State (runState) import Data.Effect.Fresh import Data.Effect.State (State, get, modify) import Numeric.Natural (Natural) -runFreshNatural :: Eff '[] (Fresh Natural ': r) a -> Eff '[] r (Natural, a)+runFreshNatural :: (FOEs es) => Eff (Fresh Natural ': es) a -> Eff es (Natural, a) runFreshNatural =     raiseUnder >>> runFreshNaturalAsState >>> runState 0+{-# INLINE runFreshNatural #-}  runFreshNaturalAsState-    :: (State Natural <| r)-    => Eff eh (Fresh Natural ': r) ~> Eff eh r+    :: (State Natural :> es)+    => Eff (Fresh Natural ': es) a+    -> Eff es a runFreshNaturalAsState =-    interpret \Fresh -> get @Natural <* modify @Natural (+ 1)+    interpret \Fresh -> get <* modify (+ 1)+{-# INLINE runFreshNaturalAsState #-}

@@ -1,7 +1,7 @@ -- 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 @@ -14,32 +14,18 @@ where  import Control.Arrow ((>>>))-import Control.Monad.Hefty (Eff, interpret, raiseUnder, type (~>))+import Control.Monad.Hefty (Eff, FOEs, interpret, raiseUnder) import Control.Monad.Hefty.State (evalState) import Data.Effect.Input import Data.Effect.State (gets, put) import Data.List (uncons) --- | Interprets the t'Input' effect by executing the given input handler each time an input is required.-runInputEff-    :: forall i ef eh-     . Eff eh ef i-    -> Eff eh (Input i ': ef) ~> Eff eh ef-runInputEff a = interpret \Input -> a---- | Interprets the t'Input' effect by providing the given constant as input.-runInputConst-    :: forall i ef eh-     . i-    -> Eff eh (Input i ': ef) ~> Eff eh ef-runInputConst i = interpret \Input -> pure i- {- | Interprets the t'Input' effect by using the given list as a series of inputs.  Each time 'input' is called, it retrieves elements from the list one by one from the beginning, and after all elements are consumed, 'Nothing' is returned indefinitely. -}-runInputList :: forall i r. [i] -> Eff '[] (Input (Maybe i) ': r) ~> Eff '[] r+runInputList :: forall i a es. (FOEs es) => [i] -> Eff (Input (Maybe i) ': es) a -> Eff es a runInputList is =     raiseUnder         >>> int@@ -49,3 +35,4 @@         is' <- gets @[i] uncons         mapM_ (put . snd) is'         pure $ fst <$> is'+{-# INLINE runInputList #-}

@@ -1,12 +1,9 @@--- 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/.+-- 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-Portability :  portable  This module provides handlers for the t`KVStore` effect, comes from [@Polysemy.KVStore@](https://hackage.haskell.org/package/polysemy-kvstore-0.1.3.0/docs/Polysemy-KVStore.html)@@ -19,29 +16,19 @@ where  import Control.Arrow ((>>>))-import Control.Monad.Hefty (Eff, interpret, raiseUnder, type (<|), type (~>))+import Control.Monad.Hefty (Eff, FOEs, raiseUnder) import Control.Monad.Hefty.State (runState) import Data.Effect.KVStore-import Data.Effect.State (State, get, modify)-import Data.Functor ((<&>)) import Data.Map (Map)-import Data.Map qualified as Map -runKVStorePure-    :: forall k v r a-     . (Ord k)+runKVStoreCC+    :: forall k v a es+     . (Ord k, FOEs es)     => Map k v-    -> Eff '[] (KVStore k v ': r) a-    -> Eff '[] r (Map k v, a)-runKVStorePure initial =+    -> Eff (KVStore k v ': es) a+    -> Eff es (Map k v, a)+runKVStoreCC initial =     raiseUnder         >>> runKVStoreAsState         >>> runState initial--runKVStoreAsState-    :: forall k v r-     . (Ord k, State (Map k v) <| r)-    => Eff '[] (KVStore k v ': r) ~> Eff '[] r-runKVStoreAsState = interpret \case-    LookupKV k -> get <&> Map.lookup k-    UpdateKV k v -> modify $ Map.update (const v) k+{-# INLINE runKVStoreCC #-}

@@ -1,7 +1,7 @@ -- 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 @@ -10,25 +10,8 @@ The interface is similar to [@co-log-polysemy@](https://hackage.haskell.org/package/co-log-polysemy). -} module Control.Monad.Hefty.Log (-    module Control.Monad.Hefty.Log,     module Data.Effect.Log, ) where -import Colog.Core (LogAction (LogAction))-import Control.Monad.Hefty (Eff, interpret, send, type (<|), type (~>))-import Control.Monad.Hefty.Output (Output (..), output) import Data.Effect.Log-import Prelude hiding (log)--runLogAsOutput :: (Output msg <| ef) => Eff eh (Log msg ': ef) ~> Eff eh ef-runLogAsOutput = interpret \(Log msg) -> output msg--runOutputAsLog :: (Log msg <| ef) => Eff eh (Output msg ': ef) ~> Eff eh ef-runOutputAsLog = interpret \(Output msg) -> log msg--runLogAction :: LogAction (Eff eh ef) msg -> Eff eh (Log msg ': ef) ~> Eff eh ef-runLogAction (LogAction f) = interpret \(Log msg) -> f msg--runLogActionEmbed :: (m <| ef) => LogAction m msg -> Eff eh (Log msg ': ef) ~> Eff eh ef-runLogActionEmbed (LogAction f) = interpret \(Log msg) -> send $ f msg

@@ -1,11 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-}-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}  -- 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 @@ -22,142 +21,65 @@ import Control.Applicative (liftA2) #endif import Control.Applicative qualified as A-import Control.Arrow ((>>>))-import Control.Monad.Hefty (-    Eff,-    bundleN,-    interpret,-    interpretBy,-    interpretH,-    nil,-    (!+),-    (&),-    type (<<|),-    type (<|),-    type (~>),- )-import Data.Bool (bool)+import Control.Monad.Hefty (Eff, FOEs, interpretBy, interpretsBy, nil, (!:)) import Data.Effect.NonDet-import Data.Effect.Unlift (UnliftIO)-import UnliftIO (Exception, SomeException, throwIO, try)  -- | [NonDet]("Data.Effect.NonDet") effects handler for alternative answer type. runNonDet-    :: forall f ef a-     . (Alternative f)-    => Eff '[] (Choose ': Empty ': ef) a-    -> Eff '[] ef (f a)+    :: forall f es a+     . (Alternative f, FOEs es)+    => Eff (Choose ': Empty ': es) a+    -> Eff es (f a) runNonDet =-    bundleN @2-        >>> interpretBy-            (pure . pure)-            ( (\Choose k -> liftA2 (<|>) (k False) (k True))-                !+ (\Empty _ -> pure A.empty)-                !+ nil-            )+    interpretsBy+        (pure . pure)+        $ (\Choose k -> liftA2 (<|>) (k False) (k True))+            !: (\Empty _ -> pure A.empty)+            !: nil+{-# INLINE runNonDet #-}  -- | [NonDet]("Data.Effect.NonDet") effects handler for monoidal answer type. runNonDetMonoid-    :: forall ans ef a-     . (Monoid ans)-    => (a -> Eff '[] ef ans)-    -> Eff '[] (Choose ': Empty ': ef) a-    -> Eff '[] ef ans-runNonDetMonoid f =-    bundleN @2-        >>> interpretBy-            f-            ( (\Choose k -> liftA2 (<>) (k False) (k True))-                !+ (\Empty _ -> pure mempty)-                !+ nil-            )+    :: forall ans es a+     . (Monoid ans, FOEs es)+    => (a -> Eff es ans)+    -> Eff (Choose ': Empty ': es) a+    -> Eff es ans+runNonDetMonoid ret =+    interpretsBy+        ret+        $ (\Choose k -> liftA2 (<>) (k False) (k True))+            !: (\Empty _ -> pure mempty)+            !: nil+{-# INLINE runNonDetMonoid #-}  -- | t'Choose' effect handler for alternative answer type. runChoose-    :: forall f ef a-     . (Alternative f)-    => Eff '[] (Choose ': ef) a-    -> Eff '[] ef (f a)+    :: forall f es a+     . (Alternative f, FOEs es)+    => Eff (Choose ': es) a+    -> Eff es (f a) runChoose =     interpretBy (pure . pure) \Choose k ->         liftA2 (<|>) (k False) (k True)+{-# INLINE runChoose #-}  -- | t'Choose' effect handler for monoidal answer type. runChooseMonoid-    :: forall ans ef a-     . (Semigroup ans)-    => (a -> Eff '[] ef ans)-    -> Eff '[] (Choose ': ef) a-    -> Eff '[] ef ans+    :: forall ans es a+     . (Semigroup ans, FOEs es)+    => (a -> Eff es ans)+    -> Eff (Choose ': es) a+    -> Eff es ans runChooseMonoid f =     interpretBy f \Choose k ->         liftA2 (<>) (k False) (k True)+{-# INLINE runChooseMonoid #-}  -- | t'Empty' effect handler.-runEmpty :: forall a ef. Eff '[] (Empty ': ef) a -> Eff '[] ef (Maybe a)+runEmpty :: forall a es. (FOEs es) => Eff (Empty ': es) a -> Eff es (Maybe a) runEmpty =     interpretBy         (pure . Just)         \Empty _ -> pure Nothing--{- | t'ChooseH' effect elaborator.--    Convert a higher-order effect of the form--        @chooseH :: m a -> m a -> m a@--    into a first-order effect of the form:--        @choose :: m Bool@--}-runChooseH-    :: (Choose <| ef)-    => Eff (ChooseH ': eh) ef ~> Eff eh ef-runChooseH = interpretH \(ChooseH a b) -> branch a b---- | Faster than `<|>`.-branch :: (Choose <| ef) => Eff eh ef a -> Eff eh ef a -> Eff eh ef a-branch a b = do-    world <- choose-    bool a b world-{-# INLINE branch #-}--infixl 3 `branch`---- | Selects one element from the list nondeterministically, branching the control as many times as the number of elements.-choice :: (Choose <| ef, Empty <| ef) => [a] -> Eff eh ef a-choice = \case-    [] -> empty-    x : xs -> pure x `branch` choice xs---- | Selects one element from the list nondeterministically, branching the control as many times as the number of elements. Uses t'ChooseH'.-choiceH :: (ChooseH <<| eh, Empty <| ef) => [a] -> Eff eh ef a-choiceH = \case-    [] -> empty-    x : xs -> pure x <|> choiceH xs--{- |-Interprets the [NonDet]("Data.Effect.NonDet") effects using IO-level exceptions.--When 'empty' occurs, an 'EmptyException' is thrown, and unless all branches from- 'chooseH' fail due to IO-level exceptions, only the leftmost result is returned- as the final result.--}-runNonDetIO-    :: (UnliftIO <<| eh, IO <| ef)-    => Eff (ChooseH ': eh) (Empty ': ef) a-    -> Eff eh ef (Either SomeException a)-runNonDetIO m = try do-    m-        & interpretH-            ( \(ChooseH a b) ->-                try a >>= \case-                    Right x -> pure x-                    Left (_ :: SomeException) -> b-            )-        & interpret (\Empty -> throwIO EmptyException)---- | Exception thrown when 'empty' occurs in 'runNonDetIO'.-data EmptyException = EmptyException-    deriving stock (Show)-    deriving anyclass (Exception)+{-# INLINE runEmpty #-}

@@ -1,7 +1,7 @@ -- 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 @@ -14,31 +14,19 @@ where  import Control.Arrow ((>>>))-import Control.Monad.Hefty (Eff, interpret, interpretStateBy, raiseUnder, type (~>))+import Control.Monad.Hefty (Eff, FOEs, interpret, interpretStateBy, raiseUnder) import Control.Monad.Hefty.State (runState) import Control.Monad.Hefty.Writer (handleTell) import Data.Effect.Output import Data.Effect.State (modify) import Data.Effect.Writer (Tell (Tell)) --- | Interprets the t'Output' effect using the given output handler.-runOutputEff-    :: forall o ef eh-     . (o -> Eff eh ef ())-    -> Eff eh (Output o ': ef) ~> Eff eh ef-runOutputEff f = interpret \(Output o) -> f o---- | Interprets the t'Output' effect by ignoring the outputs.-ignoreOutput-    :: forall o ef eh-     . Eff eh (Output o ': ef) ~> Eff eh ef-ignoreOutput = runOutputEff $ const $ pure ()- -- | Interprets the t'Output' effect by accumulating the outputs into a list. runOutputList-    :: forall o a ef-     . Eff '[] (Output o ': ef) a-    -> Eff '[] ef ([o], a)+    :: forall o a es+     . (FOEs es)+    => Eff (Output o ': es) a+    -> Eff es ([o], a) runOutputList =     raiseUnder         >>> interpret (\(Output o) -> modify (o :))@@ -46,12 +34,11 @@  -- | Interprets the t'Output' effect by accumulating the outputs into a monoid. runOutputMonoid-    :: forall o w a ef-     . ( Monoid w-       )+    :: forall o w a es+     . (Monoid w, FOEs es)     => (o -> w)-    -> Eff '[] (Output o ': ef) a-    -> Eff '[] ef (w, a)+    -> Eff (Output o ': es) a+    -> Eff es (w, a) runOutputMonoid f =     interpretStateBy mempty (curry pure) \(Output o) ->         handleTell $ Tell $ f o

@@ -1,128 +1,12 @@ -- 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  Interpreters for the [Provider]("Data.Effect.Provider") effects. -}-module Control.Monad.Hefty.Provider (-    module Control.Monad.Hefty.Provider,-    module Data.Effect.Provider,-)-where+module Control.Monad.Hefty.Provider (module Data.Effect.Provider) where -import Control.Monad.Hefty (-    Eff,-    HFunctor,-    KeyH (KeyH),-    MemberHBy,-    Type,-    interpretH,-    key,-    keyH,-    transEffHF,-    unkey,-    unkeyH,-    weaken,-    weakenNH,-    type (##>),-    type (#>),-    type (~>),- ) import Data.Effect.Provider-import Data.Functor.Const (Const (Const))-import Data.Functor.Identity (Identity (Identity))--type Provide ctx i sh sf eh ef = Provider ctx i (ProviderEff ctx i sh sf eh ef)--newtype ProviderEff ctx i sh sf eh ef p a-    = ProviderEff {unProviderEff :: Eff (sh p ': Provide ctx i sh sf eh ef ': eh) (sf p ': ef) a}--type Provide_ i sh sf eh ef =-    Provider (Const1 Identity) (Const i :: () -> Type) (Const1 (ProviderEff_ i sh sf eh ef))--newtype ProviderEff_ i sh sf eh ef a-    = ProviderEff_ {unProviderEff_ :: Eff (sh ': Provide_ i sh sf eh ef ': eh) (sf ': ef) a}---- | Interpret the t'Provider' effect using the given effect interpreter.-runProvider-    :: forall ctx i sh sf eh ef-     . ( forall p x-          . i p-         -> Eff (sh p ': Provide ctx i sh sf eh ef ': eh) (sf p ': ef) x-         -> Eff (Provide ctx i sh sf eh ef ': eh) ef (ctx p x)-       )-    -> Eff (Provide ctx i sh sf eh ef ': eh) ef ~> Eff eh ef-runProvider run =-    interpretH \(KeyH (Provide i f)) ->-        runProvider run $-            run i (unProviderEff $ f $ ProviderEff . transEffHF (weakenNH @2) weaken)--{- |-Interpret the t'Provider' effect using the given effect interpreter.-A version of 'runProvider' where the type of t'Provider' is simpler.--}-runProvider_-    :: forall i sh sf eh ef-     . (HFunctor sh)-    => ( forall x-          . i-         -> Eff (sh ': Provide_ i sh sf eh ef ': eh) (sf ': ef) x-         -> Eff (Provide_ i sh sf eh ef ': eh) ef x-       )-    -> Eff (Provide_ i sh sf eh ef ': eh) ef ~> Eff eh ef-runProvider_ run =-    interpretH \(KeyH (Provide (Const i) f)) ->-        runProvider_ run $-            run-                i-                ( fmap (Const1 . Identity)-                    . unProviderEff_-                    . getConst1-                    $ f-                    $ Const1-                        . ProviderEff_-                        . transEffHF (weakenNH @2) weaken-                )---- | Introduces a new local scope that provides effects @sh p@ and @sf p@ parameterized by @i p@ value and with results wrapped in @ctx p@.-scope-    :: forall key ctx i p eh ef a sh sf bh bf-     . ( MemberHBy-            (ProviderKey ctx i)-            (Provider' ctx i (ProviderEff ctx i sh sf bh bf))-            eh-       , HFunctor (sh p)-       )-    => i p-    -> ( Eff eh ef ~> Eff (key ##> sh p ': Provide ctx i sh sf bh bf ': bh) (key #> sf p ': bf)-         -> Eff (key ##> sh p ': Provide ctx i sh sf bh bf ': bh) (key #> sf p ': bf) a-       )-    -> Eff eh ef (ctx p a)-scope i f =-    i ..! \runInScope ->-        ProviderEff $ unkeyH . unkey $ f (keyH . key . unProviderEff . runInScope)---- | Introduces a new local scope that provides effects @sh@ and @sf@ parameterized by @i@ value.-scope_-    :: forall key i eh ef a sh sf bh bf-     . ( MemberHBy-            (ProviderKey (Const1 Identity :: () -> Type -> Type) (Const i :: () -> Type))-            ( Provider'-                (Const1 Identity)-                (Const i)-                (Const1 (ProviderEff_ i sh sf bh bf))-            )-            eh-       , HFunctor sh-       )-    => i-    -> ( Eff eh ef ~> Eff (key ##> sh ': Provide_ i sh sf bh bf ': bh) (key #> sf ': bf)-         -> Eff (key ##> sh ': Provide_ i sh sf bh bf ': bh) (key #> sf ': bf) a-       )-    -> Eff eh ef a-scope_ i f =-    i .! \runInScope ->-        ProviderEff_ $ unkeyH . unkey $ f (keyH . key . unProviderEff_ . runInScope)

@@ -1,54 +1,14 @@ -- SPDX-License-Identifier: MPL-2.0  {- |-Copyright   :  (c) 2023 Sayo Koyoneda+Copyright   :  (c) 2023-2025 Sayo contributors License     :  MPL-2.0 (see the LICENSE file) Maintainer  :  ymdfield@outlook.jp -Interpreters for the [Reader]("Data.Effect.Reader") effects.+Effects that can be used to hold environmental values in the context.+Environmental values are immutable and do not change across procedures, but you+can modify the value within a local scope using the `local` operation. -}-module Control.Monad.Hefty.Reader (-    module Control.Monad.Hefty.Reader,-    module Data.Effect.Reader,-)-where+module Control.Monad.Hefty.Reader (module Data.Effect.Reader) where -import Control.Monad.Hefty (-    Eff,-    interpose,-    interpret,-    interpretH,-    (&),-    type (<|),-    type (~>),-    type (~~>),- ) import Data.Effect.Reader---- | Interpret the t'Ask'/t'Local' effects.-runReader-    :: forall r eh ef-     . r-    -> Eff (Local r ': eh) (Ask r ': ef) ~> Eff eh ef-runReader r = runAsk r . runLocal---- | Interpret the t'Local' effect.-runLocal-    :: forall r eh ef-     . (Ask r <| ef)-    => Eff (Local r ': eh) ef ~> Eff eh ef-runLocal = interpretH elabLocal---- | A elaborator function for the t'Local' effect.-elabLocal-    :: forall r eh ef-     . (Ask r <| ef)-    => Local r ~~> Eff eh ef-elabLocal (Local f a) = a & interpose @(Ask r) \Ask -> f <$> ask---- | Interpret the t'Ask' effect.-runAsk-    :: forall r ef eh-     . r-    -> Eff eh (Ask r ': ef) ~> Eff eh ef-runAsk r = interpret \Ask -> pure r

@@ -1,41 +0,0 @@--- 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) 2023 Sayo Koyoneda-               (c) 2017 FP Complete-               (c) 2022 Fumiaki Kinoshita-License     :  MPL-2.0 (see the LICENSE file)-Maintainer  :  ymdfield@outlook.jp-Portability :  portable--An elaborator for the t'Control.Effect.Class.Resource.Resource' effect class.--}-module Control.Monad.Hefty.Resource (-    module Control.Monad.Hefty.Resource,-    module Data.Effect.Resource,-)-where--import Control.Effect (type (~>))-import Control.Monad.Hefty.Interpret (interpretH)-import Control.Monad.Hefty.Types (Eff, type (~~>))-import Data.Effect.OpenUnion.Internal.FO (type (<|))-import Data.Effect.OpenUnion.Internal.HO (type (<<|))-import Data.Effect.Resource-import Data.Effect.Unlift (UnliftIO)-import UnliftIO (MonadUnliftIO)-import UnliftIO qualified as IO---- | Elaborates the `Resource` effect under the `UnliftIO` context.-runResourceIO-    :: (UnliftIO <<| eh, IO <| ef)-    => Eff (Resource ': eh) ef ~> Eff eh ef-runResourceIO = interpretH elabResourceIO--elabResourceIO :: (MonadUnliftIO m) => Resource ~~> m-elabResourceIO = \case-    Bracket acquire release thing -> IO.bracket acquire release thing-    BracketOnExcept acquire onError thing -> IO.bracketOnError acquire onError thing-{-# INLINE elabResourceIO #-}

@@ -0,0 +1,32 @@+-- SPDX-License-Identifier: MPL-2.0++{- |+Copyright   :  (c) 2025 Sayo contributors+License     :  MPL-2.0 (see the LICENSE file)+Maintainer  :  ymdfield@outlook.jp+-}+module Control.Monad.Hefty.Shift (+    module Control.Monad.Hefty.Shift,+    module Data.Effect.Shift,+)+where++import Control.Monad.Hefty (AlgHandler, Eff, interpretBy)+import Data.Effect.OpenUnion (FOEs)+import Data.Effect.Shift+import Data.Functor.Contravariant (Op (Op))++runShift :: (FOEs es) => (a -> Eff es ans) -> Eff (Shift ans (Op (Eff es ans)) ': es) a -> Eff es ans+runShift k = interpretBy k handleShift+{-# INLINE runShift #-}++handleShift :: (Monad m) => AlgHandler (Shift ans (Op (m ans))) n m ans+handleShift = \case+    SubShiftFork -> \exit -> exit . Left . Op $ exit . Right+    Call (Op exit) x -> (exit x >>=)+    Abort ans -> const $ pure ans+{-# INLINE handleShift #-}++evalShift :: (FOEs es) => Eff (Shift a (Op (Eff es a)) ': es) a -> Eff es a+evalShift = runShift pure+{-# INLINE evalShift #-}

@@ -1,66 +0,0 @@--- 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/.--module Control.Monad.Hefty.ShiftReset (-    module Control.Monad.Hefty.ShiftReset,-    module Data.Effect.ShiftReset,-)-where--import Control.Monad.Hefty (-    Eff,-    MemberHBy,-    interpret,-    interpretBy,-    interpretH,-    interpretHBy,-    interpretRecHWith,-    raiseH,-    runEff,-    send0,-    sendH,-    type (~>),- )-import Data.Effect.Key (KeyH (KeyH))-import Data.Effect.ShiftReset (Shift' (Shift))-import Data.Effect.ShiftReset hiding (Shift)-import Data.Effect.ShiftReset qualified as D--type Shift ans eh ef = D.Shift ans (ShiftEff ans eh ef)--newtype ShiftEff ans eh ef a-    = ShiftEff {unShiftEff :: Eff (D.Shift ans (ShiftEff ans eh ef) ': eh) ef a}-    deriving newtype (Functor, Applicative, Monad)--evalShift :: Eff '[Shift ans '[] ef] ef ans -> Eff '[] ef ans-evalShift = runShift pure--runShift :: (a -> Eff '[] ef ans) -> Eff '[Shift ans '[] ef] ef a -> Eff '[] ef ans-runShift f =-    interpretHBy f \e k ->-        evalShift $ case e of-            KeyH (Shift initiate) -> unShiftEff $ initiate (ShiftEff . raiseH . k) ShiftEff--withShift :: Eff '[Shift ans '[] '[Eff eh ef]] '[Eff eh ef] ans -> Eff eh ef ans-withShift = runEff . evalShift--runShift_ :: forall eh ef. Eff (Shift_ (Eff eh ef) ': eh) ef ~> Eff eh ef-runShift_ = interpretRecHWith \(KeyH (Shift_' initiate)) k -> initiate k id--runReset :: forall eh ef. Eff (Reset ': eh) ef ~> Eff eh ef-runReset = interpretH \(Reset a) -> a--runShiftF :: Eff '[] (ShiftF (Eff '[] ef ans) ': ef) ans -> Eff '[] ef ans-runShiftF = interpretBy pure \(ShiftF initiate) resume -> initiate resume--runShiftEff :: (Monad n) => (a -> n ans) -> Eff '[] '[ShiftF (n ans), n] a -> n ans-runShiftEff f =-    runEff-        . interpretBy (send0 . f) \(ShiftF initiate) resume ->-            send0 $ initiate $ runEff . resume--runShiftAsF-    :: (MemberHBy ShiftKey (Shift' ans n) eh)-    => Eff eh (ShiftF (n ans) ': ef) ~> Eff eh ef-runShiftAsF = interpret $ sendH . fromShiftF

@@ -3,7 +3,7 @@ -- SPDX-License-Identifier: MPL-2.0  {- |-Copyright   :  (c) 2023 Sayo Koyoneda+Copyright   :  (c) 2023 Sayo contributors License     :  MPL-2.0 (see the LICENSE file) Maintainer  :  ymdfield@outlook.jp @@ -15,109 +15,55 @@ ) where -import Control.Arrow ((>>>)) import Control.Monad.Hefty (     Eff,-    StateInterpreter,-    interpose,+    FOEs,+    StateHandler,     interposeStateBy,-    interpret,     interpretBy,-    interpretRecWith,     interpretStateBy,-    interpretStateRecWith,-    raiseUnder,     (&),-    type (<|),-    type (~>),+    (:>),  )-import Control.Monad.Hefty.Reader (runAsk)-import Data.Effect.Reader (Ask (Ask), ask) import Data.Effect.State-import Data.Functor ((<&>))-import UnliftIO (newIORef, readIORef, writeIORef)  -- | Interpret the 'State' effect.-runState :: forall s ef a. s -> Eff '[] (State s ': ef) a -> Eff '[] ef (s, a)+runState :: forall s es a. (FOEs es) => s -> Eff (State s ': es) a -> Eff es (s, a) runState s0 = interpretStateBy s0 (curry pure) handleState+{-# INLINE runState #-}  -- | Interpret the 'State' effect. Do not include the final state in the return value.-evalState :: forall s ef a. s -> Eff '[] (State s ': ef) a -> Eff '[] ef a+evalState :: forall s es a. s -> (FOEs es) => Eff (State s ': es) a -> Eff es a evalState s0 = interpretStateBy s0 (const pure) handleState+{-# INLINE evalState #-}  -- | Interpret the 'State' effect. Do not include the final result in the return value.-execState :: forall s ef a. s -> Eff '[] (State s ': ef) a -> Eff '[] ef s+execState :: forall s es a. (FOEs es) => s -> Eff (State s ': es) a -> Eff es s execState s0 = interpretStateBy s0 (\s _ -> pure s) handleState--{- |-Interpret the 'State' effect.--Interpretation is performed recursively with respect to the scopes of unelaborated higher-order effects @eh@.-Note that the state is reset and does not persist beyond the scopes.--}-evalStateRec :: forall s ef eh. s -> Eff eh (State s ': ef) ~> Eff eh ef-evalStateRec s0 = interpretStateRecWith s0 handleState+{-# INLINE execState #-}  -- | A handler function for the 'State' effect.-handleState :: StateInterpreter s (State s) (Eff eh r) ans+handleState :: StateHandler s (State s) f g ans handleState = \case     Put s -> \_ k -> k s ()     Get -> \s k -> k s s {-# INLINE handleState #-} --- | Interpret the 'State' effect based on an IO-fused semantics using t'Data.IORef.IORef'.-runStateIORef-    :: forall s ef eh a-     . (IO <| ef)-    => s-    -> Eff eh (State s ': ef) a-    -> Eff eh ef (s, a)-runStateIORef s0 m = do-    ref <- newIORef s0-    a <--        m & interpret \case-            Get -> readIORef ref-            Put s -> writeIORef ref s-    readIORef ref <&> (,a)--{- |-Interpret the 'State' effect based on an IO-fused semantics using t'Data.IORef.IORef'.-Do not include the final state in the return value.--}-evalStateIORef-    :: forall s ef eh a-     . (IO <| ef)-    => s-    -> Eff eh (State s ': ef) a-    -> Eff eh ef a-evalStateIORef s0 m = do-    ref <- newIORef s0-    m & interpret \case-        Get -> readIORef ref-        Put s -> writeIORef ref s- -- | Within the given scope, make the state roll back to the beginning of the scope in case of exceptions, etc.-transactState :: forall s ef. (State s <| ef) => Eff '[] ef ~> Eff '[] ef+transactState :: forall s es a. (State s :> es, FOEs es) => Eff es a -> Eff es a transactState m = do     pre <- get @s     (post, a) <- interposeStateBy pre (curry pure) handleState m     put post     pure a+{-# INLINE transactState #-}  -- | A naive but somewhat slower version of 'runState' that does not use ad-hoc optimizations.-runStateNaive :: forall s ef a. s -> Eff '[] (State s ': ef) a -> Eff '[] ef (s, a)+runStateNaive :: forall s es a. (FOEs es) => s -> Eff (State s ': es) a -> Eff es (s, a) runStateNaive s0 m = do     f <-         m & interpretBy (\a -> pure \s -> pure (s, a)) \case             Get -> \k -> pure \s -> k s >>= ($ s)             Put s -> \k -> pure \_ -> k () >>= ($ s)     f s0---- | A naive but somewhat slower version of 'evalStateRec' that does not use ad-hoc optimizations.-evalStateNaiveRec :: forall s ef eh. s -> Eff eh (State s ': ef) ~> Eff eh ef-evalStateNaiveRec s0 =-    raiseUnder-        >>> interpretRecWith \case-            Get -> (ask @s >>=)-            Put s -> \k -> k () & interpose @(Ask s) \Ask -> pure s-        >>> runAsk @s s0+{-# INLINE runStateNaive #-}

@@ -1,29 +1,23 @@ -- 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 -Interpreters for the [Unlift]("Data.Effect.Unlift") effects.+Realizes [@unliftio@](https://hackage.haskell.org/package/unliftio) in the form of higher-order effects. -}-module Control.Monad.Hefty.Unlift (-    module Control.Monad.Hefty.Unlift,-    module Data.Effect.Unlift,-)-where+module Control.Monad.Hefty.Unlift (module Control.Monad.Hefty.Unlift, module Data.Effect.Unlift) where -import Control.Monad.Hefty (Eff, interpretH, runEff, send0, type (~>))-import Data.Effect.Unlift+import Control.Monad.Hefty (Eff, Emb)+import Data.Effect.Unlift hiding (runUnliftBase, runUnliftIO)+import Data.Effect.Unlift qualified as G import UnliftIO (MonadUnliftIO)-import UnliftIO qualified as IO -runUnliftBase :: forall b. (Monad b) => Eff '[UnliftBase b] '[b] ~> b-runUnliftBase =-    runEff . interpretH \(WithRunInBase f) ->-        send0 $ f runEff+runUnliftBase :: (Monad m) => Eff '[UnliftBase m, Emb m] a -> m a+runUnliftBase = G.runUnliftBase+{-# INLINE runUnliftBase #-} -runUnliftIO :: (MonadUnliftIO m) => Eff '[UnliftIO] '[m] ~> m-runUnliftIO =-    runEff . interpretH \(WithRunInBase f) ->-        send0 $ IO.withRunInIO \run -> f $ run . runEff+runUnliftIO :: (MonadUnliftIO m) => Eff '[UnliftIO, Emb m] a -> m a+runUnliftIO = G.runUnliftIO+{-# INLINE runUnliftIO #-}

@@ -1,7 +1,7 @@ -- SPDX-License-Identifier: MPL-2.0  {- |-Copyright   :  (c) 2023 Sayo Koyoneda+Copyright   :  (c) 2023 Sayo contributors License     :  MPL-2.0 (see the LICENSE file) Maintainer  :  ymdfield@outlook.jp @@ -15,43 +15,42 @@  import Control.Monad.Hefty (     Eff,-    StateInterpreter,-    interpose,-    interposeStateBy,-    interpretH,+    FOEs,+    In,+    StateHandler,+    interposeStateInBy,+    interpret,     interpretStateBy,     send,-    type (<|),-    type (~>),  ) import Data.Effect.Writer  -- | Interpret the [Writer]("Data.Effect.Writer") effects with post-applying censor semantics.-runWriterPost :: (Monoid w) => Eff '[WriterH w] (Tell w ': ef) a -> Eff '[] ef (w, a)+runWriterPost :: (Monoid w, FOEs es) => Eff (WriterH w ': Tell w ': es) a -> Eff es (w, a) runWriterPost = runTell . runWriterHPost  -- | Interpret the [Writer]("Data.Effect.Writer") effects with pre-applying censor semantics.-runWriterPre :: (Monoid w) => Eff '[WriterH w] (Tell w ': ef) a -> Eff '[] ef (w, a)+runWriterPre :: (Monoid w, FOEs es) => Eff (WriterH w ': Tell w ': es) a -> Eff es (w, a) runWriterPre = runTell . runWriterHPre  -- | Interpret the t'Tell' effect.-runTell :: (Monoid w) => Eff '[] (Tell w ': ef) a -> Eff '[] ef (w, a)+runTell :: (Monoid w, FOEs es) => Eff (Tell w ': es) a -> Eff es (w, a) runTell = interpretStateBy mempty (curry pure) handleTell  -- | A handler function for the t'Tell' effect.-handleTell :: (Monoid w) => StateInterpreter w (Tell w) (Eff '[] ef) (w, a)+handleTell :: (Monoid w) => StateHandler w (Tell w) f g (w, a) handleTell (Tell w') w k = k (w <> w') () {-# INLINE handleTell #-}  -- | Interpret the 'WriterH' effect with post-applying censor semantics.-runWriterHPost :: (Monoid w, Tell w <| ef) => Eff '[WriterH w] ef ~> Eff '[] ef-runWriterHPost = interpretH \case+runWriterHPost :: (Monoid w, Tell w `In` es, FOEs es) => Eff (WriterH w ': es) a -> Eff es a+runWriterHPost = interpret \case     Listen m -> intercept m     Censor f m -> censorPost f m  -- | Interpret the 'WriterH' effect with pre-applying censor semantics.-runWriterHPre :: (Monoid w, Tell w <| ef) => Eff '[WriterH w] ef ~> Eff '[] ef-runWriterHPre = interpretH \case+runWriterHPre :: (Monoid w, Tell w `In` es, FOEs es) => Eff (WriterH w ': es) a -> Eff es a+runWriterHPre = interpret \case     Listen m -> intercept m     Censor f m -> censorPre f m @@ -59,12 +58,12 @@ The v'tell' effect is not consumed and remains intact. -} intercept-    :: forall w ef a-     . (Tell w <| ef, Monoid w)-    => Eff '[] ef a-    -> Eff '[] ef (w, a)+    :: forall w es a+     . (Tell w `In` es, Monoid w, FOEs es)+    => Eff es a+    -> Eff es (w, a) intercept =-    interposeStateBy @_ @(Tell w)+    interposeStateInBy @_ @(Tell w)         mempty         (curry pure)         \e@(Tell _) w k -> do@@ -75,27 +74,20 @@ given action and returns the accumulated monoidal value along with the result. -} confiscate-    :: forall w ef a-     . (Tell w <| ef, Monoid w)-    => Eff '[] ef a-    -> Eff '[] ef (w, a)-confiscate = interposeStateBy mempty (curry pure) handleTell+    :: forall w es a+     . (Tell w `In` es, Monoid w, FOEs es)+    => Eff es a+    -> Eff es (w, a)+confiscate = interposeStateInBy mempty (curry pure) handleTell  -- | 'censor' with post-applying semantics. censorPost-    :: forall w ef-     . (Tell w <| ef, Monoid w)+    :: forall w a es+     . (Tell w `In` es, Monoid w, FOEs es)     => (w -> w)-    -> Eff '[] ef ~> Eff '[] ef+    -> Eff es a+    -> Eff es a censorPost f m = do     (w, a) <- confiscate m-    tell $ f w+    tell'_ $ f w     pure a---- | 'censor' with pre-applying semantics.-censorPre-    :: forall w eh ef-     . (Tell w <| ef, Monoid w)-    => (w -> w)-    -> Eff eh ef ~> Eff eh ef-censorPre f = interpose @(Tell w) \(Tell w) -> tell $ f w

@@ -1,12 +1,12 @@ {-# LANGUAGE ApplicativeDo #-}-{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}+{-# OPTIONS_GHC -fconstraint-solver-iterations=16 #-}  -- SPDX-License-Identifier: MPL-2.0  module Test.Concurrent where  import Control.Applicative ((<|>))-import Control.Monad.Hefty (Eff, liftIO, runEff, type (<<|), type (<|))+import Control.Monad.Hefty (Eff, Emb, liftIO, onlyFOEs, runEff, (:>)) import Control.Monad.Hefty.Concurrent.Parallel (     Concurrently (Concurrently, runConcurrently),     Parallel,@@ -25,7 +25,7 @@ spec_Concurrent :: Spec spec_Concurrent = do     let-        prog :: (Parallel <<| eh, IO <| ef) => Eff eh ef (String, String)+        prog :: (Parallel :> es, Emb IO :> es) => Eff es (String, String)         prog = runTimerIO . runStateIORef "" . runConcurrently $ do             r <- Concurrently do                 sleep 0.001@@ -67,7 +67,7 @@     it "Cancel" do         (s, ((), b)) <-             runUnliftIO . runTimerIO . runStateIORef "" . runConcurrentIO $-                sleep 0.001 `cancels` do+                sleep 0.001 `cancels` onlyFOEs do                     modify (<> "A")                     sleep 0.002                     modify (<> "B")

@@ -3,18 +3,18 @@ module Test.Coroutine where  import Control.Monad (forM)+import Control.Monad.Hefty ((:>)) import Control.Monad.Hefty.Coroutine (runCoroutine) import Control.Monad.Hefty.Interpret (runPure) import Control.Monad.Hefty.Types (Eff) import Data.Effect.Coroutine (Status (..), Yield, yield)-import Data.Effect.OpenUnion.Internal.FO (type (<|)) import Test.Hspec (Spec, it, shouldBe) -generateSeq :: (Yield Int Int <| ef) => Int -> Eff '[] ef [Int]+generateSeq :: (Yield Int Int :> es) => Int -> Eff es [Int] generateSeq n =     forM [1 .. n] yield -replyDouble :: Status (Eff '[] ef) Int Int r -> Eff '[] ef r+replyDouble :: Status (Eff es) Int Int r -> Eff es r replyDouble = \case     Done r -> pure r     Continue i f -> replyDouble =<< f (i * 2)

@@ -8,12 +8,11 @@ import Control.Applicative ((<|>)) import Control.Effect (type (~>)) import Control.Monad.Hefty (+    Eff,+    Effect,     interpret,     runPure,-    type ($),-    type (:!!),-    type (<<|),-    type (<|),+    (:>),  ) import Control.Monad.Hefty.Except (runCatch, runThrow) import Control.Monad.Hefty.NonDet (runChooseH, runNonDet)@@ -30,7 +29,7 @@  spec_State_Except :: Spec spec_State_Except = describe "State & Except semantics" do-    let action :: (State Bool <| ef, Throw () <| ef, Catch () <<| eh) => (eh :!! ef) Bool+    let action :: (State Bool :> es, Throw () :> es, Catch () :> es) => Eff es Bool         action = do             (put True *> throw ()) `catch` \() -> pure ()             get@@ -44,7 +43,7 @@ spec_NonDet_Except = describe "NonDet & Except semantics" do     let action1             , action2-                :: (Empty <| ef, ChooseH <<| eh, Throw () <| ef, Catch () <<| eh) => eh :!! ef $ Bool+                :: (Empty :> es, ChooseH :> es, Throw () :> es, Catch () :> es) => Eff es Bool         action1 = (pure True <|> throw ()) `catch` \() -> pure False         action2 = (throw () <|> pure True) `catch` \() -> pure False @@ -60,8 +59,8 @@ spec_NonDet_Writer :: Spec spec_NonDet_Writer = describe "NonDet & Writer semantics" do     let action-            :: (Empty <| ef, ChooseH <<| eh, Tell (Sum Int) <| ef, WriterH (Sum Int) <<| eh)-            => eh :!! ef $ (Sum Int, Bool)+            :: (Empty :> es, ChooseH :> es, Tell (Sum Int) :> es, WriterH (Sum Int) :> es)+            => Eff es (Sum Int, Bool)         action = listen $ add 1 *> (add 2 $> True <|> add 3 $> False)           where             add = tell . Sum @Int@@ -71,19 +70,19 @@     it "runTell   . runNonDet $ listen $ add 1 *> (add 2 $> True <|> add 3 $> False)  ==>  (6, [(3, True), (4, False)])" do         runPure (runTell @(Sum Int) . runNonDet @[] . runWriterHPre @(Sum Int) . runChooseH $ action) `shouldBe` (6, [(3, True), (4, False)]) -data SomeEff a where-    SomeAction :: SomeEff String-makeEffectF [''SomeEff]+data SomeEff :: Effect where+    SomeAction :: SomeEff f String+makeEffectF ''SomeEff  spec_The_issue_12 :: Spec spec_The_issue_12 = describe "hasura/eff#12 semantics" do-    let action :: (Catch String <<| eh, Throw String <| ef, SomeEff <| ef) => eh :!! ef $ String+    let action :: (Catch String :> es, SomeEff :> es) => Eff es String         action = someAction `catch` \(_ :: String) -> pure "caught" -        runSomeEff :: (Throw String <| ef) => eh :!! SomeEff ': ef ~> eh :!! ef+        runSomeEff :: (Throw String :> es) => Eff (SomeEff ': es) ~> Eff es         runSomeEff = interpret (\SomeAction -> throw "not caught")      it "runCatch . interpret (\\SomeAction -> throw \"not caught\") $ someAction `catch` \"caught\"  ==>  Right \"caught\"" do-        runPure (runThrow @String . runCatch @String . runSomeEff $ action) `shouldBe` Right "caught"+        runPure (runThrow . runCatch . runSomeEff $ action) `shouldBe` Right "caught"     it "interpret (\\SomeAction -> throw \"not caught\") . runCatch $ someAction `catch` \"caught\"  ==>  Left \"not caught\"" do-        runPure (runThrow @String . runSomeEff . runCatch @String $ action) `shouldBe` Left "not caught"+        runPure (runThrow . runSomeEff . runCatch $ action) `shouldBe` Left "not caught"

@@ -0,0 +1,20 @@+-- SPDX-License-Identifier: MPL-2.0++module Test.UnliftIO where++import Control.Monad.Hefty (liftIO)+import Control.Monad.Hefty.State (evalStateIORef, get)+import Control.Monad.Hefty.Unlift (runUnliftIO, withRunInIO)+import Test.Hspec (Spec, describe, it, shouldBe)++--  https://github.com/tomjaguarpaw/bluefin/issues/29++spec_UnliftIO :: Spec+spec_UnliftIO = describe "MonadUnliftIO safety" do+    it "with evalState" do+        x <- runUnliftIO do+            m <- evalStateIORef @Int 0 do+                withRunInIO \run -> do+                    pure $ run get+            liftIO m+        x `shouldBe` 0

@@ -2,18 +2,18 @@  module Test.Writer where -import Control.Effect (type (<:), type (<<:))+import Control.Monad.Hefty (Eff, (:>)) import Control.Monad.Hefty.Interpret (runEff) import Control.Monad.Hefty.Writer (runTell, runWriterHPost, runWriterHPre) import Data.Effect.Writer (Tell, WriterH, censor, tell) import Test.Hspec (Spec, describe, it, shouldBe) -hello :: (Tell String <: m, Monad m) => m ()+hello :: (Tell String :> es) => Eff es () hello = do     tell "Hello"     tell " world!" -censorHello :: (Tell String <: m, WriterH String <<: m, Monad m) => m ()+censorHello :: (Tell String :> es, WriterH String :> es) => Eff es () censorHello =     censor         ( \s ->