avoid possibly re-adding a removed transfer when updating its info

Doesn't fix the bug I thought it'd fix, but is clearly correct.

3 files changed, 14 insertions, 13 deletions

diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index 8e3b48777..a07d19124 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -191,19 +191,21 @@ adjustTransfersSTM dstatus a = do
 	s <- takeTMVar dstatus
 	putTMVar dstatus $ s { currentTransfers = a (currentTransfers s) }
 
-{- Updates a transfer's info.
- - Preserves the transferTid and transferPaused values,
- - which are not written to disk. -}
+{- Alters a transfer's info, if the transfer is in the map. -}
+alterTransferInfo :: DaemonStatusHandle -> Transfer -> TransferInfo -> IO ()
+alterTransferInfo dstatus t info = updateTransferInfo' dstatus $
+	M.adjust (mergeTransferInfo info) t
+
+{- Updates a transfer's info. Adds the transfer to the map if necessary. -}
 updateTransferInfo :: DaemonStatusHandle -> Transfer -> TransferInfo -> IO ()
-updateTransferInfo dstatus t info =
+updateTransferInfo dstatus t info = updateTransferInfo' dstatus $
+	M.insertWith' mergeTransferInfo t info
+
+updateTransferInfo' :: DaemonStatusHandle -> (TransferMap -> TransferMap) -> IO ()
+updateTransferInfo' dstatus a =
 	notifyTransfer dstatus `after` modifyDaemonStatus_ dstatus go
 	where
-		go s = s { currentTransfers = update (currentTransfers s) }
-		update m = M.insertWith' merge t info m
-		merge new old = new
-			{ transferTid = maybe (transferTid new) Just (transferTid old)
-			, transferPaused = transferPaused new || transferPaused old
-			}
+		go s = s { currentTransfers = a (currentTransfers s) }
 
 {- Removes a transfer from the map, and returns its info. -}
 removeTransfer :: DaemonStatusHandle -> Transfer -> IO (Maybe TransferInfo)
diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs
index d720bcc45..12394373f 100644
--- a/Assistant/Threads/TransferPoller.hs
+++ b/Assistant/Threads/TransferPoller.hs
@@ -41,8 +41,7 @@ transferPollerThread st dstatus = do
 				sz <- catchMaybeIO $
 					fromIntegral . fileSize
 						<$> getFileStatus f
-				when (bytesComplete info /= sz && isJust sz) $ do
-					putStrLn $ "download size " ++ show sz
+				when (bytesComplete info /= sz && isJust sz) $
 					updateTransferInfo dstatus t info
 						{ bytesComplete = sz }
 			{- can't poll uploads -}
diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs
index fe8af9aad..31116a724 100644
--- a/Assistant/Threads/TransferWatcher.hs
+++ b/Assistant/Threads/TransferWatcher.hs
@@ -64,7 +64,7 @@ onAdd st dstatus file _ = case parseTransferFile file of
 				]
 			r <- headMaybe . filter (sameuuid t) . knownRemotes
 				<$> getDaemonStatus dstatus
-			updateTransferInfo dstatus t info
+			alterTransferInfo dstatus t info
 				{ transferRemote = r }
 		sameuuid t r = Remote.uuid r == transferUUID t