catch IO exceptions in runThreadState

A few places catch IO errors after calling runThreadState,
but since the MVar was not restored, it'd later deadlock trying to read
from it.

I'd like to catch all exceptions here, but I could not get the types
to unify.

1 files changed, 5 insertions, 1 deletions

diff --git a/Assistant/ThreadedMonad.hs b/Assistant/ThreadedMonad.hs
index c4d331f61..51f579d07 100644
--- a/Assistant/ThreadedMonad.hs
+++ b/Assistant/ThreadedMonad.hs
@@ -11,6 +11,7 @@ import Common.Annex
 import qualified Annex
 
 import Control.Concurrent
+import Control.Exception (throw)
 
 {- The Annex state is stored in a MVar, so that threaded actions can access
  - it. -}
@@ -35,6 +36,9 @@ withThreadState a = do
 runThreadState :: ThreadState -> Annex a -> IO a
 runThreadState mvar a = do
 	startstate <- takeMVar mvar
-	!(r, newstate) <- Annex.run startstate a
+	-- catch IO errors and rethrow after restoring the MVar
+	!(r, newstate) <- catchIO (Annex.run startstate a) $ \e -> do
+		putMVar mvar startstate
+		throw e
 	putMVar mvar newstate
 	return r