@@ -21,9 +21,8 @@ module Effectful.Interpreter
2121
2222 -- *** 'IO'
2323 , localSeqUnliftIO
24− , localSeqLiftUnliftIO
2524 , localUnliftIO
26− , localLiftUnliftIO
25+ , withLiftH
2726 ) where
2827
2928import Control.Exception
@@ -151,21 +150,6 @@ localSeqUnliftIO
151150 -> Eff es a
152151localSeqUnliftIO (LocalEnv les) f = unsafeEff_ $ unEff (seqUnliftEff f) les
153152
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−
169153-- | Create a local unlifting function with the given strategy.
170154localUnlift
171155 :: LocalEnv localEs
@@ -191,10 +175,7 @@ localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
191175 SeqUnlift -> unEff (seqUnliftEff f) les
192176 ConcUnlift p b -> unEff (concUnliftEff p b f) les
193177
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.
178+-- | Bring into scope a higher order lifting function.
198179--
199180-- Necessary for lifting 'Control.Concurrent.forkIOWithUnmask'-like operations:
200181--
@@ -205,22 +186,15 @@ localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
205186--
206187-- >>> :{
207188-- 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
189+-- runFork = interpretM $ \env (ForkWithUnmask m) -> withLiftH $ \liftH -> do
190+-- localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
191+-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftH unmask
211192-- :}
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
193+withLiftH
194+ :: IOE :> baseEs
195+ => ((forall a b es. (IO a -> IO b) -> Eff es a -> Eff es b) -> Eff baseEs r)
196+ -> Eff baseEs r
197+withLiftH k = k $ \f m -> unsafeEff $ f . unEff m
224198
225199-- $setup
226200-- >>> import Control.Concurrent