git.iko.soy/effectful
on master help sign in
Bring back withLiftH (as withLiftSeqOp) with appropriate restrictions
b7fe35bAndrzej Rybczak
src/Effectful.hs+1−1
compare with master
unifiedsplit
@@ -44,9 +44,9 @@ module Effectful
44
44
45 -- *** 'IO'
45 -- *** 'IO'
46 , localSeqUnliftIO
46 , localSeqUnliftIO
47− , localSeqLiftUnliftIO
48 , localUnliftIO
47 , localUnliftIO
49 , localLiftUnliftIO
48 , localLiftUnliftIO
49+ , withLiftSeqOp
50 ) where
50 ) where
51
51
52import Effectful.Interpreter
52import Effectful.Interpreter
src/Effectful/Internal/Monad.hs+33−17
@@ -35,8 +35,9 @@ module Effectful.Internal.Monad
35 , withUnliftStrategy
35 , withUnliftStrategy
36
36
37 --- *** Low-level helpers
37 --- *** Low-level helpers
38− , seqUnliftEff
38+ , unsafeWithLiftSeqOp
39− , concUnliftEff
39+ , unsafeSeqUnliftEff
40+ , unsafeConcUnliftEff
40
41
41 -- * Primitive effects
42 -- * Primitive effects
42
43
@@ -123,17 +124,32 @@ runEff (Eff m) =
123unEff :: Eff es a -> Env es -> IO a
124unEff :: Eff es a -> Env es -> IO a
124unEff (Eff m) = m
125unEff (Eff m) = m
125
126
126−-- | Access underlying 'IO' monad along with the environment.
127+-- | Access the underlying 'IO' monad along with the environment.
127unsafeEff :: (Env es -> IO a) -> Eff es a
128unsafeEff :: (Env es -> IO a) -> Eff es a
128unsafeEff m = Eff (oneShot m)
129unsafeEff m = Eff (oneShot m)
129
130
130−-- | Access underlying 'IO' monad.
131+-- | Access the underlying 'IO' monad.
131unsafeEff_ :: IO a -> Eff es a
132unsafeEff_ :: IO a -> Eff es a
132unsafeEff_ m = unsafeEff $ \_ -> m
133unsafeEff_ m = unsafeEff $ \_ -> m
133
134
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+
134-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
150-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
135−seqUnliftEff :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
151+unsafeSeqUnliftEff :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
136−seqUnliftEff f = unsafeEff $ \es -> do
152+unsafeSeqUnliftEff f = unsafeEff $ \es -> do
137 tid0 <- myThreadId
153 tid0 <- myThreadId
138 f $ \m -> do
154 f $ \m -> do
139 tid <- myThreadId
155 tid <- myThreadId
@@ -144,19 +160,19 @@ seqUnliftEff f = unsafeEff $ \es -> do
144 ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
160 ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
145
161
146-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
162-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
147−concUnliftEff
163+unsafeConcUnliftEff
148 :: Persistence
164 :: Persistence
149 -> Limit
165 -> Limit
150 -> ((forall r. Eff es r -> IO r) -> IO a)
166 -> ((forall r. Eff es r -> IO r) -> IO a)
151 -> Eff es a
167 -> Eff es a
152−concUnliftEff Ephemeral (Limited uses) f = unsafeEff $ \es -> do
168+unsafeConcUnliftEff Ephemeral (Limited uses) f = unsafeEff $ \es -> do
153− ephemeralConcUnliftIO uses f es unEff
169+ unsafeEphemeralConcUnliftIO uses f es unEff
154−concUnliftEff Ephemeral Unlimited f = unsafeEff $ \es -> do
170+unsafeConcUnliftEff Ephemeral Unlimited f = unsafeEff $ \es -> do
155− ephemeralConcUnliftIO maxBound f es unEff
171+ unsafeEphemeralConcUnliftIO maxBound f es unEff
156−concUnliftEff Persistent (Limited threads) f = unsafeEff $ \es -> do
172+unsafeConcUnliftEff Persistent (Limited threads) f = unsafeEff $ \es -> do
157− persistentConcUnliftIO False threads f es unEff
173+ unsafePersistentConcUnliftIO False threads f es unEff
158−concUnliftEff Persistent Unlimited f = unsafeEff $ \es -> do
174+unsafeConcUnliftEff Persistent Unlimited f = unsafeEff $ \es -> do
159− persistentConcUnliftIO True maxBound f es unEff
175+ unsafePersistentConcUnliftIO True maxBound f es unEff
160
176
161----------------------------------------
177----------------------------------------
162-- Base
178-- Base
@@ -362,8 +378,8 @@ withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
362-- | Helper for 'MonadBaseControl' and 'MonadUnliftIO' instances.
378-- | Helper for 'MonadBaseControl' and 'MonadUnliftIO' instances.
363unliftEff :: IOE :> es => ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
379unliftEff :: IOE :> es => ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
364unliftEff f = unliftStrategy >>= \case
380unliftEff f = unliftStrategy >>= \case
365− SeqUnlift -> seqUnliftEff f
381+ SeqUnlift -> unsafeSeqUnliftEff f
366− ConcUnlift p b -> withUnliftStrategy SeqUnlift $ concUnliftEff p b f
382+ ConcUnlift p b -> withUnliftStrategy SeqUnlift $ unsafeConcUnliftEff p b f
367
383
368----------------------------------------
384----------------------------------------
369-- Helpers
385-- Helpers
src/Effectful/Internal/Unlift.hs+6−6
@@ -6,8 +6,8 @@
6-- This module is intended for internal use only, and may change without warning
6-- This module is intended for internal use only, and may change without warning
7-- in subsequent releases.
7-- in subsequent releases.
8module Effectful.Internal.Unlift
8module Effectful.Internal.Unlift
9− ( ephemeralConcUnliftIO
9+ ( unsafeEphemeralConcUnliftIO
10− , persistentConcUnliftIO
10+ , unsafePersistentConcUnliftIO
11 ) where
11 ) where
12
12
13import Control.Concurrent
13import Control.Concurrent
@@ -24,13 +24,13 @@ import Effectful.Internal.Utils
24
24
25-- | Concurrent unlift that doesn't preserve the environment between calls to
25-- | Concurrent unlift that doesn't preserve the environment between calls to
26-- the unlifting function in threads other than its creator.
26-- the unlifting function in threads other than its creator.
27−ephemeralConcUnliftIO
27+unsafeEphemeralConcUnliftIO
28 :: Int
28 :: Int
29 -> ((forall r. m r -> IO r) -> IO a)
29 -> ((forall r. m r -> IO r) -> IO a)
30 -> Env es
30 -> Env es
31 -> (forall r. m r -> Env es -> IO r)
31 -> (forall r. m r -> Env es -> IO r)
32 -> IO a
32 -> IO a
33−ephemeralConcUnliftIO uses f es0 unEff = do
33+unsafeEphemeralConcUnliftIO uses f es0 unEff = do
34 when (uses < 0) $ do
34 when (uses < 0) $ do
35 error $ "ephemeralConcUnliftIO: invalid number of uses: " ++ show uses
35 error $ "ephemeralConcUnliftIO: invalid number of uses: " ++ show uses
36 tid0 <- myThreadId
36 tid0 <- myThreadId
@@ -56,14 +56,14 @@ ephemeralConcUnliftIO uses f es0 unEff = do
56
56
57-- | Concurrent unlift that preserves the environment between calls to the
57-- | Concurrent unlift that preserves the environment between calls to the
58-- unlifting function within a particular thread.
58-- unlifting function within a particular thread.
59−persistentConcUnliftIO
59+unsafePersistentConcUnliftIO
60 :: Bool
60 :: Bool
61 -> Int
61 -> Int
62 -> ((forall r. m r -> IO r) -> IO a)
62 -> ((forall r. m r -> IO r) -> IO a)
63 -> Env es
63 -> Env es
64 -> (forall r. m r -> Env es -> IO r)
64 -> (forall r. m r -> Env es -> IO r)
65 -> IO a
65 -> IO a
66−persistentConcUnliftIO cleanUp threads f es0 unEff = do
66+unsafePersistentConcUnliftIO cleanUp threads f es0 unEff = do
67 when (threads < 0) $ do
67 when (threads < 0) $ do
68 error $ "persistentConcUnliftIO: invalid number of threads: " ++ show threads
68 error $ "persistentConcUnliftIO: invalid number of threads: " ++ show threads
69 tid0 <- myThreadId
69 tid0 <- myThreadId
src/Effectful/Interpreter.hs+49−40
@@ -21,9 +21,9 @@ module Effectful.Interpreter
21
21
22 -- *** 'IO'
22 -- *** 'IO'
23 , localSeqUnliftIO
23 , localSeqUnliftIO
24− , localSeqLiftUnliftIO
25 , localUnliftIO
24 , localUnliftIO
26 , localLiftUnliftIO
25 , localLiftUnliftIO
26+ , withLiftSeqOp
27 ) where
27 ) where
28
28
29import Control.Exception
29import Control.Exception
@@ -140,7 +140,7 @@ localSeqUnlift
140 -- ^ Continuation with the unlifting function in scope.
140 -- ^ Continuation with the unlifting function in scope.
141 -> Eff es a
141 -> Eff es a
142localSeqUnlift (LocalEnv les) f = unsafeEff $ \es -> do
142localSeqUnlift (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
144
144
145-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
145-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
146-- general version see 'localUnliftIO'.
146-- general version see 'localUnliftIO'.
@@ -151,22 +151,7 @@ localSeqUnliftIO
151 -> ((forall r. Eff localEs r -> IO r) -> IO a)
151 -> ((forall r. Eff localEs r -> IO r) -> IO a)
152 -- ^ Continuation with the unlifting function in scope.
152 -- ^ Continuation with the unlifting function in scope.
153 -> Eff es a
153 -> Eff es a
154−localSeqUnliftIO (LocalEnv les) f = unsafeEff_ $ unEff (seqUnliftEff f) les
154+localSeqUnliftIO (LocalEnv les) f = unsafeEff_ $ unEff (unsafeSeqUnliftEff 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
170
155
171-- | Create a local unlifting function with the given strategy.
156-- | Create a local unlifting function with the given strategy.
172localUnlift
157localUnlift
@@ -176,9 +161,11 @@ localUnlift
176 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
161 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
177 -- ^ Continuation with the unlifting function in scope.
162 -- ^ Continuation with the unlifting function in scope.
178 -> Eff es a
163 -> Eff es a
179−localUnlift (LocalEnv les) unlift f = unsafeEff $ \es -> case unlift of
164+localUnlift (LocalEnv les) strategy f = unsafeEff $ \es -> case strategy of
165+ SeqUnlift ->
180− SeqUnlift -> unEff (seqUnliftEff $ \k -> unEff (f $ unsafeEff_ . k) es) les
166+ unEff (unsafeSeqUnliftEff $ \unlift -> unEff (f $ unsafeEff_ . unlift) es) les
167+ ConcUnlift p l ->
181− ConcUnlift p b -> unEff (concUnliftEff p b $ \k -> unEff (f $ unsafeEff_ . k) es) les
168+ unEff (unsafeConcUnliftEff p l $ \unlift -> unEff (f $ unsafeEff_ . unlift) es) les
182
169
183-- | Create a local unlifting function with the given strategy.
170-- | Create a local unlifting function with the given strategy.
184localUnliftIO
171localUnliftIO
@@ -190,15 +177,42 @@ localUnliftIO
190 -- ^ Continuation with the unlifting function in scope.
177 -- ^ Continuation with the unlifting function in scope.
191 -> Eff es a
178 -> Eff es a
192localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
179localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
193− SeqUnlift -> unEff (seqUnliftEff 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
194− ConcUnlift p b -> unEff (concUnliftEff p b f) les
201+ ConcUnlift p l -> unEff (unsafeConcUnliftEff p l $ f unsafeEff_) les
195
202
196−-- | Create a local lifting and unlifting function with the given strategy.
203+-- | Utility for lifting 'IO' actions of type
197--
204--
198−-- /Note:/ the strategy applies only to the unlifting function, lifting function
205+-- @'IO' a -> 'IO' b@
199−-- doesn't have any restrictions.
200--
206--
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
201−-- Necessary for lifting 'Control.Concurrent.forkIOWithUnmask'-like operations:
215+-- 'Control.Exception.mask'-like operations:
202--
216--
203-- >>> :{
217-- >>> :{
204-- data Fork :: Effect where
218-- data Fork :: Effect where
@@ -207,21 +221,16 @@ localUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
207--
221--
208-- >>> :{
222-- >>> :{
209-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a
223-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a
210−-- runFork = interpretM $ \env (ForkWithUnmask m) -> do
224+-- runFork = interpretM $ \env (ForkWithUnmask m) -> withLiftSeqOp $ \liftSeqOp -> do
211−-- localLiftUnliftIO env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do
225+-- localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
212−-- forkIOWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift
226+-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftSeqOp unmask
213-- :}
227-- :}
214−localLiftUnliftIO
228+withLiftSeqOp
215 :: IOE :> es
229 :: IOE :> es
216− => LocalEnv localEs
230+ => ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
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.
231+ -- ^ Continuation with the lifting function in scope.
221− -> Eff es a
232+ -> Eff es r
222−localLiftUnliftIO (LocalEnv les) unlift f = unsafeEff_ $ case unlift of
233+withLiftSeqOp = unsafeWithLiftSeqOp
223− SeqUnlift -> unEff (seqUnliftEff $ f unsafeEff_) les
224− ConcUnlift p b -> unEff (concUnliftEff p b $ f unsafeEff_) les
225
234
226-- $setup
235-- $setup
227-- >>> import Control.Concurrent
236-- >>> import Control.Concurrent