@@ -10,10 +10,13 @@ module Development.IDE.Core.WorkerThread
10
10
(withWorkerQueue , awaitRunInThread )
11
11
where
12
12
13
- import Control.Concurrent.Async (withAsync )
13
+ import Control.Concurrent.Async (AsyncCancelled (AsyncCancelled ),
14
+ withAsync )
14
15
import Control.Concurrent.STM
15
16
import Control.Concurrent.Strict (newBarrier , signalBarrier ,
16
17
waitBarrier )
18
+ import Control.Exception.Safe (Exception (fromException ),
19
+ SomeException , throwIO , try )
17
20
import Control.Monad (forever )
18
21
import Control.Monad.Cont (ContT (ContT ))
19
22
@@ -42,13 +45,15 @@ withWorkerQueue workerAction = ContT $ \mainAction -> do
42
45
workerAction l
43
46
44
47
-- | 'awaitRunInThread' queues up an 'IO' action to be run by a worker thread,
45
- -- and then blocks until the result is computed.
48
+ -- and then blocks until the result is computed. If the action throws an
49
+ -- non-async exception, it is rethrown in the calling thread.
46
50
awaitRunInThread :: TQueue (IO () ) -> IO result -> IO result
47
51
awaitRunInThread q act = do
48
52
-- Take an action from TQueue, run it and
49
53
-- use barrier to wait for the result
50
54
barrier <- newBarrier
51
- atomically $ writeTQueue q $ do
52
- res <- act
53
- signalBarrier barrier res
54
- waitBarrier barrier
55
+ atomically $ writeTQueue q $ try act >>= signalBarrier barrier
56
+ resultOrException <- waitBarrier barrier
57
+ case resultOrException of
58
+ Left e -> throwIO (e :: SomeException )
59
+ Right r -> return r
0 commit comments