@@ -10,6 +10,7 @@ module Effectful.Internal.Monad
1010 , runEff
1111 , impureEff
1212 , impureEff_
13+ , impureUnliftEff
1314
1415 -- * IO
1516 , IOE
@@ -52,6 +53,19 @@ impureEff m = Eff (oneShot m)
5253impureEff_ :: IO a -> Eff es a
5354impureEff_ m = impureEff $ \_ -> m
5455
56+-- | Run 'Eff' computations in 'IO'.
57+impureUnliftEff :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
58+impureUnliftEff f = impureEff $ \es -> do
59+ tid0 <- myThreadId
60+ f $ \(Eff m) -> do
61+ tid <- myThreadId
62+ -- If the lifting function is called from a different thread, we need to
63+ -- clone the environment. Otherwise multiple threads will attempt to modify
64+ -- it in different ways and things will break horribly.
65+ if tid0 == tid
66+ then m es
67+ else m =<< cloneEnv es
68+
5569----------------------------------------
5670-- Base
5771
@@ -114,24 +128,11 @@ instance IOE :> es => MonadBase IO (Eff es) where
114128
115129instance IOE :> es => MonadBaseControl IO (Eff es) where
116130 type StM (Eff es) a = a
117− liftBaseWith = runInIO
131+ liftBaseWith = impureUnliftEff
118132 restoreM = pure
119133
120134instance IOE :> es => MonadUnliftIO (Eff es) where
121− withRunInIO = runInIO
122−
123−-- | Run 'Eff' computations in 'IO'.
124−runInIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
125−runInIO f = impureEff $ \es -> do
126− tid0 <- myThreadId
127− f $ \(Eff m) -> do
128− tid <- myThreadId
129− -- If the lifting function is called from a different thread, we need to
130− -- clone the environment. Otherwise multiple threads will attempt to modify
131− -- it in different ways and things will break horribly.
132− if tid0 == tid
133− then m es
134− else m =<< cloneEnv es
135+ withRunInIO = impureUnliftEff
135136
136137----------------------------------------
137138-- Helpers