git.iko.soy/effectful
on master help sign in
Temporarily remove support for running Eff in IO from a different thread
4e66e7bAndrzej Rybczak
effectful.cabal−1
compare with master
unifiedsplit
@@ -89,7 +89,6 @@ test-suite test
89 build-depends: base <5
89 build-depends: base <5
90 , effectful
90 , effectful
91 , exceptions
91 , exceptions
92− , lifted-async
93 , lifted-base
92 , lifted-base
94 , tasty
93 , tasty
95 , tasty-hunit
94 , tasty-hunit
src/Effectful/Internal/Monad.hs+17−5
@@ -60,13 +60,25 @@ unsafeUnliftEff :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
60unsafeUnliftEff f = unsafeEff $ \es -> do
60unsafeUnliftEff f = unsafeEff $ \es -> do
61 tid0 <- myThreadId
61 tid0 <- myThreadId
62 f $ \(Eff m) -> do
62 f $ \(Eff m) -> do
63+ -- The unlifting function can't be safely called from another thread.
64+ --
65+ -- Consider the following:
66+ --
67+ -- runState 'x' $ do
68+ -- liftBaseWith $ \run -> forkIO $ do
69+ -- threadDelay 1000000
70+ -- run $ ... (1)
71+ -- ... (2)
72+ -- ...
73+ --
74+ -- If (1) runs after (2) completed, the State Char effect is no longer in
75+ -- scope, but (1) assumes otherwise and things break horribly.
63 tid <- myThreadId
76 tid <- myThreadId
64− -- If the unlifting function is called from another thread, we need to clone
77+ if tid == tid0
65− -- the environment. Otherwise multiple threads will attempt to modify it in
66− -- different ways and things will break horribly.
67− if tid0 == tid
68 then m es
78 then m es
69− else m =<< cloneEnv es
79+ else do
80+ -- TODO: Add Fork and Async effect.
81+ error "Running computations in a different thread is not supported yet"
70
82
71----------------------------------------
83----------------------------------------
72-- Base
84-- Base
tests/Main.hs−18
@@ -1,6 +1,5 @@
1module Main (main) where
1module Main (main) where
2
2
3−import Control.Concurrent.Async.Lifted
4import Control.Monad.IO.Class
3import Control.Monad.IO.Class
5import Test.Tasty
4import Test.Tasty
6import Test.Tasty.HUnit
5import Test.Tasty.HUnit
@@ -20,7 +19,6 @@ main = defaultMain $ testGroup "effectful"
20 , testCase "stateM" test_stateM
19 , testCase "stateM" test_stateM
21 , testCase "deep stack" test_deepStack
20 , testCase "deep stack" test_deepStack
22 , testCase "exceptions" test_exceptions
21 , testCase "exceptions" test_exceptions
23− , testCase "concurrency" test_concurrentState
24 , testCase "local effects" test_localEffects
22 , testCase "local effects" test_localEffects
25 ]
23 ]
26 ]
24 ]
@@ -89,22 +87,6 @@ test_exceptions = runIOE $ do
89 _ <- E.throwM Ex
87 _ <- E.throwM Ex
90 modify @Int (+2)
88 modify @Int (+2)
91
89
92−test_concurrentState :: Assertion
93−test_concurrentState = runIOE . runHasInt x $ do
94− replicateConcurrently_ 2 $ do
95− r <- goDownward 0
96− assertEqual_ "x = n" x r
97− where
98− x :: Int
99− x = 1000000
100−
101− goDownward :: HasInt :> es => Int -> Eff es Int
102− goDownward acc = getInt >>= \case
103− 0 -> pure acc
104− n -> do
105− putInt $ n - 1
106− goDownward $ acc + 1
107−
108test_localEffects :: Assertion
90test_localEffects :: Assertion
109test_localEffects = runIOE $ do
91test_localEffects = runIOE $ do
110 x <- runHasInt 0 $ do
92 x <- runHasInt 0 $ do