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.
This commit is contained in:
Joey Hess 2012-08-28 14:19:11 -04:00
parent 7024a973b2
commit 1296cfb09a
4 changed files with 22 additions and 13 deletions

View file

@ -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)

View file

@ -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 -}

View file

@ -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

View file

@ -215,6 +215,14 @@ readTransferInfo mpid s =
(bits, filebits) = splitAt 1 $ lines s
filename = join "\n" filebits
{- Preserves the old transferTid and transferPaused values,
- which are not written to disk. -}
mergeTransferInfo :: TransferInfo -> TransferInfo -> TransferInfo
mergeTransferInfo new old = new
{ transferTid = maybe (transferTid new) Just (transferTid old)
, transferPaused = transferPaused new || transferPaused old
}
parsePOSIXTime :: String -> Maybe POSIXTime
parsePOSIXTime s = utcTimeToPOSIXSeconds
<$> parseTime defaultTimeLocale "%s%Qs" s