git.iko.soy/effectful
on master help sign in
Add withLiftH
53715ffAndrzej Rybczak
src/Effectful.hs+1−2
compare with master
unifiedsplit
@@ -44,9 +44,8 @@ module Effectful
44
44
45 -- *** 'IO'
45 -- *** 'IO'
46 , localSeqUnliftIO
46 , localSeqUnliftIO
47− , localSeqLiftUnliftIO
48 , localUnliftIO
47 , localUnliftIO
49− , localLiftUnliftIO
48+ , withLiftH
50 ) where
49 ) where
51
50
52import Effectful.Interpreter
51import Effectful.Interpreter
src/Effectful/Interpreter.hs+10−36
@@ -21,9 +21,8 @@ module Effectful.Interpreter
21
21
22 -- *** 'IO'
22 -- *** 'IO'
23 , localSeqUnliftIO
23 , localSeqUnliftIO
24− , localSeqLiftUnliftIO
25 , localUnliftIO
24 , localUnliftIO
26− , localLiftUnliftIO
25+ , withLiftH
27 ) where
26 ) where
28
27
29import Control.Exception
28import Control.Exception
@@ -151,21 +150,6 @@ localSeqUnliftIO
151 -> Eff es a
150 -> Eff es a
152localSeqUnliftIO (LocalEnv les) f = unsafeEff_ $ unEff (seqUnliftEff f) les
151localSeqUnliftIO (LocalEnv les) f = unsafeEff_ $ unEff (seqUnliftEff f) les
153
152
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−
169-- | Create a local unlifting function with the given strategy.
153-- | Create a local unlifting function with the given strategy.
170localUnlift
154localUnlift
171 :: LocalEnv localEs
155 :: LocalEnv localEs
@@ -191,10 +175,7 @@ localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
191 SeqUnlift -> unEff (seqUnliftEff f) les
175 SeqUnlift -> unEff (seqUnliftEff f) les
192 ConcUnlift p b -> unEff (concUnliftEff p b f) les
176 ConcUnlift p b -> unEff (concUnliftEff p b f) les
193
177
194−-- | Create a local lifting and unlifting function with the given strategy.
178+-- | Bring into scope a higher order lifting function.
195−--
196−-- /Note:/ the strategy applies only to the unlifting function, lifting function
197−-- doesn't have any restrictions.
198--
179--
199-- Necessary for lifting 'Control.Concurrent.forkIOWithUnmask'-like operations:
180-- Necessary for lifting 'Control.Concurrent.forkIOWithUnmask'-like operations:
200--
181--
@@ -205,22 +186,15 @@ localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
205--
186--
206-- >>> :{
187-- >>> :{
207-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a
188-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a
208−-- runFork = interpretM $ \env (ForkWithUnmask m) -> do
189+-- runFork = interpretM $ \env (ForkWithUnmask m) -> withLiftH $ \liftH -> do
209−-- localLiftUnliftIO env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do
190+-- localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
210−-- forkIOWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift
191+-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftH unmask
211-- :}
192-- :}
212−--
193+withLiftH
213−localLiftUnliftIO
214− :: IOE :> es
194+ :: IOE :> baseEs
215− => LocalEnv localEs
195+ => ((forall a b es. (IO a -> IO b) -> Eff es a -> Eff es b) -> Eff baseEs r)
216− -- ^ Local environment from the effect handler.
196+ -> Eff baseEs r
217− -> UnliftStrategy
197+withLiftH k = k $ \f m -> unsafeEff $ f . unEff m
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
198
225-- $setup
199-- $setup
226-- >>> import Control.Concurrent
200-- >>> import Control.Concurrent