mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-10-03 19:57:27 +03:00
capture error in worker thread (#4342)
* use safe try that does not catch the asyncException
This commit is contained in:
parent
012e809054
commit
f0ba40baf6
@ -10,10 +10,13 @@ module Development.IDE.Core.WorkerThread
|
||||
(withWorkerQueue, awaitRunInThread)
|
||||
where
|
||||
|
||||
import Control.Concurrent.Async (withAsync)
|
||||
import Control.Concurrent.Async (AsyncCancelled (AsyncCancelled),
|
||||
withAsync)
|
||||
import Control.Concurrent.STM
|
||||
import Control.Concurrent.Strict (newBarrier, signalBarrier,
|
||||
waitBarrier)
|
||||
import Control.Exception.Safe (Exception (fromException),
|
||||
SomeException, throwIO, try)
|
||||
import Control.Monad (forever)
|
||||
import Control.Monad.Cont (ContT (ContT))
|
||||
|
||||
@ -42,13 +45,15 @@ withWorkerQueue workerAction = ContT $ \mainAction -> do
|
||||
workerAction l
|
||||
|
||||
-- | 'awaitRunInThread' queues up an 'IO' action to be run by a worker thread,
|
||||
-- and then blocks until the result is computed.
|
||||
-- and then blocks until the result is computed. If the action throws an
|
||||
-- non-async exception, it is rethrown in the calling thread.
|
||||
awaitRunInThread :: TQueue (IO ()) -> IO result -> IO result
|
||||
awaitRunInThread q act = do
|
||||
-- Take an action from TQueue, run it and
|
||||
-- use barrier to wait for the result
|
||||
barrier <- newBarrier
|
||||
atomically $ writeTQueue q $ do
|
||||
res <- act
|
||||
signalBarrier barrier res
|
||||
waitBarrier barrier
|
||||
atomically $ writeTQueue q $ try act >>= signalBarrier barrier
|
||||
resultOrException <- waitBarrier barrier
|
||||
case resultOrException of
|
||||
Left e -> throwIO (e :: SomeException)
|
||||
Right r -> return r
|
||||
|
Loading…
Reference in New Issue
Block a user