on master help sign in
Temporarily remove support for running Eff in IO from a different thread
commit4e66e7b955054d40c4f6415dfb58d531653d1c6e authorAndrzej Rybczak <andrzej@rybczak.net> dateWed 23 Jun 2021, 02:29 (5 years ago) parentb8c6c3f
3 files changed+17−24
effectful.cabal−1 src/Effectful/Internal/Monad.hs+17−5 tests/Main.hs−18
effectful.cabal−1
@@ -89,7 +89,6 @@ test-suite test
8989 build-depends: base <5
9090 , effectful
9191 , exceptions
92− , lifted-async
9392 , lifted-base
9493 , tasty
9594 , 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
6060unsafeUnliftEff f = unsafeEff $ \es -> do
6161 tid0 <- myThreadId
6262 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.
6376 tid <- myThreadId
64− -- If the unlifting function is called from another thread, we need to clone
65− -- the environment. Otherwise multiple threads will attempt to modify it in
66− -- different ways and things will break horribly.
67− if tid0 == tid
77+ if tid == tid0
6878 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"
7082
7183----------------------------------------
7284-- Base
tests/Main.hs−18
@@ -1,6 +1,5 @@
11module Main (main) where
22
3−import Control.Concurrent.Async.Lifted
43import Control.Monad.IO.Class
54import Test.Tasty
65import Test.Tasty.HUnit
@@ -20,7 +19,6 @@ main = defaultMain $ testGroup "effectful"
2019 , testCase "stateM" test_stateM
2120 , testCase "deep stack" test_deepStack
2221 , testCase "exceptions" test_exceptions
23− , testCase "concurrency" test_concurrentState
2422 , testCase "local effects" test_localEffects
2523 ]
2624 ]
@@ -89,22 +87,6 @@ test_exceptions = runIOE $ do
8987 _ <- E.throwM Ex
9088 modify @Int (+2)
9189
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−
10890test_localEffects :: Assertion
10991test_localEffects = runIOE $ do
11092 x <- runHasInt 0 $ do