From 1296cfb09a763878e7b9376f59aabf60fb8d7314 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 28 Aug 2012 14:19:11 -0400 Subject: 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. --- Assistant/DaemonStatus.hs | 22 ++++++++++++---------- Assistant/Threads/TransferPoller.hs | 3 +-- Assistant/Threads/TransferWatcher.hs | 2 +- 3 files changed, 14 insertions(+), 13 deletions(-) (limited to 'Assistant') 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 -- cgit v1.2.3