@@ -21,7 +21,9 @@ module Effectful.Interpreter
2121
2222 -- *** 'IO'
2323 , localSeqUnliftIO
24+ , localSeqLiftUnliftIO
2425 , localUnliftIO
26+ , localLiftUnliftIO
2527 ) where
2628
2729import Control.Exception
@@ -127,7 +129,8 @@ reinterpretM runHandlerEs interpreter m = unsafeEff $ \es -> do
127129----------------------------------------
128130-- Unlifting
129131
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'.
131134localSeqUnlift
132135 :: LocalEnv localEs
133136 -- ^ Local environment from the effect handler.
@@ -137,7 +140,8 @@ localSeqUnlift
137140localSeqUnlift (LocalEnv les) f = unsafeEff $ \es -> do
138141 unEff (seqUnliftEff $ \k -> unEff (f $ unsafeEff_ . k) es) les
139142
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'.
141145localSeqUnliftIO
142146 :: IOE :> es
143147 => LocalEnv localEs
@@ -147,6 +151,21 @@ localSeqUnliftIO
147151 -> Eff es a
148152localSeqUnliftIO (LocalEnv les) f = unsafeEff_ $ unEff (seqUnliftEff f) les
149153
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+
150169-- | Create a local unlifting function with the given strategy.
151170localUnlift
152171 :: LocalEnv localEs
@@ -171,3 +190,38 @@ localUnliftIO
171190localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
172191 SeqUnlift -> unEff (seqUnliftEff f) les
173192 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