@@ -6,7 +6,7 @@
66-- This module is intended for internal use only, and may change without warning
77-- in subsequent releases.
88module Effectful.Internal.Monad
9− ( -- * The 'Eff' monad
9+ ( -- * Monad
1010 Eff
1111 , runPureEff
1212
@@ -16,17 +16,18 @@ module Effectful.Internal.Monad
1616 , unsafeEff_
1717
1818 -- * Fail
19− , Fail(..)
19+ , Fail
20+ , runFail
2021
2122 -- * IO
2223 , IOE
2324 , runEff
2425
25− -- * Prim
26+ -- * Primitive
2627 , Prim
2728 , runPrim
2829
29− -- * Unlift strategies
30+ -- ** Unlift strategies
3031 , UnliftStrategy(..)
3132 , Persistence(..)
3233 , Limit(..)
@@ -34,88 +35,88 @@ module Effectful.Internal.Monad
3435 , withUnliftStrategy
3536 , withEffToIO
3637
37− -- ** Low-level unlifts
38− , seqUnliftIO
39− , concUnliftIO
40−
41− -- * Effects
42−
43− -- ** Dynamic dispatch
44− , EffectHandler
45− , LocalEnv(..)
46− , HandlerA(..)
47− , runHandler
48− , send
49−
50− -- ** Static dispatch
51− , DataA(..)
52− , runData
53− , evalData
54− , execData
55− , getData
56− , putData
57− , stateData
58− , stateDataM
59− , localData
38+ --- *** Low-level helpers
39+ , unsafeWithLiftMapIO
40+ , unsafeSeqUnliftEff
41+ , unsafeConcUnliftEff
42+
43+ -- * Primitive effects
44+
45+ -- ** Running
46+ , runEffect
47+ , evalEffect
48+ , execEffect
49+
50+ -- ** Modification
51+ , getEffect
52+ , putEffect
53+ , stateEffect
54+ , localEffect
55+ , readerEffectM
56+ , stateEffectM
6057 ) where
6158
6259import Control.Applicative (liftA2)
60+import Control.Concurrent (myThreadId)
61+import Control.Exception
6362import Control.Monad.Base
6463import Control.Monad.Fix
6564import Control.Monad.IO.Class
6665import Control.Monad.IO.Unlift
6766import Control.Monad.Primitive
6867import Control.Monad.Trans.Control
68+import Data.Unique
6969import GHC.Exts (oneShot)
7070import GHC.IO (IO(..))
7171import GHC.Stack (HasCallStack)
7272import System.IO.Unsafe (unsafeDupablePerformIO)
73−import qualified Control.Exception as E
74−import qualified Control.Monad.Catch as C
73+import qualified Control.Monad.Catch as E
7574
7675import Effectful.Internal.Effect
7776import Effectful.Internal.Env
7877import Effectful.Internal.Unlift
78+import Effectful.Internal.Utils
7979
8080type role Eff nominal representational
8181
82−-- | The 'Eff' monad provides the implementation of a computation that performs
82+-- | The 'Eff' monad provides the implementation of an operation that performs
8383-- an arbitrary set of effects. In @'Eff' es a@, @es@ is a type-level list that
84−-- contains all the effects that the computation may perform. For example, a
85−-- computation that produces an 'Integer' by consuming a 'String' from the
86−-- global environment and acting upon a single mutable value of type 'Bool'
87−-- would have the following type:
84+-- contains all the effects that the operation may perform. For example, an
85+-- operation that produces an 'Integer' by consuming a 'String' from the global
86+-- environment and acting upon a single mutable cell containing a 'Bool' would
87+-- have the following type:
8888--
8989-- @
90−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'
90+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
9191-- @
9292--
9393-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
9494-- Instead, the '(:>)' type class is used to express constraints on the list of
95−-- effects without coupling a computation to a concrete list of effects. For
96−-- example, the above example would be expressed with the following type:
95+-- effects without coupling an operation to a concrete list of effects. For
96+-- example, the above example would more commonly be expressed with the
97+-- following type:
9798--
9899-- @
99−-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
100+-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
100101-- @
101102--
102−-- This abstraction allows the computation to be used in functions that may
103+-- This abstraction allows the operation to be used in functions that may
103104-- perform other effects, and it also allows the effects to be handled in any
104105-- order.
105106newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
106107 deriving (Monoid, Semigroup)
107108
108−-- | Run a pure 'Eff' computation.
109+-- | Run a pure 'Eff' operation.
109110--
110−-- For running computations with side effects see 'runEff'.
111+-- For running operations with side effects see 'runEff'.
111112runPureEff :: Eff '[] a -> a
112113runPureEff (Eff m) =
113− -- unsafeDupablePerformIO is safe here since IOE was not on the stack, so no
114− -- IO with side effects was performed (unless someone sneakily introduced side
115− -- effects with unsafeEff, but then all bets are off).
114+ -- unsafePerformIO is safe here since IOE was not on the stack, so no IO with
115+ -- side effects was performed (unless someone sneakily introduced side effects
116+ -- with unsafeEff, but then all bets are off).
116117 --
117118 -- Moreover, internals don't allocate any resources that require explicit
118− -- cleanup actions to run.
119+ -- cleanup actions to run, so the "Dupable" part should also be just fine.
119120 unsafeDupablePerformIO $ m =<< emptyEnv
120121
121122----------------------------------------
@@ -126,70 +127,62 @@ unEff :: Eff es a -> Env es -> IO a
126127unEff (Eff m) = m
127128
128129-- | Access the underlying 'IO' monad along with the environment.
129−--
130−-- This function is __unsafe__ because it can be used to introduce arbitrary
131−-- 'IO' actions into pure 'Eff' computations.
132130unsafeEff :: (Env es -> IO a) -> Eff es a
133131unsafeEff m = Eff (oneShot m)
134132
135133-- | Access the underlying 'IO' monad.
136−--
137−-- This function is __unsafe__ because it can be used to introduce arbitrary
138−-- 'IO' actions into pure 'Eff' computations.
139134unsafeEff_ :: IO a -> Eff es a
140135unsafeEff_ m = unsafeEff $ \_ -> m
141136
142−----------------------------------------
143−-- Unlifting IO
144−
145−-- | Get the current 'UnliftStrategy'.
146−unliftStrategy :: IOE :> es => Eff es UnliftStrategy
147−unliftStrategy = do
148− DataA (IOE unlift) <- getData
149− pure unlift
150−
151−-- | Locally override the 'UnliftStrategy' with the given value.
152−withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
153−withUnliftStrategy unlift = localData $ \_ -> DataA (IOE unlift)
154−
155−-- | Create an unlifting function with the current 'UnliftStrategy'.
137+-- | Utility for lifting 'IO' operations of type
156138--
157−-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'
158−-- constraint for accurate stack traces in case an insufficiently powerful
159−-- 'UnliftStrategy' is used and the unlifting function fails.
139+-- @'IO' a -> 'IO' b@
160140--
161−-- /Note:/ the strategy is reset to 'SeqUnlift' inside the continuation.
162−withEffToIO
163− :: (HasCallStack, IOE :> es)
164− => ((forall r. Eff es r -> IO r) -> IO a)
165− -- ^ Continuation with the unlifting function in scope.
166− -> Eff es a
167−withEffToIO f = unliftStrategy >>= \case
168− SeqUnlift -> unsafeEff $ \es -> seqUnliftIO es f
169− ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
170− unsafeEff $ \es -> concUnliftIO es p b f
141+-- to
142+--
143+-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
144+--
145+-- /Note:/ the 'IO' operation must not run its argument in a separate thread,
146+-- attempting to do so will result in a runtime error.
147+unsafeWithLiftMapIO
148+ :: HasCallStack
149+ => ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
150+ -> Eff es r
151+unsafeWithLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
152+ unsafeSeqUnliftEff es $ \unlift -> mapIO $ unlift m
171153
172−-- | Create an unlifting function with the 'SeqUnlift' strategy.
173−seqUnliftIO
154+-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
155+unsafeSeqUnliftEff
174156 :: HasCallStack
175157 => Env es
176− -- ^ The environment.
177158 -> ((forall r. Eff es r -> IO r) -> IO a)
178− -- ^ Continuation with the unlifting function in scope.
179159 -> IO a
180−seqUnliftIO es k = seqUnlift k es unEff
181−
182−-- | Create an unlifting function with the 'ConcUnlift' strategy.
183−concUnliftIO
160+unsafeSeqUnliftEff es k = do
161+ tid0 <- myThreadId
162+ k $ \m -> do
163+ tid <- myThreadId
164+ if tid `eqThreadId` tid0
165+ then unEff m es
166+ else error
167+ $ "If you want to use the unlifting function to run Eff operations "
168+ ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
169+
170+-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
171+unsafeConcUnliftEff
184172 :: HasCallStack
185173 => Env es
186− -- ^ The environment.
187174 -> Persistence
188175 -> Limit
189176 -> ((forall r. Eff es r -> IO r) -> IO a)
190− -- ^ Continuation with the unlifting function in scope.
191177 -> IO a
192−concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
178+unsafeConcUnliftEff es Ephemeral (Limited uses) k =
179+ unsafeEphemeralConcUnliftIO uses k es unEff
180+unsafeConcUnliftEff es Ephemeral Unlimited k =
181+ unsafeEphemeralConcUnliftIO maxBound k es unEff
182+unsafeConcUnliftEff es Persistent (Limited threads) k =
183+ unsafePersistentConcUnliftIO False threads k es unEff
184+unsafeConcUnliftEff es Persistent Unlimited k =
185+ unsafePersistentConcUnliftIO True maxBound k es unEff
193186
194187----------------------------------------
195188-- Base
@@ -217,56 +210,83 @@ instance MonadFix (Eff es) where
217210----------------------------------------
218211-- Exception
219212
220−instance C.MonadThrow (Eff es) where
221− throwM = unsafeEff_ . E.throwIO
213+instance E.MonadThrow (Eff es) where
214+ throwM = unsafeEff_ . throwIO
222215
223−instance C.MonadCatch (Eff es) where
216+instance E.MonadCatch (Eff es) where
224217 catch m handler = unsafeEff $ \es -> do
225218 size <- sizeEnv es
226− unEff m es `E.catch` \e -> do
219+ unEff m es `catch` \e -> do
227220 checkSizeEnv size es
228221 unEff (handler e) es
229222
230−instance C.MonadMask (Eff es) where
231− mask k = unsafeEff $ \es -> E.mask $ \restore ->
223+instance E.MonadMask (Eff es) where
224+ mask k = unsafeEff $ \es -> mask $ \restore ->
232225 unEff (k $ \m -> unsafeEff $ restore . unEff m) es
233226
234− uninterruptibleMask k = unsafeEff $ \es -> E.uninterruptibleMask $ \restore ->
227+ uninterruptibleMask k = unsafeEff $ \es -> uninterruptibleMask $ \restore ->
235228 unEff (k $ \m -> unsafeEff $ restore . unEff m) es
236229
237− generalBracket acquire release use = unsafeEff $ \es -> E.mask $ \restore -> do
230+ generalBracket acquire release use = unsafeEff $ \es -> mask $ \restore -> do
238231 size <- sizeEnv es
239232 resource <- unEff acquire es
240− b <- restore (unEff (use resource) es) `E.catch` \e -> do
233+ b <- restore (unEff (use resource) es) `catch` \e -> do
241234 checkSizeEnv size es
242− _ <- unEff (release resource $ C.ExitCaseException e) es
243− E.throwIO e
235+ _ <- unEff (release resource $ E.ExitCaseException e) es
236+ throwIO e
244237 checkSizeEnv size es
245− c <- unEff (release resource $ C.ExitCaseSuccess b) es
238+ c <- unEff (release resource $ E.ExitCaseSuccess b) es
246239 pure (b, c)
247240
248241----------------------------------------
249242-- Fail
250243
251−-- | Provide the ability to use the 'MonadFail' instance of 'Eff'.
252244data Fail :: Effect where
253− Fail :: String -> Fail m a
245+ Fail :: Unique -> Fail m r
246+
247+runFail :: Eff (Fail : es) a -> Eff es (Either String a)
248+runFail m = unsafeEff $ \es0 -> mask $ \release -> do
249+ -- A unique tag is picked so that different runFail handlers don't catch each
250+ -- other's exceptions.
251+ tag <- newUnique
252+ size0 <- sizeEnv es0
253+ es <- unsafeConsEnv (IdE (Fail tag)) noRelinker es0
254+ r <- tryFailIO tag (release $ unEff m es) `onException` unsafeTailEnv size0 es
255+ _ <- unsafeTailEnv size0 es
256+ pure r
254257
255258instance Fail :> es => MonadFail (Eff es) where
256− fail = send . Fail
259+ fail msg = readerEffectM $ \(IdE (Fail tag)) -> unsafeEff_ $ do
260+ throwIO $ FailEx tag msg
261+
262+--------------------
263+
264+data FailEx = FailEx Unique String
265+instance Show FailEx where
266+ showsPrec p (FailEx _ msg)
267+ = ("Effectful.Internal.Monad.FailEx " ++)
268+ . showsPrec p msg
269+instance Exception FailEx
270+
271+tryFailIO :: Unique -> IO a -> IO (Either String a)
272+tryFailIO tag m =
273+ (Right <$> m) `catch` \err@(FailEx etag msg) -> do
274+ if tag == etag
275+ then pure $ Left msg
276+ else throwIO err
257277
258278----------------------------------------
259279-- IO
260280
261−-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.
281+-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.
262282newtype IOE :: Effect where
263283 IOE :: UnliftStrategy -> IOE m r
264284
265−-- | Run an 'Eff' computation with side effects.
285+-- | Run an 'Eff' operation with side effects.
266286--
267−-- For running pure computations see 'runPureEff'.
287+-- For running pure operations see 'runPureEff'.
268288runEff :: Eff '[IOE] a -> IO a
269−runEff m = unEff (evalData (DataA (IOE SeqUnlift)) m) =<< emptyEnv
289+runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv
270290
271291instance IOE :> es => MonadIO (Eff es) where
272292 liftIO = unsafeEff_
@@ -290,126 +310,142 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where
290310----------------------------------------
291311-- Primitive
292312
293−-- | Provide the ability to perform primitive state-transformer actions.
313+-- | An effect to perform primitive state-transformer actions.
294314data Prim :: Effect where
295315 Prim :: Prim m r
296316
297−-- | Run an 'Eff' computation with primitive state-transformer actions.
317+-- | Run an 'Eff' operation with primitive state-transformer actions.
298318runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
299−runPrim = evalData (DataA Prim)
319+runPrim = evalEffect (IdE Prim)
300320
301321instance Prim :> es => PrimMonad (Eff es) where
302− type PrimState (Eff es) = RealWorld
322+ type PrimState (Eff es) = PrimState IO
303323 primitive = unsafeEff_ . IO
304324
305325----------------------------------------
306−-- Dynamic dispatch
326+-- Unlift strategies
327+
328+-- | The strategy to use when unlifting 'Eff' operations via 'withRunInIO' or
329+-- the 'Effectful.Interpreter.localUnlift' family.
330+data UnliftStrategy
331+ = SeqUnlift
332+ -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call
333+ -- the unlifting function in threads distinct from its creator will result in
334+ -- a runtime error.
335+ | ConcUnlift Persistence Limit
336+ -- ^ A strategy that makes it possible for the unlifting function to be called
337+ -- in threads distinct from its creator. See 'Persistence' and 'Limit'
338+ -- settings for more information.
339+ deriving (Eq, Ord, Show)
340+
341+-- | Persistence setting for the 'ConcUnlift' strategy.
342+--
343+-- Different functions require different persistence strategies. Examples:
344+--
345+-- - Lifting 'pooledMapConcurrentlyN' from the @unliftio@ library requires the
346+-- 'Ephemeral' strategy as we don't want jobs to share environment changes
347+-- made by previous jobs run in the same worker thread.
348+--
349+-- - Lifting 'Control.Concurrent.forkIOWithUnmask' requires the 'Persistent'
350+-- strategy, otherwise the unmasking function would start with a fresh
351+-- environment each time it's called.
352+data Persistence
353+ = Ephemeral
354+ -- ^ Don't persist the environment between calls to the unlifting function in
355+ -- threads distinct from its creator.
356+ | Persistent
357+ -- ^ Persist the environment between calls to the unlifting function within a
358+ -- particular thread.
359+ deriving (Eq, Ord, Show)
360+
361+-- | Limit setting for the 'ConcUnlift' strategy.
362+data Limit
363+ = Limited Int
364+ -- ^ Behavior dependent on the 'Persistence' setting.
365+ --
366+ -- For 'Ephemeral', it limits the amount of uses of the unlifting function in
367+ -- threads distinct from its creator to @N@. The unlifting function will
368+ -- create @N@ copies of the environment when called @N@ times and @K+1@ copies
369+ -- when called @K < N@ times.
370+ --
371+ -- For 'Persistent', it limits the amount of threads, distinct from the
372+ -- creator of the unlifting function, it can be called in to @N@. The amount
373+ -- of calls to the unlifting function within a particular threads is
374+ -- unlimited. The unlifting function will create @N@ copies of the environment
375+ -- when called in @N@ threads and @K+1@ copies when called in @K < N@ threads.
376+ | Unlimited
377+ -- ^ Unlimited use of the unlifting function.
378+ deriving (Eq, Ord, Show)
307379
308−type role LocalEnv nominal nominal
380+-- | Get the current 'UnliftStrategy'.
381+unliftStrategy :: IOE :> es => Eff es UnliftStrategy
382+unliftStrategy = readerEffectM $ \(IdE (IOE unlift)) -> pure unlift
309383
310−-- | Opaque representation of the 'Eff' environment at the point of calling the
311−-- 'send' function, i.e. right before the control is passed to the effect
312−-- handler.
384+-- | Locally override the 'UnliftStrategy' with a given value.
313385--
314−-- The second type variable represents effects of a handler and is needed for
315−-- technical reasons to guarantee soundness.
316−newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env localEs)
317−
318−-- | Type signature of the effect handler.
319−type EffectHandler e es
320− = forall a localEs. HasCallStack
321− => LocalEnv localEs es
322− -- ^ Capture of the local environment for handling local 'Eff' computations
323− -- when @e@ is a higher order effect.
324− -> e (Eff localEs) a
325− -- ^ The effect performed in the local environment.
326− -> Eff es a
386+-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
387+withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
388+withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
327389
328−-- | An adapter for dynamically dispatched effects.
390+-- | Create an unlifting function with the current 'UnliftStrategy'.
329391--
330−-- Represents the effect handler bundled with its environment.
331−data HandlerA :: Effect -> Type where
332− HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e
333−
334−-- | Run a dynamically dispatched effect with the given handler.
335−runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a
336−runHandler e m = unsafeEff $ \es0 -> do
337− size0 <- sizeEnv es0
338− E.bracket (unsafeConsEnv e relinker es0)
339− (unsafeTailEnv size0)
340− (\es -> unEff m es)
341− where
342− relinker :: Relinker HandlerA e
343− relinker = Relinker $ \relink (HandlerA handlerEs handle) -> do
344− newHandlerEs <- relink handlerEs
345− pure $ HandlerA newHandlerEs handle
346−
347−-- | Send an operation of the given effect to its handler for execution.
348−send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
349−send op = unsafeEff $ \es -> do
350− HandlerA handlerEs handle <- getEnv es
351− unEff (handle (LocalEnv es) op) handlerEs
392+-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'
393+-- constraint for accurate stack traces in case an insufficiently powerful
394+-- 'UnliftStrategy' is used and the unlifting function fails.
395+withEffToIO
396+ :: (HasCallStack, IOE :> es)
397+ => ((forall r. Eff es r -> IO r) -> IO a)
398+ -- ^ Continuation with the unlifting function in scope.
399+ -> Eff es a
400+withEffToIO f = unliftStrategy >>= \case
401+ SeqUnlift -> unsafeEff $ \es -> unsafeSeqUnliftEff es f
402+ ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
403+ unsafeEff $ \es -> unsafeConcUnliftEff es p b f
352404
353405----------------------------------------
354−-- Static dispatch
406+-- Helpers
355407
356−-- | An adapter for statically dispatched effects.
357−--
358−-- Represents an arbitrary data type with the appropriate number of phantom type
359−-- parameters.
360−newtype DataA :: Effect -> Type where
361− DataA :: (forall m r. e m r) -> DataA e
362−
363−-- | Run a statically dispatched effect with the given initial state and return
364−-- the final value along with the final state.
365−runData :: DataA e -> Eff (e : es) a -> Eff es (a, DataA e)
366−runData e0 m = unsafeEff $ \es0 -> do
408+runEffect :: handler e -> Eff (e : es) a -> Eff es (a, handler e)
409+runEffect e0 m = unsafeEff $ \es0 -> do
367410 size0 <- sizeEnv es0
368− E.bracket (unsafeConsEnv e0 noRelinker es0)
369− (unsafeTailEnv size0)
370− (\es -> (,) <$> unEff m es <*> getEnv es)
371−
372−-- | Run a statically dispatched effect with the given initial state and return
373−-- the final value, discarding the final state.
374−evalData :: DataA e -> Eff (e : es) a -> Eff es a
375−evalData e m = unsafeEff $ \es0 -> do
411+ bracket (unsafeConsEnv e0 noRelinker es0)
412+ (unsafeTailEnv size0)
413+ (\es -> (,) <$> unEff m es <*> getEnv es)
414+
415+evalEffect :: handler e -> Eff (e : es) a -> Eff es a
416+evalEffect e m = unsafeEff $ \es0 -> do
376417 size0 <- sizeEnv es0
377− E.bracket (unsafeConsEnv e noRelinker es0)
378− (unsafeTailEnv size0)
379− (\es -> unEff m es)
380−
381−-- | Run a statically dispatched effect with the given initial state and return
382−-- the final state, discarding the final value.
383−execData :: DataA e -> Eff (e : es) a -> Eff es (DataA e)
384−execData e0 m = unsafeEff $ \es0 -> do
418+ bracket (unsafeConsEnv e noRelinker es0)
419+ (unsafeTailEnv size0)
420+ (\es -> unEff m es)
421+
422+execEffect :: handler e -> Eff (e : es) a -> Eff es (handler e)
423+execEffect e0 m = unsafeEff $ \es0 -> do
385424 size0 <- sizeEnv es0
386− E.bracket (unsafeConsEnv e0 noRelinker es0)
387− (unsafeTailEnv size0)
388− (\es -> unEff m es *> getEnv es)
389−
390−-- | Fetch the current state of the effect.
391−getData :: e :> es => Eff es (DataA e)
392−getData = unsafeEff $ \es -> getEnv es
393−
394−-- | Set the current state of the effect to the given value.
395−putData :: e :> es => DataA e -> Eff es ()
396−putData e = unsafeEff $ \es -> putEnv es e
397−
398−-- | Apply the function to the current state of the effect and return a value.
399−stateData :: e :> es => (DataA e -> (a, DataA e)) -> Eff es a
400−stateData f = unsafeEff $ \es -> stateEnv es f
401−
402−-- | Apply the monadic function to the current state of the effect and return a
403−-- value.
404−stateDataM :: e :> es => (DataA e -> Eff es (a, DataA e)) -> Eff es a
405−stateDataM f = unsafeEff $ \es -> E.mask $ \release -> do
425+ bracket (unsafeConsEnv e0 noRelinker es0)
426+ (unsafeTailEnv size0)
427+ (\es -> unEff m es *> getEnv es)
428+
429+getEffect :: e :> es => Eff es (handler e)
430+getEffect = unsafeEff $ \es -> getEnv es
431+
432+putEffect :: e :> es => handler e -> Eff es ()
433+putEffect e = unsafeEff $ \es -> unsafePutEnv e es
434+
435+stateEffect :: e :> es => (handler e -> (a, handler e)) -> Eff es a
436+stateEffect f = unsafeEff $ \es -> unsafeStateEnv f es
437+
438+localEffect :: e :> es => (handler e -> handler e) -> Eff es a -> Eff es a
439+localEffect f m = unsafeEff $ \es -> do
440+ bracket (unsafeStateEnv (\e -> (e, f e)) es)
441+ (\e -> unsafePutEnv e es)
442+ (\_ -> unEff m es)
443+
444+readerEffectM :: e :> es => (handler e -> Eff es a) -> Eff es a
445+readerEffectM f = unsafeEff $ \es -> getEnv es >>= \e -> unEff (f e) es
446+
447+stateEffectM :: e :> es => (handler e -> Eff es (a, handler e)) -> Eff es a
448+stateEffectM f = unsafeEff $ \es -> mask $ \release -> do
406449 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
407− putEnv es e
450+ unsafePutEnv e es
408451 pure a
409−
410−-- | Execute a computation with a temporarily modified state of the effect.
411−localData :: e :> es => (DataA e -> DataA e) -> Eff es a -> Eff es a
412−localData f m = unsafeEff $ \es -> do
413− E.bracket (stateEnv es $ \e -> (e, f e))
414− (\e -> putEnv es e)
415− (\_ -> unEff m es)