git.iko.soy/effectful
on master help sign in
Support lifting mask-like operations in the effect handler
7ec9f1eAndrzej Rybczak
src/Effectful.hs+2
compare with master
unifiedsplit
@@ -44,7 +44,9 @@ module Effectful
44
44
45 -- *** 'IO'
45 -- *** 'IO'
46 , localSeqUnliftIO
46 , localSeqUnliftIO
47+ , localSeqLiftUnliftIO
47 , localUnliftIO
48 , localUnliftIO
49+ , localLiftUnliftIO
48 ) where
50 ) where
49
51
50import Effectful.Interpreter
52import Effectful.Interpreter
src/Effectful/Interpreter.hs+56−2
@@ -21,7 +21,9 @@ module Effectful.Interpreter
21
21
22 -- *** 'IO'
22 -- *** 'IO'
23 , localSeqUnliftIO
23 , localSeqUnliftIO
24+ , localSeqLiftUnliftIO
24 , localUnliftIO
25 , localUnliftIO
26+ , localLiftUnliftIO
25 ) where
27 ) where
26
28
27import Control.Exception
29import Control.Exception
@@ -127,7 +129,8 @@ reinterpretM runHandlerEs interpreter m = unsafeEff $ \es -> do
127----------------------------------------
129----------------------------------------
128-- Unlifting
130-- Unlifting
129
131
130−-- | Create a local unlifting function with the 'SeqUnlift' strategy.
132+-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
133+-- general version see 'localUnlift'.
131localSeqUnlift
134localSeqUnlift
132 :: LocalEnv localEs
135 :: LocalEnv localEs
133 -- ^ Local environment from the effect handler.
136 -- ^ Local environment from the effect handler.
@@ -137,7 +140,8 @@ localSeqUnlift
137localSeqUnlift (LocalEnv les) f = unsafeEff $ \es -> do
140localSeqUnlift (LocalEnv les) f = unsafeEff $ \es -> do
138 unEff (seqUnliftEff $ \k -> unEff (f $ unsafeEff_ . k) es) les
141 unEff (seqUnliftEff $ \k -> unEff (f $ unsafeEff_ . k) es) les
139
142
140−-- | Create a local unlifting function with the 'SeqUnlift' strategy.
143+-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
144+-- general version see 'localUnliftIO'.
141localSeqUnliftIO
145localSeqUnliftIO
142 :: IOE :> es
146 :: IOE :> es
143 => LocalEnv localEs
147 => LocalEnv localEs
@@ -147,6 +151,21 @@ localSeqUnliftIO
147 -> Eff es a
151 -> Eff es a
148localSeqUnliftIO (LocalEnv les) f = unsafeEff_ $ unEff (seqUnliftEff f) les
152localSeqUnliftIO (LocalEnv les) f = unsafeEff_ $ unEff (seqUnliftEff f) les
149
153
154+-- | Create a local lifting and unlifting function with the 'SeqUnlift'
155+-- strategy. More the general version see 'localLiftUnliftIO'.
156+--
157+-- /Note:/ the strategy applies only to the unlifting function, lifting function
158+-- doesn't have any restrictions.
159+localSeqLiftUnliftIO
160+ :: IOE :> es
161+ => LocalEnv localEs
162+ -- ^ Local environment from the effect handler.
163+ -> ((forall r. IO r -> Eff localEs r) -> (forall r. Eff localEs r -> IO r) -> IO a)
164+ -- ^ Continuation with the lifting and unlifting function.
165+ -> Eff es a
166+localSeqLiftUnliftIO (LocalEnv les) f = unsafeEff_ $ do
167+ unEff (seqUnliftEff $ f unsafeEff_) les
168+
150-- | Create a local unlifting function with the given strategy.
169-- | Create a local unlifting function with the given strategy.
151localUnlift
170localUnlift
152 :: LocalEnv localEs
171 :: LocalEnv localEs
@@ -171,3 +190,38 @@ localUnliftIO
171localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
190localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
172 SeqUnlift -> unEff (seqUnliftEff f) les
191 SeqUnlift -> unEff (seqUnliftEff f) les
173 ConcUnlift p b -> unEff (concUnliftEff p b f) les
192 ConcUnlift p b -> unEff (concUnliftEff p b f) les
193+
194+-- | Create a local lifting and unlifting function with the given strategy.
195+--
196+-- /Note:/ the strategy applies only to the unlifting function, lifting function
197+-- doesn't have any restrictions.
198+--
199+-- Necessary for lifting 'Control.Concurrent.forkIOWithUnmask'-like operations:
200+--
201+-- >>> :{
202+-- data Fork :: Effect where
203+-- ForkWithUnmask :: ((forall a. m a -> m a) -> m ()) -> Fork m ThreadId
204+-- :}
205+--
206+-- >>> :{
207+-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a
208+-- runFork = interpretM $ \env (ForkWithUnmask m) -> do
209+-- localLiftUnliftIO env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do
210+-- forkIOWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift
211+-- :}
212+--
213+localLiftUnliftIO
214+ :: IOE :> es
215+ => LocalEnv localEs
216+ -- ^ Local environment from the effect handler.
217+ -> UnliftStrategy
218+ -> ((forall r. IO r -> Eff localEs r) -> (forall r. Eff localEs r -> IO r) -> IO a)
219+ -- ^ Continuation with the lifting and unlifting function.
220+ -> Eff es a
221+localLiftUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
222+ SeqUnlift -> unEff (seqUnliftEff $ f unsafeEff_) les
223+ ConcUnlift p b -> unEff (concUnliftEff p b $ f unsafeEff_) les
224+
225+-- $setup
226+-- >>> import Control.Concurrent
227+-- >>> import Effectful