@@ -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 )
1415import Control.Concurrent.STM
1516import Control.Concurrent.Strict (newBarrier , signalBarrier ,
1617 waitBarrier )
18+ import Control.Exception.Safe (Exception (fromException ),
19+ SomeException , throwIO , try )
1720import Control.Monad (forever )
1821import 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.
4650awaitRunInThread :: TQueue (IO () ) -> IO result -> IO result
4751awaitRunInThread 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