effectful-core 2.5.1.0 → 2.6.0.0

raw patch · 12 files changed

+184/−101 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• README.md +2/−2
• effectful-core.cabal +2/−2
• src/Effectful.hs +0/−1
• src/Effectful/Dispatch/Dynamic.hs +36/−1
• src/Effectful/Dispatch/Static/Unsafe.hs +0/−47
• src/Effectful/Error/Static.hs +4/−1
• src/Effectful/Exception.hs +22/−0
• src/Effectful/Internal/Env.hs +2/−6
• src/Effectful/Internal/Monad.hs +84/−34
• src/Effectful/Internal/Utils.hs +12/−1
• src/Effectful/Reader/Dynamic.hs +9/−6

@@ -1,3 +1,14 @@+# effectful-core-2.6.0.0 (2025-06-13)+* Adjust `generalBracket` with `base >= 4.21` to make use of the new exception+  annotation mechanism.+* Add `withException` to `Effectful.Exception`.+* Deprecate `Effectful.Reader.Dynamic.withReader` as it doesn't work correctly+  for all potential interpreters.+* **Breaking changes**:+  - Change the order of type parameters in `raise` for better usability.+  - `Effectful.Error.Static.ErrorWrapper` is no longer caught by `catchSync`.+  - Remove deprecated function `Effectful.withConcEffToIO`.+ # effectful-core-2.5.1.0 (2024-11-27) * Add `passthrough` to `Effectful.Dispatch.Dynamic` for passing operations to   the upstream handler within `interpose` and `impose` without having to fully

@@ -1,12 +1,12 @@ # effectful -[![Build Status](https://github.com/haskell-effectful/effectful/workflows/Haskell-CI/badge.svg?branch=master)](https://github.com/haskell-effectful/effectful/actions?query=branch%3Amaster)+[![CI](https://github.com/haskell-effectful/effectful/actions/workflows/haskell-ci.yml/badge.svg?branch=master)](https://github.com/haskell-effectful/effectful/actions/workflows/haskell-ci.yml) [![Hackage](https://img.shields.io/hackage/v/effectful.svg)](https://hackage.haskell.org/package/effectful) [![Stackage LTS](https://www.stackage.org/package/effectful/badge/lts)](https://www.stackage.org/lts/package/effectful) [![Stackage Nightly](https://www.stackage.org/package/effectful/badge/nightly)](https://www.stackage.org/nightly/package/effectful)  -<img src="https://user-images.githubusercontent.com/387658/127747903-f728437f-2ee4-47b8-9f0c-5102fd44c8e4.png" width="128">+<img src="https://raw.githubusercontent.com/haskell-effectful/effectful/master/logo.svg" width="150">  An easy to use, fast extensible effects library with seamless integration with the existing Haskell ecosystem.

@@ -1,7 +1,7 @@ cabal-version:      3.0 build-type:         Simple name:               effectful-core-version:            2.5.1.0+version:            2.6.0.0 license:            BSD-3-Clause license-file:       LICENSE category:           Control@@ -21,7 +21,7 @@   CHANGELOG.md   README.md -tested-with: GHC == { 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.5, 9.8.3, 9.10.1, 9.12.1 }+tested-with: GHC == { 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.7, 9.8.4, 9.10.2, 9.12.2 }  bug-reports:   https://github.com/haskell-effectful/effectful/issues source-repository head

@@ -46,7 +46,6 @@   , withUnliftStrategy   , withSeqEffToIO   , withEffToIO-  , withConcEffToIO      -- ** Lifting   , raise

@@ -466,6 +466,41 @@ -- | Interpret an effect using other, private effects. -- -- @'interpret' ≡ 'reinterpret' 'id'@+--+-- /Note:/ If you want to interpret multiple effects using other, private+-- effects, you can do so with a combination of 'interpret' and 'inject'.+--+-- This is in particular useful for splitting a large effect into smaller+-- ones. For example, let's say you want to split a+-- t'Effectful.State.Static.Local.State' into a read only and read write+-- component:+--+-- >>> :{+--  data Get s :: Effect where+--    Get :: Get s m s+--  type instance DispatchOf (Get s) = Dynamic+-- :}+--+-- >>> :{+--  data Put s :: Effect where+--    Put :: s -> Put s m ()+--  type instance DispatchOf (Put s) = Dynamic+-- :}+--+-- >>> import Effectful.State.Static.Local qualified as S+--+-- >>> :{+--  runGetPut :: forall s es a. s -> Eff (Get s : Put s : es) a -> Eff es (a, s)+--  runGetPut s0+--    = S.runState s0+--    . interpret_ @(Put s) (\(Put s) -> S.put s)+--    . interpret_ @(Get s) (\Get -> S.get)+--    . inject+-- :}+--+-- Here, a t'Effectful.State.Static.Local.State' effect is introduced, then+-- @Put@ and @Get@ effects that use it underneath and finally 'inject' hides the+-- original state from downstream code. reinterpret   :: (HasCallStack, DispatchOf e ~ Dynamic)   => (Eff handlerEs a -> Eff es b)@@ -539,7 +574,7 @@ -- -- >>> runEff . runE . augmentOp2 $ send Op3 -- *** Exception: Op3 not implemented--- CallStack (from HasCallStack):+-- ... --   error, called at <interactive>:... --   handler, called at src/Effectful/Dispatch/Dynamic.hs:... --   passthrough, called at <interactive>:...

@@ -5,50 +5,3 @@   ) where  import Effectful.Internal.Monad---- | Utility for lifting 'IO' computations of type------ @'IO' a -> 'IO' b@------ to------ @'Eff' es a -> 'Eff' es b@------ This function is __really unsafe__ because:------ - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'---   computations.------ - The 'IO' computation must run its argument in a way that's perceived as---   sequential to the outside observer, e.g. in the same thread or in a worker---   thread that finishes before the argument is run again.------ __Warning:__ if you disregard the second point, you will experience weird--- bugs, data races or internal consistency check failures.------ When in doubt, use 'Effectful.Dispatch.Static.unsafeLiftMapIO', especially--- since this version saves only a simple safety check per call of--- @reallyUnsafeLiftMapIO f@.-reallyUnsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b-reallyUnsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)---- | Create an unlifting function.------ This function is __really unsafe__ because:------ - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'---   computations.------ - Unlifted 'Eff' computations must be run in a way that's perceived as---   sequential to the outside observer, e.g. in the same thread as the caller---   of 'reallyUnsafeUnliftIO' or in a worker thread that finishes before---   another unlifted computation is run.------ __Warning:__ if you disregard the second point, you will experience weird--- bugs, data races or internal consistency check failures.------ When in doubt, use 'Effectful.Dispatch.Static.unsafeSeqUnliftIO', especially--- since this version saves only a simple safety check per call of the unlifting--- function.-reallyUnsafeUnliftIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a-reallyUnsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)

@@ -247,7 +247,10 @@     . ("\n" ++)     . (prettyCallStack cs ++) -instance Exception ErrorWrapper+instance Exception ErrorWrapper where+  -- See discussion in https://github.com/haskell-effectful/effectful/pull/232.+  toException = asyncExceptionToException+  fromException = asyncExceptionFromException  matchError :: ErrorId -> ErrorWrapper -> Maybe (CallStack, e) matchError eid (ErrorWrapper etag cs _ e)

@@ -59,6 +59,7 @@   , C.ExitCase(..)   , finally   , onException+  , withException      -- * Utils @@ -511,6 +512,27 @@   -> Eff es a onException action handler = reallyUnsafeUnliftIO $ \unlift -> do   E.onException (unlift action) (unlift handler)++-- | A variant of 'onException' that gives access to the exception.+--+-- @since 2.6.0.0+withException+  :: E.Exception e+  => Eff es a+  -> (e -> Eff es b)+  -- ^ Computation to run last when an exception or+  -- t'Effectful.Error.Static.Error' was thrown.+  -> Eff es a+withException action cleanup = do+#if MIN_VERSION_base(4,21,0)+  action `catchNoPropagate` \ec@(E.ExceptionWithContext _ e) -> do+    _ <- annotateIO (E.WhileHandling (E.toException ec)) (cleanup e)+    rethrowIO ec+#else+  action `catch` \e -> do+    _ <- cleanup e+    throwIO e+#endif  ---------------------------------------- -- Utils

@@ -439,7 +439,7 @@          ++ show storageVersion ++ ")\n"          ++ "If you're attempting to run an unlifting function outside "          ++ "of the scope of effects it captures, have a look at "-         ++ "UnliftingStrategy (SeqForkUnlift)."+         ++ "UnliftStrategy (SeqForkUnlift)."   pure (ref, es)   where     Ref ref version = indexPrimArray refs (offset + reifyIndex @e @es)@@ -477,7 +477,7 @@         Storage (bumpVersion version) (StorageData (size + 1) vs0 es0 fs0)       pure $ Ref size version     EQ -> do-      let len = doubleCapacity len0+      let len = growCapacity len0       vs <- newPrimArray len       es <- newSmallArray len undefinedEffect       fs <- newSmallArray len undefinedRelinker@@ -510,10 +510,6 @@ -- | Relink the environment to use the new storage. relinkEnv :: IORef' Storage -> Env es -> IO (Env es) relinkEnv storage (Env offset refs _) = pure $ Env offset refs storage---- | Double the capacity of an array.-doubleCapacity :: Int -> Int-doubleCapacity n = max 1 n * 2  undefinedVersion :: Version undefinedVersion = Version 0

@@ -1,5 +1,5 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-noncanonical-monad-instances #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_HADDOCK not-home #-} -- | The 'Eff' monad.@@ -46,7 +46,8 @@   , withUnliftStrategy   , withSeqEffToIO   , withEffToIO-  , withConcEffToIO+  , reallyUnsafeLiftMapIO+  , reallyUnsafeUnliftIO    -- ** Low-level unlifts   , seqUnliftIO@@ -203,20 +204,6 @@   ConcUnlift p b -> unsafeEff $ \es -> concUnliftIO es p b k {-# INLINE withEffToIO #-} --- | Create an unlifting function with the 'ConcUnlift' strategy.------ @since 2.2.2.0-withConcEffToIO-  :: (HasCallStack, IOE :> es)-  => Persistence-  -> Limit-  -> ((forall r. Eff es r -> IO r) -> IO a)-  -- ^ Continuation with the unlifting function in scope.-  -> Eff es a-withConcEffToIO persistence limit k = unsafeEff $ \es ->-  concUnliftIO es persistence limit k-{-# DEPRECATED withConcEffToIO "Use withEffToIO with the appropriate strategy." #-}- -- | Create an unlifting function with the 'SeqUnlift' strategy. seqUnliftIO   :: HasCallStack@@ -261,6 +248,53 @@ concUnliftIO es Persistent (Limited threads) = persistentConcUnlift es False threads concUnliftIO es Persistent Unlimited = persistentConcUnlift es True maxBound +-- | Utility for lifting 'IO' computations of type+--+-- @'IO' a -> 'IO' b@+--+-- to+--+-- @'Eff' es a -> 'Eff' es b@+--+-- This function is __really unsafe__ because:+--+-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'+--   computations.+--+-- - The 'IO' computation must run its argument in a way that's perceived as+--   sequential to the outside observer, e.g. in the same thread or in a worker+--   thread that finishes before the argument is run again.+--+-- __Warning:__ if you disregard the second point, you will experience weird+-- bugs, data races or internal consistency check failures.+--+-- When in doubt, use 'Effectful.Dispatch.Static.unsafeLiftMapIO', especially+-- since this version saves only a simple safety check per call of+-- @reallyUnsafeLiftMapIO f@.+reallyUnsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b+reallyUnsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)++-- | Create an unlifting function.+--+-- This function is __really unsafe__ because:+--+-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'+--   computations.+--+-- - Unlifted 'Eff' computations must be run in a way that's perceived as+--   sequential to the outside observer, e.g. in the same thread as the caller+--   of 'reallyUnsafeUnliftIO' or in a worker thread that finishes before+--   another unlifted computation is run.+--+-- __Warning:__ if you disregard the second point, you will experience weird+-- bugs, data races or internal consistency check failures.+--+-- When in doubt, use 'Effectful.Dispatch.Static.unsafeSeqUnliftIO', especially+-- since this version saves only a simple safety check per call of the unlifting+-- function.+reallyUnsafeUnliftIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a+reallyUnsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)+ ---------------------------------------- -- Base @@ -276,10 +310,9 @@   liftA2 f (Eff ma) (Eff mb) = unsafeEff $ \es -> liftA2 f (ma es) (mb es)  instance Monad (Eff es) where-  return = unsafeEff_ . pure   Eff m >>= k = unsafeEff $ \es -> m es >>= \a -> unEff (k a) es   -- https://gitlab.haskell.org/ghc/ghc/-/issues/20008-  Eff ma >> Eff mb = unsafeEff $ \es -> ma es >> mb es+  {-# INLINE (>>=) #-}  instance MonadFix (Eff es) where   mfix f = unsafeEff $ \es -> mfix $ \a -> unEff (f a) es@@ -290,6 +323,10 @@ -- | Provide the ability to use the 'Alternative' and 'MonadPlus' instance for -- 'Eff'. --+-- /Note:/ 'NonDet' does not backtrack. Formally, it obeys the "left-catch" law+-- for 'MonadPlus', rather than the "left-distribution" law. This means that it+-- behaves more like 'Maybe' than @[]@.+-- -- @since 2.2.0.0 data NonDet :: Effect where   Empty   :: NonDet m a@@ -309,27 +346,40 @@ -- Exception  instance C.MonadThrow (Eff es) where-  throwM = unsafeEff_ . E.throwIO+  throwM = unsafeEff_ . withFrozenCallStack E.throwIO  instance C.MonadCatch (Eff es) where-  catch m handler = unsafeEff $ \es -> do-    unEff m es `E.catch` \e -> do-      unEff (handler e) es+  catch action handler = reallyUnsafeUnliftIO $ \unlift -> do+    E.catch (unlift action) (unlift . handler)  instance C.MonadMask (Eff es) where-  mask k = unsafeEff $ \es -> E.mask $ \unmask ->-    unEff (k $ \m -> unsafeEff $ unmask . unEff m) es+  mask k = reallyUnsafeUnliftIO $ \unlift -> do+    E.mask $ \release -> unlift $ k (reallyUnsafeLiftMapIO release) -  uninterruptibleMask k = unsafeEff $ \es -> E.uninterruptibleMask $ \unmask ->-    unEff (k $ \m -> unsafeEff $ unmask . unEff m) es+  uninterruptibleMask k = reallyUnsafeUnliftIO $ \unlift -> do+    E.uninterruptibleMask $ \release -> unlift $ k (reallyUnsafeLiftMapIO release) -  generalBracket acquire release use = unsafeEff $ \es -> E.mask $ \unmask -> do-    resource <- unEff acquire es-    b <- unmask (unEff (use resource) es) `E.catch` \e -> do-      _ <- unEff (release resource $ C.ExitCaseException e) es-      E.throwIO e-    c <- unEff (release resource $ C.ExitCaseSuccess b) es-    pure (b, c)+  generalBracket before after action = reallyUnsafeUnliftIO $ \unlift -> do+     E.mask $ \unmask -> do+      a <- unlift before+#if MIN_VERSION_base(4,21,0)+      b <- E.catchNoPropagate+        (unmask . unlift $ action a)+        (\ec@(E.ExceptionWithContext _ e) -> do+            _ <- E.annotateIO (E.WhileHandling (E.toException ec)) $ do+              unlift . after a $ C.ExitCaseException e+            E.rethrowIO ec+        )+#else+      b <- E.catch+        (unmask . unlift $ action a)+        (\e -> do+            _ <- unlift . after a $ C.ExitCaseException e+            E.throwIO e+        )+#endif+      c <- unlift . after a $ C.ExitCaseSuccess b+      pure (b, c)  ---------------------------------------- -- Fail@@ -418,7 +468,7 @@ -- Lifting  -- | Lift an 'Eff' computation into an effect stack with one more effect.-raise :: Eff es a -> Eff (e : es) a+raise :: forall e es a. Eff es a -> Eff (e : es) a raise m = unsafeEff $ \es -> unEff m =<< tailEnv es  -- | Lift an 'Eff' computation into an effect stack with one more effect and

@@ -18,8 +18,11 @@   , Unique   , newUnique -  -- * CallStack+    -- * CallStack   , thawCallStack++    -- * Array capacity+  , growCapacity   ) where  import Control.Exception@@ -129,3 +132,11 @@ thawCallStack = \case   FreezeCallStack cs -> cs   cs -> cs++----------------------------------------++-- | Grow capacity of an array.+--+-- See https://archive.ph/Z2R8w.+growCapacity :: Int -> Int+growCapacity n = 1 + quot (n * 3) 2

@@ -19,7 +19,6 @@  import Effectful import Effectful.Dispatch.Dynamic-import Effectful.Reader.Static qualified as R  data Reader r :: Effect where   Ask   :: Reader r m r@@ -27,16 +26,19 @@  type instance DispatchOf (Reader r) = Dynamic --- | Run the 'Reader' effect with the given initial environment (via--- "Effectful.Reader.Static").+-- | Run the 'Reader' effect with the given initial environment. runReader   :: HasCallStack   => r -- ^ The initial environment.   -> Eff (Reader r : es) a   -> Eff es a-runReader r = reinterpret (R.runReader r) $ \env -> \case-  Ask       -> R.ask-  Local f m -> localSeqUnlift env $ \unlift -> R.local f (unlift m)+runReader r0 = interpret $ handler r0+  where+    handler :: r -> EffectHandler (Reader r) es+    handler r env = \case+      Ask -> pure r+      Local f action -> localSeqUnlift env $ \unlift -> do+        unlift $ interpose (handler $ f r) action  -- | Execute a computation in a modified environment. --@@ -51,6 +53,7 @@ withReader f m = do   r <- ask   raise $ runReader (f r) m+{-# DEPRECATED withReader "withReader doesn't work correctly for all potential interpreters" #-}  ---------------------------------------- -- Operations