on master help sign in
Simplify unsafeWithLiftMapIO
commit8dc4d18f8e492696ea179b7d02526c950d0373f5 authorAndrzej Rybczak <andrzej@rybczak.net> dateSat 25 Sep 2021, 08:24 (5 years ago) parent7527aa4
2 files changed+17−21
effectful-core/src/Effectful/Internal/Monad.hs+10−12 effectful/src/Effectful/Async.hs+7−9
effectful-core/src/Effectful/Internal/Monad.hs+10−12
@@ -35,7 +35,7 @@ module Effectful.Internal.Monad
3535 , withEffToIO
3636
3737 --- *** Low-level helpers
38− , unsafeWithLiftMapIO
38+ , unsafeLiftMapIO
3939 , seqUnliftEff
4040 , concUnliftEff
4141
@@ -154,19 +154,17 @@ unsafeEff_ m = unsafeEff $ \_ -> m
154154--
155155-- to
156156--
157−-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
157+-- @'Eff' es a -> 'Eff' es b@
158158--
159−-- This function is __unsafe__ because it can be used to introduce arbitrary
160−-- 'IO' actions into pure 'Eff' operations.
159+-- This function is __unsafe__ because:
161160--
162−-- /Note:/ the 'IO' operation must not run its argument in a separate thread,
163−-- attempting to do so will result in a runtime error.
164−unsafeWithLiftMapIO
165− :: HasCallStack
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
161+-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
162+-- operations.
163+--
164+-- - The 'IO' operation must not run its argument in a separate thread, but it's
165+-- not checked anywhere.
166+unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
167+unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
170168
171169-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
172170seqUnliftEff
effectful/src/Effectful/Async.hs+7−9
@@ -533,10 +533,9 @@ liftAsyncWithUnmask
533533 :: (((forall b. IO b -> IO b) -> IO a) -> IO (Async a))
534534 -> ((forall b. Eff es b -> Eff es b) -> Eff es a)
535535 -> Eff es (Async a)
536−liftAsyncWithUnmask fork action = do
537− unsafeWithLiftMapIO $ \liftMap -> unsafeEff $ \es -> do
538− esA <- cloneEnv es
539− fork $ \unmask -> unEff (action $ liftMap unmask) esA
536+liftAsyncWithUnmask fork action = unsafeEff $ \es -> do
537+ esA <- cloneEnv es
538+ fork $ \unmask -> unEff (action $ unsafeLiftMapIO unmask) esA
540539
541540liftWithAsync
542541 :: (IO a -> (Async a -> IO b) -> IO b)
@@ -553,8 +552,7 @@ liftWithAsyncWithUnmask
553552 -> ((forall c. Eff es c -> Eff es c) -> Eff es a)
554553 -> (Async a -> Eff es b)
555554 -> Eff es b
556−liftWithAsyncWithUnmask withA action k = do
557− unsafeWithLiftMapIO $ \liftMap -> unsafeEff $ \es -> do
558− esA <- cloneEnv es
559− withA (\unmask -> unEff (action $ liftMap unmask) esA)
560− (\a -> unEff (k a) es)
555+liftWithAsyncWithUnmask withA action k = unsafeEff $ \es -> do
556+ esA <- cloneEnv es
557+ withA (\unmask -> unEff (action $ unsafeLiftMapIO unmask) esA)
558+ (\a -> unEff (k a) es)