effectful-core 2.5.0.0 → 2.5.1.0

raw patch · 7 files changed

+268/−176 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• README.md +0/−1
• effectful-core.cabal +2/−2
• src/Effectful/Dispatch/Dynamic.hs +195/−144
• src/Effectful/Internal/Monad.hs +11/−6
• src/Effectful/Provider.hs +26/−11
• src/Effectful/Provider/List.hs +26/−12

@@ -1,3 +1,11 @@+# 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+  pattern match on them.+* **Bugfixes**:+  - Fix a potential space leak related to `HasCallStack` quirks (see+    https://gitlab.haskell.org/ghc/ghc/-/issues/25520 for more information).+ # effectful-core-2.5.0.0 (2024-10-23) * Add `plusEff` (specialized version of `<|>`) to `Effectful.NonDet` and make   `emptyEff` and `sumEff` generate better call stacks.

@@ -2,7 +2,6 @@  [![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) [![Hackage](https://img.shields.io/hackage/v/effectful.svg)](https://hackage.haskell.org/package/effectful)-[![Dependencies](https://img.shields.io/hackage-deps/v/effectful.svg)](https://packdeps.haskellers.com/feed?needle=andrzej@rybczak.net) [![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) 

@@ -1,7 +1,7 @@ cabal-version:      3.0 build-type:         Simple name:               effectful-core-version:            2.5.0.0+version:            2.5.1.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.2, 9.10.1 }+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 }  bug-reports:   https://github.com/haskell-effectful/effectful/issues source-repository head

@@ -20,6 +20,7 @@      -- * Sending operations to the handler     send+  , passthrough      -- * Handling effects   , EffectHandler@@ -74,8 +75,9 @@   , HasCallStack   ) where +import Control.Monad import Data.Primitive.PrimArray-import GHC.Stack (HasCallStack)+import GHC.Stack import GHC.TypeLits  import Effectful.Internal.Effect@@ -263,8 +265,8 @@ -- -- The problem is that @action@ has a type @Eff localEs a@, while the monad of -- the effect handler is @Eff es@. @localEs@ represents the /local environment/--- in which the @Profile@ operation was called, which is opaque as the effect--- handler cannot possibly know how it looks like.+-- in which the @Profile@ operation was called, which is more or less opaque to+-- the effect handler. -- -- The solution is to use the 'LocalEnv' that an 'EffectHandler' is given to run -- the action using one of the functions from the 'localUnlift' family:@@ -414,23 +416,40 @@ -- >>> runPureEff . runReader @Int 3 $ double -- 6 +-- | A variant of 'send' for passing operations to the upstream handler within+-- 'interpose' and 'impose' without having to fully pattern match on them.+passthrough+  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es, e :> localEs, SharedSuffix es handlerEs)+  => LocalEnv localEs handlerEs+  -> e (Eff localEs) a+  -- ^ The operation.+  -> Eff es a+passthrough (LocalEnv les) op = unsafeEff $ \es -> do+  Handler handlerEs (HandlerImpl handler) <- getEnv es+  when (envStorage les /= envStorage handlerEs) $ do+    error "les and handlerEs point to different Storages"+  -- Prevent the addition of unnecessary 'handler' stack frame to the call+  -- stack. Note that functions 'interpret', 'reinterpret', 'interpose' and+  -- 'impose' need to thaw the call stack so that useful stack frames from+  -- inside the effect handler continue to be added.+  unEff (withFrozenCallStack handler (LocalEnv les) op) handlerEs+{-# NOINLINE passthrough #-}+ ---------------------------------------- -- Handling effects  -- | Interpret an effect. ----- /Note:/ 'interpret' can be turned into a 'reinterpret' with the use of--- 'inject'.+-- /Note:/ if you want to use intermediate effects in multiple handlers, then+-- hide them from downstream, have a look at 'inject'. interpret   :: (HasCallStack, DispatchOf e ~ Dynamic)   => EffectHandler e es   -- ^ The effect handler.   -> Eff (e : es) a   -> Eff      es  a-interpret handler m = unsafeEff $ \es -> do-  (`unEff` es) $ runHandler (mkHandler es) m-  where-    mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)+interpret handler action = interpretImpl action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in handler)  -- | 'interpret' with the effect handler as the last argument. --@@ -441,7 +460,8 @@   -> EffectHandler e es   -- ^ The effect handler.   -> Eff      es  a-interpretWith m handler = interpret handler m+interpretWith action handler = interpretImpl action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in handler)  -- | Interpret an effect using other, private effects. --@@ -449,16 +469,13 @@ reinterpret   :: (HasCallStack, DispatchOf e ~ Dynamic)   => (Eff handlerEs a -> Eff es b)-  -- ^ Introduction of effects encapsulated within the handler.+  -- ^ Setup of effects encapsulated in the handler.   -> EffectHandler e handlerEs   -- ^ The effect handler.   -> Eff (e : es) a   -> Eff      es  b-reinterpret runHandlerEs handler m = unsafeEff $ \es -> do-  (`unEff` es) . runHandlerEs . unsafeEff $ \handlerEs -> do-    (`unEff` es) $ runHandler (mkHandler handlerEs) m-  where-    mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)+reinterpret runSetup handler action = reinterpretImpl runSetup action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in handler)  -- | 'reinterpret' with the effect handler as the last argument. --@@ -466,12 +483,13 @@ reinterpretWith   :: (HasCallStack, DispatchOf e ~ Dynamic)   => (Eff handlerEs a -> Eff es b)-  -- ^ Introduction of effects encapsulated within the handler.+  -- ^ Setup of effects encapsulated in the handler.   -> Eff (e : es) a   -> EffectHandler e handlerEs   -- ^ The effect handler.   -> Eff      es  b-reinterpretWith runHandlerEs m handler = reinterpret runHandlerEs handler m+reinterpretWith runSetup action handler = reinterpretImpl runSetup action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in handler)  -- | Replace the handler of an existing effect with a new one. --@@ -482,6 +500,7 @@ --   data E :: Effect where --     Op1 :: E m () --     Op2 :: E m ()+--     Op3 :: E m () --   type instance DispatchOf E = Dynamic -- :} --@@ -490,83 +509,50 @@ --   runE = interpret_ $ \case --     Op1 -> liftIO (putStrLn "op1") --     Op2 -> liftIO (putStrLn "op2")+--     Op3 -> error "Op3 not implemented" -- :} ----- >>> runEff . runE $ send Op1 >> send Op2--- op1--- op2------ >>> :{---   augmentOp2 :: (E :> es, IOE :> es) => Eff es a -> Eff es a---   augmentOp2 = interpose_ $ \case---     Op1 -> send Op1---     Op2 -> liftIO (putStrLn "augmented op2") >> send Op2--- :}+-- >>> let action = send Op1 >> send Op2 ----- >>> runEff . runE . augmentOp2 $ send Op1 >> send Op2+-- >>> runEff . runE $ action -- op1--- augmented op2 -- op2 ----- /Note:/ when using 'interpose' to modify only specific operations of the--- effect, your first instinct might be to match on them, then handle the rest--- with a generic match. Unfortunately, this doesn't work out of the box:+-- You can modify only specific operations and send the rest to the upstream+-- handler with 'passthrough': -- -- >>> :{---   genericAugmentOp2 :: (E :> es, IOE :> es) => Eff es a -> Eff es a---   genericAugmentOp2 = interpose_ $ \case---     Op2 -> liftIO (putStrLn "augmented op2") >> send Op2---     op  -> send op--- :}--- ...--- ...Couldn't match type ‘localEs’ with ‘es’--- ...------ This is because within the generic match, 'send' expects @Op (Eff es) a@, but--- @op@ has a type @Op (Eff localEs) a@. If the effect in question is first--- order (i.e. its @m@ type parameter is phantom), you can use 'coerce':------ >>> import Data.Coerce--- >>> :{---   genericAugmentOp2 :: (E :> es, IOE :> es) => Eff es a -> Eff es a---   genericAugmentOp2 = interpose_ $ \case+--   augmentOp2 :: (E :> es, IOE :> es) => Eff es a -> Eff es a+--   augmentOp2 = interpose $ \env -> \case --     Op2 -> liftIO (putStrLn "augmented op2") >> send Op2---     op  -> send @E (coerce op)+--     op  -> passthrough env op -- :} ----- >>> runEff . runE . genericAugmentOp2 $ send Op1 >> send Op2+-- >>> runEff . runE . augmentOp2 $ action -- op1 -- augmented op2 -- op2 ----- On the other hand, when dealing with higher order effects you need to pattern--- match on each operation and unlift where necessary.+-- /Note:/ when an exception is raised while handling an operation, good+-- debugging experience is ensured by strategically placed 'HasCallStack'+-- constraints: --+-- >>> 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>:...+--   handler, called at src/Effectful/Dispatch/Dynamic.hs:...+--   send, called at <interactive>:... interpose-  :: forall e es a. (HasCallStack, DispatchOf e ~ Dynamic, e :> es)+  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)   => EffectHandler e es   -- ^ The effect handler.   -> Eff es a   -> Eff es a-interpose handler m = unsafeEff $ \es -> do-  inlineBracket-    (do-        origHandler <- getEnv @e es-        replaceEnv origHandler relinkHandler es-    )-    (\newEs -> do-        -- Restore the original handler.-        putEnv es =<< getEnv @e newEs-        unreplaceEnv @e newEs-    )-    (\newEs -> do-        -- Replace the original handler with a new one. Note that 'newEs'-        -- will still see the original handler.-        putEnv es $ mkHandler newEs-        unEff m es-    )-  where-    mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)+interpose handler action = interposeImpl action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in handler)  -- | 'interpose' with the effect handler as the last argument. --@@ -577,41 +563,23 @@   -> EffectHandler e es   -- ^ The effect handler.   -> Eff es a-interposeWith m handler = interpose handler m+interposeWith action handler = interposeImpl action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in handler)  -- | Replace the handler of an existing effect with a new one that uses other, -- private effects. -- -- @'interpose' ≡ 'impose' 'id'@ impose-  :: forall e es handlerEs a b. (HasCallStack, DispatchOf e ~ Dynamic, e :> es)+  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)   => (Eff handlerEs a -> Eff es b)-  -- ^ Introduction of effects encapsulated within the handler.+  -- ^ Setup of effects encapsulated in the handler.   -> EffectHandler e handlerEs   -- ^ The effect handler.   -> Eff es a   -> Eff es b-impose runHandlerEs handler m = unsafeEff $ \es -> do-  inlineBracket-    (do-        origHandler <- getEnv @e es-        replaceEnv origHandler relinkHandler es-    )-    (\newEs -> do-        -- Restore the original handler.-        putEnv es =<< getEnv @e newEs-        unreplaceEnv @e newEs-    )-    (\newEs -> do-        (`unEff` newEs) . runHandlerEs . unsafeEff $ \handlerEs -> do-          -- Replace the original handler with a new one. Note that-          -- 'newEs' (and thus 'handlerEs') wil still see the original-          -- handler.-          putEnv es $ mkHandler handlerEs-          unEff m es-    )-  where-    mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)+impose runSetup handler action = imposeImpl runSetup action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in handler)  -- | 'impose' with the effect handler as the last argument. --@@ -619,12 +587,13 @@ imposeWith   :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)   => (Eff handlerEs a -> Eff es b)-  -- ^ Introduction of effects encapsulated within the handler.+  -- ^ Setup of effects encapsulated in the handler.   -> Eff es a   -> EffectHandler e handlerEs   -- ^ The effect handler.   -> Eff es b-imposeWith runHandlerEs m handler = impose runHandlerEs handler m+imposeWith runSetup action handler = imposeImpl runSetup action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in handler)  ---------------------------------------- -- First order effects@@ -647,7 +616,8 @@   -- ^ The effect handler.   -> Eff (e : es) a   -> Eff      es  a-interpret_ handler = interpret (const handler)+interpret_ handler action = interpretImpl action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in const handler)  -- | 'interpretWith' for first order effects. --@@ -658,7 +628,8 @@   -> EffectHandler_ e es   -- ^ The effect handler.   -> Eff      es  a-interpretWith_ m handler = interpret (const handler) m+interpretWith_ action handler = interpretImpl action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in const handler)  -- | 'reinterpret' for first order effects. --@@ -666,12 +637,13 @@ reinterpret_   :: (HasCallStack, DispatchOf e ~ Dynamic)   => (Eff handlerEs a -> Eff es b)-  -- ^ Introduction of effects encapsulated within the handler.+  -- ^ Setup of effects encapsulated in the handler.   -> EffectHandler_ e handlerEs   -- ^ The effect handler.   -> Eff (e : es) a   -> Eff      es  b-reinterpret_ runHandlerEs handler = reinterpret runHandlerEs (const handler)+reinterpret_ runSetup handler action = reinterpretImpl runSetup action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in const handler)  -- | 'reinterpretWith' for first order effects. --@@ -679,12 +651,13 @@ reinterpretWith_   :: (HasCallStack, DispatchOf e ~ Dynamic)   => (Eff handlerEs a -> Eff es b)-  -- ^ Introduction of effects encapsulated within the handler.+  -- ^ Setup of effects encapsulated in the handler.   -> Eff (e : es) a   -> EffectHandler_ e handlerEs   -- ^ The effect handler.   -> Eff      es  b-reinterpretWith_ runHandlerEs m handler = reinterpret runHandlerEs (const handler) m+reinterpretWith_ runSetup action handler = reinterpretImpl runSetup action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in const handler)  -- | 'interpose' for first order effects. --@@ -695,7 +668,8 @@   -- ^ The effect handler.   -> Eff es a   -> Eff es a-interpose_ handler = interpose (const handler)+interpose_ handler action = interposeImpl action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in const handler)  -- | 'interposeWith' for first order effects. --@@ -706,7 +680,8 @@   -> EffectHandler_ e es   -- ^ The effect handler.   -> Eff es a-interposeWith_ m handler = interpose (const handler) m+interposeWith_ action handler = interposeImpl action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in const handler)  -- | 'impose' for first order effects. --@@ -714,12 +689,13 @@ impose_   :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)   => (Eff handlerEs a -> Eff es b)-  -- ^ Introduction of effects encapsulated within the handler.+  -- ^ Setup of effects encapsulated in the handler.   -> EffectHandler_ e handlerEs   -- ^ The effect handler.   -> Eff es a   -> Eff es b-impose_ runHandlerEs handler = impose runHandlerEs (const handler)+impose_ runSetup handler action = imposeImpl runSetup action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in const handler)  -- | 'imposeWith' for first order effects. --@@ -727,12 +703,13 @@ imposeWith_   :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)   => (Eff handlerEs a -> Eff es b)-  -- ^ Introduction of effects encapsulated within the handler.+  -- ^ Setup of effects encapsulated in the handler.   -> Eff es a   -> EffectHandler_ e handlerEs   -- ^ The effect handler.   -> Eff es b-imposeWith_ runHandlerEs m handler = impose runHandlerEs (const handler) m+imposeWith_ runSetup action handler = imposeImpl runSetup action $+  HandlerImpl (let ?callStack = thawCallStack ?callStack in const handler)  ---------------------------------------- -- Unlifts@@ -1086,38 +1063,6 @@       (`unEff` es) $ k $ unsafeEff_ . unlift {-# INLINE localBorrow #-} -copyRefs-  :: forall es srcEs destEs-   . (HasCallStack, KnownSubset es srcEs)-  => Env srcEs-  -> Env destEs-  -> IO (Env (es ++ destEs))-copyRefs src@(Env soffset srefs _) dest@(Env doffset drefs storage) = do-  requireMatchingStorages src dest-  let es = reifyIndices @es @srcEs-      esSize = length es-      destSize = sizeofPrimArray drefs - doffset-  mrefs <- newPrimArray (esSize + destSize)-  copyPrimArray mrefs esSize drefs doffset destSize-  let writeRefs i = \case-        [] -> pure ()-        (x : xs) -> do-          writePrimArray mrefs i $ indexPrimArray srefs (soffset + x)-          writeRefs (i + 1) xs-  writeRefs 0 es-  refs <- unsafeFreezePrimArray mrefs-  pure $ Env 0 refs storage-{-# NOINLINE copyRefs #-}--requireMatchingStorages :: HasCallStack => Env es1 -> Env es2 -> IO ()-requireMatchingStorages es1 es2-  | envStorage es1 /= envStorage es2 = error-    $ "Env and LocalEnv point to different Storages.\n"-    ++ "If you passed LocalEnv to a different thread and tried to create an "-    ++ "unlifting function there, it's not allowed. You need to create it in "-    ++ "the thread of the effect handler."-  | otherwise = pure ()- -- | Require that both effect stacks share an opaque suffix. -- -- Functions from the 'localUnlift' family utilize this constraint to guarantee@@ -1188,6 +1133,112 @@   ( Text "Running local actions in monomorphic effect stacks is not supported." :$$:     Text "As a solution simply change the stack to have a polymorphic suffix."   ) => SharedSuffix '[] '[]++----------------------------------------+-- Helpers++interpretImpl+  :: (HasCallStack, DispatchOf e ~ Dynamic)+  => Eff (e : es) a+  -> HandlerImpl e es+  -> Eff      es  a+interpretImpl action handlerImpl = unsafeEff $ \es -> do+  (`unEff` es) $ runHandler (Handler es handlerImpl) action+{-# INLINE interpretImpl #-}++reinterpretImpl+  :: (HasCallStack, DispatchOf e ~ Dynamic)+  => (Eff handlerEs a -> Eff es b)+  -> Eff (e : es) a+  -> HandlerImpl e handlerEs+  -> Eff      es  b+reinterpretImpl runSetup action handlerImpl = unsafeEff $ \es -> do+  (`unEff` es) . runSetup . unsafeEff $ \handlerEs -> do+    (`unEff` es) $ runHandler (Handler handlerEs handlerImpl) action+{-# INLINE reinterpretImpl #-}++interposeImpl+  :: forall e es a. (HasCallStack, DispatchOf e ~ Dynamic, e :> es)+  => Eff es a+  -> HandlerImpl e es+  -> Eff es a+interposeImpl action handlerImpl = unsafeEff $ \es -> do+  inlineBracket+    (do+        origHandler <- getEnv @e es+        replaceEnv origHandler relinkHandler es+    )+    (\newEs -> do+        -- Restore the original handler.+        putEnv es =<< getEnv @e newEs+        unreplaceEnv @e newEs+    )+    (\newEs -> do+        -- Replace the original handler with a new one. Note that 'newEs'+        -- will still see the original handler.+        putEnv es $ Handler newEs handlerImpl+        unEff action es+    )+{-# INLINE interposeImpl #-}++imposeImpl+  :: forall e es handlerEs a b. (HasCallStack, DispatchOf e ~ Dynamic, e :> es)+  => (Eff handlerEs a -> Eff es b)+  -> Eff es a+  -> HandlerImpl e handlerEs+  -> Eff es b+imposeImpl runSetup action handlerImpl = unsafeEff $ \es -> do+  inlineBracket+    (do+        origHandler <- getEnv @e es+        replaceEnv origHandler relinkHandler es+    )+    (\newEs -> do+        -- Restore the original handler.+        putEnv es =<< getEnv @e newEs+        unreplaceEnv @e newEs+    )+    (\newEs -> do+        (`unEff` newEs) . runSetup . unsafeEff $ \handlerEs -> do+          -- Replace the original handler with a new one. Note that+          -- 'newEs' (and thus 'handlerEs') wil still see the original+          -- handler.+          putEnv es $ Handler handlerEs handlerImpl+          unEff action es+    )+{-# INLINE imposeImpl #-}++copyRefs+  :: forall es srcEs destEs+   . (HasCallStack, KnownSubset es srcEs)+  => Env srcEs+  -> Env destEs+  -> IO (Env (es ++ destEs))+copyRefs src@(Env soffset srefs _) dest@(Env doffset drefs storage) = do+  requireMatchingStorages src dest+  let es = reifyIndices @es @srcEs+      esSize = length es+      destSize = sizeofPrimArray drefs - doffset+  mrefs <- newPrimArray (esSize + destSize)+  copyPrimArray mrefs esSize drefs doffset destSize+  let writeRefs i = \case+        [] -> pure ()+        (x : xs) -> do+          writePrimArray mrefs i $ indexPrimArray srefs (soffset + x)+          writeRefs (i + 1) xs+  writeRefs 0 es+  refs <- unsafeFreezePrimArray mrefs+  pure $ Env 0 refs storage+{-# NOINLINE copyRefs #-}++requireMatchingStorages :: HasCallStack => Env es1 -> Env es2 -> IO ()+requireMatchingStorages es1 es2+  | envStorage es1 /= envStorage es2 = error+    $ "Env and LocalEnv point to different Storages.\n"+    ++ "If you passed LocalEnv to a different thread and tried to create an "+    ++ "unlifting function there, it's not allowed. You need to create it in "+    ++ "the thread of the effect handler."+  | otherwise = pure ()  -- $setup -- >>> import Control.Concurrent (ThreadId, forkIOWithUnmask)

@@ -59,6 +59,7 @@   , EffectHandler   , LocalEnv(..)   , Handler(..)+  , HandlerImpl(..)   , relinkHandler   , runHandler   , send@@ -522,10 +523,14 @@   -- ^ The operation.   -> Eff es a +-- | Wrapper to prevent a space leak on reconstruction of 'Handler' in+-- 'relinkHandler' (see https://gitlab.haskell.org/ghc/ghc/-/issues/25520).+newtype HandlerImpl e es = HandlerImpl (EffectHandler e es)+ -- | An internal representation of dynamically dispatched effects, i.e. the -- effect handler bundled with its environment. data Handler :: Effect -> Type where-  Handler :: !(Env handlerEs) -> !(EffectHandler e handlerEs) -> Handler e+  Handler :: !(Env handlerEs) -> !(HandlerImpl e handlerEs) -> Handler e type instance EffectRep Dynamic = Handler  relinkHandler :: Relinker Handler e@@ -552,13 +557,13 @@   -- ^ The operation.   -> Eff es a send op = unsafeEff $ \es -> do-  Handler handlerEs handler <- getEnv es+  Handler handlerEs (HandlerImpl handler) <- getEnv es   when (envStorage es /= envStorage handlerEs) $ do     error "es and handlerEs point to different Storages"-  -- Prevent internal functions that rebind the effect handler from polluting-  -- its call stack by freezing it. Note that functions 'interpret',-  -- 'reinterpret', 'interpose' and 'impose' need to thaw it so that useful-  -- stack frames from inside the effect handler continue to be added.+  -- Prevent the addition of unnecessary 'handler' stack frame to the call+  -- stack. Note that functions 'interpret', 'reinterpret', 'interpose' and+  -- 'impose' need to thaw the call stack so that useful stack frames from+  -- inside the effect handler continue to be added.   unEff (withFrozenCallStack handler (LocalEnv es) op) handlerEs {-# NOINLINE send #-} 

@@ -123,10 +123,17 @@  type instance DispatchOf (Provider e input f) = Static NoSideEffects +-- | Wrapper to prevent a space leak on reconstruction of 'Provider' in+-- 'relinkProvider' (see https://gitlab.haskell.org/ghc/ghc/-/issues/25520).+newtype ProviderImpl input f e es where+  ProviderImpl+    :: (forall r. HasCallStack => input -> Eff (e : es) r -> Eff es (f r))+    -> ProviderImpl input f e es+ data instance StaticRep (Provider e input f) where   Provider     :: !(Env handlerEs)-    -> !(forall r. HasCallStack => input -> Eff (e : handlerEs) r -> Eff handlerEs (f r))+    -> !(ProviderImpl input f e handlerEs)     -> StaticRep (Provider e input f)  -- | Run the 'Provider' effect with a given effect handler.@@ -136,14 +143,8 @@   -- ^ The effect handler.   -> Eff (Provider e input f : es) a   -> Eff es a-runProvider provider m = unsafeEff $ \es0 -> do-  inlineBracket-    (consEnv (mkProvider es0) relinkProvider es0)-    unconsEnv-    (\es -> unEff m es)-  where-    -- Corresponds to withFrozenCallStack in provideWith.-    mkProvider es = Provider es (let ?callStack = thawCallStack ?callStack in provider)+runProvider provider action = runProviderImpl action $+  ProviderImpl (let ?callStack = thawCallStack ?callStack in provider)  -- | Run the 'Provider' effect with a given effect handler that doesn't change -- its return type.@@ -153,7 +154,9 @@   -- ^ The effect handler.   -> Eff (Provider_ e input : es) a   -> Eff es a-runProvider_ provider = runProvider $ \input -> coerce . provider input+runProvider_ provider action = runProviderImpl action $+  ProviderImpl $ let ?callStack = thawCallStack ?callStack+                 in \input -> coerce . provider input  -- | Run the effect handler. provide :: (HasCallStack, Provider e () f :> es) => Eff (e : es) a -> Eff es (f a)@@ -171,7 +174,7 @@   -> Eff (e : es) a   -> Eff es (f a) provideWith input action = unsafeEff $ \es -> do-  Provider handlerEs handler <- getEnv es+  Provider handlerEs (ProviderImpl handler) <- getEnv es   (`unEff` handlerEs)     -- Corresponds to thawCallStack in runProvider.     . withFrozenCallStack handler input@@ -193,6 +196,18 @@  ---------------------------------------- -- Helpers++runProviderImpl+  :: HasCallStack+  => Eff (Provider e input f : es) a+  -> ProviderImpl input f e es+  -> Eff es a+runProviderImpl action providerImpl = unsafeEff $ \es -> do+  inlineBracket+    (consEnv (Provider es providerImpl) relinkProvider es)+    unconsEnv+    (unEff action)+{-# INLINE runProviderImpl #-}  relinkProvider :: Relinker StaticRep (Provider e input f) relinkProvider = Relinker $ \relink (Provider handlerEs run) -> do

@@ -51,11 +51,18 @@  type instance DispatchOf (ProviderList providedEs input f) = Static NoSideEffects +-- | Wrapper to prevent a space leak on reconstruction of 'ProviderList' in+-- 'relinkProviderList' (see https://gitlab.haskell.org/ghc/ghc/-/issues/25520).+newtype ProviderListImpl input f providedEs es where+  ProviderListImpl+    :: (forall r. HasCallStack => input -> Eff (providedEs ++ es) r -> Eff es (f r))+    -> ProviderListImpl input f providedEs es+ data instance StaticRep (ProviderList providedEs input f) where   ProviderList     :: KnownEffects providedEs     => !(Env handlerEs)-    -> !(forall r. HasCallStack => input -> Eff (providedEs ++ handlerEs) r -> Eff handlerEs (f r))+    -> !(ProviderListImpl input f providedEs handlerEs)     -> StaticRep (ProviderList providedEs input f)  -- | Run the 'ProviderList' effect with a given handler.@@ -65,15 +72,8 @@   -- ^ The handler.   -> Eff (ProviderList providedEs input f : es) a   -> Eff es a-runProviderList providerList m = unsafeEff $ \es0 -> do-  inlineBracket-    (consEnv (mkProviderList es0) relinkProviderList es0)-    unconsEnv-    (\es -> unEff m es)-  where-    -- Corresponds to withFrozenCallStack in provideListWith.-    mkProviderList es =-      ProviderList es (let ?callStack = thawCallStack ?callStack in providerList)+runProviderList providerList action = runProviderListImpl action $+  ProviderListImpl (let ?callStack = thawCallStack ?callStack in providerList)  -- | Run the 'Provider' effect with a given handler that doesn't change its -- return type.@@ -83,7 +83,9 @@   -- ^ The handler.   -> Eff (ProviderList_ providedEs input : es) a   -> Eff es a-runProviderList_ providerList = runProviderList $ \input -> coerce . providerList input+runProviderList_ providerList action = runProviderListImpl action $+  ProviderListImpl $ let ?callStack = thawCallStack ?callStack+                     in \input -> coerce . providerList input  -- | Run the handler. provideList@@ -110,7 +112,7 @@   -> Eff (providedEs ++ es) a   -> Eff es (f a) provideListWith input action = unsafeEff $ \es -> do-  ProviderList (handlerEs :: Env handlerEs) providerList <- do+  ProviderList (handlerEs :: Env handlerEs) (ProviderListImpl providerList) <- do     getEnv @(ProviderList providedEs input f) es   (`unEff` handlerEs)     -- Corresponds to a thawCallStack in runProviderList.@@ -133,6 +135,18 @@  ---------------------------------------- -- Helpers++runProviderListImpl+  :: (HasCallStack, KnownEffects providedEs)+  => Eff (ProviderList providedEs input f : es) a+  -> ProviderListImpl input f providedEs es+  -> Eff es a+runProviderListImpl action providerListImpl = unsafeEff $ \es -> do+  inlineBracket+    (consEnv (ProviderList es providerListImpl) relinkProviderList es)+    unconsEnv+    (unEff action)+{-# INLINE runProviderListImpl #-}  relinkProviderList :: Relinker StaticRep (ProviderList e input f) relinkProviderList = Relinker $ \relink (ProviderList handlerEs run) -> do