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 +10/−1
- README.md +2/−1
- effectful-core.cabal +7/−5
- src/Effectful.hs +4/−2
- src/Effectful/Dispatch/Dynamic.hs +142/−6
- src/Effectful/Dispatch/Static.hs +1/−3
- src/Effectful/Error/Dynamic.hs +5/−1
- src/Effectful/Error/Static.hs +4/−4
- src/Effectful/Internal/Effect.hs +25/−1
- src/Effectful/Internal/Monad.hs +7/−5
- src/Effectful/Internal/Unlift.hs +3/−1
- src/Effectful/Internal/Utils.hs +1/−1
- src/Effectful/Labeled.hs +2/−0
- src/Effectful/Provider.hs +3/−2
- src/Effectful/Provider/List.hs +146/−0
- src/Effectful/Reader/Dynamic.hs +1/−1
- src/Effectful/State/Dynamic.hs +2/−2
- src/Effectful/Writer/Dynamic.hs +2/−2
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