packages feed

effectful-core 2.3.0.1 → 2.3.1.0

raw patch · 18 files changed

+367/−38 lines, 18 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

- Effectful.Dispatch.Dynamic: type EffectHandler e es = forall a localEs. (HasCallStack, e :> localEs) => LocalEnv localEs es " Capture of the local environment for handling local 'Eff' computations when @e@ is a higher order effect." -> e (Eff localEs) a " The effect performed in the local environment." -> Eff es a
- Effectful.Internal.Monad: type EffectHandler e es = forall a localEs. (HasCallStack, e :> localEs) => LocalEnv localEs es " Capture of the local environment for handling local 'Eff' computations when @e@ is a higher order effect." -> e (Eff localEs) a " The effect performed in the local environment." -> Eff es a
+ Effectful.Dispatch.Dynamic: localBorrow :: (e :> localEs, SharedSuffix es handlerEs) => LocalEnv localEs handlerEs -> UnliftStrategy -> ((forall r. Eff (e : es) r -> Eff es r) -> Eff es a) -> Eff es a
+ Effectful.Dispatch.Dynamic: localLend :: (e :> es, SharedSuffix es handlerEs) => LocalEnv localEs handlerEs -> UnliftStrategy -> ((forall r. Eff (e : localEs) r -> Eff localEs r) -> Eff es a) -> Eff es a
+ Effectful.Dispatch.Dynamic: localSeqBorrow :: (e :> localEs, SharedSuffix es handlerEs) => LocalEnv localEs handlerEs -> ((forall r. Eff (e : es) r -> Eff es r) -> Eff es a) -> Eff es a
+ Effectful.Dispatch.Dynamic: localSeqLend :: (e :> es, SharedSuffix es handlerEs) => LocalEnv localEs handlerEs -> ((forall r. Eff (e : localEs) r -> Eff localEs r) -> Eff es a) -> Eff es a
+ Effectful.Dispatch.Dynamic: type EffectHandler e es = forall a localEs. (HasCallStack, e :> localEs) => -- | Capture of the local environment for handling local 'Eff' computations -- when @e@ is a higher order effect. LocalEnv localEs es -> -- | The effect performed in the local environment. e (Eff localEs) a -> Eff es a
+ Effectful.Internal.Effect: class KnownEffects (es :: [Effect])
+ Effectful.Internal.Effect: infixr 5 ++
+ Effectful.Internal.Effect: instance Effectful.Internal.Effect.KnownEffects '[]
+ Effectful.Internal.Effect: instance Effectful.Internal.Effect.KnownEffects es => Effectful.Internal.Effect.KnownEffects (e : es)
+ Effectful.Internal.Effect: knownEffectsLength :: KnownEffects es => Int
+ Effectful.Internal.Monad: type EffectHandler e es = forall a localEs. (HasCallStack, e :> localEs) => -- | Capture of the local environment for handling local 'Eff' computations -- when @e@ is a higher order effect. LocalEnv localEs es -> -- | The effect performed in the local environment. e (Eff localEs) a -> Eff es a
+ Effectful.Provider.List: class KnownEffects (es :: [Effect])
+ Effectful.Provider.List: data ProviderList (effects :: [Effect]) (input :: Type) (f :: Type -> Type) :: Effect
+ Effectful.Provider.List: infixr 5 ++
+ Effectful.Provider.List: provideList :: forall effs f es a. ProviderList effs () f :> es => Eff (effs ++ es) a -> Eff es (f a)
+ Effectful.Provider.List: provideListWith :: forall effs input f es a. ProviderList effs input f :> es => input -> Eff (effs ++ es) a -> Eff es (f a)
+ Effectful.Provider.List: provideListWith_ :: forall effs input es a. ProviderList_ effs input :> es => input -> Eff (effs ++ es) a -> Eff es a
+ Effectful.Provider.List: provideList_ :: forall effs es a. ProviderList_ effs () :> es => Eff (effs ++ es) a -> Eff es a
+ Effectful.Provider.List: runProviderList :: KnownEffects effs => (forall r. input -> Eff (effs ++ es) r -> Eff es (f r)) -> Eff (ProviderList effs input f : es) a -> Eff es a
+ Effectful.Provider.List: runProviderList_ :: KnownEffects effs => (forall r. input -> Eff (effs ++ es) r -> Eff es r) -> Eff (ProviderList_ effs input : es) a -> Eff es a
+ Effectful.Provider.List: type ProviderList_ effs input = ProviderList effs input Identity
+ Effectful.Provider.List: type family (xs :: [Effect]) ++ (ys :: [Effect]) :: [Effect]
- Effectful.Error.Dynamic: data CallStack
+ Effectful.Error.Dynamic: data () => CallStack
- Effectful.Error.Static: data CallStack
+ Effectful.Error.Static: data () => CallStack
- Effectful.Internal.Effect: type family xs :>> es :: Constraint
+ Effectful.Internal.Effect: type family (xs :: [Effect]) ++ (ys :: [Effect]) :: [Effect]
- Effectful.NonDet: data CallStack
+ Effectful.NonDet: data () => CallStack

Files

CHANGELOG.md view
@@ -1,5 +1,14 @@+# effectful-core-2.3.1.0 (2024-06-07)+* Drop support for GHC 8.8.+* Remove inaccurate information from the `Show` instance of `ErrorWrapper`.+* Add `Effectful.Provider.List`, generalization of `Effectful.Provider`.+* Respect `withFrozenCallStack` used by callers of `send`.+* Support exchange of effects between the environment of the handler and the+  local one via `localSeqLend`, `localLend`, `localSeqBorrow` and `localBorrow`+  from `Effectful.Dispatch.Dynamic`.+ # effectful-core-2.3.0.1 (2023-11-13)-* Prevent internal functions from appending calls stack frames to handlers.+* Prevent internal functions from appending call stack frames to handlers.  # effectful-core-2.3.0.0 (2023-09-13) * Deprecate `withConcEffToIO`.
README.md view
@@ -161,7 +161,8 @@ For the examples see the *Introduction* sections of [`Effectful.Dispatch.Dynamic`](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Dynamic.html) and-[`Effectful.Dispatch.Static`](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Static.html).+[`Effectful.Dispatch.Static`](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Static.html)+(when in doubt, start with dynamic dispatch).  ## Acknowledgements 
effectful-core.cabal view
@@ -1,7 +1,7 @@-cabal-version:      2.4+cabal-version:      3.0 build-type:         Simple name:               effectful-core-version:            2.3.0.1+version:            2.3.1.0 license:            BSD-3-Clause license-file:       LICENSE category:           Control@@ -21,8 +21,7 @@   CHANGELOG.md   README.md -tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.7 || ==9.6.3-              || ==9.8.1+tested-with: GHC == { 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.5, 9.8.2, 9.10.1 }  bug-reports:   https://github.com/haskell-effectful/effectful/issues source-repository head@@ -31,6 +30,7 @@  common language     ghc-options:        -Wall -Wcompat -Wno-unticked-promoted-constructors+                        -Werror=prepositive-qualified-module      default-language:   Haskell2010 @@ -43,6 +43,7 @@                         FlexibleInstances                         GADTs                         GeneralizedNewtypeDeriving+                        ImportQualifiedPost                         LambdaCase                         MultiParamTypeClasses                         NoStarIsType@@ -60,7 +61,7 @@      ghc-options:    -O2 -    build-depends:    base                >= 4.13      && < 5+    build-depends:    base                >= 4.14      && < 5                     , containers          >= 0.6                     , exceptions          >= 0.10.4                     , monad-control       >= 1.0.3@@ -90,6 +91,7 @@                      Effectful.NonDet                      Effectful.Prim                      Effectful.Provider+                     Effectful.Provider.List                      Effectful.Reader.Dynamic                      Effectful.Reader.Static                      Effectful.State.Dynamic
src/Effectful.hs view
@@ -97,7 +97,8 @@ -- -- It implements support for extensible effects with both dynamic and static -- dispatch. For more information about each type consult the documentation in--- "Effectful.Dispatch.Dynamic" and "Effectful.Dispatch.Static".+-- "Effectful.Dispatch.Dynamic" and "Effectful.Dispatch.Static" (when in doubt,+-- start with dynamic dispatch). -- -- The library provides: --@@ -109,7 +110,8 @@ --   t'Effectful.Writer.Static.Local.Writer'. -- -- - Utilities for defining new effects and interpreting them, possibly in terms---   of already existing ones.+--   of already existing ones (see introduction of the+--   "Effectful.Dispatch.Dynamic" module for more information). -- -- While basic effects can be used out of the box, in general it's recommended -- to create your own that serve a more specific purpose.
src/Effectful/Dispatch/Dynamic.hs view
@@ -46,14 +46,20 @@   , localLiftUnlift   , localLiftUnliftIO -    -- *** Utils+    -- *** Misc+  , localSeqLend+  , localLend+  , localSeqBorrow+  , localBorrow   , SharedSuffix      -- * Re-exports   , HasCallStack   ) where +import Control.Monad import Control.Monad.IO.Unlift+import Data.Primitive.PrimArray import GHC.Stack (HasCallStack) import GHC.TypeLits @@ -560,6 +566,7 @@   ConcUnlift p l -> unsafeEff $ \es -> do     concUnliftIO les p l $ \unlift -> do       (`unEff` es) $ k $ unsafeEff_ . unlift+{-# INLINE localUnlift #-}  -- | Create a local unlifting function with the given strategy. localUnliftIO@@ -573,6 +580,7 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of   SeqUnlift      -> liftIO $ seqUnliftIO les k   ConcUnlift p l -> liftIO $ concUnliftIO les p l k+{-# INLINE localUnliftIO #-}  ---------------------------------------- -- Lifts@@ -614,6 +622,7 @@   ConcUnlift p l -> unsafeEff $ \es -> do     concUnliftIO es p l $ \unlift -> do       (`unEff` es) $ k $ unsafeEff_ . unlift+{-# INLINE localLift #-}  -- | Utility for lifting 'Eff' computations of type --@@ -704,6 +713,7 @@     concUnliftIO es p l $ \unliftEs -> do       concUnliftIO les p l $ \unliftLocalEs -> do         (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)+{-# INLINE localLiftUnlift #-}  -- | Create a local unlifting function with the given strategy along with an -- unrestricted lifting function.@@ -724,10 +734,136 @@ localLiftUnliftIO (LocalEnv les) strategy k = case strategy of   SeqUnlift      -> liftIO $ seqUnliftIO les $ k unsafeEff_   ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_+{-# INLINE localLiftUnliftIO #-}  ------------------------------------------- Utils+-- Misc +-- | Lend an effect to the local environment.+--+-- Consider the following effect:+--+-- >>> :{+--   data D :: Effect where+--     D :: D m ()+--   type instance DispatchOf D = Dynamic+-- :}+--+-- and an auxiliary effect that requires both @IOE@ and @D@ to run:+--+-- >>> :{+--   data E :: Effect+--   runE :: (IOE :> es, D :> es) => Eff (E : es) a -> Eff es a+--   runE = error "runE"+-- :}+--+-- Trying to use @runE@ inside the handler of @D@ doesn't work out of the box:+--+-- >>> :{+--   runD :: IOE :> es => Eff (D : es) a -> Eff es a+--   runD = interpret $ \env -> \case+--     D -> localSeqUnlift env $ \unlift -> do+--       unlift . runE $ pure ()+-- :}+-- ...+-- ...Could not deduce ...IOE :> localEs... arising from a use of ‘runE’+-- ...from the context: IOE :> es+-- ...+--+-- The problem is that @runE@ needs @IOE :> localEs@, but only @IOE :> es@ is+-- available. This function allows us to bridge the gap:+--+-- >>> :{+--   runD :: IOE :> es => Eff (D : es) a -> Eff es a+--   runD = interpret $ \env -> \case+--     D -> localSeqUnlift env $ \unlift -> do+--       localSeqLend @IOE env $ \useIOE -> do+--         unlift . useIOE . runE $ pure ()+-- :}+--+-- @since 2.3.1.0+localSeqLend+  :: (e :> es, SharedSuffix es handlerEs)+  => LocalEnv localEs handlerEs+  -> ((forall r. Eff (e : localEs) r -> Eff localEs r) -> Eff es a)+  -- ^ Continuation with the lent handler in scope.+  -> Eff es a+localSeqLend (LocalEnv les) k = unsafeEff $ \es -> do+  eles <- copyRef es les+  seqUnliftIO eles $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift++-- | Lend an effect to the local environment with a given unlifting strategy.+--+-- Generalizes 'localSeqLend'.+--+-- @since 2.3.1.0+localLend+  :: (e :> es, SharedSuffix es handlerEs)+  => LocalEnv localEs handlerEs+  -> UnliftStrategy+  -> ((forall r. Eff (e : localEs) r -> Eff localEs r) -> Eff es a)+  -- ^ Continuation with the lent handler in scope.+  -> Eff es a+localLend (LocalEnv les) strategy k = case strategy of+  SeqUnlift -> unsafeEff $ \es -> do+    eles <- copyRef es les+    seqUnliftIO eles $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift+  ConcUnlift p l -> unsafeEff $ \es -> do+    eles <- copyRef es les+    concUnliftIO eles p l $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift+{-# INLINE localLend #-}++-- | Borrow an effect from the local environment.+--+-- @since 2.3.1.0+localSeqBorrow+  :: (e :> localEs, SharedSuffix es handlerEs)+  => LocalEnv localEs handlerEs+  -> ((forall r. Eff (e : es) r -> Eff es r) -> Eff es a)+  -- ^ Continuation with the borrowed handler in scope.+  -> Eff es a+localSeqBorrow (LocalEnv les) k = unsafeEff $ \es -> do+  ees <- copyRef les es+  seqUnliftIO ees $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift++-- | Borrow an effect from the local environment with a given unlifting+-- strategy.+--+-- Generalizes 'localSeqBorrow'.+--+-- @since 2.3.1.0+localBorrow+  :: (e :> localEs, SharedSuffix es handlerEs)+  => LocalEnv localEs handlerEs+  -> UnliftStrategy+  -> ((forall r. Eff (e : es) r -> Eff es r) -> Eff es a)+  -- ^ Continuation with the borrowed handler in scope.+  -> Eff es a+localBorrow (LocalEnv les) strategy k = case strategy of+  SeqUnlift -> unsafeEff $ \es -> do+    ees <- copyRef les es+    seqUnliftIO ees $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift+  ConcUnlift p l -> unsafeEff $ \es -> do+    ees <- copyRef les es+    concUnliftIO ees p l $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift+{-# INLINE localBorrow #-}++copyRef+  :: forall e srcEs destEs. e :> srcEs+  => Env srcEs+  -> Env destEs+  -> IO (Env (e : destEs))+copyRef (Env hoffset hrefs hstorage) (Env offset refs0 storage) = do+  when (hstorage /= storage) $ do+    error "storages do not match"+  let size = sizeofPrimArray refs0 - offset+      i = 2 * reifyIndex @e @srcEs+  mrefs <- newPrimArray (size + 2)+  copyPrimArray mrefs 0 hrefs (hoffset + i) 2+  copyPrimArray mrefs 2 refs0 offset size+  refs <- unsafeFreezePrimArray mrefs+  pure $ Env 0 refs storage+ -- | Require that both effect stacks share an opaque suffix. -- -- Functions from the 'localUnlift' family utilize this constraint to guarantee@@ -744,7 +880,7 @@ -- Running local actions in a more specific environment is fine: -- -- >>> :{---  runE1 :: Eff (E ': es) a -> Eff es a+--  runE1 :: Eff (E : es) a -> Eff es a --  runE1 = interpret $ \env -> \case --    E m -> runReader () $ do --      localSeqUnlift env $ \unlift -> unlift m@@ -753,7 +889,7 @@ -- Running local actions in a more general environment is fine: -- -- >>> :{---  runE2 :: Eff (E ': es) a -> Eff es a+--  runE2 :: Eff (E : es) a -> Eff es a --  runE2 = reinterpret (runReader ()) $ \env -> \case --    E m -> raise $ do --      localSeqUnlift env $ \unlift -> unlift m@@ -763,7 +899,7 @@ -- this would make it possible to run anything within 'runPureEff': -- -- >>> :{---  runE3 :: Eff (E ': es) a -> Eff es a+--  runE3 :: Eff (E : es) a -> Eff es a --  runE3 = reinterpret (runReader ()) $ \env -> \case --    E m -> pure . runPureEff $ do --      localSeqUnlift env $ \unlift -> unlift m@@ -776,7 +912,7 @@ -- this makes a special case of the above possible: -- -- >>> :{---  runE4 :: Eff '[E, IOE] a -> Eff '[IOE] a+--  runE4 :: Eff [E, IOE] a -> Eff '[IOE] a --  runE4 = interpret $ \env -> \case --    E m -> pure . runPureEff $ do --      localSeqUnlift env $ \unlift -> unlift m
src/Effectful/Dispatch/Static.hs view
@@ -57,9 +57,7 @@ -- * If the effect you're about to define has only one reasonable --   implementation, it makes a lot of sense to make it statically dispatched. ----- Statically dispatched effects also perform slightly better than dynamically--- dispatched ones, because their operations are implemented as standard top--- level functions, so the compiler can apply more optimizations to them.+-- __When in doubt, use dynamic dispatch as it's more flexible.__ --  -- $example
src/Effectful/Error/Dynamic.hs view
@@ -30,7 +30,7 @@  import Effectful import Effectful.Dispatch.Dynamic-import qualified Effectful.Error.Static as E+import Effectful.Error.Static qualified as E  -- | Provide the ability to handle errors of type @e@. data Error e :: Effect where@@ -50,6 +50,8 @@  -- | Handle errors of type @e@ (via "Effectful.Error.Static") with a specific -- error handler.+--+-- @since 2.3.0.0 runErrorWith   :: (E.CallStack -> e -> Eff es a)   -- ^ The error handler.@@ -61,6 +63,8 @@  -- | Handle errors of type @e@ (via "Effectful.Error.Static"). In case of an -- error discard the 'E.CallStack'.+--+-- @since 2.3.0.0 runErrorNoCallStack   :: Eff (Error e : es) a   -> Eff es (Either e a)
src/Effectful/Error/Static.hs view
@@ -130,6 +130,8 @@                $ throwIO ex  -- | Handle errors of type @e@ with a specific error handler.+--+-- @since 2.3.0.0 runErrorWith   :: (CallStack -> e -> Eff es a)   -- ^ The error handler.@@ -140,6 +142,8 @@   Right a -> pure a  -- | Handle errors of type @e@. In case of an error discard the 'CallStack'.+--+-- @since 2.3.0.0 runErrorNoCallStack   :: forall e es a   .  Eff (Error e : es) a@@ -227,10 +231,6 @@ instance Show ErrorWrapper where   showsPrec p (ErrorWrapper _ cs _)     = ("Effectful.Error.Static.ErrorWrapper\n\n" ++)-    . ("If you see this, most likely there is a stray 'Async' action that\n" ++)-    . ("outlived the scope of the 'Error' effect, was interacted with and threw\n" ++)-    . ("an error to the parent thread. If that scenario sounds unlikely, please\n" ++)-    . ("file a ticket at https://github.com/haskell-effectful/effectful/issues.\n\n" ++)     . showsPrec p (prettyCallStack cs) instance Exception ErrorWrapper 
src/Effectful/Internal/Effect.hs view
@@ -12,6 +12,8 @@   , Subset(..)   , KnownPrefix(..)   , IsUnknownSuffixOf+  , type (++)+  , KnownEffects(..)    -- * Re-exports   , Type@@ -64,7 +66,7 @@ type family xs :>> es :: Constraint where   '[]      :>> es = ()   (x : xs) :>> es = (x :> es, xs :>> es)-{-# DEPRECATED (:>>) "Usage of (:>>) slows down GHC too much, so it will be removed in 3.0.0.0. See https://github.com/haskell-effectful/effectful/issues/52#issuecomment-1269155485 for more information." #-}+{-# DEPRECATED (:>>) "Usage of (:>>) slows down GHC too much. See https://github.com/haskell-effectful/effectful/issues/52#issuecomment-1269155485 for more information." #-}  ---------------------------------------- @@ -116,3 +118,25 @@ class (xs :: [Effect]) `IsUnknownSuffixOf` (es :: [Effect]) instance {-# INCOHERENT #-} xs ~ es => xs `IsUnknownSuffixOf` es instance xs `IsUnknownSuffixOf` es => xs `IsUnknownSuffixOf` (e : es)++----++-- | Append two type-level lists together.+type family (xs :: [Effect]) ++ (ys :: [Effect]) :: [Effect] where+  '[] ++ ys  = ys+  (x : xs) ++ ys = x : xs ++ ys++infixr 5 ++++-- | Calculate length of a list of known effects.+class KnownEffects (es :: [Effect]) where+  knownEffectsLength :: Int+  knownEffectsLength =+  -- Don't show "minimal complete definition" in haddock.+    error "knownEffectsLength"++instance KnownEffects es => KnownEffects (e : es) where+  knownEffectsLength = 1 + knownEffectsLength @es++instance KnownEffects '[] where+  knownEffectsLength = 0
src/Effectful/Internal/Monad.hs view
@@ -83,8 +83,10 @@   ) where  import Control.Applicative+import Control.Exception qualified as E import Control.Monad import Control.Monad.Base+import Control.Monad.Catch qualified as C import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.IO.Unlift@@ -96,8 +98,6 @@ import GHC.Stack import System.IO.Unsafe (unsafeDupablePerformIO) import Unsafe.Coerce (unsafeCoerce)-import qualified Control.Exception as E-import qualified Control.Monad.Catch as C  import Effectful.Internal.Effect import Effectful.Internal.Env@@ -200,9 +200,10 @@   -> ((forall r. Eff es r -> IO r) -> IO a)   -- ^ Continuation with the unlifting function in scope.   -> Eff es a-withEffToIO strategy f = case strategy of-  SeqUnlift      -> unsafeEff $ \es -> seqUnliftIO es f-  ConcUnlift p b -> unsafeEff $ \es -> concUnliftIO es p b f+withEffToIO strategy k = case strategy of+  SeqUnlift      -> unsafeEff $ \es -> seqUnliftIO es k+  ConcUnlift p b -> unsafeEff $ \es -> concUnliftIO es p b k+{-# INLINE withEffToIO #-}  -- | Create an unlifting function with the 'ConcUnlift' strategy. --@@ -419,6 +420,7 @@     es <- tailEnv ees     concUnliftIO ees p l $ \unlift -> do       (`unEff` es) $ k $ unsafeEff_ . unlift+{-# INLINE raiseWith #-}  -- | Eliminate a duplicate effect from the top of the effect stack. subsume :: e :> es => Eff (e : es) a -> Eff es a
src/Effectful/Internal/Unlift.hs view
@@ -18,6 +18,7 @@  import Control.Concurrent import Control.Monad+import Data.IntMap.Strict qualified as IM import GHC.Conc.Sync (ThreadId(..)) import GHC.Exts (mkWeak#, mkWeakNoFinalizer#) import GHC.Generics (Generic)@@ -25,7 +26,6 @@ import GHC.Stack (HasCallStack) import GHC.Weak (Weak(..)) import System.Mem.Weak (deRefWeak)-import qualified Data.IntMap.Strict as IM  import Effectful.Internal.Env import Effectful.Internal.Utils@@ -159,6 +159,7 @@           es <- cloneEnv esTemplate           pure (n - 1, es)     unEff m es+{-# NOINLINE ephemeralConcUnlift #-}  -- | Concurrent unlift that preserves the environment between calls to the -- unlifting function within a particular thread.@@ -211,6 +212,7 @@                     }               pure (newEntries, es)     unEff m es+{-# NOINLINE persistentConcUnlift #-}  ---------------------------------------- -- Data types
src/Effectful/Internal/Utils.hs view
@@ -186,5 +186,5 @@  thawCallStack :: CallStack -> CallStack thawCallStack = \case-  FreezeCallStack cs -> thawCallStack cs+  FreezeCallStack cs -> cs   cs -> cs
src/Effectful/Labeled.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE PolyKinds #-} -- | Labeled effects.+--+-- @since 2.3.0.0 module Effectful.Labeled   ( -- * Example     -- $example
src/Effectful/Provider.hs view
@@ -1,4 +1,6 @@ -- | Turn an effect handler into an effectful operation.+--+-- @since 2.3.0.0 module Effectful.Provider   ( -- * Example     -- $example@@ -192,8 +194,7 @@     error "storages do not match"   let size = sizeofPrimArray refs0 - offset   mrefs <- newPrimArray (size + 2)+  copyPrimArray mrefs 0 hrefs hoffset 2   copyPrimArray mrefs 2 refs0 offset size-  writePrimArray mrefs 0 $ indexPrimArray hrefs  hoffset-  writePrimArray mrefs 1 $ indexPrimArray hrefs (hoffset + 1)   refs <- unsafeFreezePrimArray mrefs   pure $ Env 0 refs storage
+ src/Effectful/Provider/List.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+-- | Turn a handler of multiple effects into an effectful operation.+--+-- Generalizes "Effectful.Provider".+--+-- @since 2.3.1.0+module Effectful.Provider.List+  ( -- * Effect+    ProviderList+  , ProviderList_++    -- ** Handlers+  , runProviderList+  , runProviderList_++    -- ** Operations+  , provideList+  , provideList_+  , provideListWith+  , provideListWith_++    -- * Misc+  , type (++)+  , KnownEffects+  ) where++import Control.Monad+import Data.Coerce+import Data.Functor.Identity+import Data.Primitive.PrimArray++import Effectful+import Effectful.Dispatch.Static+import Effectful.Dispatch.Static.Primitive+import Effectful.Internal.Effect+import Effectful.Internal.Env (Env(..))+import Effectful.Internal.Utils++-- | Provide a way to run a handler of multiple @effects@ with a given @input@.+--+-- /Note:/ @f@ can be used to alter the return type of the handler. If that's+-- unnecessary, use 'ProviderList_'.+data ProviderList (effects :: [Effect]) (input :: Type) (f :: Type -> Type) :: Effect++-- | A restricted variant of 'ProviderList' with unchanged return type of the+-- handler.+type ProviderList_ effs input = ProviderList effs input Identity++type instance DispatchOf (ProviderList effs input f) = Static NoSideEffects++data instance StaticRep (ProviderList effs input f) where+  ProviderList+    :: KnownEffects effs+    => !(Env handlerEs)+    -> !(forall r. input -> Eff (effs ++ handlerEs) r -> Eff handlerEs (f r))+    -> StaticRep (ProviderList effs input f)++-- | Run the 'ProviderList' effect with a given handler.+runProviderList+  :: KnownEffects effs+  => (forall r. input -> Eff (effs ++ es) r -> Eff es (f r))+  -- ^ The handler.+  -> Eff (ProviderList effs input f : es) a+  -> Eff es a+runProviderList run m = unsafeEff $ \es0 -> do+  inlineBracket+    (consEnv (ProviderList es0 run) relinkProviderList es0)+    unconsEnv+    (\es -> unEff m es)++-- | Run the 'Provider' effect with a given handler that doesn't change its+-- return type.+runProviderList_+  :: KnownEffects effs+  => (forall r. input -> Eff (effs ++ es) r -> Eff es r)+  -- ^ The handler.+  -> Eff (ProviderList_ effs input : es) a+  -> Eff es a+runProviderList_ run = runProviderList $ \input -> coerce . run input++-- | Run the handler.+provideList+  :: forall effs f es a+   . ProviderList effs () f :> es+  => Eff (effs ++ es) a+  -> Eff es (f a)+provideList = provideListWith @effs ()++-- | Run the handler with unchanged return type.+provideList_+  :: forall effs es a+   . ProviderList_ effs () :> es+  => Eff (effs ++ es) a+  -> Eff es a+provideList_ = provideListWith_ @effs ()++-- | Run the handler with a given input.+provideListWith+  :: forall effs input f es a+   . ProviderList effs input f :> es+  => input+  -- ^ The input to the handler.+  -> Eff (effs ++ es) a+  -> Eff es (f a)+provideListWith input action = unsafeEff $ \es -> do+  ProviderList (handlerEs :: Env handlerEs) run <- getEnv @(ProviderList effs input f) es+  (`unEff` handlerEs) . run input . unsafeEff $ \eHandlerEs -> do+    unEff action =<< copyRefs @effs @handlerEs eHandlerEs es++-- | Run the handler that doesn't change its return type with a given input.+provideListWith_+  :: forall effs input es a+   . ProviderList_ effs input :> es+  => input+  -- ^ The input to the handler.+  -> Eff (effs ++ es) a+  -> Eff es a+provideListWith_ input = adapt . provideListWith @effs input+  where+    adapt :: Eff es (Identity a) -> Eff es a+    adapt = coerce++----------------------------------------+-- Helpers++relinkProviderList :: Relinker StaticRep (ProviderList e input f)+relinkProviderList = Relinker $ \relink (ProviderList handlerEs run) -> do+  newHandlerEs <- relink handlerEs+  pure $ ProviderList newHandlerEs run++copyRefs+  :: forall effs handlerEs es+   . KnownEffects effs+  => Env (effs ++ handlerEs)+  -> Env es+  -> IO (Env (effs ++ es))+copyRefs (Env hoffset hrefs hstorage) (Env offset refs0 storage) = do+  when (hstorage /= storage) $ do+    error "storages do not match"+  let size = sizeofPrimArray refs0 - offset+      effsSize = 2 * knownEffectsLength @effs+  mrefs <- newPrimArray (size + effsSize)+  copyPrimArray mrefs 0 hrefs hoffset effsSize+  copyPrimArray mrefs effsSize refs0 offset size+  refs <- unsafeFreezePrimArray mrefs+  pure $ Env 0 refs storage
src/Effectful/Reader/Dynamic.hs view
@@ -19,7 +19,7 @@  import Effectful import Effectful.Dispatch.Dynamic-import qualified Effectful.Reader.Static as R+import Effectful.Reader.Static qualified as R  data Reader r :: Effect where   Ask   :: Reader r m r
src/Effectful/State/Dynamic.hs view
@@ -31,8 +31,8 @@  import Effectful import Effectful.Dispatch.Dynamic-import qualified Effectful.State.Static.Local as L-import qualified Effectful.State.Static.Shared as S+import Effectful.State.Static.Local qualified as L+import Effectful.State.Static.Shared qualified as S  -- | Provide access to a mutable value of type @s@. data State s :: Effect where
src/Effectful/Writer/Dynamic.hs view
@@ -25,8 +25,8 @@  import Effectful import Effectful.Dispatch.Dynamic-import qualified Effectful.Writer.Static.Local as L-import qualified Effectful.Writer.Static.Shared as S+import Effectful.Writer.Static.Local qualified as L+import Effectful.Writer.Static.Shared qualified as S  -- | Provide access to a write only value of type @w@. data Writer w :: Effect where