diff options
author | Joey Hess <joey@kitenet.net> | 2012-08-29 21:28:59 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-08-29 21:28:59 -0400 |
commit | 0e205184bbeff17186022f84f72c451d7fe75912 (patch) | |
tree | 738bdc19a40bc0ed2dbe5449c4e4625b0bcb2011 | |
parent | 9219f0baeec3db3d09e3369b4da12723dbca9847 (diff) |
use only one level of exception handling for transfer slot
-rw-r--r-- | Assistant/TransferSlots.hs | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 1573c2757..2633c04c9 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -69,7 +69,7 @@ inImmediateTransferSlot dstatus s gen = do runTransferThread :: DaemonStatusHandle -> TransferSlots -> Maybe (Transfer, TransferInfo, IO ()) -> IO () runTransferThread _ s Nothing = signalQSemN s 1 runTransferThread dstatus s (Just (t, info, a)) = do - tid <- forkIO $ E.bracket_ noop (signalQSemN s 1) go + tid <- forkIO $ go updateTransferInfo dstatus t $ info { transferTid = Just tid } where go = catchPauseResume a @@ -79,8 +79,11 @@ runTransferThread dstatus s (Just (t, info, a)) = do - handler, Control.Concurrent.throwTo will block sometimes - when signaling. Using E.try avoids the problem. -} catchPauseResume a' = do - r <- E.try a' + r <- E.try a' :: IO (Either E.SomeException ()) case r of - Right v -> return v - Left PauseTransfer -> pause - Left ResumeTransfer -> go + Left e -> case E.fromException e of + Just PauseTransfer -> pause + Just ResumeTransfer -> go + _ -> done + _ -> done + done = signalQSemN s 1 |