@@ -28,6 +28,7 @@ module Effective.Internal.Monad
2828 , stateEffectM
2929 ) where
3030
31+import Control.Concurrent (myThreadId)
3132import Control.Monad.Base
3233import Control.Monad.Catch
3334import Control.Monad.IO.Class
@@ -113,12 +114,24 @@ instance IOE :> es => MonadBase IO (Eff es) where
113114
114115instance IOE :> es => MonadBaseControl IO (Eff es) where
115116 type StM (Eff es) a = a
116− liftBaseWith f = impureEff $ \es -> f $ \(Eff m) -> m es
117+ liftBaseWith = runInIO
117118 restoreM = pure
118119
119120instance IOE :> es => MonadUnliftIO (Eff es) where
120− withRunInIO k = impureEff $ \es ->
121− withRunInIO $ \run -> k (\(Eff m) -> run $ m es)
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
122135
123136----------------------------------------
124137-- Helpers