Simplify unsafeWithLiftMapIO

effectful-core/src/Effectful/Internal/Monad.hs

@@ -35,7 +35,7 @@ module Effectful.Internal.Monad
   , withEffToIO
 
   --- *** Low-level helpers
-  , unsafeWithLiftMapIO
+  , unsafeLiftMapIO
   , seqUnliftEff
   , concUnliftEff
 
@@ -154,19 +154,17 @@ unsafeEff_ m = unsafeEff $ \_ -> m
 --
 -- to
 --
--- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
+-- @'Eff' es a -> 'Eff' es b@
 --
--- This function is __unsafe__ because it can be used to introduce arbitrary
--- 'IO' actions into pure 'Eff' operations.
+-- This function is __unsafe__ because:
 --
--- /Note:/ the 'IO' operation must not run its argument in a separate thread,
--- attempting to do so will result in a runtime error.
-unsafeWithLiftMapIO
-  :: HasCallStack
-  => ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
-  -> Eff es r
-unsafeWithLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
-  seqUnliftEff es $ \unlift -> mapIO $ unlift m
+-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
+--   operations.
+--
+-- - The 'IO' operation must not run its argument in a separate thread, but it's
+--   not checked anywhere.
+unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
+unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
 
 -- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
 seqUnliftEff

effectful/src/Effectful/Async.hs

@@ -533,10 +533,9 @@ liftAsyncWithUnmask
   :: (((forall b. IO b -> IO b) -> IO a) -> IO (Async a))
   -> ((forall b. Eff es b -> Eff es b) -> Eff es a)
   -> Eff es (Async a)
-liftAsyncWithUnmask fork action = do
-  unsafeWithLiftMapIO $ \liftMap -> unsafeEff $ \es -> do
-    esA <- cloneEnv es
-    fork $ \unmask -> unEff (action $ liftMap unmask) esA
+liftAsyncWithUnmask fork action = unsafeEff $ \es -> do
+  esA <- cloneEnv es
+  fork $ \unmask -> unEff (action $ unsafeLiftMapIO unmask) esA
 
 liftWithAsync
   :: (IO a -> (Async a -> IO b) -> IO b)
@@ -553,8 +552,7 @@ liftWithAsyncWithUnmask
   -> ((forall c. Eff es c -> Eff es c) -> Eff es a)
   -> (Async a -> Eff es b)
   -> Eff es b
-liftWithAsyncWithUnmask withA action k = do
-  unsafeWithLiftMapIO $ \liftMap -> unsafeEff $ \es -> do
-    esA <- cloneEnv es
-    withA (\unmask -> unEff (action $ liftMap unmask) esA)
-          (\a -> unEff (k a) es)
+liftWithAsyncWithUnmask withA action k = unsafeEff $ \es -> do
+  esA <- cloneEnv es
+  withA (\unmask -> unEff (action $ unsafeLiftMapIO unmask) esA)
+        (\a -> unEff (k a) es)