@@ -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− ( -- * Monad
9+ ( -- * The 'Eff' monad
1010 Eff
1111 , runPureEff
1212
@@ -16,18 +16,17 @@ module Effectful.Internal.Monad
1616 , unsafeEff_
1717
1818 -- * Fail
19− , Fail
20− , runFail
19+ , Fail(..)
2120
2221 -- * IO
2322 , IOE
2423 , runEff
2524
26− -- * Primitive
25+ -- * Prim
2726 , Prim
2827 , runPrim
2928
30− -- ** Unlift strategies
29+ -- * Unlift strategies
3130 , UnliftStrategy(..)
3231 , Persistence(..)
3332 , Limit(..)
@@ -35,88 +34,88 @@ module Effectful.Internal.Monad
3534 , withUnliftStrategy
3635 , withEffToIO
3736
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
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
5760 ) where
5861
5962import Control.Applicative (liftA2)
60−import Control.Concurrent (myThreadId)
61−import Control.Exception
6263import Control.Monad.Base
6364import Control.Monad.Fix
6465import Control.Monad.IO.Class
6566import Control.Monad.IO.Unlift
6667import Control.Monad.Primitive
6768import 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.Monad.Catch as E
73+import qualified Control.Exception as E
74+import qualified Control.Monad.Catch as C
7475
7576import Effectful.Internal.Effect
7677import Effectful.Internal.Env
7778import Effectful.Internal.Unlift
78−import Effectful.Internal.Utils
7979
8080type role Eff nominal representational
8181
82−-- | The 'Eff' monad provides the implementation of an operation that performs
82+-- | The 'Eff' monad provides the implementation of a computation 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 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:
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:
8888--
8989-- @
90−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
90+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.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 an operation to a concrete list of effects. For
96−-- example, the above example would more commonly be expressed with the
97−-- following type:
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:
9897--
9998-- @
100−-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
99+-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
101100-- @
102101--
103−-- This abstraction allows the operation to be used in functions that may
102+-- This abstraction allows the computation to be used in functions that may
104103-- perform other effects, and it also allows the effects to be handled in any
105104-- order.
106105newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
107106 deriving (Monoid, Semigroup)
108107
109−-- | Run a pure 'Eff' operation.
108+-- | Run a pure 'Eff' computation.
110109--
111−-- For running operations with side effects see 'runEff'.
110+-- For running computations with side effects see 'runEff'.
112111runPureEff :: Eff '[] a -> a
113112runPureEff (Eff m) =
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).
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).
117116 --
118117 -- Moreover, internals don't allocate any resources that require explicit
119− -- cleanup actions to run, so the "Dupable" part should also be just fine.
118+ -- cleanup actions to run.
120119 unsafeDupablePerformIO $ m =<< emptyEnv
121120
122121----------------------------------------
@@ -127,62 +126,70 @@ unEff :: Eff es a -> Env es -> IO a
127126unEff (Eff m) = m
128127
129128-- | 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.
130132unsafeEff :: (Env es -> IO a) -> Eff es a
131133unsafeEff m = Eff (oneShot m)
132134
133135-- | 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.
134139unsafeEff_ :: IO a -> Eff es a
135140unsafeEff_ m = unsafeEff $ \_ -> m
136141
137−-- | Utility for lifting 'IO' operations of type
138−--
139−-- @'IO' a -> 'IO' b@
140−--
141−-- to
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'.
142156--
143−-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
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.
144160--
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
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
153171
154−-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
155−unsafeSeqUnliftEff
172+-- | Create an unlifting function with the 'SeqUnlift' strategy.
173+seqUnliftIO
156174 :: HasCallStack
157175 => Env es
176+ -- ^ The environment.
158177 -> ((forall r. Eff es r -> IO r) -> IO a)
178+ -- ^ Continuation with the unlifting function in scope.
159179 -> IO a
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
180+seqUnliftIO es k = seqUnlift k es unEff
181+
182+-- | Create an unlifting function with the 'ConcUnlift' strategy.
183+concUnliftIO
172184 :: HasCallStack
173185 => Env es
186+ -- ^ The environment.
174187 -> Persistence
175188 -> Limit
176189 -> ((forall r. Eff es r -> IO r) -> IO a)
190+ -- ^ Continuation with the unlifting function in scope.
177191 -> IO a
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
192+concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
186193
187194----------------------------------------
188195-- Base
@@ -210,83 +217,56 @@ instance MonadFix (Eff es) where
210217----------------------------------------
211218-- Exception
212219
213−instance E.MonadThrow (Eff es) where
214− throwM = unsafeEff_ . throwIO
220+instance C.MonadThrow (Eff es) where
221+ throwM = unsafeEff_ . E.throwIO
215222
216−instance E.MonadCatch (Eff es) where
223+instance C.MonadCatch (Eff es) where
217224 catch m handler = unsafeEff $ \es -> do
218225 size <- sizeEnv es
219− unEff m es `catch` \e -> do
226+ unEff m es `E.catch` \e -> do
220227 checkSizeEnv size es
221228 unEff (handler e) es
222229
223−instance E.MonadMask (Eff es) where
224− mask k = unsafeEff $ \es -> mask $ \restore ->
230+instance C.MonadMask (Eff es) where
231+ mask k = unsafeEff $ \es -> E.mask $ \restore ->
225232 unEff (k $ \m -> unsafeEff $ restore . unEff m) es
226233
227− uninterruptibleMask k = unsafeEff $ \es -> uninterruptibleMask $ \restore ->
234+ uninterruptibleMask k = unsafeEff $ \es -> E.uninterruptibleMask $ \restore ->
228235 unEff (k $ \m -> unsafeEff $ restore . unEff m) es
229236
230− generalBracket acquire release use = unsafeEff $ \es -> mask $ \restore -> do
237+ generalBracket acquire release use = unsafeEff $ \es -> E.mask $ \restore -> do
231238 size <- sizeEnv es
232239 resource <- unEff acquire es
233− b <- restore (unEff (use resource) es) `catch` \e -> do
240+ b <- restore (unEff (use resource) es) `E.catch` \e -> do
234241 checkSizeEnv size es
235− _ <- unEff (release resource $ E.ExitCaseException e) es
236− throwIO e
242+ _ <- unEff (release resource $ C.ExitCaseException e) es
243+ E.throwIO e
237244 checkSizeEnv size es
238− c <- unEff (release resource $ E.ExitCaseSuccess b) es
245+ c <- unEff (release resource $ C.ExitCaseSuccess b) es
239246 pure (b, c)
240247
241248----------------------------------------
242249-- Fail
243250
251+-- | Provide the ability to use the 'MonadFail' instance of 'Eff'.
244252data Fail :: Effect where
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
253+ Fail :: String -> Fail m a
257254
258255instance Fail :> es => MonadFail (Eff es) where
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
256+ fail = send . Fail
277257
278258----------------------------------------
279259-- IO
280260
281−-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.
261+-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.
282262newtype IOE :: Effect where
283263 IOE :: UnliftStrategy -> IOE m r
284264
285−-- | Run an 'Eff' operation with side effects.
265+-- | Run an 'Eff' computation with side effects.
286266--
287−-- For running pure operations see 'runPureEff'.
267+-- For running pure computations see 'runPureEff'.
288268runEff :: Eff '[IOE] a -> IO a
289−runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv
269+runEff m = unEff (evalData (DataA (IOE SeqUnlift)) m) =<< emptyEnv
290270
291271instance IOE :> es => MonadIO (Eff es) where
292272 liftIO = unsafeEff_
@@ -310,142 +290,126 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where
310290----------------------------------------
311291-- Primitive
312292
313−-- | An effect to perform primitive state-transformer actions.
293+-- | Provide the ability to perform primitive state-transformer actions.
314294data Prim :: Effect where
315295 Prim :: Prim m r
316296
317−-- | Run an 'Eff' operation with primitive state-transformer actions.
297+-- | Run an 'Eff' computation with primitive state-transformer actions.
318298runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
319−runPrim = evalEffect (IdE Prim)
299+runPrim = evalData (DataA Prim)
320300
321301instance Prim :> es => PrimMonad (Eff es) where
322− type PrimState (Eff es) = PrimState IO
302+ type PrimState (Eff es) = RealWorld
323303 primitive = unsafeEff_ . IO
324304
325305----------------------------------------
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)
306+-- Dynamic dispatch
379307
380−-- | Get the current 'UnliftStrategy'.
381−unliftStrategy :: IOE :> es => Eff es UnliftStrategy
382−unliftStrategy = readerEffectM $ \(IdE (IOE unlift)) -> pure unlift
308+type role LocalEnv nominal nominal
383309
384−-- | Locally override the 'UnliftStrategy' with a given value.
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.
385313--
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)
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
389327
390−-- | Create an unlifting function with the current 'UnliftStrategy'.
328+-- | An adapter for dynamically dispatched effects.
391329--
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
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
404352
405353----------------------------------------
406−-- Helpers
354+-- Static dispatch
407355
408−runEffect :: handler e -> Eff (e : es) a -> Eff es (a, handler e)
409−runEffect e0 m = unsafeEff $ \es0 -> do
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
410367 size0 <- sizeEnv es0
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
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
417376 size0 <- sizeEnv es0
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
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
424385 size0 <- sizeEnv es0
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
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
449406 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
450− unsafePutEnv e es
407+ putEnv es e
451408 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)