git.iko.soy/effectful
on master help sign in
Bring back withLiftH (as withLiftSeqOp) with appropriate restrictions
commitb7fe35b4e5b4d3f7d57ebca2eaa4eeed609a560f authorAndrzej Rybczak <andrzej@rybczak.net> dateSat 10 Jul 2021, 16:14 (5 years ago) parent641a85f
4 files changed+89−64
compare with master
unifiedsplit
src/Effectful.hs+1−1 src/Effectful/Internal/Monad.hs+33−17 src/Effectful/Internal/Unlift.hs+6−6 src/Effectful/Interpreter.hs+49−40
src/Effectful.hs+1−1
@@ -44,9 +44,9 @@ module Effectful
4444
4545 -- *** 'IO'
4646 , localSeqUnliftIO
47− , localSeqLiftUnliftIO
4847 , localUnliftIO
4948 , localLiftUnliftIO
49+ , withLiftSeqOp
5050 ) where
5151
5252import Effectful.Interpreter
src/Effectful/Internal/Monad.hs+33−17
@@ -35,8 +35,9 @@ module Effectful.Internal.Monad
3535 , withUnliftStrategy
3636
3737 --- *** Low-level helpers
38− , seqUnliftEff
39− , concUnliftEff
38+ , unsafeWithLiftSeqOp
39+ , unsafeSeqUnliftEff
40+ , unsafeConcUnliftEff
4041
4142 -- * Primitive effects
4243
@@ -123,17 +124,32 @@ runEff (Eff m) =
123124unEff :: Eff es a -> Env es -> IO a
124125unEff (Eff m) = m
125126
126−-- | Access underlying 'IO' monad along with the environment.
127+-- | Access the underlying 'IO' monad along with the environment.
127128unsafeEff :: (Env es -> IO a) -> Eff es a
128129unsafeEff m = Eff (oneShot m)
129130
130−-- | Access underlying 'IO' monad.
131+-- | Access the underlying 'IO' monad.
131132unsafeEff_ :: IO a -> Eff es a
132133unsafeEff_ m = unsafeEff $ \_ -> m
133134
135+-- | Utility for lifting sequential 'IO' actions of type
136+--
137+-- @'IO' a -> 'IO' b@
138+--
139+-- to
140+--
141+-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
142+--
143+-- /Note:/ the 'IO' operation must not try to run its argument in a different
144+-- thread, attempting to do so will result in a runtime error.
145+unsafeWithLiftSeqOp
146+ :: ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
147+ -> Eff es r
148+unsafeWithLiftSeqOp k = k $ \f m -> unsafeSeqUnliftEff $ \unlift -> f $ unlift m
149+
134150-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
135−seqUnliftEff :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
136−seqUnliftEff f = unsafeEff $ \es -> do
151+unsafeSeqUnliftEff :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
152+unsafeSeqUnliftEff f = unsafeEff $ \es -> do
137153 tid0 <- myThreadId
138154 f $ \m -> do
139155 tid <- myThreadId
@@ -144,19 +160,19 @@ seqUnliftEff f = unsafeEff $ \es -> do
144160 ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
145161
146162-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
147−concUnliftEff
163+unsafeConcUnliftEff
148164 :: Persistence
149165 -> Limit
150166 -> ((forall r. Eff es r -> IO r) -> IO a)
151167 -> Eff es a
152−concUnliftEff Ephemeral (Limited uses) f = unsafeEff $ \es -> do
153− ephemeralConcUnliftIO uses f es unEff
154−concUnliftEff Ephemeral Unlimited f = unsafeEff $ \es -> do
155− ephemeralConcUnliftIO maxBound f es unEff
156−concUnliftEff Persistent (Limited threads) f = unsafeEff $ \es -> do
157− persistentConcUnliftIO False threads f es unEff
158−concUnliftEff Persistent Unlimited f = unsafeEff $ \es -> do
159− persistentConcUnliftIO True maxBound f es unEff
168+unsafeConcUnliftEff Ephemeral (Limited uses) f = unsafeEff $ \es -> do
169+ unsafeEphemeralConcUnliftIO uses f es unEff
170+unsafeConcUnliftEff Ephemeral Unlimited f = unsafeEff $ \es -> do
171+ unsafeEphemeralConcUnliftIO maxBound f es unEff
172+unsafeConcUnliftEff Persistent (Limited threads) f = unsafeEff $ \es -> do
173+ unsafePersistentConcUnliftIO False threads f es unEff
174+unsafeConcUnliftEff Persistent Unlimited f = unsafeEff $ \es -> do
175+ unsafePersistentConcUnliftIO True maxBound f es unEff
160176
161177----------------------------------------
162178-- Base
@@ -362,8 +378,8 @@ withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
362378-- | Helper for 'MonadBaseControl' and 'MonadUnliftIO' instances.
363379unliftEff :: IOE :> es => ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
364380unliftEff f = unliftStrategy >>= \case
365− SeqUnlift -> seqUnliftEff f
366− ConcUnlift p b -> withUnliftStrategy SeqUnlift $ concUnliftEff p b f
381+ SeqUnlift -> unsafeSeqUnliftEff f
382+ ConcUnlift p b -> withUnliftStrategy SeqUnlift $ unsafeConcUnliftEff p b f
367383
368384----------------------------------------
369385-- Helpers
src/Effectful/Internal/Unlift.hs+6−6
@@ -6,8 +6,8 @@
66-- This module is intended for internal use only, and may change without warning
77-- in subsequent releases.
88module Effectful.Internal.Unlift
9− ( ephemeralConcUnliftIO
10− , persistentConcUnliftIO
9+ ( unsafeEphemeralConcUnliftIO
10+ , unsafePersistentConcUnliftIO
1111 ) where
1212
1313import Control.Concurrent
@@ -24,13 +24,13 @@ import Effectful.Internal.Utils
2424
2525-- | Concurrent unlift that doesn't preserve the environment between calls to
2626-- the unlifting function in threads other than its creator.
27−ephemeralConcUnliftIO
27+unsafeEphemeralConcUnliftIO
2828 :: Int
2929 -> ((forall r. m r -> IO r) -> IO a)
3030 -> Env es
3131 -> (forall r. m r -> Env es -> IO r)
3232 -> IO a
33−ephemeralConcUnliftIO uses f es0 unEff = do
33+unsafeEphemeralConcUnliftIO uses f es0 unEff = do
3434 when (uses < 0) $ do
3535 error $ "ephemeralConcUnliftIO: invalid number of uses: " ++ show uses
3636 tid0 <- myThreadId
@@ -56,14 +56,14 @@ ephemeralConcUnliftIO uses f es0 unEff = do
5656
5757-- | Concurrent unlift that preserves the environment between calls to the
5858-- unlifting function within a particular thread.
59−persistentConcUnliftIO
59+unsafePersistentConcUnliftIO
6060 :: Bool
6161 -> Int
6262 -> ((forall r. m r -> IO r) -> IO a)
6363 -> Env es
6464 -> (forall r. m r -> Env es -> IO r)
6565 -> IO a
66−persistentConcUnliftIO cleanUp threads f es0 unEff = do
66+unsafePersistentConcUnliftIO cleanUp threads f es0 unEff = do
6767 when (threads < 0) $ do
6868 error $ "persistentConcUnliftIO: invalid number of threads: " ++ show threads
6969 tid0 <- myThreadId
src/Effectful/Interpreter.hs+49−40
@@ -21,9 +21,9 @@ module Effectful.Interpreter
2121
2222 -- *** 'IO'
2323 , localSeqUnliftIO
24− , localSeqLiftUnliftIO
2524 , localUnliftIO
2625 , localLiftUnliftIO
26+ , withLiftSeqOp
2727 ) where
2828
2929import Control.Exception
@@ -140,7 +140,7 @@ localSeqUnlift
140140 -- ^ Continuation with the unlifting function in scope.
141141 -> Eff es a
142142localSeqUnlift (LocalEnv les) f = unsafeEff $ \es -> do
143− unEff (seqUnliftEff $ \k -> unEff (f $ unsafeEff_ . k) es) les
143+ unEff (unsafeSeqUnliftEff $ \unlift -> unEff (f $ unsafeEff_ . unlift) es) les
144144
145145-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
146146-- general version see 'localUnliftIO'.
@@ -151,22 +151,7 @@ localSeqUnliftIO
151151 -> ((forall r. Eff localEs r -> IO r) -> IO a)
152152 -- ^ Continuation with the unlifting function in scope.
153153 -> Eff es a
154−localSeqUnliftIO (LocalEnv les) f = unsafeEff_ $ unEff (seqUnliftEff f) les
155−
156−-- | Create a local lifting and unlifting function with the 'SeqUnlift'
157−-- strategy. For the general version see 'localLiftUnliftIO'.
158−--
159−-- /Note:/ the strategy applies only to the unlifting function, lifting function
160−-- doesn't have any restrictions.
161−localSeqLiftUnliftIO
162− :: IOE :> es
163− => LocalEnv localEs
164− -- ^ Local environment.
165− -> ((forall r. IO r -> Eff localEs r) -> (forall r. Eff localEs r -> IO r) -> IO a)
166− -- ^ Continuation with the lifting and unlifting function.
167− -> Eff es a
168−localSeqLiftUnliftIO (LocalEnv les) f = unsafeEff_ $ do
169− unEff (seqUnliftEff $ f unsafeEff_) les
154+localSeqUnliftIO (LocalEnv les) f = unsafeEff_ $ unEff (unsafeSeqUnliftEff f) les
170155
171156-- | Create a local unlifting function with the given strategy.
172157localUnlift
@@ -176,9 +161,11 @@ localUnlift
176161 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
177162 -- ^ Continuation with the unlifting function in scope.
178163 -> Eff es a
179−localUnlift (LocalEnv les) unlift f = unsafeEff $ \es -> case unlift of
180− SeqUnlift -> unEff (seqUnliftEff $ \k -> unEff (f $ unsafeEff_ . k) es) les
181− ConcUnlift p b -> unEff (concUnliftEff p b $ \k -> unEff (f $ unsafeEff_ . k) es) les
164+localUnlift (LocalEnv les) strategy f = unsafeEff $ \es -> case strategy of
165+ SeqUnlift ->
166+ unEff (unsafeSeqUnliftEff $ \unlift -> unEff (f $ unsafeEff_ . unlift) es) les
167+ ConcUnlift p l ->
168+ unEff (unsafeConcUnliftEff p l $ \unlift -> unEff (f $ unsafeEff_ . unlift) es) les
182169
183170-- | Create a local unlifting function with the given strategy.
184171localUnliftIO
@@ -190,15 +177,42 @@ localUnliftIO
190177 -- ^ Continuation with the unlifting function in scope.
191178 -> Eff es a
192179localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
193− SeqUnlift -> unEff (seqUnliftEff f) les
194− ConcUnlift p b -> unEff (concUnliftEff p b f) les
180+ SeqUnlift -> unEff (unsafeSeqUnliftEff f) les
181+ ConcUnlift p l -> unEff (unsafeConcUnliftEff p l f) les
182+
183+-- | Create a local unlifting function with the given strategy along with an
184+-- unrestricted lifting function.
185+--
186+-- Useful for lifting local 'Eff' operations where the monadic action shows in
187+-- both positive and negative position.
188+--
189+-- /Note:/ depending on the operations you're lifting, 'localUnliftIO' along
190+-- with 'withLiftSeqOp' might be enough and is more efficient.
191+localLiftUnliftIO
192+ :: IOE :> es
193+ => LocalEnv localEs
194+ -- ^ Local environment.
195+ -> UnliftStrategy
196+ -> ((forall r. IO r -> Eff localEs r) -> (forall r. Eff localEs r -> IO r) -> IO a)
197+ -- ^ Continuation with the lifting and unlifting function in scope.
198+ -> Eff es a
199+localLiftUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
200+ SeqUnlift -> unEff (unsafeSeqUnliftEff $ f unsafeEff_) les
201+ ConcUnlift p l -> unEff (unsafeConcUnliftEff p l $ f unsafeEff_) les
195202
196−-- | Create a local lifting and unlifting function with the given strategy.
203+-- | Utility for lifting 'IO' actions of type
197204--
198−-- /Note:/ the strategy applies only to the unlifting function, lifting function
199−-- doesn't have any restrictions.
205+-- @'IO' a -> 'IO' b@
200206--
201−-- Necessary for lifting 'Control.Concurrent.forkIOWithUnmask'-like operations:
207+-- to
208+--
209+-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
210+--
211+-- /Note:/ the 'IO' operation must not try to run its argument in a different
212+-- thread, attempting to do so will result in a runtime error.
213+--
214+-- Useful e.g. for lifting the unmasking function in
215+-- 'Control.Exception.mask'-like operations:
202216--
203217-- >>> :{
204218-- data Fork :: Effect where
@@ -207,21 +221,16 @@ localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
207221--
208222-- >>> :{
209223-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a
210−-- runFork = interpretM $ \env (ForkWithUnmask m) -> do
211−-- localLiftUnliftIO env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do
212−-- forkIOWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift
224+-- runFork = interpretM $ \env (ForkWithUnmask m) -> withLiftSeqOp $ \liftSeqOp -> do
225+-- localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
226+-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftSeqOp unmask
213227-- :}
214−localLiftUnliftIO
228+withLiftSeqOp
215229 :: IOE :> es
216− => LocalEnv localEs
217− -- ^ Local environment.
218− -> UnliftStrategy
219− -> ((forall r. IO r -> Eff localEs r) -> (forall r. Eff localEs r -> IO r) -> IO a)
220− -- ^ Continuation with the lifting and unlifting function in scope.
221− -> Eff es a
222−localLiftUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
223− SeqUnlift -> unEff (seqUnliftEff $ f unsafeEff_) les
224− ConcUnlift p b -> unEff (concUnliftEff p b $ f unsafeEff_) les
230+ => ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
231+ -- ^ Continuation with the lifting function in scope.
232+ -> Eff es r
233+withLiftSeqOp = unsafeWithLiftSeqOp
225234
226235-- $setup
227236-- >>> import Control.Concurrent