effectful 2.2.2.0 → 2.3.0.0

raw patch · 15 files changed

+566/−91 lines, 15 filesdep ~effectful-coredep ~fused-effectsdep ~polysemyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: effectful-core, fused-effects, polysemy

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• README.md +1/−1
• bench/Countdown.hs +42/−0
• bench/Main.hs +30/−17
• effectful.cabal +18/−9
• src/Effectful/Console/ByteString.hs +59/−0
• src/Effectful/Console/ByteString/Lazy.hs +53/−0
• src/Effectful/Console/Effect.hs +21/−0
• src/Effectful/FileSystem/IO/ByteString.hs +118/−0
• src/Effectful/FileSystem/IO/ByteString/Builder.hs +40/−0
• src/Effectful/FileSystem/IO/ByteString/Lazy.hs +83/−0
• tests/ConcurrencyTests.hs +14/−15
• tests/EnvTests.hs +51/−15
• tests/UnliftTests.hs +17/−24
• tests/Utils.hs +5/−10

@@ -1,3 +1,17 @@+# effectful-2.3.0.0 (2023-09-13)+* Deprecate `withConcEffToIO`.+* Make `withEffToIO` take an explicit unlifting strategy for the sake of+  consistency with unlifting functions from `Effectful.Dispatch.Dynamic` and+  easier to understand API.+* Add support for turning an effect handler into an effectful operation via the+  `Provider` effect.+* Add `runErrorWith` and `runErrorNoCallStackWith` to `Effectful.Error.Dynamic`+  and `Effectful.Error.Static`.+* Add support for having multiple effects of the same type in scope via the+  `Labeled` effect.+* Add various `ByteString` related functions to the `FileSystem` effect.+* Add the `Console` effect.+ # effectful-2.2.2.0 (2023-01-11) * Add `withSeqEffToIO` and `withConcEffToIO` to `Effectful`. * Use strict `IORef` and `MVar` variants where appropriate.

@@ -38,7 +38,7 @@ [freer-simple](https://hackage.haskell.org/package/freer-simple), [fused-effects](https://hackage.haskell.org/package/fused-effects), [polysemy](https://hackage.haskell.org/package/polysemy),-[eff](https://github.com/hasura/eff) and probably a few more.+[eff](https://github.com/lexi-lambda/eff) and probably a few more.  It needs to be noted that of all of them only the work-in-progress `eff` library is a promising proposition because of reasonable performance characteristics

@@ -19,6 +19,7 @@ -- effectful import qualified Effectful as E import qualified Effectful.Dispatch.Dynamic as E+import qualified Effectful.Labeled as E import qualified Effectful.Reader.Static as E import qualified Effectful.State.Dynamic as ED import qualified Effectful.State.Static.Local as EL@@ -281,6 +282,47 @@   . runDoubleStateShared n   . runR . runR . runR . runR . runR   $ programEffectfulDynamic+  where+    runR = E.runReader ()++----------------------------------------+-- effectful (labeled-dynamic)++programEffectfulLabeledDynamic+  :: E.Labeled "s" (ED.State Integer) E.:> es+  => E.Eff es Integer+programEffectfulLabeledDynamic = do+  n <- E.labeled @"s" @(ED.State Integer) $ ED.get @Integer+  if n <= 0+    then pure n+    else do+      E.labeled @"s" @(ED.State Integer) $ ED.put (n - 1)+      programEffectfulLabeledDynamic+{-# NOINLINE programEffectfulLabeledDynamic #-}++countdownEffectfulLabeledDynLocal :: Integer -> (Integer, Integer)+countdownEffectfulLabeledDynLocal n =+  E.runPureEff . E.runLabeled @"s" (ED.runStateLocal n) $ programEffectfulLabeledDynamic++countdownEffectfulLabeledDynShared :: Integer -> (Integer, Integer)+countdownEffectfulLabeledDynShared n =+  E.runPureEff . E.runLabeled @"s" (ED.runStateShared n) $ programEffectfulLabeledDynamic++countdownEffectfulLabeledDynLocalDeep :: Integer -> (Integer, Integer)+countdownEffectfulLabeledDynLocalDeep n = E.runPureEff+  . runR . runR . runR . runR . runR+  . E.runLabeled @"s" (ED.runStateLocal n)+  . runR . runR . runR . runR . runR+  $ programEffectfulLabeledDynamic+  where+    runR = E.runReader ()++countdownEffectfulLabeledDynSharedDeep :: Integer -> (Integer, Integer)+countdownEffectfulLabeledDynSharedDeep n = E.runPureEff+  . runR . runR . runR . runR . runR+  . E.runLabeled @"s" (ED.runStateShared n)+  . runR . runR . runR . runR . runR+  $ programEffectfulLabeledDynamic   where     runR = E.runReader () 

@@ -20,18 +20,13 @@   [ concurrencyBenchmark   , unliftBenchmark   , bgroup "countdown" $ map countdown [1000, 2000, 3000]-  , bgroup "filesize"  $ map filesize  [1000, 2000, 3000]+  , bgroup "countdown (extra)" $ map countdownExtra [1000, 2000, 3000]+  , bgroup "filesize" $ map filesize  [1000, 2000, 3000]   ] -countdown :: Integer -> Benchmark-countdown n = bgroup (show n)-  [ bench "reference (pure)"             $ nf countdownRef n-  , bench "reference (ST)"               $ nf countdownST n-  , bgroup "effectful (local/static)"-    [ bench "shallow" $ nf countdownEffectfulLocal n-    , bench "deep"    $ nf countdownEffectfulLocalDeep n-    ]-  , bgroup "effectful (local/static/state)"+countdownExtra :: Integer -> Benchmark+countdownExtra n = bgroup (show n)+  [ bgroup "effectful (local/static/state)"     [ bench "shallow" $ nf countdownEffectfulLocalSt n     , bench "deep"    $ nf countdownEffectfulLocalDeepSt n     ]@@ -39,14 +34,36 @@     [ bench "shallow" $ nf countdownEffectfulLocalStM n     , bench "deep"    $ nf countdownEffectfulLocalDeepStM n     ]-  , bgroup "effectful (local/dynamic)"-    [ bench "shallow" $ nf countdownEffectfulDynLocal n-    , bench "deep"    $ nf countdownEffectfulDynLocalDeep n+  , bgroup "effectful (local/dynamic/labeled)"+    [ bench "shallow" $ nf countdownEffectfulLabeledDynLocal n+    , bench "deep"    $ nf countdownEffectfulLabeledDynLocalDeep n     ]+  , bgroup "effectful (shared/dynamic/labeled)"+    [ bench "shallow" $ nf countdownEffectfulLabeledDynShared n+    , bench "deep"    $ nf countdownEffectfulLabeledDynSharedDeep n+    ]   , bgroup "effectful (local/dynamic/double)"     [ bench "shallow" $ nf countdownEffectfulDoubleDynLocal n     , bench "deep"    $ nf countdownEffectfulDoubleDynLocalDeep n     ]+  , bgroup "effectful (shared/dynamic/double)"+    [ bench "shallow" $ nf countdownEffectfulDoubleDynShared n+    , bench "deep"    $ nf countdownEffectfulDoubleDynSharedDeep n+    ]+  ]++countdown :: Integer -> Benchmark+countdown n = bgroup (show n)+  [ bench "reference (pure)" $ nf countdownRef n+  , bench "reference (ST)"   $ nf countdownST n+  , bgroup "effectful (local/static)"+    [ bench "shallow" $ nf countdownEffectfulLocal n+    , bench "deep"    $ nf countdownEffectfulLocalDeep n+    ]+  , bgroup "effectful (local/dynamic)"+    [ bench "shallow" $ nf countdownEffectfulDynLocal n+    , bench "deep"    $ nf countdownEffectfulDynLocalDeep n+    ]   , bgroup "effectful (shared/static)"     [ bench "shallow" $ nf countdownEffectfulShared n     , bench "deep"    $ nf countdownEffectfulSharedDeep n@@ -54,10 +71,6 @@   , bgroup "effectful (shared/dynamic)"     [ bench "shallow" $ nf countdownEffectfulDynShared n     , bench "deep"    $ nf countdownEffectfulDynSharedDeep n-    ]-  , bgroup "effectful (shared/dynamic/double)"-    [ bench "shallow" $ nf countdownEffectfulDoubleDynShared n-    , bench "deep"    $ nf countdownEffectfulDoubleDynSharedDeep n     ] #ifdef VERSION_cleff   , bgroup "cleff (local)"

@@ -1,7 +1,7 @@ cabal-version:      2.4 build-type:         Simple name:               effectful-version:            2.2.2.0+version:            2.3.0.0 license:            BSD-3-Clause license-file:       LICENSE category:           Control@@ -22,7 +22,8 @@   CHANGELOG.md   README.md -tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.5 || ==9.4.4+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.7 || ==9.6.2+              || ==9.8.1  bug-reports:   https://github.com/haskell-effectful/effectful/issues source-repository head@@ -67,7 +68,7 @@                     , async               >= 2.2.2                     , bytestring          >= 0.10                     , directory           >= 1.3.2-                    , effectful-core      >= 2.2.2.0   && < 2.2.3.0+                    , effectful-core      >= 2.3.0.0   && < 2.3.1.0                     , process             >= 1.6.9                      , time                >= 1.9.2@@ -84,15 +85,21 @@                      Effectful.Concurrent.STM                      Effectful.Concurrent.QSem                      Effectful.Concurrent.QSemN+                     Effectful.Console.ByteString+                     Effectful.Console.ByteString.Lazy                      Effectful.Environment                      Effectful.FileSystem                      Effectful.FileSystem.IO+                     Effectful.FileSystem.IO.ByteString+                     Effectful.FileSystem.IO.ByteString.Builder+                     Effectful.FileSystem.IO.ByteString.Lazy                      Effectful.FileSystem.IO.File                      Effectful.Process                      Effectful.Temporary                      Effectful.Timeout      other-modules:   Effectful.Concurrent.Effect+                     Effectful.Console.Effect                      Effectful.FileSystem.Effect      reexported-modules:    Effectful@@ -101,8 +108,10 @@                          , Effectful.Error.Static                          , Effectful.Error.Dynamic                          , Effectful.Fail+                         , Effectful.Labeled                          , Effectful.NonDet                          , Effectful.Prim+                         , Effectful.Provider                          , Effectful.Reader.Dynamic                          , Effectful.Reader.Static                          , Effectful.State.Dynamic@@ -154,17 +163,17 @@     if flag(benchmark-foreign-libraries)        build-depends: mtl -       if impl(ghc < 9.5)+       if impl(ghc < 9.9)           build-depends: cleff >= 0.3.3.0 -       if impl(ghc < 9.5)+       if impl(ghc < 9.9)           build-depends: freer-simple >= 1.2.1.2 -       if impl(ghc < 9.5)-          build-depends: fused-effects >= 1.1.2.0+       if impl(ghc < 9.9)+          build-depends: fused-effects >= 1.1.2.2 -       if impl(ghc < 9.5)-          build-depends: polysemy >= 1.9.0.0+       if impl(ghc < 9.7)+          build-depends: polysemy >= 1.9.1.0      build-depends:    base                     , async

@@ -0,0 +1,59 @@+-- | Lifted functions from "Data.ByteString.Char8" that are related to standard+-- streams.+-- Like the original module, you probably want to import this module qualified+-- to avoid name clashes with the functions provided by "Prelude", e.g.:+--+-- > import Data.ByteString (ByteString)+-- > import qualified Data.ByteString.Char8 as BS8+-- > import Effectful.Console.ByteString (Console)+-- > import qualified Effectful.Console.ByteString as Console+--+module Effectful.Console.ByteString+  ( -- * Effect+    Console++    -- ** Handlers+  , runConsole++    -- * Operations+  , getLine+  , getContents+  , putStr+  , putStrLn+  , interact+  ) where++import Prelude hiding+  ( getContents+  , getLine+  , interact+  , putStr+  , putStrLn+  )++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8++import Effectful+import Effectful.Console.Effect+import Effectful.Dispatch.Static++-- | Lifted 'BS8.getLine'.+getLine :: Console :> es => Eff es ByteString+getLine = unsafeEff_ BS8.getLine++-- | Lifted 'BS8.getContents'.+getContents :: Console :> es => Eff es ByteString+getContents = unsafeEff_ BS8.getContents++-- | Lifted 'BS8.putStr'.+putStr :: Console :> es => ByteString -> Eff es ()+putStr = unsafeEff_ . BS8.putStr++-- | Lifted 'BS8.putStrLn'.+putStrLn :: Console :> es => ByteString -> Eff es ()+putStrLn = unsafeEff_ . BS8.putStrLn++-- | Lifted 'BS8.interact'.+interact :: Console :> es => (ByteString -> ByteString) -> Eff es ()+interact = unsafeEff_ . BS8.interact

@@ -0,0 +1,53 @@+-- | Lifted functions from "Data.ByteString.Lazy.Char8" that are related to+-- standard streams.+-- Like the original module, you probably want to import this module qualified+-- to avoid name clashes with the functions provided by "Prelude", e.g.:+--+-- > import Data.ByteString.Lazy.Char8 (ByteString)+-- > import qualified Data.ByteString.Lazy.Char8 as LBS8+-- > import Effectful.Console.ByteString.Lazy (Console)+-- > import qualified Effectful.Console.ByteString.Lazy as Console+--+module Effectful.Console.ByteString.Lazy+  ( -- * Effect+    Console++    -- ** Handlers+  , runConsole++    -- * Operations+  , getContents+  , putStr+  , putStrLn+  , interact+  ) where++import Prelude hiding+  ( getContents+  , interact+  , putStr+  , putStrLn+  )++import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy.Char8 as LBS8++import Effectful+import Effectful.Console.Effect+import Effectful.Dispatch.Static++-- | Lifted 'LBS8.getContents'.+getContents :: Console :> es => Eff es ByteString+getContents = unsafeEff_ LBS8.getContents++-- | Lifted 'LBS8.putStr'.+putStr :: Console :> es => ByteString -> Eff es ()+putStr = unsafeEff_ . LBS8.putStr++-- | Lifted 'LBS8.putStrLn'.+putStrLn :: Console :> es => ByteString -> Eff es ()+putStrLn = unsafeEff_ . LBS8.putStrLn++-- | Lifted 'LBS8.interact'.+interact :: Console :> es => (ByteString -> ByteString) -> Eff es ()+interact = unsafeEff_ . LBS8.interact

@@ -0,0 +1,21 @@+module Effectful.Console.Effect+  ( -- * Effect+    Console++    -- ** Handlers+  , runConsole+  ) where++import Effectful+import Effectful.Dispatch.Static++-- | An effect for reading from/writing to 'System.IO.stdin', 'System.IO.stdout'+-- or 'System.IO.stderr'.+data Console :: Effect++type instance DispatchOf Console = Static WithSideEffects+data instance StaticRep Console = Console++-- | Run the 'Console' effect.+runConsole :: IOE :> es => Eff (Console : es) a -> Eff es a+runConsole = evalStaticRep Console

@@ -0,0 +1,118 @@+{-# LANGUAGE CPP #-}++-- | Lifted "Data.ByteString".+-- Like the original module, you probably want to import this module qualified+-- to avoid name clashes with the functions provided by "Prelude", e.g.:+--+-- > import Data.ByteString (ByteString)+-- > import qualified Data.ByteString as BS+-- > import qualified Effectful.FileSystem.IO.ByteString as EBS+--+module Effectful.FileSystem.IO.ByteString+#if MIN_VERSION_bytestring(0,11,2)+  ( -- * Introducing and eliminating ByteStrings+    fromFilePath+  , toFilePath++    -- * Files+  , readFile+#else+  ( -- * Files+    readFile+#endif+  , writeFile+  , appendFile++    -- * I/O with Handles+  , hGetLine+  , hGetContents+  , hGet+  , hGetSome+  , hGetNonBlocking+  , hPut+  , hPutNonBlocking+  , hPutStr+  , hPutStrLn+  ) where++import Prelude hiding+  ( appendFile+  , readFile+  , writeFile+  )++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import System.IO (Handle)++import Effectful+import Effectful.Dispatch.Static+import Effectful.FileSystem++----------------------------------------+-- Introducing and eliminating ByteStrings++#if MIN_VERSION_bytestring(0,11,2)+-- | Lifted 'BS.fromFilePath'.+fromFilePath :: FileSystem :> es => FilePath -> Eff es ByteString+fromFilePath = unsafeEff_ . BS.fromFilePath++-- | Lifted 'BS.toFilePath'.+toFilePath :: FileSystem :> es => ByteString -> Eff es FilePath+toFilePath = unsafeEff_ . BS.toFilePath+#endif++----------------------------------------+-- Files++-- | Lifted 'BS8.readFile'.+readFile :: FileSystem :> es => FilePath -> Eff es ByteString+readFile = unsafeEff_ . BS8.readFile++-- | Lifted 'BS8.writeFile'.+writeFile :: FileSystem :> es => FilePath -> ByteString -> Eff es ()+writeFile fp = unsafeEff_ . BS8.writeFile fp++-- | Lifted 'BS8.appendFile'.+appendFile :: FileSystem :> es => FilePath -> ByteString -> Eff es ()+appendFile fp = unsafeEff_ . BS8.appendFile fp++----------------------------------------+-- I/O with Handles++-- | Lifted 'BS8.hGetLine'.+hGetLine :: FileSystem :> es => Handle -> Eff es ByteString+hGetLine = unsafeEff_ . BS8.hGetLine++-- | Lifted 'BS8.hGetContents'.+hGetContents :: FileSystem :> es => Handle -> Eff es ByteString+hGetContents = unsafeEff_ . BS8.hGetContents++-- | Lifted 'BS8.hGet'.+hGet :: FileSystem :> es => Handle -> Int -> Eff es ByteString+hGet h = unsafeEff_ . BS8.hGet h++-- | Lifted 'BS8.hGetSome'.+hGetSome :: FileSystem :> es => Handle -> Int -> Eff es ByteString+hGetSome h = unsafeEff_ . BS8.hGetSome h++-- | Lifted 'BS8.hGetNonBlocking'.+hGetNonBlocking :: FileSystem :> es => Handle -> Int -> Eff es ByteString+hGetNonBlocking h = unsafeEff_ . BS8.hGetNonBlocking h++-- | Lifted 'BS8.hPut'.+hPut :: FileSystem :> es => Handle -> ByteString -> Eff es ()+hPut h = unsafeEff_ . BS8.hPut h++-- | Lifted 'BS8.hPutNonBlocking'.+hPutNonBlocking :: FileSystem :> es => Handle -> ByteString -> Eff es ByteString+hPutNonBlocking h = unsafeEff_ . BS8.hPutNonBlocking h++-- | Lifted 'BS8.hPutStr'.+hPutStr :: FileSystem :> es => Handle -> ByteString -> Eff es ()+hPutStr h = unsafeEff_ . BS8.hPutStr h++-- | Lifted 'BS8.hPutStrLn'.+hPutStrLn :: FileSystem :> es => Handle -> ByteString -> Eff es ()+hPutStrLn h = unsafeEff_ . BS8.hPutStrLn h

@@ -0,0 +1,40 @@+{-# LANGUAGE CPP #-}++-- | Lifted "Data.ByteString.Builder".+-- Like the original module, you probably want to import this module qualified+-- to avoid name clashes with the functions provided by "Prelude", e.g.:+--+-- > import Data.ByteString.Builder (Builder)+-- > import qualified Data.ByteString.Builder as BSB+-- > import qualified Effectful.FileSystem.IO.ByteString.Builder as EBSB+--+module Effectful.FileSystem.IO.ByteString.Builder+  ( -- * Executing Builders+    hPutBuilder+#if MIN_VERSION_bytestring(0,11,2)+  , writeFile+#endif+  ) where++import Prelude hiding (writeFile)++import Data.ByteString.Builder (Builder)+import qualified Data.ByteString.Builder as BSB+import System.IO (Handle)++import Effectful+import Effectful.Dispatch.Static+import Effectful.FileSystem++----------------------------------------+-- Executing Builders++-- | Lifted 'BS.Builder.hPutBuilder'.+hPutBuilder :: FileSystem :> es => Handle -> Builder -> Eff es ()+hPutBuilder h = unsafeEff_ . BSB.hPutBuilder h++#if MIN_VERSION_bytestring(0,11,2)+-- | Lifted 'BS.Builder.writeFile'.+writeFile :: FileSystem :> es => FilePath -> Builder -> Eff es ()+writeFile fp = unsafeEff_ . BSB.writeFile fp+#endif

@@ -0,0 +1,83 @@+-- | Lifted "Data.ByteString.Lazy.Char8".+-- Like the original module, you probably want to import this module qualified+-- to avoid name clashes with the functions provided by "Prelude", e.g.:+--+-- > import Data.ByteString.Lazy (ByteString)+-- > import qualified Data.ByteString.Lazy.Char8 as LBS8+-- > import qualified Effectful.FileSystem.IO.ByteString.Lazy as ELBS+--+module Effectful.FileSystem.IO.ByteString.Lazy+  ( -- * Files+    readFile+  , writeFile+  , appendFile++    -- * I/O with Handles+  , hGetContents+  , hGet+  , hGetNonBlocking+  , hPut+  , hPutNonBlocking+  , hPutStr+  , hPutStrLn+  ) where++import Prelude hiding+  ( appendFile+  , readFile+  , writeFile+  )++import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy.Char8 as LBS8+import System.IO (Handle)++import Effectful+import Effectful.Dispatch.Static+import Effectful.FileSystem++----------------------------------------+-- Files++-- | Lifted 'LBS8.readFile'.+readFile :: FileSystem :> es => FilePath -> Eff es ByteString+readFile = unsafeEff_ . LBS8.readFile++-- | Lifted 'LBS8.writeFile'.+writeFile :: FileSystem :> es => FilePath -> ByteString -> Eff es ()+writeFile fp = unsafeEff_ . LBS8.writeFile fp++-- | Lifted 'LBS8.appendFile'.+appendFile :: FileSystem :> es => FilePath -> ByteString -> Eff es ()+appendFile fp = unsafeEff_ . LBS8.appendFile fp++----------------------------------------+-- I/O with Handles++-- | Lifted 'LBS8.hGetContents'.+hGetContents :: FileSystem :> es => Handle -> Eff es ByteString+hGetContents = unsafeEff_ . LBS8.hGetContents++-- | Lifted 'LBS8.hGet'.+hGet :: FileSystem :> es => Handle -> Int -> Eff es ByteString+hGet h = unsafeEff_ . LBS8.hGet h++-- | Lifted 'LBS8.hGetNonBlocking'.+hGetNonBlocking :: FileSystem :> es => Handle -> Int -> Eff es ByteString+hGetNonBlocking h = unsafeEff_ . LBS8.hGetNonBlocking h++-- | Lifted 'LBS8.hPut'.+hPut :: FileSystem :> es => Handle -> ByteString -> Eff es ()+hPut h = unsafeEff_ . LBS8.hPut h++-- | Lifted 'LBS8.hPutNonBlocking'.+hPutNonBlocking :: FileSystem :> es => Handle -> ByteString -> Eff es ByteString+hPutNonBlocking h = unsafeEff_ . LBS8.hPutNonBlocking h++-- | Lifted 'LBS8.hPutStr'.+hPutStr :: FileSystem :> es => Handle -> ByteString -> Eff es ()+hPutStr h = unsafeEff_ . LBS8.hPutStr h++-- | Lifted 'LBS8.hPutStrLn'.+hPutStrLn :: FileSystem :> es => Handle -> ByteString -> Eff es ()+hPutStrLn h = unsafeEff_ . LBS8.hPutStrLn h

@@ -77,21 +77,20 @@  test_unliftMany :: Assertion test_unliftMany = runEff . evalStateLocal "initial value" $ do-  withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do-    x <- withRunInIO $ \runInIO -> async $ do-      v1 <- runInIO $ get @String  -- 1-      threadDelay 20000-      v2 <- runInIO $ get @String -- 3-      runInIO $ put "inner change"-      v3 <- runInIO $ get @String-      return (v1, v2, v3)-    liftIO $ threadDelay 10000-    put "outer change"  -- 2-    (v1, v2, v3) <- liftIO $ wait x-    v4 <- get  -- 4-    U.assertEqual "expected result"-      ("initial value", "initial value", "inner change", "outer change")-      (v1, v2, v3, v4)+  x <- withEffToIO (ConcUnlift Persistent $ Limited 1) $ \runInIO -> async $ do+    v1 <- runInIO $ get @String  -- 1+    threadDelay 20000+    v2 <- runInIO $ get @String -- 3+    runInIO $ put "inner change"+    v3 <- runInIO $ get @String+    return (v1, v2, v3)+  liftIO $ threadDelay 10000+  put "outer change"  -- 2+  (v1, v2, v3) <- liftIO $ wait x+  v4 <- get  -- 4+  U.assertEqual "expected result"+    ("initial value", "initial value", "inner change", "outer change")+    (v1, v2, v3, v4)  test_asyncWithUnmask :: Assertion test_asyncWithUnmask = runEff . evalStateLocal "initial" $ do

@@ -10,6 +10,7 @@ import Effectful.Dispatch.Static import Effectful.Dispatch.Static.Primitive import Effectful.Reader.Static+import Effectful.Provider import Effectful.State.Static.Local import qualified Utils as U @@ -20,6 +21,7 @@   , testCase "inject works" test_injectEnv   , testCase "unsafeCoerce doesn't work" test_noUnsafeCoerce   , testCase "interpose works" test_interpose+  , testCase "interpose/provider works" test_interposeProvider   ]  test_tailEnv :: Assertion@@ -45,7 +47,7 @@ test_injectEnv = runEff . runReader () $ do   assertEnvSize "runEff" 2   s <- execState @Int 0 $ inject action-  U.assertEqual "expected result" 63 s+  U.assertEqual "expected result" 127 s   where     action :: Eff [State Int, IOE, Reader (), State Int] ()     action = do@@ -67,16 +69,22 @@       raise $ do         assertEnvSize "innerAction.raise" 2         modify @Int (+8)+        only @(State Int) $ do+          assertEnvSize "only" 1+          modify @Int (+16)       hideReader $ do         assertEnvSize "hideReader" 2-        modify @Int (+16)+        modify @Int (+32)         onlyState $ do           assertEnvSize "onlyState" 1-          modify @Int (+32)+          modify @Int (+64)      hideReader :: Eff (State s : es) r -> Eff (State s : Reader r : es) r     hideReader = inject +    only :: e :> es => Eff '[e] a -> Eff es a+    only = inject+     onlyState :: Eff '[State s] a -> Eff (State s : es) a     onlyState = inject @@ -139,30 +147,54 @@  test_interpose :: IO () test_interpose = runEff $ do-  runA . runB . runReader () $ do+  runA 2 . runB . runReader () $ do     a1 <- send A     b1 <- send B-    U.assertEqual "a1 original" 3 a1-    U.assertEqual "b1 original" 3 b1+    U.assertEqual "a1 original" 2 a1+    U.assertEqual "b1 original" 2 b1     doubleA $ do       a2 <- send A       b2 <- send B-      U.assertEqual "a2 interposed" 6 a2-      U.assertEqual "b2 interposed" 6 b2+      U.assertEqual "a2 interposed" 4 a2+      U.assertEqual "b2 interposed" 4 b2     a3 <- send A     b3 <- send B-    U.assertEqual "a3 original" 3 a3-    U.assertEqual "b3 original" 3 b3+    U.assertEqual "a3 original" 2 a3+    U.assertEqual "b3 original" 2 b3 +test_interposeProvider :: IO ()+test_interposeProvider = runEff $ do+  runA 2 . runProvider_ (\() -> runB) $ do+    runA 3 . provide_ @B $ do+      b0 <- send B+      U.assertEqual "b0" 2 b0+    provide_ @B $ do+      b1 <- send B+      b2 <- doubleA $ send B+      U.assertEqual "b1" 2 b1+      U.assertEqual "b2" 4 b2+      runA 5 $ do+        b3 <- send B+        b4 <- doubleA $ send B+        b5 <- raise . doubleA $ send B+        U.assertEqual "b3" 2 b3+        U.assertEqual "b4" 2 b4+        U.assertEqual "b5" 4 b5+      doubleB $ do+        b6 <- send B+        b7 <- doubleA $ send B+        U.assertEqual "b6" 4 b6+        U.assertEqual "b7" 8 b7+ data A :: Effect where   A :: A m Int type instance DispatchOf A = Dynamic -runA :: IOE :> es => Eff (A : es) a -> Eff es a-runA = interpret $ \_ -> \case-  A -> pure 3+runA :: Int -> Eff (A : es) a -> Eff es a+runA n = interpret $ \_ -> \case+  A -> pure n -doubleA :: (IOE :> es, A :> es) => Eff es a -> Eff es a+doubleA :: A :> es => Eff es a -> Eff es a doubleA = interpose $ \_ -> \case   A -> (+) <$> send A <*> send A @@ -170,6 +202,10 @@   B :: B m Int type instance DispatchOf B = Dynamic -runB :: (IOE :> es, A :> es) => Eff (B : es) a -> Eff es a+runB :: A :> es => Eff (B : es) a -> Eff es a runB = interpret $ \_ -> \case   B -> send A++doubleB :: B :> es => Eff es a -> Eff es a+doubleB = interpose $ \_ -> \case+  B -> (+) <$> send B <*> send B

@@ -28,59 +28,52 @@ test_threadStrategy = runEff $ do   let strategy = ConcUnlift Ephemeral Unlimited   s <- withUnliftStrategy strategy $ do-    withEffToIO $ \runInIO -> do+    withRunInIO $ \runInIO -> do       inThread $ runInIO unliftStrategy   U.assertEqual "correct strategy" strategy s  test_seqUnliftInNewThread :: Assertion test_seqUnliftInNewThread = runEff $ do   assertThrowsUnliftError "InvalidUseOfSeqUnlift error" $ do-    withUnliftStrategy SeqUnlift $ do-      withEffToIO $ \runInIO -> do-        inThread $ runInIO $ return ()+    withEffToIO SeqUnlift $ \runInIO -> do+      inThread $ runInIO $ return ()  test_ephemeralInvalid :: Assertion test_ephemeralInvalid = runEff $ do   assertThrowsUnliftError "InvalidNumberOfUses error" $ do-    withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do-      withEffToIO $ \_ -> return ()+    withEffToIO (ConcUnlift Ephemeral $ Limited 0) $ \_ -> return ()  test_ephemeralSameThread :: Assertion test_ephemeralSameThread = runEff $ do   assertThrowsUnliftError "ExceededNumberOfUses error" $ do-    withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do-      withEffToIO $ \runInIO -> inThread $ do-        runInIO $ return ()-        runInIO $ return ()+    withEffToIO (ConcUnlift Ephemeral $ Limited 1) $ \runInIO -> inThread $ do+      runInIO $ return ()+      runInIO $ return ()  test_ephemeralMultipleThreads :: Assertion test_ephemeralMultipleThreads = runEff $ do   assertThrowsUnliftError "ExceededNumberOfUses error" $ do-    withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do-      withEffToIO $ \runInIO -> do-        inThread $ runInIO $ return ()-        inThread $ runInIO $ return ()+    withEffToIO (ConcUnlift Ephemeral $ Limited 1) $ \runInIO -> do+      inThread $ runInIO $ return ()+      inThread $ runInIO $ return ()  test_persistentInvalid :: Assertion test_persistentInvalid = runEff $ do   assertThrowsUnliftError "InvalidNumberOfThreads error" $ do-    withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do-      withEffToIO $ \_ -> return ()+    withEffToIO (ConcUnlift Persistent $ Limited 0) $ \_ -> return ()  test_persistentSameThread :: Assertion test_persistentSameThread = runEff $ do-  withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do-    withEffToIO $ \runInIO -> inThread $ do-      runInIO $ return ()-      runInIO $ return ()+  withEffToIO (ConcUnlift Persistent $ Limited 1) $ \runInIO -> inThread $ do+    runInIO $ return ()+    runInIO $ return ()  test_persistentMultipleThreads :: Assertion test_persistentMultipleThreads = runEff $ do   assertThrowsUnliftError "ExceededNumberOfThreads error" $ do-    withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do-      withEffToIO $ \runInIO -> do-        inThread $ runInIO $ return ()-        inThread $ runInIO $ return ()+    withEffToIO (ConcUnlift Persistent $ Limited 1) $ \runInIO -> do+      inThread $ runInIO $ return ()+      inThread $ runInIO $ return ()  ---------------------------------------- -- Helpers

@@ -6,8 +6,7 @@   , Ex(..)   ) where -import Control.Exception-import Control.Monad+import Control.Monad.Catch import GHC.Stack import qualified Test.Tasty.HUnit as T @@ -33,14 +32,10 @@   -> (e -> Bool)   -> Eff es a   -> Eff es ()-assertThrows msg p k = withEffToIO $ \runInIO -> do-  let k' = do-        void $ runInIO k-        T.assertFailure msg--  k' `catch` \e -> if p e-    then return ()-    else throwIO e+assertThrows msg p k = catchJust+  (\e -> if p e then Just () else Nothing)+  (k >> liftIO (T.assertFailure msg))+  pure  data Ex = Ex deriving (Eq, Show) instance Exception Ex