@@ -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
@@ -22,11 +22,11 @@ module Effectful.Internal.Monad
2222 , IOE
2323 , runEff
2424
25− -- * Prim
25+ -- * Primitive
2626 , Prim
2727 , runPrim
2828
29− -- * Unlift strategies
29+ -- ** Unlift strategies
3030 , UnliftStrategy(..)
3131 , Persistence(..)
3232 , Limit(..)
@@ -34,32 +34,39 @@ module Effectful.Internal.Monad
3434 , withUnliftStrategy
3535 , withEffToIO
3636
37− -- ** Low-level unlifts
38− , seqUnliftIO
39− , concUnliftIO
37+ --- *** Low-level helpers
38+ , unsafeWithLiftMapIO
39+ , seqUnliftEff
40+ , concUnliftEff
4041
4142 -- * Effects
4243
43− -- ** Dynamic dispatch
44+ -- ** Handler
4445 , EffectHandler
4546 , LocalEnv(..)
46− , HandlerA(..)
47+ , Handler(..)
4748 , runHandler
49+
50+ -- *** Sending operations
4851 , send
4952
50− -- ** Static dispatch
51− , DataA(..)
52− , runData
53− , evalData
54− , execData
55− , getData
56− , putData
57− , stateData
58− , stateDataM
59− , localData
53+ -- ** Primitive
54+
55+ -- *** Running
56+ , runEffect
57+ , evalEffect
58+ , execEffect
59+
60+ -- *** Modification
61+ , getEffect
62+ , putEffect
63+ , stateEffect
64+ , stateEffectM
65+ , localEffect
6066 ) where
6167
6268import Control.Applicative (liftA2)
69+import Control.Concurrent (myThreadId)
6370import Control.Monad.Base
6471import Control.Monad.Fix
6572import Control.Monad.IO.Class
@@ -76,46 +83,48 @@ import qualified Control.Monad.Catch as C
7683import Effectful.Internal.Effect
7784import Effectful.Internal.Env
7885import Effectful.Internal.Unlift
86+import Effectful.Internal.Utils
7987
8088type role Eff nominal representational
8189
82−-- | The 'Eff' monad provides the implementation of a computation that performs
90+-- | The 'Eff' monad provides the implementation of an operation that performs
8391-- 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:
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:
8896--
8997-- @
90−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'
98+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
9199-- @
92100--
93101-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
94102-- 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:
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:
97106--
98107-- @
99−-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
108+-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
100109-- @
101110--
102−-- This abstraction allows the computation to be used in functions that may
111+-- This abstraction allows the operation to be used in functions that may
103112-- perform other effects, and it also allows the effects to be handled in any
104113-- order.
105114newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
106115 deriving (Monoid, Semigroup)
107116
108−-- | Run a pure 'Eff' computation.
117+-- | Run a pure 'Eff' operation.
109118--
110−-- For running computations with side effects see 'runEff'.
119+-- For running operations with side effects see 'runEff'.
111120runPureEff :: Eff '[] a -> a
112121runPureEff (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).
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).
116125 --
117126 -- Moreover, internals don't allocate any resources that require explicit
118− -- cleanup actions to run.
127+ -- cleanup actions to run, so the "Dupable" part should also be just fine.
119128 unsafeDupablePerformIO $ m =<< emptyEnv
120129
121130----------------------------------------
@@ -128,68 +137,69 @@ unEff (Eff m) = m
128137-- | Access the underlying 'IO' monad along with the environment.
129138--
130139-- This function is __unsafe__ because it can be used to introduce arbitrary
131−-- 'IO' actions into pure 'Eff' computations.
140+-- 'IO' actions into pure 'Eff' operations.
132141unsafeEff :: (Env es -> IO a) -> Eff es a
133142unsafeEff m = Eff (oneShot m)
134143
135144-- | Access the underlying 'IO' monad.
136145--
137146-- This function is __unsafe__ because it can be used to introduce arbitrary
138−-- 'IO' actions into pure 'Eff' computations.
147+-- 'IO' actions into pure 'Eff' operations.
139148unsafeEff_ :: IO a -> Eff es a
140149unsafeEff_ m = unsafeEff $ \_ -> m
141150
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'.
151+-- | Utility for lifting 'IO' operations of type
156152--
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.
153+-- @'IO' a -> 'IO' b@
160154--
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
155+-- to
156+--
157+-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
158+--
159+-- This function is __unsafe__ because it can be used to introduce arbitrary
160+-- 'IO' actions into pure 'Eff' operations.
161+--
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
171170
172−-- | Create an unlifting function with the 'SeqUnlift' strategy.
173−seqUnliftIO
171+-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
172+seqUnliftEff
174173 :: HasCallStack
175174 => Env es
176− -- ^ The environment.
177175 -> ((forall r. Eff es r -> IO r) -> IO a)
178− -- ^ Continuation with the unlifting function in scope.
179176 -> IO a
180−seqUnliftIO es k = seqUnlift k es unEff
181−
182−-- | Create an unlifting function with the 'ConcUnlift' strategy.
183−concUnliftIO
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
184189 :: HasCallStack
185190 => Env es
186− -- ^ The environment.
187191 -> Persistence
188192 -> Limit
189193 -> ((forall r. Eff es r -> IO r) -> IO a)
190− -- ^ Continuation with the unlifting function in scope.
191194 -> IO a
192−concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
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
193203
194204----------------------------------------
195205-- Base
@@ -258,15 +268,15 @@ instance Fail :> es => MonadFail (Eff es) where
258268----------------------------------------
259269-- IO
260270
261−-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.
271+-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.
262272newtype IOE :: Effect where
263273 IOE :: UnliftStrategy -> IOE m r
264274
265−-- | Run an 'Eff' computation with side effects.
275+-- | Run an 'Eff' operation with side effects.
266276--
267−-- For running pure computations see 'runPureEff'.
277+-- For running pure operations see 'runPureEff'.
268278runEff :: Eff '[IOE] a -> IO a
269−runEff m = unEff (evalData (DataA (IOE SeqUnlift)) m) =<< emptyEnv
279+runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv
270280
271281instance IOE :> es => MonadIO (Eff es) where
272282 liftIO = unsafeEff_
@@ -290,126 +300,182 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where
290300----------------------------------------
291301-- Primitive
292302
293−-- | Provide the ability to perform primitive state-transformer actions.
303+-- | An effect to perform primitive state-transformer actions.
294304data Prim :: Effect where
295305 Prim :: Prim m r
296306
297−-- | Run an 'Eff' computation with primitive state-transformer actions.
307+-- | Run an 'Eff' operation with primitive state-transformer actions.
298308runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
299−runPrim = evalData (DataA Prim)
309+runPrim = evalEffect (IdE Prim)
300310
301311instance Prim :> es => PrimMonad (Eff es) where
302312 type PrimState (Eff es) = RealWorld
303313 primitive = unsafeEff_ . IO
304314
305315----------------------------------------
306−-- Dynamic dispatch
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
307375
308−type role LocalEnv nominal nominal
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
309399
310400-- | Opaque representation of the 'Eff' environment at the point of calling the
311401-- 'send' function, i.e. right before the control is passed to the effect
312402-- handler.
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)
403+newtype LocalEnv es = LocalEnv (Env es)
317404
318405-- | Type signature of the effect handler.
319406type EffectHandler e es
320407 = 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.
408+ => LocalEnv localEs
409+ -- ^ Capture of the local environment for handling local 'Eff' operations when
410+ -- @e@ is a higher order effect.
324411 -> e (Eff localEs) a
325412 -- ^ The effect performed in the local environment.
326413 -> Eff es a
327414
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
415+-- | An effect handler bundled along with its environment.
416+data Handler :: Effect -> Type where
417+ Handler :: !(Env es) -> !(EffectHandler e es) -> Handler e
333418
334−-- | Run a dynamically dispatched effect with the given handler.
335−runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a
419+-- | Run the effect with the given handler.
420+runHandler :: Handler e -> Eff (e : es) a -> Eff es a
336421runHandler e m = unsafeEff $ \es0 -> do
337422 size0 <- sizeEnv es0
338423 E.bracket (unsafeConsEnv e relinker es0)
339424 (unsafeTailEnv size0)
340425 (\es -> unEff m es)
341426 where
342− relinker :: Relinker HandlerA e
343− relinker = Relinker $ \relink (HandlerA handlerEs handle) -> do
344− newHandlerEs <- relink handlerEs
345− pure $ HandlerA newHandlerEs handle
427+ relinker :: Relinker Handler e
428+ relinker = Relinker $ \relink (Handler env handle) -> do
429+ newEnv <- relink env
430+ pure $ Handler newEnv handle
346431
347432-- | Send an operation of the given effect to its handler for execution.
348433send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
349434send op = unsafeEff $ \es -> do
350− HandlerA handlerEs handle <- getEnv es
351− unEff (handle (LocalEnv es) op) handlerEs
435+ Handler env handle <- getEnv es
436+ unEff (handle (LocalEnv es) op) env
352437
353438----------------------------------------
354−-- Static dispatch
439+-- Helpers
355440
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
441+runEffect :: handler e -> Eff (e : es) a -> Eff es (a, handler e)
442+runEffect e0 m = unsafeEff $ \es0 -> do
367443 size0 <- sizeEnv es0
368444 E.bracket (unsafeConsEnv e0 noRelinker es0)
369445 (unsafeTailEnv size0)
370446 (\es -> (,) <$> unEff m es <*> getEnv es)
371447
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
448+evalEffect :: handler e -> Eff (e : es) a -> Eff es a
449+evalEffect e m = unsafeEff $ \es0 -> do
376450 size0 <- sizeEnv es0
377451 E.bracket (unsafeConsEnv e noRelinker es0)
378452 (unsafeTailEnv size0)
379453 (\es -> unEff m es)
380454
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
455+execEffect :: handler e -> Eff (e : es) a -> Eff es (handler e)
456+execEffect e0 m = unsafeEff $ \es0 -> do
385457 size0 <- sizeEnv es0
386458 E.bracket (unsafeConsEnv e0 noRelinker es0)
387459 (unsafeTailEnv size0)
388460 (\es -> unEff m es *> getEnv es)
389461
390−-- | Fetch the current state of the effect.
391−getData :: e :> es => Eff es (DataA e)
392−getData = unsafeEff $ \es -> getEnv es
462+getEffect :: e :> es => Eff es (handler e)
463+getEffect = unsafeEff $ \es -> getEnv es
393464
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
465+putEffect :: e :> es => handler e -> Eff es ()
466+putEffect e = unsafeEff $ \es -> putEnv es e
397467
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
468+stateEffect :: e :> es => (handler e -> (a, handler e)) -> Eff es a
469+stateEffect f = unsafeEff $ \es -> stateEnv es f
401470
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
471+stateEffectM :: e :> es => (handler e -> Eff es (a, handler e)) -> Eff es a
472+stateEffectM f = unsafeEff $ \es -> E.mask $ \release -> do
406473 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
407474 putEnv es e
408475 pure a
409476
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
477+localEffect :: e :> es => (handler e -> handler e) -> Eff es a -> Eff es a
478+localEffect f m = unsafeEff $ \es -> do
413479 E.bracket (stateEnv es $ \e -> (e, f e))
414480 (\e -> putEnv es e)
415481 (\_ -> unEff m es)