git.iko.soy/effectful
on master help sign in
Expose impureUnliftEff
134c929Andrzej Rybczak
src/Effectful/Internal/Monad.hs+16−15
compare with master
unifiedsplit
@@ -10,6 +10,7 @@ module Effectful.Internal.Monad
10 , runEff
10 , runEff
11 , impureEff
11 , impureEff
12 , impureEff_
12 , impureEff_
13+ , impureUnliftEff
13
14
14 -- * IO
15 -- * IO
15 , IOE
16 , IOE
@@ -52,6 +53,19 @@ impureEff m = Eff (oneShot m)
52impureEff_ :: IO a -> Eff es a
53impureEff_ :: IO a -> Eff es a
53impureEff_ m = impureEff $ \_ -> m
54impureEff_ m = impureEff $ \_ -> m
54
55
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+
55----------------------------------------
69----------------------------------------
56-- Base
70-- Base
57
71
@@ -114,24 +128,11 @@ instance IOE :> es => MonadBase IO (Eff es) where
114
128
115instance IOE :> es => MonadBaseControl IO (Eff es) where
129instance IOE :> es => MonadBaseControl IO (Eff es) where
116 type StM (Eff es) a = a
130 type StM (Eff es) a = a
117− liftBaseWith = runInIO
131+ liftBaseWith = impureUnliftEff
118 restoreM = pure
132 restoreM = pure
119
133
120instance IOE :> es => MonadUnliftIO (Eff es) where
134instance IOE :> es => MonadUnliftIO (Eff es) where
121− withRunInIO = runInIO
135+ withRunInIO = impureUnliftEff
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
136
136----------------------------------------
137----------------------------------------
137-- Helpers
138-- Helpers