fix repeated pause and resume of a transfer

I had an intuition that throwTo might be blocking because an exception was
caught and the exception handler was running. This seems to be the case,
and is avoided by using try. However, I can't really find anywhere in
throwTo's documentation that justifies this behavior.

1 files changed, 11 insertions, 4 deletions

diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index 3dd29a823..30163dbde 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -73,7 +73,14 @@ runTransferThread dstatus s (Just (t, info, a)) = do
 	updateTransferInfo dstatus t $ info { transferTid = Just tid }
 	where
 		go = catchPauseResume a
-		pause = catchPauseResume $ runEvery (Seconds 86400) noop
-		catchPauseResume a' = E.catch a' handlePauseResume
-		handlePauseResume PauseTransfer = pause
-		handlePauseResume ResumeTransfer = go
+		pause = catchPauseResume $ runEvery (Seconds 1) $ print "paused"
+		{- Note: This must use E.try, rather than E.catch.
+		 - When E.catch is used, and has called go in its exception
+		 - handler, Control.Concurrent.throwTo will block sometimes
+		 - when signaling. Using E.try avoids the problem. -}
+		catchPauseResume a' = do
+			r <- E.try a'
+			case r of
+				Right v -> return v
+				Left PauseTransfer -> pause
+				Left ResumeTransfer -> go