on master help sign in
Simplify unsafeWithLiftMapIO
8dc4d18Andrzej Rybczak
effectful-core/src/Effectful/Internal/Monad.hs+10−12
@@ -35,7 +35,7 @@ module Effectful.Internal.Monad
35 , withEffToIO
35 , withEffToIO
36
36
37 --- *** Low-level helpers
37 --- *** Low-level helpers
38− , unsafeWithLiftMapIO
38+ , unsafeLiftMapIO
39 , seqUnliftEff
39 , seqUnliftEff
40 , concUnliftEff
40 , concUnliftEff
41
41
@@ -154,19 +154,17 @@ unsafeEff_ m = unsafeEff $ \_ -> m
154--
154--
155-- to
155-- to
156--
156--
157−-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
157+-- @'Eff' es a -> 'Eff' es b@
158--
158--
159−-- This function is __unsafe__ because it can be used to introduce arbitrary
159+-- This function is __unsafe__ because:
160−-- 'IO' actions into pure 'Eff' operations.
161--
160--
161+-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
162+-- operations.
163+--
162−-- /Note:/ the 'IO' operation must not run its argument in a separate thread,
164+-- - The 'IO' operation must not run its argument in a separate thread, but it's
163−-- attempting to do so will result in a runtime error.
165+-- not checked anywhere.
164−unsafeWithLiftMapIO
166+unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
165− :: HasCallStack
167+unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
166− => ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
167− -> Eff es r
168−unsafeWithLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
169− seqUnliftEff es $ \unlift -> mapIO $ unlift m
170
168
171-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
169-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
172seqUnliftEff
170seqUnliftEff
effectful/src/Effectful/Async.hs+7−9
@@ -533,10 +533,9 @@ liftAsyncWithUnmask
533 :: (((forall b. IO b -> IO b) -> IO a) -> IO (Async a))
533 :: (((forall b. IO b -> IO b) -> IO a) -> IO (Async a))
534 -> ((forall b. Eff es b -> Eff es b) -> Eff es a)
534 -> ((forall b. Eff es b -> Eff es b) -> Eff es a)
535 -> Eff es (Async a)
535 -> Eff es (Async a)
536−liftAsyncWithUnmask fork action = do
536+liftAsyncWithUnmask fork action = unsafeEff $ \es -> do
537− unsafeWithLiftMapIO $ \liftMap -> unsafeEff $ \es -> do
538− esA <- cloneEnv es
537+ esA <- cloneEnv es
539− fork $ \unmask -> unEff (action $ liftMap unmask) esA
538+ fork $ \unmask -> unEff (action $ unsafeLiftMapIO unmask) esA
540
539
541liftWithAsync
540liftWithAsync
542 :: (IO a -> (Async a -> IO b) -> IO b)
541 :: (IO a -> (Async a -> IO b) -> IO b)
@@ -553,8 +552,7 @@ liftWithAsyncWithUnmask
553 -> ((forall c. Eff es c -> Eff es c) -> Eff es a)
552 -> ((forall c. Eff es c -> Eff es c) -> Eff es a)
554 -> (Async a -> Eff es b)
553 -> (Async a -> Eff es b)
555 -> Eff es b
554 -> Eff es b
556−liftWithAsyncWithUnmask withA action k = do
555+liftWithAsyncWithUnmask withA action k = unsafeEff $ \es -> do
557− unsafeWithLiftMapIO $ \liftMap -> unsafeEff $ \es -> do
558− esA <- cloneEnv es
556+ esA <- cloneEnv es
559− withA (\unmask -> unEff (action $ liftMap unmask) esA)
557+ withA (\unmask -> unEff (action $ unsafeLiftMapIO unmask) esA)
560− (\a -> unEff (k a) es)
558+ (\a -> unEff (k a) es)