@@ -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
@@ -22,11 +22,11 @@ module Effectful.Internal.Monad
2222 , IOE
2323 , runEff
2424
25− -- * Primitive
25+ -- * Prim
2626 , Prim
2727 , runPrim
2828
29− -- ** Unlift strategies
29+ -- * Unlift strategies
3030 , UnliftStrategy(..)
3131 , Persistence(..)
3232 , Limit(..)
@@ -34,39 +34,32 @@ module Effectful.Internal.Monad
3434 , withUnliftStrategy
3535 , withEffToIO
3636
37− --- *** Low-level helpers
38− , unsafeWithLiftMapIO
39− , seqUnliftEff
40− , concUnliftEff
37+ -- ** Low-level unlifts
38+ , seqUnliftIO
39+ , concUnliftIO
4140
4241 -- * Effects
4342
44− -- ** Handler
43+ -- ** Dynamic dispatch
4544 , EffectHandler
4645 , LocalEnv(..)
47− , Handler(..)
46+ , HandlerA(..)
4847 , runHandler
49−
50− -- *** Sending operations
5148 , send
5249
53− -- ** Primitive
54−
55− -- *** Running
56− , runEffect
57− , evalEffect
58− , execEffect
59−
60− -- *** Modification
61− , getEffect
62− , putEffect
63− , stateEffect
64− , stateEffectM
65− , localEffect
50+ -- ** Static dispatch
51+ , DataA(..)
52+ , runData
53+ , evalData
54+ , execData
55+ , getData
56+ , putData
57+ , stateData
58+ , stateDataM
59+ , localData
6660 ) where
6761
6862import Control.Applicative (liftA2)
69−import Control.Concurrent (myThreadId)
7063import Control.Monad.Base
7164import Control.Monad.Fix
7265import Control.Monad.IO.Class
@@ -83,48 +76,46 @@ import qualified Control.Monad.Catch as C
8376import Effectful.Internal.Effect
8477import Effectful.Internal.Env
8578import Effectful.Internal.Unlift
86−import Effectful.Internal.Utils
8779
8880type role Eff nominal representational
8981
90−-- | The 'Eff' monad provides the implementation of an operation that performs
82+-- | The 'Eff' monad provides the implementation of a computation that performs
9183-- an arbitrary set of effects. In @'Eff' es a@, @es@ is a type-level list that
92−-- contains all the effects that the operation may perform. For example, an
93−-- operation that produces an 'Integer' by consuming a 'String' from the global
94−-- environment and acting upon a single mutable cell containing a 'Bool' would
95−-- 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:
9688--
9789-- @
98−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
90+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'
9991-- @
10092--
10193-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
10294-- Instead, the '(:>)' type class is used to express constraints on the list of
103−-- effects without coupling an operation to a concrete list of effects. For
104−-- example, the above example would more commonly be expressed with the
105−-- 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:
10697--
10798-- @
108−-- ('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'
109100-- @
110101--
111−-- 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
112103-- perform other effects, and it also allows the effects to be handled in any
113104-- order.
114105newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
115106 deriving (Monoid, Semigroup)
116107
117−-- | Run a pure 'Eff' operation.
108+-- | Run a pure 'Eff' computation.
118109--
119−-- For running operations with side effects see 'runEff'.
110+-- For running computations with side effects see 'runEff'.
120111runPureEff :: Eff '[] a -> a
121112runPureEff (Eff m) =
122− -- unsafePerformIO is safe here since IOE was not on the stack, so no IO with
123− -- side effects was performed (unless someone sneakily introduced side effects
124− -- 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).
125116 --
126117 -- Moreover, internals don't allocate any resources that require explicit
127− -- cleanup actions to run, so the "Dupable" part should also be just fine.
118+ -- cleanup actions to run.
128119 unsafeDupablePerformIO $ m =<< emptyEnv
129120
130121----------------------------------------
@@ -137,69 +128,68 @@ unEff (Eff m) = m
137128-- | Access the underlying 'IO' monad along with the environment.
138129--
139130-- This function is __unsafe__ because it can be used to introduce arbitrary
140−-- 'IO' actions into pure 'Eff' operations.
131+-- 'IO' actions into pure 'Eff' computations.
141132unsafeEff :: (Env es -> IO a) -> Eff es a
142133unsafeEff m = Eff (oneShot m)
143134
144135-- | Access the underlying 'IO' monad.
145136--
146137-- This function is __unsafe__ because it can be used to introduce arbitrary
147−-- 'IO' actions into pure 'Eff' operations.
138+-- 'IO' actions into pure 'Eff' computations.
148139unsafeEff_ :: IO a -> Eff es a
149140unsafeEff_ m = unsafeEff $ \_ -> m
150141
151−-- | Utility for lifting 'IO' operations of type
152−--
153−-- @'IO' a -> 'IO' b@
154−--
155−-- to
156−--
157−-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
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'.
158156--
159−-- This function is __unsafe__ because it can be used to introduce arbitrary
160−-- 'IO' actions into pure 'Eff' operations.
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.
161160--
162−-- /Note:/ the 'IO' operation must not run its argument in a separate thread,
163−-- attempting to do so will result in a runtime error.
164−unsafeWithLiftMapIO
165− :: HasCallStack
166− => ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
167− -> Eff es r
168−unsafeWithLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
169− seqUnliftEff 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
170171
171−-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
172−seqUnliftEff
172+-- | Create an unlifting function with the 'SeqUnlift' strategy.
173+seqUnliftIO
173174 :: HasCallStack
174175 => Env es
176+ -- ^ The environment.
175177 -> ((forall r. Eff es r -> IO r) -> IO a)
178+ -- ^ Continuation with the unlifting function in scope.
176179 -> IO a
177−seqUnliftEff es k = do
178− tid0 <- myThreadId
179− k $ \m -> do
180− tid <- myThreadId
181− if tid `eqThreadId` tid0
182− then unEff m es
183− else error
184− $ "If you want to use the unlifting function to run Eff operations "
185− ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
186−
187−-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
188−concUnliftEff
180+seqUnliftIO es k = seqUnlift k es unEff
181+
182+-- | Create an unlifting function with the 'ConcUnlift' strategy.
183+concUnliftIO
189184 :: HasCallStack
190185 => Env es
186+ -- ^ The environment.
191187 -> Persistence
192188 -> Limit
193189 -> ((forall r. Eff es r -> IO r) -> IO a)
190+ -- ^ Continuation with the unlifting function in scope.
194191 -> IO a
195−concUnliftEff es Ephemeral (Limited uses) k =
196− ephemeralConcUnliftIO uses k es unEff
197−concUnliftEff es Ephemeral Unlimited k =
198− ephemeralConcUnliftIO maxBound k es unEff
199−concUnliftEff es Persistent (Limited threads) k =
200− persistentConcUnliftIO False threads k es unEff
201−concUnliftEff es Persistent Unlimited k =
202− persistentConcUnliftIO True maxBound k es unEff
192+concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
203193
204194----------------------------------------
205195-- Base
@@ -268,15 +258,15 @@ instance Fail :> es => MonadFail (Eff es) where
268258----------------------------------------
269259-- IO
270260
271−-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.
261+-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.
272262newtype IOE :: Effect where
273263 IOE :: UnliftStrategy -> IOE m r
274264
275−-- | Run an 'Eff' operation with side effects.
265+-- | Run an 'Eff' computation with side effects.
276266--
277−-- For running pure operations see 'runPureEff'.
267+-- For running pure computations see 'runPureEff'.
278268runEff :: Eff '[IOE] a -> IO a
279−runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv
269+runEff m = unEff (evalData (DataA (IOE SeqUnlift)) m) =<< emptyEnv
280270
281271instance IOE :> es => MonadIO (Eff es) where
282272 liftIO = unsafeEff_
@@ -300,182 +290,126 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where
300290----------------------------------------
301291-- Primitive
302292
303−-- | An effect to perform primitive state-transformer actions.
293+-- | Provide the ability to perform primitive state-transformer actions.
304294data Prim :: Effect where
305295 Prim :: Prim m r
306296
307−-- | Run an 'Eff' operation with primitive state-transformer actions.
297+-- | Run an 'Eff' computation with primitive state-transformer actions.
308298runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
309−runPrim = evalEffect (IdE Prim)
299+runPrim = evalData (DataA Prim)
310300
311301instance Prim :> es => PrimMonad (Eff es) where
312302 type PrimState (Eff es) = RealWorld
313303 primitive = unsafeEff_ . IO
314304
315305----------------------------------------
316−-- Unlift strategies
317−
318−-- | The strategy to use when unlifting 'Eff' operations via 'withRunInIO' or
319−-- the 'Effectful.Interpreter.localUnlift' family.
320−data UnliftStrategy
321− = SeqUnlift
322− -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call
323− -- the unlifting function in threads distinct from its creator will result in
324− -- a runtime error.
325− | ConcUnlift !Persistence !Limit
326− -- ^ A strategy that makes it possible for the unlifting function to be called
327− -- in threads distinct from its creator. See 'Persistence' and 'Limit'
328− -- settings for more information.
329− deriving (Eq, Ord, Show)
330−
331−-- | Persistence setting for the 'ConcUnlift' strategy.
332−--
333−-- Different functions require different persistence strategies. Examples:
334−--
335−-- - Lifting 'pooledMapConcurrentlyN' from the @unliftio@ library requires the
336−-- 'Ephemeral' strategy as we don't want jobs to share environment changes
337−-- made by previous jobs run in the same worker thread.
338−--
339−-- - Lifting 'Control.Concurrent.forkIOWithUnmask' requires the 'Persistent'
340−-- strategy, otherwise the unmasking function would start with a fresh
341−-- environment each time it's called.
342−data Persistence
343− = Ephemeral
344− -- ^ Don't persist the environment between calls to the unlifting function in
345− -- threads distinct from its creator.
346− | Persistent
347− -- ^ Persist the environment between calls to the unlifting function within a
348− -- particular thread.
349− deriving (Eq, Ord, Show)
350−
351−-- | Limit setting for the 'ConcUnlift' strategy.
352−data Limit
353− = Limited !Int
354− -- ^ Behavior dependent on the 'Persistence' setting.
355− --
356− -- For 'Ephemeral', it limits the amount of uses of the unlifting function in
357− -- threads distinct from its creator to @N@. The unlifting function will
358− -- create @N@ copies of the environment when called @N@ times and @K+1@ copies
359− -- when called @K < N@ times.
360− --
361− -- For 'Persistent', it limits the amount of threads, distinct from the
362− -- creator of the unlifting function, it can be called in to @N@. The amount
363− -- of calls to the unlifting function within a particular threads is
364− -- unlimited. The unlifting function will create @N@ copies of the environment
365− -- when called in @N@ threads and @K+1@ copies when called in @K < N@ threads.
366− | Unlimited
367− -- ^ Unlimited use of the unlifting function.
368− deriving (Eq, Ord, Show)
369−
370−-- | Get the current 'UnliftStrategy'.
371−unliftStrategy :: IOE :> es => Eff es UnliftStrategy
372−unliftStrategy = do
373− IdE (IOE unlift) <- getEffect
374− pure unlift
306+-- Dynamic dispatch
375307
376−-- | Locally override the 'UnliftStrategy' with the given value.
377−--
378−-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
379−withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
380−withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
381−
382−-- | Create an unlifting function with the current 'UnliftStrategy'.
383−--
384−-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'
385−-- constraint for accurate stack traces in case an insufficiently powerful
386−-- 'UnliftStrategy' is used and the unlifting function fails.
387−withEffToIO
388− :: (HasCallStack, IOE :> es)
389− => ((forall r. Eff es r -> IO r) -> IO a)
390− -- ^ Continuation with the unlifting function in scope.
391− -> Eff es a
392−withEffToIO f = unliftStrategy >>= \case
393− SeqUnlift -> unsafeEff $ \es -> seqUnliftEff es f
394− ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
395− unsafeEff $ \es -> concUnliftEff es p b f
396−
397−----------------------------------------
398−-- Handler
308+type role LocalEnv nominal nominal
399309
400310-- | Opaque representation of the 'Eff' environment at the point of calling the
401311-- 'send' function, i.e. right before the control is passed to the effect
402312-- handler.
403−newtype LocalEnv es = LocalEnv (Env es)
313+--
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)
404317
405318-- | Type signature of the effect handler.
406319type EffectHandler e es
407320 = forall a localEs. HasCallStack
408− => LocalEnv localEs
409− -- ^ Capture of the local environment for handling local 'Eff' operations when
410− -- @e@ is a higher order effect.
321+ => LocalEnv localEs es
322+ -- ^ Capture of the local environment for handling local 'Eff' computations
323+ -- when @e@ is a higher order effect.
411324 -> e (Eff localEs) a
412325 -- ^ The effect performed in the local environment.
413326 -> Eff es a
414327
415−-- | An effect handler bundled along with its environment.
416−data Handler :: Effect -> Type where
417− Handler :: !(Env es) -> !(EffectHandler e es) -> Handler e
328+-- | An adapter for dynamically dispatched effects.
329+--
330+-- Represents the effect handler bundled with its environment.
331+data HandlerA :: Effect -> Type where
332+ HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e
418333
419−-- | Run the effect with the given handler.
420−runHandler :: Handler e -> Eff (e : es) a -> Eff es a
334+-- | Run a dynamically dispatched effect with the given handler.
335+runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a
421336runHandler e m = unsafeEff $ \es0 -> do
422337 size0 <- sizeEnv es0
423338 E.bracket (unsafeConsEnv e relinker es0)
424339 (unsafeTailEnv size0)
425340 (\es -> unEff m es)
426341 where
427− relinker :: Relinker Handler e
428− relinker = Relinker $ \relink (Handler env handle) -> do
429− newEnv <- relink env
430− pure $ Handler newEnv handle
342+ relinker :: Relinker HandlerA e
343+ relinker = Relinker $ \relink (HandlerA handlerEs handle) -> do
344+ newHandlerEs <- relink handlerEs
345+ pure $ HandlerA newHandlerEs handle
431346
432347-- | Send an operation of the given effect to its handler for execution.
433348send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
434349send op = unsafeEff $ \es -> do
435− Handler env handle <- getEnv es
436− unEff (handle (LocalEnv es) op) env
350+ HandlerA handlerEs handle <- getEnv es
351+ unEff (handle (LocalEnv es) op) handlerEs
437352
438353----------------------------------------
439−-- Helpers
354+-- Static dispatch
440355
441−runEffect :: handler e -> Eff (e : es) a -> Eff es (a, handler e)
442−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
443367 size0 <- sizeEnv es0
444368 E.bracket (unsafeConsEnv e0 noRelinker es0)
445369 (unsafeTailEnv size0)
446370 (\es -> (,) <$> unEff m es <*> getEnv es)
447371
448−evalEffect :: handler e -> Eff (e : es) a -> Eff es a
449−evalEffect e m = unsafeEff $ \es0 -> do
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
450376 size0 <- sizeEnv es0
451377 E.bracket (unsafeConsEnv e noRelinker es0)
452378 (unsafeTailEnv size0)
453379 (\es -> unEff m es)
454380
455−execEffect :: handler e -> Eff (e : es) a -> Eff es (handler e)
456−execEffect e0 m = unsafeEff $ \es0 -> do
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
457385 size0 <- sizeEnv es0
458386 E.bracket (unsafeConsEnv e0 noRelinker es0)
459387 (unsafeTailEnv size0)
460388 (\es -> unEff m es *> getEnv es)
461389
462−getEffect :: e :> es => Eff es (handler e)
463−getEffect = unsafeEff $ \es -> getEnv es
390+-- | Fetch the current state of the effect.
391+getData :: e :> es => Eff es (DataA e)
392+getData = unsafeEff $ \es -> getEnv es
464393
465−putEffect :: e :> es => handler e -> Eff es ()
466−putEffect e = unsafeEff $ \es -> putEnv es e
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
467397
468−stateEffect :: e :> es => (handler e -> (a, handler e)) -> Eff es a
469−stateEffect f = unsafeEff $ \es -> stateEnv es f
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
470401
471−stateEffectM :: e :> es => (handler e -> Eff es (a, handler e)) -> Eff es a
472−stateEffectM f = unsafeEff $ \es -> E.mask $ \release -> do
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
473406 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
474407 putEnv es e
475408 pure a
476409
477−localEffect :: e :> es => (handler e -> handler e) -> Eff es a -> Eff es a
478−localEffect f m = unsafeEff $ \es -> do
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
479413 E.bracket (stateEnv es $ \e -> (e, f e))
480414 (\e -> putEnv es e)
481415 (\_ -> unEff m es)