git.iko.soy/effectful
on master help sign in
Add withEffToIO
ace82edAndrzej Rybczak
src/Effectful.hs+1
compare with master
unifiedsplit
@@ -21,6 +21,7 @@ module Effectful
21 , Limit(..)
21 , Limit(..)
22 , unliftStrategy
22 , unliftStrategy
23 , withUnliftStrategy
23 , withUnliftStrategy
24+ , withEffToIO
24
25
25 -- * 'Effect' handlers
26 -- * 'Effect' handlers
26
27
src/Effectful/Internal/Monad.hs+26−29
@@ -33,6 +33,7 @@ module Effectful.Internal.Monad
33 , Limit(..)
33 , Limit(..)
34 , unliftStrategy
34 , unliftStrategy
35 , withUnliftStrategy
35 , withUnliftStrategy
36+ , withEffToIO
36
37
37 --- *** Low-level helpers
38 --- *** Low-level helpers
38 , unsafeWithLiftMapIO
39 , unsafeWithLiftMapIO
@@ -58,18 +59,18 @@ module Effectful.Internal.Monad
58import Control.Applicative (liftA2)
59import Control.Applicative (liftA2)
59import Control.Concurrent (myThreadId)
60import Control.Concurrent (myThreadId)
60import Control.Exception
61import Control.Exception
62+import Control.Monad.Base
61import Control.Monad.Fix
63import Control.Monad.Fix
62import Control.Monad.IO.Class
64import Control.Monad.IO.Class
65+import Control.Monad.IO.Unlift
63import Control.Monad.Primitive
66import Control.Monad.Primitive
67+import Control.Monad.Trans.Control
64import Data.Unique
68import Data.Unique
65import GHC.Exts (oneShot)
69import GHC.Exts (oneShot)
66import GHC.IO (IO(..))
70import GHC.IO (IO(..))
67import GHC.Stack (HasCallStack)
71import GHC.Stack (HasCallStack)
68import System.IO.Unsafe (unsafeDupablePerformIO)
72import System.IO.Unsafe (unsafeDupablePerformIO)
69−import qualified Control.Monad.Base as M
70import qualified Control.Monad.Catch as E
73import qualified Control.Monad.Catch as E
71−import qualified Control.Monad.IO.Unlift as M
72−import qualified Control.Monad.Trans.Control as M
73
74
74import Effectful.Internal.Effect
75import Effectful.Internal.Effect
75import Effectful.Internal.Env
76import Effectful.Internal.Env
@@ -290,40 +291,21 @@ runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv
290instance IOE :> es => MonadIO (Eff es) where
291instance IOE :> es => MonadIO (Eff es) where
291 liftIO = unsafeEff_
292 liftIO = unsafeEff_
292
293
294+-- | Use 'withEffToIO' if you want accurate stack traces on errors.
293−instance IOE :> es => M.MonadUnliftIO (Eff es) where
295+instance IOE :> es => MonadUnliftIO (Eff es) where
294− withRunInIO = withRunInIO
296+ withRunInIO = withEffToIO
295− where
296− -- A trick to show name of the function in the call stack.
297− withRunInIO
298− :: (HasCallStack, IOE :> es)
299− => ((forall r. Eff es r -> IO r) -> IO a)
300− -> Eff es a
301− withRunInIO f = unliftStrategy >>= \case
302− SeqUnlift -> unsafeEff $ \es -> unsafeSeqUnliftEff es f
303− ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
304− unsafeEff $ \es -> unsafeConcUnliftEff es p b f
305
297
306-- | Instance included for compatibility with existing code, usage of 'liftIO'
298-- | Instance included for compatibility with existing code, usage of 'liftIO'
307-- is preferrable.
299-- is preferrable.
308−instance IOE :> es => M.MonadBase IO (Eff es) where
300+instance IOE :> es => MonadBase IO (Eff es) where
309 liftBase = unsafeEff_
301 liftBase = unsafeEff_
310
302
311-- | Instance included for compatibility with existing code, usage of
303-- | Instance included for compatibility with existing code, usage of
312-- 'withRunInIO' is preferrable.
304-- 'withRunInIO' is preferrable.
313−instance IOE :> es => M.MonadBaseControl IO (Eff es) where
305+instance IOE :> es => MonadBaseControl IO (Eff es) where
314 type StM (Eff es) a = a
306 type StM (Eff es) a = a
307+ liftBaseWith = withEffToIO
315 restoreM = pure
308 restoreM = pure
316− liftBaseWith = liftBaseWith
317− where
318− -- A trick to show name of the function in the call stack.
319− liftBaseWith
320− :: (HasCallStack, IOE :> es)
321− => ((forall r. Eff es r -> IO r) -> IO a)
322− -> Eff es a
323− liftBaseWith f = unliftStrategy >>= \case
324− SeqUnlift -> unsafeEff $ \es -> unsafeSeqUnliftEff es f
325− ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
326− unsafeEff $ \es -> unsafeConcUnliftEff es p b f
327
309
328----------------------------------------
310----------------------------------------
329-- Primitive
311-- Primitive
@@ -401,10 +383,25 @@ unliftStrategy = readerEffectM $ \(IdE (IOE unlift)) -> pure unlift
401
383
402-- | Locally override the 'UnliftStrategy' with a given value.
384-- | Locally override the 'UnliftStrategy' with a given value.
403--
385--
404−-- /Note:/ the strategy is always reset to 'SeqUnlift' for new threads.
386+-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
405withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
387withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
406withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
388withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
407
389
390+-- | Create an unlifting function with the current 'UnliftStrategy'.
391+--
392+-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'
393+-- constraint for accurate stack traces in case an insufficiently powerful
394+-- 'UnliftStrategy' is used and the unlifting function fails.
395+withEffToIO
396+ :: (HasCallStack, IOE :> es)
397+ => ((forall r. Eff es r -> IO r) -> IO a)
398+ -- ^ Continuation with the unlifting function in scope.
399+ -> Eff es a
400+withEffToIO f = unliftStrategy >>= \case
401+ SeqUnlift -> unsafeEff $ \es -> unsafeSeqUnliftEff es f
402+ ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
403+ unsafeEff $ \es -> unsafeConcUnliftEff es p b f
404+
408----------------------------------------
405----------------------------------------
409-- Helpers
406-- Helpers
410
407
src/Effectful/Monad.hs+1
@@ -21,6 +21,7 @@ module Effectful.Monad
21 , Limit(..)
21 , Limit(..)
22 , unliftStrategy
22 , unliftStrategy
23 , withUnliftStrategy
23 , withUnliftStrategy
24+ , withEffToIO
24 ) where
25 ) where
25
26
26import Effectful.Internal.Effect
27import Effectful.Internal.Effect