git.iko.soy/effectful
on master help sign in
Clone the environment when lifting 'Eff' into a different thread
534ceeeAndrzej Rybczak
src/Effective/Internal/Monad.hs+16−3
compare with master
unifiedsplit
@@ -28,6 +28,7 @@ module Effective.Internal.Monad
28 , stateEffectM
28 , stateEffectM
29 ) where
29 ) where
30
30
31+import Control.Concurrent (myThreadId)
31import Control.Monad.Base
32import Control.Monad.Base
32import Control.Monad.Catch
33import Control.Monad.Catch
33import Control.Monad.IO.Class
34import Control.Monad.IO.Class
@@ -113,12 +114,24 @@ instance IOE :> es => MonadBase IO (Eff es) where
113
114
114instance IOE :> es => MonadBaseControl IO (Eff es) where
115instance IOE :> es => MonadBaseControl IO (Eff es) where
115 type StM (Eff es) a = a
116 type StM (Eff es) a = a
116− liftBaseWith f = impureEff $ \es -> f $ \(Eff m) -> m es
117+ liftBaseWith = runInIO
117 restoreM = pure
118 restoreM = pure
118
119
119instance IOE :> es => MonadUnliftIO (Eff es) where
120instance IOE :> es => MonadUnliftIO (Eff es) where
120− withRunInIO k = impureEff $ \es ->
121+ withRunInIO = runInIO
121− withRunInIO $ \run -> k (\(Eff m) -> run $ m es)
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
122
135
123----------------------------------------
136----------------------------------------
124-- Helpers
137-- Helpers