Skip to content

Commit f0ba40b

Browse files
authored
capture error in worker thread (#4342)
* use safe try that does not catch the asyncException
1 parent 012e809 commit f0ba40b

File tree

1 file changed

+11
-6
lines changed

1 file changed

+11
-6
lines changed

Diff for: ghcide/src/Development/IDE/Core/WorkerThread.hs

+11-6
Original file line numberDiff line numberDiff line change
@@ -10,10 +10,13 @@ module Development.IDE.Core.WorkerThread
1010
(withWorkerQueue, awaitRunInThread)
1111
where
1212

13-
import Control.Concurrent.Async (withAsync)
13+
import Control.Concurrent.Async (AsyncCancelled (AsyncCancelled),
14+
withAsync)
1415
import Control.Concurrent.STM
1516
import Control.Concurrent.Strict (newBarrier, signalBarrier,
1617
waitBarrier)
18+
import Control.Exception.Safe (Exception (fromException),
19+
SomeException, throwIO, try)
1720
import Control.Monad (forever)
1821
import Control.Monad.Cont (ContT (ContT))
1922

@@ -42,13 +45,15 @@ withWorkerQueue workerAction = ContT $ \mainAction -> do
4245
workerAction l
4346

4447
-- | '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.
4650
awaitRunInThread :: TQueue (IO ()) -> IO result -> IO result
4751
awaitRunInThread q act = do
4852
-- Take an action from TQueue, run it and
4953
-- use barrier to wait for the result
5054
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

Comments
 (0)