From 57baf4f10040d4a963fe1a213445cb52be56d39d Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 28 Jun 2024 17:46:01 +0800 Subject: [PATCH 1/5] capture error --- .../src/Development/IDE/Core/WorkerThread.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/WorkerThread.hs b/ghcide/src/Development/IDE/Core/WorkerThread.hs index a38da77f38..6fb630fdd3 100644 --- a/ghcide/src/Development/IDE/Core/WorkerThread.hs +++ b/ghcide/src/Development/IDE/Core/WorkerThread.hs @@ -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 (Exception (fromException), + SomeException, throwIO, try) import Control.Monad (forever) import Control.Monad.Cont (ContT (ContT)) @@ -49,6 +52,13 @@ awaitRunInThread q act = do -- use barrier to wait for the result barrier <- newBarrier atomically $ writeTQueue q $ do - res <- act - signalBarrier barrier res - waitBarrier barrier + resultOrException <- try act + case resultOrException of + Left e -> case fromException e of + Just AsyncCancelled -> throwIO e -- Rethrow if it's an AsyncCancelled exception + Nothing -> signalBarrier barrier resultOrException -- Handle other exceptions as before + Right _ -> signalBarrier barrier resultOrException + resultOrException <- waitBarrier barrier + case resultOrException of + Left e -> throwIO (e :: SomeException) + Right r -> return r From 01ebd0c99e20d6d9950ad595c72ea7b1c8e55f3a Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 28 Jun 2024 17:59:40 +0800 Subject: [PATCH 2/5] cleanup --- ghcide/src/Development/IDE/Core/WorkerThread.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/WorkerThread.hs b/ghcide/src/Development/IDE/Core/WorkerThread.hs index 6fb630fdd3..d9122ea6d3 100644 --- a/ghcide/src/Development/IDE/Core/WorkerThread.hs +++ b/ghcide/src/Development/IDE/Core/WorkerThread.hs @@ -53,11 +53,12 @@ awaitRunInThread q act = do barrier <- newBarrier atomically $ writeTQueue q $ do resultOrException <- try act - case resultOrException of - Left e -> case fromException e of - Just AsyncCancelled -> throwIO e -- Rethrow if it's an AsyncCancelled exception - Nothing -> signalBarrier barrier resultOrException -- Handle other exceptions as before - Right _ -> signalBarrier barrier resultOrException + let result + -- Rethrow if it's an AsyncCancelled exception + -- we need to do this because we can handled the exit of the worker thread + | Left e <- resultOrException, Just AsyncCancelled <- fromException e = throwIO e + | otherwise = signalBarrier barrier resultOrException + result resultOrException <- waitBarrier barrier case resultOrException of Left e -> throwIO (e :: SomeException) From 204010f55c4f7d1250a9ae55db8c55820bec74e5 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 28 Jun 2024 18:01:53 +0800 Subject: [PATCH 3/5] add comment --- ghcide/src/Development/IDE/Core/WorkerThread.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/WorkerThread.hs b/ghcide/src/Development/IDE/Core/WorkerThread.hs index d9122ea6d3..17a5de0ba0 100644 --- a/ghcide/src/Development/IDE/Core/WorkerThread.hs +++ b/ghcide/src/Development/IDE/Core/WorkerThread.hs @@ -45,7 +45,8 @@ 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 From 94bced73fe099c7a490ba107dc7d603262cc0f19 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sat, 29 Jun 2024 23:06:34 +0800 Subject: [PATCH 4/5] cleanup --- ghcide/src/Development/IDE/Core/WorkerThread.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/WorkerThread.hs b/ghcide/src/Development/IDE/Core/WorkerThread.hs index 17a5de0ba0..d80316562b 100644 --- a/ghcide/src/Development/IDE/Core/WorkerThread.hs +++ b/ghcide/src/Development/IDE/Core/WorkerThread.hs @@ -54,12 +54,9 @@ awaitRunInThread q act = do barrier <- newBarrier atomically $ writeTQueue q $ do resultOrException <- try act - let result - -- Rethrow if it's an AsyncCancelled exception - -- we need to do this because we can handled the exit of the worker thread - | Left e <- resultOrException, Just AsyncCancelled <- fromException e = throwIO e - | otherwise = signalBarrier barrier resultOrException - result + case resultOrException of + Left e@(fromException -> Just AsyncCancelled) -> throwIO e + _ -> signalBarrier barrier resultOrException resultOrException <- waitBarrier barrier case resultOrException of Left e -> throwIO (e :: SomeException) From e19834cc91f216db2e9c8e844889cb53b0b5b81c Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 1 Jul 2024 23:29:02 +0800 Subject: [PATCH 5/5] use safe try that does not catch the asyncException --- ghcide/src/Development/IDE/Core/WorkerThread.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/WorkerThread.hs b/ghcide/src/Development/IDE/Core/WorkerThread.hs index d80316562b..6d141c7ef3 100644 --- a/ghcide/src/Development/IDE/Core/WorkerThread.hs +++ b/ghcide/src/Development/IDE/Core/WorkerThread.hs @@ -15,7 +15,7 @@ import Control.Concurrent.Async (AsyncCancelled (AsyncCancelled), import Control.Concurrent.STM import Control.Concurrent.Strict (newBarrier, signalBarrier, waitBarrier) -import Control.Exception (Exception (fromException), +import Control.Exception.Safe (Exception (fromException), SomeException, throwIO, try) import Control.Monad (forever) import Control.Monad.Cont (ContT (ContT)) @@ -52,11 +52,7 @@ 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 - resultOrException <- try act - case resultOrException of - Left e@(fromException -> Just AsyncCancelled) -> throwIO e - _ -> signalBarrier barrier resultOrException + atomically $ writeTQueue q $ try act >>= signalBarrier barrier resultOrException <- waitBarrier barrier case resultOrException of Left e -> throwIO (e :: SomeException)