effectful 2.3.1.0 → 2.4.0.0

raw patch · 35 files changed

+938/−206 lines, 35 filesdep +safe-exceptionsdep +strict-mutable-basedep ~effectful-coredep ~polysemyPVP ok

version bump matches the API change (PVP)

Dependencies added: safe-exceptions, strict-mutable-base

Dependency ranges changed: effectful-core, polysemy

API changes (from Hackage documentation)

Files

• CHANGELOG.md +42/−0
• bench/Countdown.hs +41/−0
• bench/FileSizes.hs +6/−6
• bench/Main.hs +8/−0
• effectful.cabal +23/−6
• src/Effectful/Concurrent.hs +11/−10
• src/Effectful/Concurrent/Async.hs +68/−38
• src/Effectful/Concurrent/Chan/Strict.hs +50/−0
• src/Effectful/Concurrent/Effect.hs +4/−4
• src/Effectful/Concurrent/MVar.hs +14/−1
• src/Effectful/Concurrent/MVar/Strict.hs +93/−88
• src/Effectful/Concurrent/MVar/Strict/Compat.hs +138/−0
• src/Effectful/Concurrent/STM.hs +16/−2
• src/Effectful/Console/ByteString.hs +2/−2
• src/Effectful/Console/ByteString/Lazy.hs +2/−2
• src/Effectful/Console/Effect.hs +1/−1
• src/Effectful/Environment.hs +1/−1
• src/Effectful/FileSystem/Effect.hs +1/−1
• src/Effectful/FileSystem/IO/ByteString.hs +2/−2
• src/Effectful/FileSystem/IO/ByteString/Builder.hs +2/−2
• src/Effectful/FileSystem/IO/ByteString/Lazy.hs +2/−2
• src/Effectful/Prim/IORef.hs +79/−0
• src/Effectful/Prim/IORef/Strict.hs +66/−0
• src/Effectful/Process.hs +1/−1
• src/Effectful/Temporary.hs +1/−1
• src/Effectful/Timeout.hs +1/−1
• tests/ConcurrencyTests.hs +35/−0
• tests/EnvTests.hs +37/−4
• tests/ErrorTests.hs +1/−1
• tests/LabeledTests.hs +61/−0
• tests/Main.hs +2/−0
• tests/NonDetTests.hs +9/−6
• tests/StateTests.hs +27/−10
• tests/UnliftTests.hs +82/−12
• tests/Utils.hs +9/−2

@@ -1,3 +1,45 @@+# effectful-2.4.0.0 (2024-10-08)+* Add utility functions for handling effects that take the effect handler as the+  last parameter to `Effectful.Dispatch.Dynamic`.+* Add utility functions for handling first order effects to+  `Effectful.Dispatch.Dynamic`.+* Improve `Effectful.Labeled`, add `Effectful.Labeled.Error`,+  `Effectful.Labeled.Reader`, `Effectful.Labeled.State` and+  `Effectful.Labeled.Writer`.+* Add `throwErrorWith` and `throwError_` to `Effectful.Error.Static` and+  `Effectful.Error.Dynamic`.+* Add `HasCallStack` constraints where appropriate for better debugging+  experience.+* Add a `SeqForkUnlift` strategy to support running unlifting functions outside+  of the scope of effects they capture.+* Add `Effectful.Exception` with appropriate re-exports from the+  `safe-exceptions` library.+* Add `Effectful.Concurrent.Chan.Strict`.+* Add `Effectful.Prim.IORef` and `Effectful.Prim.IORef.Strict`.+* **Bugfixes**:+  - Ensure that a `LocalEnv` is only used in a thread it belongs to.+  - Properly roll back changes made to the environment when `OnEmptyRollback`+    policy for the `NonDet` effect is selected.+  - Fix a bug in `stateM` and `modifyM` of thread local `State` effect that+    might've caused dropped state updates+    ([#237](https://github.com/haskell-effectful/effectful/issues/237)).+* **Breaking changes**:+  - `localSeqLend`, `localLend`, `localSeqBorrow` and `localBorrow` now take a+    list of effects instead of a single one.+  - `Effectful.Error.Static.throwError` now requires the error type to have a+    `Show` constraint. If this is not the case for some of your error types, use+    `throwError_` for them.+  - `ThrowError` operation from the dynamic version of the `Error` effect was+    replaced with `ThrowErrorWith`.+  - `stateEnv` and `modifyEnv` now take pure modification functions. If you rely+    on their old forms, switch to a combination of `getEnv` and `putEnv`.+  - `runStateMVar`, `evalStateMVar` and `execStateMVar` now take a strict+    `MVar'` from the `strict-mutable-base` package.+  - `Effectful.Concurrent.MVar.Strict` is now a lifted version of+    `Control.Concurrent.MVar.Strict` from `strict-mutable-base`. The original+    module was renamed to `Effectful.Concurrent.MVar.Strict.Compat` and+    deprecated.+ # effectful-2.3.1.0 (2024-06-07) * Drop support for GHC 8.8. * Remove inaccurate information from the `Show` instance of `ErrorWrapper`.

@@ -286,6 +286,47 @@     runR = E.runReader ()  ----------------------------------------+-- effectful (labeled-dynamic-send)++programEffectfulLabeledDynamicSend+  :: E.Labeled "s" (ED.State Integer) E.:> es+  => E.Eff es Integer+programEffectfulLabeledDynamicSend = do+  n <- E.send . E.Labeled @"s" $ ED.Get @Integer+  if n <= 0+    then pure n+    else do+      E.send . E.Labeled @"s" $ ED.Put (n - 1)+      programEffectfulLabeledDynamicSend+{-# NOINLINE programEffectfulLabeledDynamicSend #-}++countdownEffectfulLabeledDynSendLocal :: Integer -> (Integer, Integer)+countdownEffectfulLabeledDynSendLocal n =+  E.runPureEff . E.runLabeled @"s" (ED.runStateLocal n) $ programEffectfulLabeledDynamicSend++countdownEffectfulLabeledDynSendShared :: Integer -> (Integer, Integer)+countdownEffectfulLabeledDynSendShared n =+  E.runPureEff . E.runLabeled @"s" (ED.runStateShared n) $ programEffectfulLabeledDynamicSend++countdownEffectfulLabeledDynSendLocalDeep :: Integer -> (Integer, Integer)+countdownEffectfulLabeledDynSendLocalDeep n = E.runPureEff+  . runR . runR . runR . runR . runR+  . E.runLabeled @"s" (ED.runStateLocal n)+  . runR . runR . runR . runR . runR+  $ programEffectfulLabeledDynamicSend+  where+    runR = E.runReader ()++countdownEffectfulLabeledDynSendSharedDeep :: Integer -> (Integer, Integer)+countdownEffectfulLabeledDynSendSharedDeep n = E.runPureEff+  . runR . runR . runR . runR . runR+  . E.runLabeled @"s" (ED.runStateShared n)+  . runR . runR . runR . runR . runR+  $ programEffectfulLabeledDynamicSend+  where+    runR = E.runReader ()++---------------------------------------- -- effectful (labeled-dynamic)  programEffectfulLabeledDynamic

@@ -102,7 +102,7 @@ effectful_tryFileSize = E.send . Effectful_tryFileSize  effectful_runFile :: E.IOE E.:> es => E.Eff (Effectful_File : es) a -> E.Eff es a-effectful_runFile = E.interpret \_ -> \case+effectful_runFile = E.interpret_ \case   Effectful_tryFileSize path -> liftIO $ tryGetFileSize path  data Effectful_Logging :: E.Effect where@@ -116,7 +116,7 @@ effectful_runLogging   :: E.Eff (Effectful_Logging : es) a   -> E.Eff es (a, [Text])-effectful_runLogging = E.reinterpret (E.runState []) \_ -> \case+effectful_runLogging = E.reinterpret_ (E.runState []) \case   Effectful_logMsg msg -> E.modify (msg :)  ----------@@ -363,7 +363,7 @@ fe_tryFileSize = FE.send . FE_tryFileSize  newtype FE_FileC m a = FE_FileC { fe_runFileC :: m a }-  deriving (Applicative, Functor, Monad, MonadIO)+  deriving newtype (Applicative, Functor, Monad, MonadIO)  instance   ( MonadIO m@@ -380,7 +380,7 @@ fe_logMsg = FE.send . FE_logMsg . T.pack  newtype FE_LoggingC m a = FE_LoggingC { fe_runLoggingC :: FE.StateC [Text] m a }-  deriving (Applicative, Functor, Monad)+  deriving newtype (Applicative, Functor, Monad)  instance   ( FE.Algebra sig m@@ -440,7 +440,7 @@   mtl_tryFileSize :: FilePath -> m (Maybe Int)  newtype FileT m a = FileT { runFileT :: m a }-  deriving (Functor, Applicative, Monad, MonadIO)+  deriving newtype (Functor, Applicative, Monad, MonadIO)  instance M.MonadTrans FileT where   lift = FileT@@ -459,7 +459,7 @@   mtl_logMsg :: String -> m ()  newtype LoggingT m a = LoggingT (M.StateT [Text] m a)-  deriving (Functor, Applicative, Monad, MonadIO, M.MonadTrans)+  deriving newtype (Functor, Applicative, Monad, MonadIO, M.MonadTrans)  instance {-# OVERLAPPABLE #-}   ( MonadLog m

@@ -64,6 +64,10 @@     [ bench "shallow" $ nf countdownEffectfulDynLocal n     , bench "deep"    $ nf countdownEffectfulDynLocalDeep n     ]+  , bgroup "effectful (local/dynamic/labeled/send)"+    [ bench "shallow" $ nf countdownEffectfulLabeledDynSendLocal n+    , bench "deep"    $ nf countdownEffectfulLabeledDynSendLocalDeep n+    ]   , bgroup "effectful (shared/static)"     [ bench "shallow" $ nf countdownEffectfulShared n     , bench "deep"    $ nf countdownEffectfulSharedDeep n@@ -71,6 +75,10 @@   , bgroup "effectful (shared/dynamic)"     [ bench "shallow" $ nf countdownEffectfulDynShared n     , bench "deep"    $ nf countdownEffectfulDynSharedDeep n+    ]+  , bgroup "effectful (shared/dynamic/labeled/send)"+    [ bench "shallow" $ nf countdownEffectfulLabeledDynSendShared n+    , bench "deep"    $ nf countdownEffectfulLabeledDynSendSharedDeep n     ] #ifdef VERSION_cleff   , bgroup "cleff (local)"

@@ -1,7 +1,7 @@ cabal-version:      3.0 build-type:         Simple name:               effectful-version:            2.3.1.0+version:            2.4.0.0 license:            BSD-3-Clause license-file:       LICENSE category:           Control@@ -34,7 +34,10 @@     default: False  common language-    ghc-options:        -Wall -Wcompat -Wno-unticked-promoted-constructors+    ghc-options:        -Wall+                        -Wcompat+                        -Wno-unticked-promoted-constructors+                        -Wmissing-deriving-strategies                         -Werror=prepositive-qualified-module      default-language:   Haskell2010@@ -44,6 +47,7 @@                         DataKinds                         DeriveFunctor                         DeriveGeneric+                        DerivingStrategies                         FlexibleContexts                         FlexibleInstances                         GADTs@@ -52,6 +56,7 @@                         LambdaCase                         MultiParamTypeClasses                         NoStarIsType+                        PolyKinds                         RankNTypes                         RecordWildCards                         RoleAnnotations@@ -69,9 +74,9 @@                     , async               >= 2.2.2                     , bytestring          >= 0.10                     , directory           >= 1.3.2-                    , effectful-core      >= 2.3.1.0   && < 2.3.2.0+                    , effectful-core      >= 2.4.0.0   && < 2.4.1.0                     , process             >= 1.6.9-+                    , strict-mutable-base >= 1.1.0.0                     , time                >= 1.9.2                     , stm                 >= 2.5.0.0                     , unliftio            >= 0.2.20@@ -81,8 +86,10 @@     exposed-modules: Effectful.Concurrent                      Effectful.Concurrent.Async                      Effectful.Concurrent.Chan+                     Effectful.Concurrent.Chan.Strict                      Effectful.Concurrent.MVar                      Effectful.Concurrent.MVar.Strict+                     Effectful.Concurrent.MVar.Strict.Compat                      Effectful.Concurrent.STM                      Effectful.Concurrent.QSem                      Effectful.Concurrent.QSemN@@ -95,6 +102,8 @@                      Effectful.FileSystem.IO.ByteString.Builder                      Effectful.FileSystem.IO.ByteString.Lazy                      Effectful.FileSystem.IO.File+                     Effectful.Prim.IORef+                     Effectful.Prim.IORef.Strict                      Effectful.Process                      Effectful.Temporary                      Effectful.Timeout@@ -108,8 +117,13 @@                          , Effectful.Dispatch.Static                          , Effectful.Error.Static                          , Effectful.Error.Dynamic+                         , Effectful.Exception                          , Effectful.Fail                          , Effectful.Labeled+                         , Effectful.Labeled.Error+                         , Effectful.Labeled.Reader+                         , Effectful.Labeled.State+                         , Effectful.Labeled.Writer                          , Effectful.NonDet                          , Effectful.Prim                          , Effectful.Provider@@ -135,6 +149,8 @@                     , exceptions                     , lifted-base                     , primitive+                    , safe-exceptions+                    , strict-mutable-base                     , tasty                     , tasty-hunit                     , unliftio@@ -149,6 +165,7 @@                     EnvTests                     EnvironmentTests                     ErrorTests+                    LabeledTests                     NonDetTests                     PrimTests                     ReaderTests@@ -174,8 +191,8 @@        if impl(ghc < 9.11)           build-depends: fused-effects >= 1.1.2.2 -       if impl(ghc < 9.9)-          build-depends: polysemy >= 1.9.1.3+       if impl(ghc < 9.11)+          build-depends: polysemy >= 1.9.2.0      build-depends:    base                     , async

@@ -81,14 +81,14 @@ myThreadId = unsafeEff_ C.myThreadId  -- | Lifted 'C.forkIO'.-forkIO :: Concurrent :> es => Eff es () -> Eff es C.ThreadId+forkIO :: (HasCallStack, Concurrent :> es) => Eff es () -> Eff es C.ThreadId forkIO k = unsafeEff $ \es -> do   esF <- cloneEnv es   C.forkIO $ unEff k esF  -- | Lifted 'C.forkFinally'. forkFinally-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => Eff es a   -> (Either SomeException a -> Eff es ())   -> Eff es C.ThreadId@@ -98,7 +98,7 @@  -- | Lifted 'C.forkIOWithUnmask'. forkIOWithUnmask-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => ((forall a. Eff es a -> Eff es a) -> Eff es ())   -> Eff es C.ThreadId forkIOWithUnmask = liftForkWithUnmask C.forkIOWithUnmask@@ -115,14 +115,14 @@ -- Threads with affinity  -- | Lifted 'C.forkOn'.-forkOn :: Concurrent :> es => Int -> Eff es () -> Eff es C.ThreadId+forkOn :: (HasCallStack, Concurrent :> es) => Int -> Eff es () -> Eff es C.ThreadId forkOn n k = unsafeEff $ \es -> do   esF <- cloneEnv es   C.forkOn n (unEff k esF)  -- | Lifted 'C.forkOnWithUnmask'. forkOnWithUnmask-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => Int   -> ((forall a. Eff es a -> Eff es a) -> Eff es ())   -> Eff es C.ThreadId@@ -180,14 +180,14 @@ -- Bound threads  -- | Lifted 'C.forkOS'.-forkOS :: Concurrent :> es => Eff es () -> Eff es C.ThreadId+forkOS :: (HasCallStack, Concurrent :> es) => Eff es () -> Eff es C.ThreadId forkOS k = unsafeEff $ \es -> do   esF <- cloneEnv es   C.forkOS $ unEff k esF  -- | Lifted 'E.forkOSWithUnmask'. forkOSWithUnmask-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => ((forall a. Eff es a -> Eff es a) -> Eff es ())   -> Eff es C.ThreadId forkOSWithUnmask = liftForkWithUnmask C.forkOSWithUnmask@@ -197,13 +197,13 @@ isCurrentThreadBound = unsafeEff_ C.isCurrentThreadBound  -- | Lifted 'C.runInBoundThread'.-runInBoundThread :: Concurrent :> es => Eff es a -> Eff es a+runInBoundThread :: (HasCallStack, Concurrent :> es) => Eff es a -> Eff es a runInBoundThread k = unsafeEff $ \es -> do   esF <- cloneEnv es   C.runInBoundThread $ unEff k esF  -- | Lifted 'C.runInUnboundThread'.-runInUnboundThread :: Concurrent :> es => Eff es a -> Eff es a+runInUnboundThread :: (HasCallStack, Concurrent :> es) => Eff es a -> Eff es a runInUnboundThread k = unsafeEff $ \es -> do   esF <- cloneEnv es   C.runInUnboundThread $ unEff k esF@@ -219,7 +219,8 @@ -- Helpers  liftForkWithUnmask-  :: (((forall c. IO c -> IO c) -> IO a) -> IO C.ThreadId)+  :: HasCallStack+  => (((forall c. IO c -> IO c) -> IO a) -> IO C.ThreadId)   -> ((forall c. Eff es c -> Eff es c) -> Eff es a)   -> Eff es C.ThreadId liftForkWithUnmask fork action = unsafeEff $ \es -> do

@@ -91,27 +91,27 @@ import Effectful.Dispatch.Static.Unsafe  -- | Lifted 'A.async'.-async :: Concurrent :> es => Eff es a -> Eff es (Async a)+async :: (HasCallStack, Concurrent :> es) => Eff es a -> Eff es (Async a) async = liftAsync A.async  -- | Lifted 'A.asyncBound'.-asyncBound :: Concurrent :> es => Eff es a -> Eff es (Async a)+asyncBound :: (HasCallStack, Concurrent :> es) => Eff es a -> Eff es (Async a) asyncBound = liftAsync A.asyncBound  -- | Lifted 'A.asyncOn'.-asyncOn :: Concurrent :> es => Int -> Eff es a -> Eff es (Async a)+asyncOn :: (HasCallStack, Concurrent :> es) => Int -> Eff es a -> Eff es (Async a) asyncOn cpu = liftAsync (A.asyncOn cpu)  -- | Lifted 'A.asyncWithUnmask'. asyncWithUnmask-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => ((forall b. Eff es b -> Eff es b) -> Eff es a)   -> Eff es (Async a) asyncWithUnmask = liftAsyncWithUnmask A.asyncWithUnmask  -- | Lifted 'A.asyncOnWithUnmask'. asyncOnWithUnmask-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => Int   -> ((forall b. Eff es b -> Eff es b) -> Eff es a)   -> Eff es (Async a)@@ -119,7 +119,7 @@  -- | Lifted 'A.withAsync'. withAsync-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => Eff es a   -> (Async a -> Eff es b)   -> Eff es b@@ -127,7 +127,7 @@  -- | Lifted 'A.withAsyncBound'. withAsyncBound-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => Eff es a   -> (Async a -> Eff es b)   -> Eff es b@@ -135,7 +135,7 @@  -- | Lifted 'A.withAsyncOn'. withAsyncOn-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => Int   -> Eff es a   -> (Async a -> Eff es b)@@ -144,7 +144,7 @@  -- | Lifted 'A.withAsyncWithUnmask'. withAsyncWithUnmask-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => ((forall c. Eff es c -> Eff es c) -> Eff es a)   -> (Async a -> Eff es b)   -> Eff es b@@ -152,7 +152,7 @@  -- | Lifted 'A.withAsyncOnWithUnmask'. withAsyncOnWithUnmask-  :: Concurrent :> es+  :: (HasCallStack, Concurrent :> es)   => Int   -> ((forall c. Eff es c -> Eff es c) -> Eff es a)   -> (Async a -> Eff es b)@@ -268,22 +268,22 @@ link2Only f a b = unsafeEff_ $ A.link2Only f a b  -- | Lifted 'A.race'.-race :: Concurrent :> es => Eff es a -> Eff es b -> Eff es (Either a b)+race :: (HasCallStack, Concurrent :> es) => Eff es a -> Eff es b -> Eff es (Either a b) race ma mb = unsafeEff $ \es -> do   A.race (unEff ma =<< cloneEnv es) (unEff mb =<< cloneEnv es)  -- | Lifted 'A.race_'.-race_ ::  Concurrent :> es => Eff es a -> Eff es b -> Eff es ()+race_ :: (HasCallStack, Concurrent :> es) => Eff es a -> Eff es b -> Eff es () race_ ma mb = unsafeEff $ \es -> do   A.race_ (unEff ma =<< cloneEnv es) (unEff mb =<< cloneEnv es)  -- | Lifted 'A.concurrently'.-concurrently :: Concurrent :> es => Eff es a -> Eff es b -> Eff es (a, b)+concurrently :: (HasCallStack, Concurrent :> es) => Eff es a -> Eff es b -> Eff es (a, b) concurrently ma mb = unsafeEff $ \es -> do   A.concurrently (unEff ma =<< cloneEnv es) (unEff mb =<< cloneEnv es)  -- | Lifted 'A.concurrently_'.-concurrently_ :: Concurrent :> es => Eff es a -> Eff es b -> Eff es ()+concurrently_ :: (HasCallStack, Concurrent :> es) => Eff es a -> Eff es b -> Eff es () concurrently_ ma mb = unsafeEff $ \es -> do   A.concurrently_ (unEff ma =<< cloneEnv es) (unEff mb =<< cloneEnv es) @@ -293,7 +293,7 @@  -- | Lifted 'A.mapConcurrently'. mapConcurrently-  :: (Traversable f, Concurrent :> es)+  :: (HasCallStack, Traversable f, Concurrent :> es)   => (a -> Eff es b)   -> f a   -> Eff es (f b)@@ -302,7 +302,7 @@  -- | Lifted 'A.mapConcurrently_'. mapConcurrently_-  :: (Foldable f, Concurrent :> es)+  :: (HasCallStack, Foldable f, Concurrent :> es)   => (a -> Eff es b)   -> f a   -> Eff es ()@@ -311,7 +311,7 @@  -- | Lifted 'A.forConcurrently'. forConcurrently-  :: (Traversable f, Concurrent :> es)+  :: (HasCallStack, Traversable f, Concurrent :> es)   => f a   -> (a -> Eff es b)   -> Eff es (f b)@@ -320,7 +320,7 @@  -- | Lifted 'A.forConcurrently_'. forConcurrently_-  :: (Foldable f, Concurrent :> es)+  :: (HasCallStack, Foldable f, Concurrent :> es)   => f a   -> (a -> Eff es b)   -> Eff es ()@@ -328,12 +328,20 @@   U.forConcurrently_ t (\a -> unEff (f a) =<< cloneEnv es)  -- | Lifted 'A.replicateConcurrently'.-replicateConcurrently :: Concurrent :> es => Int -> Eff es a -> Eff es [a]+replicateConcurrently+  :: (HasCallStack, Concurrent :> es)+  => Int+  -> Eff es a+  -> Eff es [a] replicateConcurrently n f = unsafeEff $ \es -> do   U.replicateConcurrently n (unEff f =<< cloneEnv es)  -- | Lifted 'A.replicateConcurrently_'.-replicateConcurrently_ :: Concurrent :> es => Int -> Eff es a -> Eff es ()+replicateConcurrently_+  :: (HasCallStack, Concurrent :> es)+  => Int+  -> Eff es a+  -> Eff es () replicateConcurrently_ n f = unsafeEff $ \es -> do   U.replicateConcurrently_ n (unEff f =<< cloneEnv es) @@ -342,7 +350,7 @@  -- | Lifted 'U.pooledMapConcurrentlyN'. pooledMapConcurrentlyN-  :: (Concurrent :> es, Traversable t)+  :: (HasCallStack, Concurrent :> es, Traversable t)   => Int   -> (a -> Eff es b)   -> t a@@ -352,7 +360,7 @@  -- | Lifted 'U.pooledMapConcurrently'. pooledMapConcurrently-  :: (Concurrent :> es, Traversable t)+  :: (HasCallStack, Concurrent :> es, Traversable t)   => (a -> Eff es b)   -> t a   -> Eff es (t b)@@ -361,7 +369,7 @@  -- | Lifted 'U.pooledMapConcurrentlyN'. pooledMapConcurrentlyN_-  :: (Concurrent :> es, Foldable f)+  :: (HasCallStack, Concurrent :> es, Foldable f)   => Int   -> (a -> Eff es b)   -> f a@@ -371,7 +379,7 @@  -- | Lifted 'U.pooledMapConcurrently_'. pooledMapConcurrently_-  :: (Concurrent :> es, Foldable f)+  :: (HasCallStack, Concurrent :> es, Foldable f)   => (a -> Eff es b)   -> f a   -> Eff es ()@@ -380,7 +388,7 @@  -- | Lifted 'U.pooledForConcurrentlyN'. pooledForConcurrentlyN-  :: (Concurrent :> es, Traversable t)+  :: (HasCallStack, Concurrent :> es, Traversable t)   => Int   -> t a   -> (a -> Eff es b)@@ -390,7 +398,7 @@  -- | Lifted 'U.pooledForConcurrently'. pooledForConcurrently-  :: (Concurrent :> es, Traversable t)+  :: (HasCallStack, Concurrent :> es, Traversable t)   => t a   -> (a -> Eff es b)   -> Eff es (t b)@@ -399,7 +407,7 @@  -- | Lifted 'U.pooledForConcurrentlyN'. pooledForConcurrentlyN_-  :: (Concurrent :> es, Foldable f)+  :: (HasCallStack, Concurrent :> es, Foldable f)   => Int   -> f a   -> (a -> Eff es b)@@ -409,7 +417,7 @@  -- | Lifted 'U.pooledForConcurrently_'. pooledForConcurrently_-  :: (Concurrent :> es, Foldable f)+  :: (HasCallStack, Concurrent :> es, Foldable f)   => f a   -> (a -> Eff es b)   -> Eff es ()@@ -417,22 +425,40 @@   U.pooledForConcurrently_ t (\a -> unEff (f a) =<< cloneEnv es)  -- | Lifted 'U.pooledReplicateConcurrentlyN'.-pooledReplicateConcurrentlyN :: Concurrent :> es => Int -> Int -> Eff es a -> Eff es [a]+pooledReplicateConcurrentlyN+  :: (HasCallStack, Concurrent :> es)+  => Int+  -> Int+  -> Eff es a+  -> Eff es [a] pooledReplicateConcurrentlyN threads n f = unsafeEff $ \es -> do   U.pooledReplicateConcurrentlyN threads n (unEff f =<< cloneEnv es)  -- | Lifted 'U.pooledReplicateConcurrently'.-pooledReplicateConcurrently :: Concurrent :> es => Int -> Eff es a -> Eff es [a]+pooledReplicateConcurrently+  :: (HasCallStack, Concurrent :> es)+  => Int+  -> Eff es a+  -> Eff es [a] pooledReplicateConcurrently n f = unsafeEff $ \es -> do   U.pooledReplicateConcurrently n (unEff f =<< cloneEnv es)  -- | Lifted 'U.pooledReplicateConcurrentlyN_'.-pooledReplicateConcurrentlyN_ :: Concurrent :> es => Int -> Int -> Eff es a -> Eff es ()+pooledReplicateConcurrentlyN_+  :: (HasCallStack, Concurrent :> es)+  => Int+  -> Int+  -> Eff es a+  -> Eff es () pooledReplicateConcurrentlyN_ threads n f = unsafeEff $ \es -> do   U.pooledReplicateConcurrentlyN_ threads n (unEff f =<< cloneEnv es)  -- | Lifted 'U.pooledReplicateConcurrently_'.-pooledReplicateConcurrently_ :: Concurrent :> es => Int -> Eff es a -> Eff es ()+pooledReplicateConcurrently_+  :: (HasCallStack, Concurrent :> es)+  => Int+  -> Eff es a+  -> Eff es () pooledReplicateConcurrently_ n f = unsafeEff $ \es -> do   U.pooledReplicateConcurrently_ n (unEff f =<< cloneEnv es) @@ -448,7 +474,7 @@   Alt    :: Conc es a -> Conc es a -> Conc es a   Empty  :: Conc es a -deriving instance Functor (Conc es)+deriving stock instance Functor (Conc es)  instance Applicative (Conc es) where   pure   = Pure@@ -472,7 +498,7 @@ conc = Action  -- | Lifted 'U.runConc'.-runConc :: Concurrent :> es => Conc es a -> Eff es a+runConc :: (HasCallStack, Concurrent :> es) => Conc es a -> Eff es a runConc m = unsafeEff $ \es -> U.runConc (unliftConc es m)   where     unliftConc :: Env es -> Conc es a -> U.Conc IO a@@ -513,7 +539,8 @@ -- Helpers  liftAsync-  :: (IO a -> IO (Async a))+  :: HasCallStack+  => (IO a -> IO (Async a))   -> Eff es a   -> Eff es (Async a) liftAsync fork action = unsafeEff $ \es -> do@@ -521,7 +548,8 @@   fork $ unEff action esA  liftAsyncWithUnmask-  :: (((forall b. IO b -> IO b) -> IO a) -> IO (Async a))+  :: HasCallStack+  => (((forall b. IO b -> IO b) -> IO a) -> IO (Async a))   -> ((forall b. Eff es b -> Eff es b) -> Eff es a)   -> Eff es (Async a) liftAsyncWithUnmask fork action = unsafeEff $ \es -> do@@ -530,7 +558,8 @@   fork $ \unmask -> unEff (action $ reallyUnsafeLiftMapIO unmask) esA  liftWithAsync-  :: (IO a -> (Async a -> IO b) -> IO b)+  :: HasCallStack+  => (IO a -> (Async a -> IO b) -> IO b)   -> Eff es a   -> (Async a -> Eff es b)   -> Eff es b@@ -540,7 +569,8 @@         (\a -> unEff (k a) es)  liftWithAsyncWithUnmask-  :: (((forall c. IO c -> IO c) -> IO a) -> (Async a -> IO b) -> IO b)+  :: HasCallStack+  => (((forall c. IO c -> IO c) -> IO a) -> (Async a -> IO b) -> IO b)   -> ((forall c. Eff es c -> Eff es c) -> Eff es a)   -> (Async a -> Eff es b)   -> Eff es b

@@ -0,0 +1,50 @@+-- | Lifted "Control.Concurrent.Chan.Strict".+--+-- @since 2.4.0.0+module Effectful.Concurrent.Chan.Strict+  ( -- * Effect+    Concurrent++    -- ** Handlers+  , runConcurrent++    -- * Chan+  , Chan'+  , newChan'+  , writeChan'+  , readChan'+  , dupChan'+  , getChan'Contents+  , writeList2Chan'+  ) where++import Control.Concurrent.Chan.Strict (Chan')+import Control.Concurrent.Chan.Strict qualified as C++import Effectful+import Effectful.Concurrent.Effect+import Effectful.Dispatch.Static++-- | Lifted 'C.newChan''.+newChan' :: Concurrent :> es => Eff es (Chan' a)+newChan' = unsafeEff_ C.newChan'++-- | Lifted 'C.writeChan''.+writeChan' :: Concurrent :> es => Chan' a -> a -> Eff es ()+writeChan' c = unsafeEff_ . C.writeChan' c++-- | Lifted 'C.readChan''.+readChan' :: Concurrent :> es => Chan' a -> Eff es a+readChan' = unsafeEff_ . C.readChan'++-- | Lifted 'C.dupChan''.+dupChan' :: Concurrent :> es => Chan' a -> Eff es (Chan' a)+dupChan' = unsafeEff_ . C.dupChan'++-- | Lifted 'C.getChan'Contents'.+getChan'Contents :: Concurrent :> es => Chan' a -> Eff es [a]+getChan'Contents = unsafeEff_ . C.getChan'Contents++-- | Lifted 'C.writeList2Chan''.+writeList2Chan' :: Concurrent :> es => Chan' a -> [a] -> Eff es ()+writeList2Chan' c = unsafeEff_ . C.writeList2Chan' c

@@ -17,7 +17,7 @@ -- it possible to escape the scope of any scoped effect operation. Consider the -- following: ----- >>> import qualified Effectful.Reader.Static as R+-- >>> import Effectful.Reader.Static qualified as R -- -- >>> printAsk msg = liftIO . putStrLn . (msg ++) . (": " ++) =<< R.ask --@@ -54,14 +54,14 @@ -- a mutable state. That's why statically dispatched @State@ and @Writer@ -- effects come in two flavors, local and shared: ----- >>> import qualified Effectful.State.Static.Local as SL+-- >>> import Effectful.State.Static.Local qualified as SL -- >>> :{ --   runEff . SL.execState "Hi" . runConcurrent $ do --     replicateConcurrently_ 3 $ SL.modify (++ "!") -- :} -- "Hi" ----- >>> import qualified Effectful.State.Static.Shared as SS+-- >>> import Effectful.State.Static.Shared qualified as SS -- >>> :{ --   runEff . SS.execState "Hi" . runConcurrent $ do --     replicateConcurrently_ 3 $ SS.modify (++ "!")@@ -78,7 +78,7 @@ data instance StaticRep Concurrent = Concurrent  -- | Run the 'Concurrent' effect.-runConcurrent :: IOE :> es => Eff (Concurrent : es) a -> Eff es a+runConcurrent :: (HasCallStack, IOE :> es) => Eff (Concurrent : es) a -> Eff es a runConcurrent = evalStaticRep Concurrent  -- $setup

@@ -81,34 +81,47 @@ withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b withMVar var f = reallyUnsafeUnliftIO $ \unlift -> do   M.withMVar var $ unlift . f+{-# INLINE withMVar #-}  -- | Lifted 'M.withMVarMasked'. withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b withMVarMasked var f = reallyUnsafeUnliftIO $ \unlift -> do   M.withMVarMasked var $ unlift . f+{-# INLINE withMVarMasked #-}  -- | Lifted 'M.modifyMVar_'. modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es () modifyMVar_ var f = reallyUnsafeUnliftIO $ \unlift -> do   M.modifyMVar_ var $ unlift . f+{-# INLINE modifyMVar_ #-}  -- | Lifted 'M.modifyMVar'. modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b modifyMVar var f = reallyUnsafeUnliftIO $ \unlift -> do   M.modifyMVar var $ unlift . f+{-# INLINE modifyMVar #-}  -- | Lifted 'M.modifyMVarMasked_'. modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es () modifyMVarMasked_ var f = reallyUnsafeUnliftIO $ \unlift -> do   M.modifyMVarMasked_ var $ unlift . f+{-# INLINE modifyMVarMasked_ #-}  -- | Lifted 'M.modifyMVarMasked'. modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b modifyMVarMasked var f = reallyUnsafeUnliftIO $ \unlift -> do   M.modifyMVarMasked var $ unlift . f+{-# INLINE modifyMVarMasked #-}  -- | Lifted 'M.mkWeakMVar'.-mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))+--+-- /Note:/ the finalizer will run a cloned environment, so any changes it makes+-- to thread local data will not be visible outside of it.+mkWeakMVar+  :: (HasCallStack, Concurrent :> es)+  => MVar a+  -> Eff es ()+  -> Eff es (Weak (MVar a)) mkWeakMVar var f = unsafeEff $ \es -> do   -- The finalizer can run at any point and in any thread.   M.mkWeakMVar var . unEff f =<< cloneEnv es

@@ -1,5 +1,6 @@--- | Lifted "Control.Concurrent.MVar" with operations that force values put--- inside an 'MVar' to WHNF.+-- | Lifted "Control.Concurrent.MVar.Strict".+--+-- @since 2.4.0.0 module Effectful.Concurrent.MVar.Strict   ( -- * Effect     Concurrent@@ -8,29 +9,29 @@   , runConcurrent      -- * MVar-  , MVar-  , newEmptyMVar-  , newMVar-  , takeMVar-  , putMVar-  , readMVar-  , swapMVar-  , tryTakeMVar-  , tryPutMVar-  , isEmptyMVar-  , withMVar-  , withMVarMasked-  , modifyMVar-  , modifyMVar_-  , modifyMVarMasked-  , modifyMVarMasked_-  , tryReadMVar-  , mkWeakMVar+  , MVar'+  , newEmptyMVar'+  , newMVar'+  , takeMVar'+  , putMVar'+  , readMVar'+  , swapMVar'+  , tryTakeMVar'+  , tryPutMVar'+  , tryReadMVar'+  , isEmptyMVar'+  , withMVar'+  , withMVar'Masked+  , modifyMVar'+  , modifyMVar'_+  , modifyMVar'Masked+  , modifyMVar'Masked_+  , mkWeakMVar'   ) where  import System.Mem.Weak (Weak)-import Control.Concurrent.MVar (MVar)-import Control.Concurrent.MVar qualified as M+import Control.Concurrent.MVar.Strict (MVar')+import Control.Concurrent.MVar.Strict qualified as M  import Effectful import Effectful.Concurrent.Effect@@ -38,86 +39,90 @@ import Effectful.Dispatch.Static.Primitive import Effectful.Dispatch.Static.Unsafe --- | Lifted 'M.newEmptyMVar'.-newEmptyMVar :: Concurrent :> es => Eff es (MVar a)-newEmptyMVar = unsafeEff_ M.newEmptyMVar+-- | Lifted 'M.newEmptyMVar''.+newEmptyMVar' :: Concurrent :> es => Eff es (MVar' a)+newEmptyMVar' = unsafeEff_ M.newEmptyMVar' --- | Lifted 'M.newMVar' that evaluates the value to WHNF.-newMVar :: Concurrent :> es => a -> Eff es (MVar a)-newMVar a = unsafeEff_ $ a `seq` M.newMVar a+-- | Lifted 'M.newMVar''.+newMVar' :: Concurrent :> es => a -> Eff es (MVar' a)+newMVar' = unsafeEff_ . M.newMVar' --- | Lifted 'M.takeMVar'.-takeMVar :: Concurrent :> es => MVar a -> Eff es a-takeMVar = unsafeEff_ . M.takeMVar+-- | Lifted 'M.takeMVar''.+takeMVar' :: Concurrent :> es => MVar' a -> Eff es a+takeMVar' = unsafeEff_ . M.takeMVar' --- | Lifted 'M.putMVar'.-putMVar :: Concurrent :> es => MVar a -> a -> Eff es ()-putMVar var a = unsafeEff_ $ a `seq` M.putMVar var a+-- | Lifted 'M.putMVar''.+putMVar' :: Concurrent :> es => MVar' a -> a -> Eff es ()+putMVar' var = unsafeEff_ . M.putMVar' var --- | Lifted 'M.readMVar'.-readMVar :: Concurrent :> es => MVar a -> Eff es a-readMVar = unsafeEff_ . M.readMVar+-- | Lifted 'M.readMVar''.+readMVar' :: Concurrent :> es => MVar' a -> Eff es a+readMVar' = unsafeEff_ . M.readMVar' --- | Lifted 'M.swapMVar' that evaluates the new value to WHNF.-swapMVar :: Concurrent :> es => MVar a -> a -> Eff es a-swapMVar var a = unsafeEff_ $ a `seq` M.swapMVar var a+-- | Lifted 'M.swapMVar''.+swapMVar' :: Concurrent :> es => MVar' a -> a -> Eff es a+swapMVar' var = unsafeEff_ . M.swapMVar' var --- | Lifted 'M.tryTakeMVar'.-tryTakeMVar :: Concurrent :> es => MVar a -> Eff es (Maybe a)-tryTakeMVar = unsafeEff_ . M.tryTakeMVar+-- | Lifted 'M.tryTakeMVar''.+tryTakeMVar' :: Concurrent :> es => MVar' a -> Eff es (Maybe a)+tryTakeMVar' = unsafeEff_ . M.tryTakeMVar' --- | Lifted 'M.tryPutMVar' that evaluates the new value to WHNF.-tryPutMVar :: Concurrent :> es => MVar a -> a -> Eff es Bool-tryPutMVar var a = unsafeEff_ $ a `seq` M.tryPutMVar var a+-- | Lifted 'M.tryPutMVar''.+tryPutMVar' :: Concurrent :> es => MVar' a -> a -> Eff es Bool+tryPutMVar' var = unsafeEff_ . M.tryPutMVar' var --- | Lifted 'M.isEmptyMVar'.-isEmptyMVar :: Concurrent :> es => MVar a -> Eff es Bool-isEmptyMVar = unsafeEff_ . M.isEmptyMVar+-- | Lifted 'M.tryReadMVar''.+tryReadMVar' :: Concurrent :> es => MVar' a -> Eff es (Maybe a)+tryReadMVar' = unsafeEff_ . M.tryReadMVar' --- | Lifted 'M.tryReadMVar'.-tryReadMVar :: Concurrent :> es => MVar a -> Eff es (Maybe a)-tryReadMVar = unsafeEff_ . M.tryReadMVar+-- | Lifted 'M.isEmptyMVar''.+isEmptyMVar' :: Concurrent :> es => MVar' a -> Eff es Bool+isEmptyMVar' = unsafeEff_ . M.isEmptyMVar' --- | Lifted 'M.withMVar'.-withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b-withMVar var f = reallyUnsafeUnliftIO $ \unlift -> do-  M.withMVar var $ unlift . f+-- | Lifted 'M.withMVar''.+withMVar' :: Concurrent :> es => MVar' a -> (a -> Eff es b) -> Eff es b+withMVar' var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.withMVar' var $ unlift . f+{-# INLINE withMVar' #-} --- | Lifted 'M.withMVarMasked'.-withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b-withMVarMasked var f = reallyUnsafeUnliftIO $ \unlift -> do-  M.withMVarMasked var $ unlift . f+-- | Lifted 'M.withMVar'Masked'.+withMVar'Masked :: Concurrent :> es => MVar' a -> (a -> Eff es b) -> Eff es b+withMVar'Masked var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.withMVar'Masked var $ unlift . f+{-# INLINE withMVar'Masked #-} --- | Lifted 'M.modifyMVar_' that evaluates the new value to WHNF.-modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()-modifyMVar_ var f = reallyUnsafeUnliftIO $ \unlift -> do-  M.modifyMVar_ var $ \a0 -> do-    a <- unlift $ f a0-    a `seq` pure a+-- | Lifted 'M.modifyMVar'_'.+modifyMVar'_ :: Concurrent :> es => MVar' a -> (a -> Eff es a) -> Eff es ()+modifyMVar'_ var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.modifyMVar'_ var $ unlift . f+{-# INLINE modifyMVar'_ #-} --- | Lifted 'M.modifyMVar' that evaluates the new value to WHNF.-modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b-modifyMVar var f = reallyUnsafeUnliftIO $ \unlift -> do-  M.modifyMVar var $ \a0 -> do-    (a, b) <- unlift $ f a0-    a `seq` pure (a, b)+-- | Lifted 'M.modifyMVar''.+modifyMVar' :: Concurrent :> es => MVar' a -> (a -> Eff es (a, b)) -> Eff es b+modifyMVar' var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.modifyMVar' var $ unlift . f+{-# INLINE modifyMVar' #-} --- | Lifted 'M.modifyMVarMasked_' that evaluates the new value to WHNF.-modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()-modifyMVarMasked_ var f = reallyUnsafeUnliftIO $ \unlift -> do-  M.modifyMVarMasked_ var $ \a0 -> do-    a <- unlift $ f a0-    a `seq` pure a+-- | Lifted 'M.modifyMVar'Masked_'.+modifyMVar'Masked_ :: Concurrent :> es => MVar' a -> (a -> Eff es a) -> Eff es ()+modifyMVar'Masked_ var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.modifyMVar'Masked_ var $ unlift . f+{-# INLINE modifyMVar'Masked_ #-} --- | Lifted 'M.modifyMVarMasked' that evaluates the new value to WHNF.-modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b-modifyMVarMasked var f = reallyUnsafeUnliftIO $ \unlift -> do-  M.modifyMVarMasked var $ \a0 -> do-    a <- unlift $ f a0-    a `seq` pure a+-- | Lifted 'M.modifyMVar'Masked'.+modifyMVar'Masked :: Concurrent :> es => MVar' a -> (a -> Eff es (a, b)) -> Eff es b+modifyMVar'Masked var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.modifyMVar'Masked var $ unlift . f+{-# INLINE modifyMVar'Masked #-} --- | Lifted 'M.mkWeakMVar'.-mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))-mkWeakMVar var f = unsafeEff $ \es -> do+-- | Lifted 'M.mkWeakMVar''.+--+-- /Note:/ the finalizer will run a cloned environment, so any changes it makes+-- to thread local data will not be visible outside of it.+mkWeakMVar'+  :: (HasCallStack, Concurrent :> es)+  => MVar' a -> Eff es ()+  -> Eff es (Weak (MVar' a))+mkWeakMVar' var f = unsafeEff $ \es -> do   -- The finalizer can run at any point and in any thread.-  M.mkWeakMVar var . unEff f =<< cloneEnv es+  M.mkWeakMVar' var . unEff f =<< cloneEnv es

@@ -0,0 +1,138 @@+-- | Lifted "Control.Concurrent.MVar" with operations that force values put+-- inside an 'MVar' to WHNF.+module Effectful.Concurrent.MVar.Strict.Compat+  {-# DEPRECATED "Use Effectful.Concurrent.MVar.Strict" #-}+  ( -- * Effect+    Concurrent++    -- ** Handlers+  , runConcurrent++    -- * MVar+  , MVar+  , newEmptyMVar+  , newMVar+  , takeMVar+  , putMVar+  , readMVar+  , swapMVar+  , tryTakeMVar+  , tryPutMVar+  , isEmptyMVar+  , withMVar+  , withMVarMasked+  , modifyMVar+  , modifyMVar_+  , modifyMVarMasked+  , modifyMVarMasked_+  , tryReadMVar+  , mkWeakMVar+  ) where++import System.Mem.Weak (Weak)+import Control.Exception (evaluate)+import Control.Concurrent.MVar (MVar)+import Control.Concurrent.MVar qualified as M++import Effectful+import Effectful.Concurrent.Effect+import Effectful.Dispatch.Static+import Effectful.Dispatch.Static.Primitive+import Effectful.Dispatch.Static.Unsafe++-- | Lifted 'M.newEmptyMVar'.+newEmptyMVar :: Concurrent :> es => Eff es (MVar a)+newEmptyMVar = unsafeEff_ M.newEmptyMVar++-- | Lifted 'M.newMVar' that evaluates the value to WHNF.+newMVar :: Concurrent :> es => a -> Eff es (MVar a)+newMVar a = unsafeEff_ $ M.newMVar =<< evaluate a++-- | Lifted 'M.takeMVar'.+takeMVar :: Concurrent :> es => MVar a -> Eff es a+takeMVar = unsafeEff_ . M.takeMVar++-- | Lifted 'M.putMVar'.+putMVar :: Concurrent :> es => MVar a -> a -> Eff es ()+putMVar var a = unsafeEff_ $ M.putMVar var =<< evaluate a++-- | Lifted 'M.readMVar'.+readMVar :: Concurrent :> es => MVar a -> Eff es a+readMVar = unsafeEff_ . M.readMVar++-- | Lifted 'M.swapMVar' that evaluates the new value to WHNF.+swapMVar :: Concurrent :> es => MVar a -> a -> Eff es a+swapMVar var a = unsafeEff_ $ M.swapMVar var =<< evaluate a++-- | Lifted 'M.tryTakeMVar'.+tryTakeMVar :: Concurrent :> es => MVar a -> Eff es (Maybe a)+tryTakeMVar = unsafeEff_ . M.tryTakeMVar++-- | Lifted 'M.tryPutMVar' that evaluates the new value to WHNF.+tryPutMVar :: Concurrent :> es => MVar a -> a -> Eff es Bool+tryPutMVar var a = unsafeEff_ $ M.tryPutMVar var =<< evaluate a++-- | Lifted 'M.isEmptyMVar'.+isEmptyMVar :: Concurrent :> es => MVar a -> Eff es Bool+isEmptyMVar = unsafeEff_ . M.isEmptyMVar++-- | Lifted 'M.tryReadMVar'.+tryReadMVar :: Concurrent :> es => MVar a -> Eff es (Maybe a)+tryReadMVar = unsafeEff_ . M.tryReadMVar++-- | Lifted 'M.withMVar'.+withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b+withMVar var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.withMVar var $ unlift . f+{-# INLINE withMVar #-}++-- | Lifted 'M.withMVarMasked'.+withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b+withMVarMasked var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.withMVarMasked var $ unlift . f+{-# INLINE withMVarMasked #-}++-- | Lifted 'M.modifyMVar_' that evaluates the new value to WHNF.+modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()+modifyMVar_ var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.modifyMVar_ var $ \a0 -> do+    a <- unlift $ f a0+    evaluate a+{-# INLINE modifyMVar_ #-}++-- | Lifted 'M.modifyMVar' that evaluates the new value to WHNF.+modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b+modifyMVar var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.modifyMVar var $ \a0 -> do+    (a, b) <- unlift $ f a0+    (, b) <$> evaluate a+{-# INLINE modifyMVar #-}++-- | Lifted 'M.modifyMVarMasked_' that evaluates the new value to WHNF.+modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()+modifyMVarMasked_ var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.modifyMVarMasked_ var $ \a0 -> do+    a <- unlift $ f a0+    evaluate a+{-# INLINE modifyMVarMasked_ #-}++-- | Lifted 'M.modifyMVarMasked' that evaluates the new value to WHNF.+modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b+modifyMVarMasked var f = reallyUnsafeUnliftIO $ \unlift -> do+  M.modifyMVarMasked var $ \a0 -> do+    (a, b) <- unlift $ f a0+    (, b) <$> evaluate a+{-# INLINE modifyMVarMasked #-}++-- | Lifted 'M.mkWeakMVar'.+--+-- /Note:/ the finalizer will run a cloned environment, so any changes it makes+-- to thread local data will not be visible outside of it.+mkWeakMVar+  :: (HasCallStack, Concurrent :> es)+  => MVar a+  -> Eff es ()+  -> Eff es (Weak (MVar a))+mkWeakMVar var f = unsafeEff $ \es -> do+  -- The finalizer can run at any point and in any thread.+  M.mkWeakMVar var . unEff f =<< cloneEnv es

@@ -116,7 +116,14 @@ registerDelay = unsafeEff_ . STM.registerDelay  -- | Lifted 'STM.mkWeakTVar'.-mkWeakTVar :: Concurrent :> es => TVar a -> Eff es () -> Eff es (Weak (TVar a))+--+-- /Note:/ the finalizer will run a cloned environment, so any changes it makes+-- to thread local data will not be visible outside of it.+mkWeakTVar+  :: (HasCallStack, Concurrent :> es)+  => TVar a+  -> Eff es ()+  -> Eff es (Weak (TVar a)) mkWeakTVar var f = unsafeEff $ \es -> do   -- The finalizer can run at any point and in any thread.   STM.mkWeakTVar var . unEff f =<< cloneEnv es@@ -130,7 +137,14 @@ newEmptyTMVarIO = unsafeEff_ STM.newEmptyTMVarIO  -- | Lifted 'STM.mkWeakTMVar'.-mkWeakTMVar :: Concurrent :> es => TMVar a -> Eff es () -> Eff es (Weak (TMVar a))+--+-- /Note:/ the finalizer will run a cloned environment, so any changes it makes+-- to thread local data will not be visible outside of it.+mkWeakTMVar+  :: (HasCallStack, Concurrent :> es)+  => TMVar a+  -> Eff es ()+  -> Eff es (Weak (TMVar a)) mkWeakTMVar var f = unsafeEff $ \es -> do   -- The finalizer can run at any point and in any thread.   STM.mkWeakTMVar var . unEff f =<< cloneEnv es

@@ -4,9 +4,9 @@ -- to avoid name clashes with the functions provided by "Prelude", e.g.: -- -- > import Data.ByteString (ByteString)--- > import qualified Data.ByteString.Char8 as BS8+-- > import Data.ByteString.Char8 qualified as BS8 -- > import Effectful.Console.ByteString (Console)--- > import qualified Effectful.Console.ByteString as Console+-- > import Effectful.Console.ByteString qualified as Console -- module Effectful.Console.ByteString   ( -- * Effect

@@ -4,9 +4,9 @@ -- 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 Data.ByteString.Lazy.Char8 qualified as LBS8 -- > import Effectful.Console.ByteString.Lazy (Console)--- > import qualified Effectful.Console.ByteString.Lazy as Console+-- > import Effectful.Console.ByteString.Lazy qualified as Console -- module Effectful.Console.ByteString.Lazy   ( -- * Effect

@@ -17,5 +17,5 @@ data instance StaticRep Console = Console  -- | Run the 'Console' effect.-runConsole :: IOE :> es => Eff (Console : es) a -> Eff es a+runConsole :: (HasCallStack, IOE :> es) => Eff (Console : es) a -> Eff es a runConsole = evalStaticRep Console

@@ -32,7 +32,7 @@ data instance StaticRep Environment = Environment  -- | Run the 'Environment' effect.-runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a+runEnvironment :: (HasCallStack, IOE :> es) => Eff (Environment : es) a -> Eff es a runEnvironment = evalStaticRep Environment  -- | Lifted 'E.getArgs'.

@@ -16,5 +16,5 @@ data instance StaticRep FileSystem = FileSystem  -- | Run the 'FileSystem' effect.-runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a+runFileSystem :: (HasCallStack, IOE :> es) => Eff (FileSystem : es) a -> Eff es a runFileSystem = evalStaticRep FileSystem

@@ -5,8 +5,8 @@ -- 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+-- > import Data.ByteString qualified as BS+-- > import Effectful.FileSystem.IO.ByteString qualified as EBS -- module Effectful.FileSystem.IO.ByteString #if MIN_VERSION_bytestring(0,11,2)

@@ -5,8 +5,8 @@ -- 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+-- > import Data.ByteString.Builder qualified as BSB+-- > import Effectful.FileSystem.IO.ByteString.Builder qualified as EBSB -- module Effectful.FileSystem.IO.ByteString.Builder   ( -- * Executing Builders

@@ -3,8 +3,8 @@ -- 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+-- > import Data.ByteString.Lazy.Char8 qualified as LBS8+-- > import Effectful.FileSystem.IO.ByteString.Lazy qualified as ELBS -- module Effectful.FileSystem.IO.ByteString.Lazy   ( -- * Files

@@ -0,0 +1,79 @@+-- | Lifted "Data.IORef".+--+-- /Note:/ it requires 'Prim' because @MutVar@ from the @primitive@ library is a+-- generalization of 'IORef'.+--+-- @since 2.4.0.0+module Effectful.Prim.IORef+  ( -- * Effect+    Prim++    -- ** Handlers+  , runPrim++    -- * IORef+  , IORef+  , newIORef+  , readIORef+  , writeIORef+  , modifyIORef+  , modifyIORef'+  , atomicModifyIORef+  , atomicModifyIORef'+  , atomicWriteIORef+  , mkWeakIORef+  ) where++import Data.IORef (IORef)+import Data.IORef qualified as Ref+import System.Mem.Weak (Weak)++import Effectful+import Effectful.Dispatch.Static+import Effectful.Dispatch.Static.Primitive+import Effectful.Prim++-- | Lifted 'Ref.newIORef'.+newIORef :: Prim :> es => a -> Eff es (IORef a)+newIORef = unsafeEff_ . Ref.newIORef++-- | Lifted 'Ref.readIORef'.+readIORef :: Prim :> es => IORef a -> Eff es a+readIORef = unsafeEff_ . Ref.readIORef++-- | Lifted 'Ref.writeIORef'.+writeIORef :: Prim :> es => IORef a -> a -> Eff es ()+writeIORef var = unsafeEff_ . Ref.writeIORef var++-- | Lifted 'Ref.modifyIORef'.+modifyIORef :: Prim :> es => IORef a -> (a -> a) -> Eff es ()+modifyIORef var = unsafeEff_ . Ref.modifyIORef var++-- | Lifted 'Ref.modifyIORef''.+modifyIORef' :: Prim :> es => IORef a -> (a -> a) -> Eff es ()+modifyIORef' var = unsafeEff_ . Ref.modifyIORef' var++-- | Lifted 'Ref.atomicModifyIORef'.+atomicModifyIORef :: Prim :> es => IORef a -> (a -> (a, b)) -> Eff es b+atomicModifyIORef var = unsafeEff_ . Ref.atomicModifyIORef var++-- | Lifted 'Ref.atomicModifyIORef''.+atomicModifyIORef' :: Prim :> es => IORef a -> (a -> (a, b)) -> Eff es b+atomicModifyIORef' var = unsafeEff_ . Ref.atomicModifyIORef' var++-- | Lifted 'Ref.atomicWriteIORef''.+atomicWriteIORef :: Prim :> es => IORef a -> a -> Eff es ()+atomicWriteIORef var = unsafeEff_ . Ref.atomicWriteIORef var++-- | Lifted 'Ref.mkWeakIORef'.+--+-- /Note:/ the finalizer will run a cloned environment, so any changes it makes+-- to thread local data will not be visible outside of it.+mkWeakIORef+  :: (HasCallStack, Prim :> es)+  => IORef a+  -> Eff es ()+  -> Eff es (Weak (IORef a))+mkWeakIORef var f = unsafeEff $ \es -> do+  -- The finalizer can run at any point and in any thread.+  Ref.mkWeakIORef var . unEff f =<< cloneEnv es

@@ -0,0 +1,66 @@+-- | Lifted "Data.IORef.Strict".+--+-- @since 2.4.0.0+module Effectful.Prim.IORef.Strict+  ( -- * Effect+    Prim++    -- ** Handlers+  , runPrim++    -- * IORef+  , IORef'+  , newIORef'+  , readIORef'+  , writeIORef'+  , modifyIORef'+  , atomicModifyIORef'+  , atomicWriteIORef'+  , mkWeakIORef'+  ) where++import Data.IORef.Strict (IORef')+import Data.IORef.Strict qualified as Ref+import System.Mem.Weak (Weak)++import Effectful+import Effectful.Dispatch.Static+import Effectful.Dispatch.Static.Primitive+import Effectful.Prim++-- | Lifted 'Ref.newIORef''.+newIORef' :: Prim :> es => a -> Eff es (IORef' a)+newIORef' = unsafeEff_ . Ref.newIORef'++-- | Lifted 'Ref.readIORef''.+readIORef' :: Prim :> es => IORef' a -> Eff es a+readIORef' = unsafeEff_ . Ref.readIORef'++-- | Lifted 'Ref.writeIORef''.+writeIORef' :: Prim :> es => IORef' a -> a -> Eff es ()+writeIORef' var = unsafeEff_ . Ref.writeIORef' var++-- | Lifted 'Ref.modifyIORef''.+modifyIORef' :: Prim :> es => IORef' a -> (a -> a) -> Eff es ()+modifyIORef' var = unsafeEff_ . Ref.modifyIORef' var++-- | Lifted 'Ref.atomicModifyIORef''.+atomicModifyIORef' :: Prim :> es => IORef' a -> (a -> (a, b)) -> Eff es b+atomicModifyIORef' var = unsafeEff_ . Ref.atomicModifyIORef' var++-- | Lifted 'Ref.atomicWriteIORef''.+atomicWriteIORef' :: Prim :> es => IORef' a -> a -> Eff es ()+atomicWriteIORef' var = unsafeEff_ . Ref.atomicWriteIORef' var++-- | Lifted 'Ref.mkWeakIORef''.+--+-- /Note:/ the finalizer will run a cloned environment, so any changes it makes+-- to thread local data will not be visible outside of it.+mkWeakIORef'+  :: (HasCallStack, Prim :> es)+  => IORef' a+  -> Eff es ()+  -> Eff es (Weak (IORef' a))+mkWeakIORef' var f = unsafeEff $ \es -> do+  -- The finalizer can run at any point and in any thread.+  Ref.mkWeakIORef' var . unEff f =<< cloneEnv es

@@ -62,7 +62,7 @@ type instance DispatchOf Process = Static WithSideEffects data instance StaticRep Process = Process -runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a+runProcess :: (HasCallStack, IOE :> es) => Eff (Process : es) a -> Eff es a runProcess = evalStaticRep Process  ----------------------------------------

@@ -25,7 +25,7 @@ data instance StaticRep Temporary = Temporary  -- | Run the 'Temporary' effect.-runTemporary :: IOE :> es => Eff (Temporary : es) a -> Eff es a+runTemporary :: (HasCallStack, IOE :> es) => Eff (Temporary : es) a -> Eff es a runTemporary = evalStaticRep Temporary  -- | Lifted 'T.withSystemTempFile'.

@@ -21,7 +21,7 @@ data instance StaticRep Timeout = Timeout  -- | Run the 'Timeout' effect.-runTimeout :: IOE :> es => Eff (Timeout : es) a -> Eff es a+runTimeout :: (HasCallStack, IOE :> es) => Eff (Timeout : es) a -> Eff es a runTimeout = evalStaticRep Timeout  -- | Lifted 'T.timeout'.

@@ -8,6 +8,8 @@ import UnliftIO  import Effectful+import Effectful.Concurrent.Async qualified as E+import Effectful.Dispatch.Dynamic import Effectful.Error.Static import Effectful.State.Dynamic import Utils qualified as U@@ -20,6 +22,8 @@   , testCase "unlifting several times" test_unliftMany   , testCase "async with unmask" test_asyncWithUnmask   , testCase "pooled workers" test_pooledWorkers+  , testCase "using local unlift correctly works" test_correctLocalUnlift+  , testCase "using local unlift incorrectly doesn't work" test_wrongLocalUnlift   ]  test_localState :: Assertion@@ -119,3 +123,34 @@   where     n = 10     threads = 4++test_correctLocalUnlift :: Assertion+test_correctLocalUnlift = runEff . E.runConcurrent $ do+  x <- runFork . send . RunAsyncCorrect $ pure ()+  E.wait x++test_wrongLocalUnlift :: Assertion+test_wrongLocalUnlift = runEff . E.runConcurrent $ do+  U.assertThrowsErrorCall "invalid LocalEnv use" $ do+    x <- runFork . send . RunAsyncWrong $ pure ()+    E.wait x++data Fork :: Effect where+  RunAsyncCorrect :: m a -> Fork m (E.Async a)+  RunAsyncWrong :: m a -> Fork m (E.Async a)+type instance DispatchOf Fork = Dynamic++runFork :: (IOE :> es, E.Concurrent :> es) => Eff (Fork : es) a -> Eff es a+runFork = interpret $ \env -> \case+  RunAsyncCorrect action -> do+    -- LocalEnv is correctly used in the thread in belongs to, so creation of+    -- the unlifting function should succeed.+    localUnlift env strategy $ \unlift -> do+      E.async $ unlift action+  RunAsyncWrong action -> E.async $ do+    -- LocalEnv is incorrectly passed to a different thread, so creation of the+    -- unlifting function should fail.+    localUnlift env strategy $ \unlift -> do+      unlift action+  where+    strategy = ConcUnlift Ephemeral $ Limited 1

@@ -22,6 +22,7 @@   , testCase "unsafeCoerce doesn't work" test_noUnsafeCoerce   , testCase "interpose works" test_interpose   , testCase "interpose/provider works" test_interposeProvider+  , testCase "borrow/lend works" test_borrowLend   ]  test_tailEnv :: Assertion@@ -191,11 +192,11 @@ type instance DispatchOf A = Dynamic  runA :: Int -> Eff (A : es) a -> Eff es a-runA n = interpret $ \_ -> \case+runA n = interpret_ $ \case   A -> pure n  doubleA :: A :> es => Eff es a -> Eff es a-doubleA = interpose $ \_ -> \case+doubleA = interpose_ $ \case   A -> (+) <$> send A <*> send A  data B :: Effect where@@ -203,9 +204,41 @@ type instance DispatchOf B = Dynamic  runB :: A :> es => Eff (B : es) a -> Eff es a-runB = interpret $ \_ -> \case+runB = interpret_ $ \case   B -> send A  doubleB :: B :> es => Eff es a -> Eff es a-doubleB = interpose $ \_ -> \case+doubleB = interpose_ $ \case   B -> (+) <$> send B <*> send B++----------------------------------------++test_borrowLend :: Assertion+test_borrowLend = runEff $ do+  runX 1 2 . evalState @[Int] [3] . runReader () . runReader @[Int] [4] $ do+    U.assertEqual "expected result" [1,2,3,4,1,2,3,4] =<< send X++data X :: Effect where+  X :: (State [Int] :> es, Reader [Int] :> es, Reader () :> es) => X (Eff es) [Int]+type instance DispatchOf X = Dynamic++runX :: Int -> Int -> Eff (X : es) a -> Eff es a+runX s0 r0 = reinterpret (evalState s0 . evalState () . runReader r0) $ \env -> \case+  X -> localSeqUnlift env $ \unlift -> do+    as <- localSeqLend @[State Int, Reader Int] env $ \withHandlerEffs -> do+      unlift . withHandlerEffs $ do+        () <- ask+        s <- get @Int+        r <- ask @Int+        ss <- get @[Int]+        rs <- ask @[Int]+        pure $ [s, r] ++ ss ++ rs+    bs <- localSeqBorrow @[Reader [Int], State [Int], Reader ()] env $ \withEffs -> do+      withEffs $ do+        () <- ask+        s <- get @Int+        r <- ask @Int+        ss <- get @[Int]+        rs <- ask @[Int]+        pure $ [s, r] ++ ss ++ rs+    pure $ as ++ bs

@@ -42,5 +42,5 @@ outerThrow = send OuterThrow  runOuterThrow :: Error String :> es => Eff (OuterThrow : es) a -> Eff es a-runOuterThrow = interpret $ \_ -> \case+runOuterThrow = interpret_ $ \case   OuterThrow -> throwError "outer"

@@ -0,0 +1,61 @@+module LabeledTests (labeledTests) where++import Test.Tasty+import Test.Tasty.HUnit++import Effectful+import Effectful.Dispatch.Dynamic+import Effectful.Labeled+import Effectful.Reader.Static+import Utils qualified as U++labeledTests :: TestTree+labeledTests = testGroup "Labeled"+  [ testCase "labeled behaves correctly" $ test_labeledBehavior+  , testCase "(labeled . send) and (send . Labeled) behave the same" $ test_labeledSend+  ]++test_labeledBehavior :: Assertion+test_labeledBehavior = do+  v <- runEff+    . runLabeled @"a" (runReader "a")+    . runLabeled @"b" (runReader "b")+    . runReader "c"+    $ action+  assertEqual "expected result" "abc" v+  where+    action+      :: ( Labeled "a" (Reader String) :> es+         , Labeled "b" (Reader String) :> es+         , Reader String :> es+         )+      => Eff es String+    action = do+      a <- labeled @"b" @(Reader String) $ do+        labeled @"a" @(Reader String) $ do+          ask+      b <- labeled @"b" @(Reader String) $ do+        ask+      c <- ask+      pure $ a ++ b ++ c++test_labeledSend :: Assertion+test_labeledSend = runEff $ do+  runX 1 . runLabeled @"x" (runX 2) $ do+    v0 <- send X2+    U.assertEqual "expected result" 1 v0+    v1 <- (labeled @"x" @X . send) X2+    U.assertEqual "expected result" 2 v1+    v2 <- (send . Labeled @"x") X2+    U.assertEqual "expected result" 2 v2++data X :: Effect where+  X1 :: X m Int+  X2 :: (X :> es, Labeled "x" X :> es) => X (Eff es) Int++type instance DispatchOf X = Dynamic++runX :: Int -> Eff (X : es) a -> Eff es a+runX x = interpret $ \env -> \case+  X1 -> pure x+  X2 -> localSeqUnlift env $ \unlift -> unlift $ send X1

@@ -7,6 +7,7 @@ import EnvTests import EnvironmentTests import ErrorTests+import LabeledTests import NonDetTests import PrimTests import ReaderTests@@ -21,6 +22,7 @@   , envTests   , environmentTests   , errorTests+  , labeledTests   , nonDetTests   , primTests   , readerTests

@@ -30,11 +30,11 @@      expectedLocalState :: OnEmptyPolicy -> Int     expectedLocalState = \case-      OnEmptyKeep     -> 3-      OnEmptyRollback -> 2+      OnEmptyKeep     -> 7+      OnEmptyRollback -> 0      expectedSharedState :: OnEmptyPolicy -> Int-    expectedSharedState _ = 3+    expectedSharedState _ = 7  test_empty   :: Eff [NonDet, IOE] Bool@@ -53,12 +53,15 @@ test_state evalState expectedState step = runEff $ do   evalState 0 . runNonDetBoth test $ \policy result -> do     liftIO . step $ show policy-    U.assertEqual "result" (Just ()) (dropLeft result)+    U.assertEqual "result" Nothing (dropLeft result)     s <- state @Int $ \s -> (s, 0)     U.assertEqual "state" (expectedState policy) s   where     test :: (NonDet :> es, State Int :> es) => Eff es ()-    test = (modify @Int (+1) >> empty) <|> modify @Int (+2)+    test = do+      modify @Int (+1)+      _<- (modify @Int (+2) >> empty) <|> (modify @Int (+4) >> empty)+      modify @Int (+8)  test_independentHandlers :: (String -> IO ()) -> Assertion test_independentHandlers step = runEff $ do@@ -84,7 +87,7 @@ outerEmpty = send OuterEmpty  runOuterEmpty :: NonDet :> es => Eff (OuterEmpty : es) a -> Eff es a-runOuterEmpty = interpret $ \_ -> \case+runOuterEmpty = interpret_ $ \case   OuterEmpty -> emptyEff  ----

@@ -1,13 +1,18 @@ module StateTests (stateTests) where  import Control.Exception.Lifted qualified as LE-import Control.Monad.Catch qualified as E+import Control.Exception.Safe qualified as Safe+import Control.Monad+import Control.Monad.Catch qualified as C+import Data.IORef.Strict import Test.Tasty import Test.Tasty.HUnit import UnliftIO.Exception qualified as UE  import Effectful import Effectful.Dispatch.Dynamic+import Effectful.Dispatch.Static+import Effectful.Internal.Env import Effectful.State.Static.Local import Utils qualified as U @@ -34,9 +39,19 @@  test_stateM :: Assertion test_stateM = runEff $ do-  (a, b) <- runState "hi" . stateM $ \s -> pure (s, s ++ "!!!")+  (a, b) <- runState "hi" $ do+    stateM $ \s -> do+      effs0 <- getEffectReps+      -- Trigger reallocation of the internal array in Storage.+      _ <- evalState () $ pure ()+      effs1 <- getEffectReps+      when (effs0 == effs1) $ do+        U.assertFailure "Internal array was not reallocated"+      pure (s, s ++ "!!!")   U.assertEqual "correct a" "hi"    a   U.assertEqual "correct b" "hi!!!" b+  where+    getEffectReps = unsafeEff $ \es -> stEffects <$> readIORef' (envStorage es)  test_deepStack :: Assertion test_deepStack = runEff $ do@@ -52,12 +67,14 @@  test_exceptions :: Assertion test_exceptions = runEff $ do-  testTry   "exceptions"  E.try-  testCatch "exceptions"  E.catch-  testTry   "lifted-base" LE.try-  testCatch "lifted-base" LE.catch-  testTry   "unliftio"    UE.try-  testCatch "unliftio"    UE.catch+  testTry   "exceptions"      C.try+  testCatch "exceptions"      C.catch+  testTry   "safe-exceptions" Safe.try+  testCatch "safe-exceptions" Safe.catch+  testTry   "lifted-base"     LE.try+  testCatch "lifted-base"     LE.catch+  testTry   "unliftio"        UE.try+  testCatch "unliftio"        UE.catch   where     testTry       :: String@@ -82,7 +99,7 @@     action :: State Int :> es => Eff es ()     action = do       modify @Int (+1)-      _ <- E.throwM U.Ex+      _ <- C.throwM U.Ex       modify @Int (+2)  test_localEffects :: Assertion@@ -117,7 +134,7 @@ runHasInt :: Int -> Eff (HasInt : es) a -> Eff es a runHasInt n =   -- reinterpret with redundant local effects-  reinterpret (evalState () . evalState n . evalState True) $ \_ -> \case+  reinterpret_ (evalState () . evalState n . evalState True) $ \case     GetInt   -> get     PutInt i -> put i 

@@ -1,11 +1,13 @@ module UnliftTests (unliftTests) where -import Control.Exception import Test.Tasty import Test.Tasty.HUnit import UnliftIO.Async qualified as A  import Effectful+import Effectful.Concurrent.Async qualified as E+import Effectful.Dispatch.Dynamic+import Effectful.State.Static.Local import Utils qualified as U  unliftTests :: TestTree@@ -22,6 +24,7 @@     , testCase "Uses in same thread" test_persistentSameThread     , testCase "Uses in multiple threads" test_persistentMultipleThreads     ]+  , testCase "Unlifting functions work correctly" test_unliftingFunctions   ]  test_threadStrategy :: Assertion@@ -34,32 +37,32 @@  test_seqUnliftInNewThread :: Assertion test_seqUnliftInNewThread = runEff $ do-  assertThrowsUnliftError "InvalidUseOfSeqUnlift error" $ do+  U.assertThrowsErrorCall "InvalidUseOfSeqUnlift error" $ do     withEffToIO SeqUnlift $ \runInIO -> do       inThread $ runInIO $ return ()  test_ephemeralInvalid :: Assertion test_ephemeralInvalid = runEff $ do-  assertThrowsUnliftError "InvalidNumberOfUses error" $ do+  U.assertThrowsErrorCall "InvalidNumberOfUses error" $ do     withEffToIO (ConcUnlift Ephemeral $ Limited 0) $ \_ -> return ()  test_ephemeralSameThread :: Assertion test_ephemeralSameThread = runEff $ do-  assertThrowsUnliftError "ExceededNumberOfUses error" $ do+  U.assertThrowsErrorCall "ExceededNumberOfUses error" $ do     withEffToIO (ConcUnlift Ephemeral $ Limited 1) $ \runInIO -> inThread $ do       runInIO $ return ()       runInIO $ return ()  test_ephemeralMultipleThreads :: Assertion test_ephemeralMultipleThreads = runEff $ do-  assertThrowsUnliftError "ExceededNumberOfUses error" $ do+  U.assertThrowsErrorCall "ExceededNumberOfUses error" $ do     withEffToIO (ConcUnlift Ephemeral $ Limited 1) $ \runInIO -> do       inThread $ runInIO $ return ()       inThread $ runInIO $ return ()  test_persistentInvalid :: Assertion test_persistentInvalid = runEff $ do-  assertThrowsUnliftError "InvalidNumberOfThreads error" $ do+  U.assertThrowsErrorCall "InvalidNumberOfThreads error" $ do     withEffToIO (ConcUnlift Persistent $ Limited 0) $ \_ -> return ()  test_persistentSameThread :: Assertion@@ -70,18 +73,85 @@  test_persistentMultipleThreads :: Assertion test_persistentMultipleThreads = runEff $ do-  assertThrowsUnliftError "ExceededNumberOfThreads error" $ do+  U.assertThrowsErrorCall "ExceededNumberOfThreads error" $ do     withEffToIO (ConcUnlift Persistent $ Limited 1) $ \runInIO -> do       inThread $ runInIO $ return ()       inThread $ runInIO $ return () +test_unliftingFunctions :: Assertion+test_unliftingFunctions = runEff . E.runConcurrent $ do+  testFork "runFork1" runFork1+  testFork "runFork2" runFork2+  testFork "runFork3" runFork3+  testFork "runFork4" runFork4+  testFork "runFork5" runFork5+  where+    testFork description runFork = do+      a <- runFork . send $ ForkWithUnmask $ \unmask -> do+        evalState @Int 0 $ raiseWith SeqUnlift $ \unlift -> do+          unlift $ modify @Int (+1)+          unmask . unlift $ modify @Int (+2)+          unlift $ modify @Int (+4)+          unmask . unlift $ modify @Int (+8)+          unlift $ U.assertEqual (description ++ ": correct state") 15 =<< get @Int+      E.waitCatch a >>= \case+        Right () -> pure ()+        Left err -> U.assertFailure $ description ++ ": " ++ show err++data Fork :: Effect where+  ForkWithUnmask :: ((forall a. m a -> m a) -> m r) -> Fork m (A.Async r)+type instance DispatchOf Fork = Dynamic++-- | Uses 'localUnliftIO' and 'withLiftMapIO'.+runFork1 :: IOE :> es => Eff (Fork : es) a -> Eff es a+runFork1 = interpret $ \env -> \case+  ForkWithUnmask m -> do+    withLiftMapIO env $ \liftMap -> do+      localUnliftIO env strategy $ \unlift -> do+        A.asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask+  where+    strategy = ConcUnlift Ephemeral $ Limited 1++-- | Uses 'localUnlift' and 'withLiftMap'.+runFork2 :: (IOE :> es, E.Concurrent :> es) => Eff (Fork : es) a -> Eff es a+runFork2 = interpret $ \env -> \case+  ForkWithUnmask m -> do+    withLiftMap env $ \liftMap -> do+      localUnlift env strategy $ \unlift -> do+        E.asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask+  where+    strategy = ConcUnlift Ephemeral $ Limited 1++-- | Uses 'localLiftUnliftIO'.+runFork3 :: IOE :> es => Eff (Fork : es) a -> Eff es a+runFork3 = interpret $ \env -> \case+  ForkWithUnmask m -> do+    localLiftUnliftIO env strategy $ \lift unlift -> do+      A.asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift+  where+    strategy = ConcUnlift Persistent $ Limited 1++-- | Uses 'localLiftUnlift'.+runFork4 :: (IOE :> es, E.Concurrent :> es) => Eff (Fork : es) a -> Eff es a+runFork4 = interpret $ \env -> \case+  ForkWithUnmask m -> do+    localLiftUnlift env strategy $ \lift unlift -> do+      E.asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift+  where+    strategy = ConcUnlift Persistent $ Limited 1++-- | Uses 'localLift' and 'localUnlift'.+runFork5 :: (IOE :> es, E.Concurrent :> es) => Eff (Fork : es) a -> Eff es a+runFork5 = interpret $ \env -> \case+  ForkWithUnmask m -> do+    localLift env strategy $ \lift -> do+      localUnlift env strategy $ \unlift -> do+        E.asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift+  where+    strategy = ConcUnlift Persistent $ Limited 1+ ---------------------------------------- -- Helpers--assertThrowsUnliftError-  :: IOE :> es-  => String -> Eff es a -> Eff es ()-assertThrowsUnliftError err = U.assertThrows err (\ErrorCall{} -> True)  inThread :: IO a -> IO a inThread k = A.async k >>= A.wait

@@ -3,14 +3,15 @@   , assertEqual   , assertFailure   , assertThrows+  , assertThrowsErrorCall   , Ex(..)   ) where -import Control.Monad.Catch import GHC.Stack import Test.Tasty.HUnit qualified as T  import Effectful+import Effectful.Exception  assertBool :: (HasCallStack, IOE :> es) => String -> Bool -> Eff es () assertBool msg p = liftIO $ T.assertBool msg p@@ -37,5 +38,11 @@   (k >> liftIO (T.assertFailure msg))   pure -data Ex = Ex deriving (Eq, Show)+assertThrowsErrorCall+  :: IOE :> es+  => String -> Eff es a -> Eff es ()+assertThrowsErrorCall err = assertThrows err (\ErrorCall{} -> True)++data Ex = Ex+  deriving stock (Eq, Show) instance Exception Ex