mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

when canceling a transfer, also cancel all other downloads of the same key

Browse source
This commit is contained in:
Joey Hess 2012-08-29 15:24:09 -04:00
parent 9e54355e8b
commit 99525f8454
3 changed files with 14 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

7
Assistant/TransferQueue.hs
View file

@ -140,12 +140,13 @@ getNextTransfer q dstatus acceptable = atomically $ do
return $ Just r return $ Just r
else return Nothing else return Nothing
{- Removes a transfer from the queue, if present, and returns True if it {- Removes a transfer (as well as any equivilant transfers) from the queue,
- was present. -} - and returns True if anything was removed. -}
dequeueTransfer :: TransferQueue -> DaemonStatusHandle -> Transfer -> IO Bool dequeueTransfer :: TransferQueue -> DaemonStatusHandle -> Transfer -> IO Bool
dequeueTransfer q dstatus t = do dequeueTransfer q dstatus t = do
ok <- atomically $ do ok <- atomically $ do
(l, removed) <- partition (\i -> fst i /= t) <$> readTVar (queuelist q) (removed, l) <- partition (equivilantTransfer t . fst)
<$> readTVar (queuelist q)
void $ writeTVar (queuesize q) (length l) void $ writeTVar (queuesize q) (length l)
void $ writeTVar (queuelist q) l void $ writeTVar (queuelist q) l
return $ not $ null removed return $ not $ null removed

7
Assistant/WebApp/DashBoard.hs
View file

@ -57,14 +57,13 @@ transfersDisplay warnNoScript = do
isrunning info = not $ isrunning info = not $
transferPaused info || isNothing (startedTime info) transferPaused info || isNothing (startedTime info)
{- Simplifies a list of transfers, avoiding display of redundant downloads, {- Simplifies a list of transfers, avoiding display of redundant
- that appear immediately after a download of the same key. -} - equivilant transfers. -}
simplifyTransfers :: [(Transfer, TransferInfo)] -> [(Transfer, TransferInfo)] simplifyTransfers :: [(Transfer, TransferInfo)] -> [(Transfer, TransferInfo)]
simplifyTransfers [] = [] simplifyTransfers [] = []
simplifyTransfers (x:[]) = [x] simplifyTransfers (x:[]) = [x]
simplifyTransfers (v@(t1, _):r@((t2, _):l)) simplifyTransfers (v@(t1, _):r@((t2, _):l))
| transferDirection t1 == Download && transferDirection t2 == Download && | equivilantTransfer t1 t2 = simplifyTransfers (v:l)
transferKey t1 == transferKey t2 = simplifyTransfers (v:l)
| otherwise = v : (simplifyTransfers r) | otherwise = v : (simplifyTransfers r)
{- Called by client to get a display of currently in process transfers. {- Called by client to get a display of currently in process transfers.

7
Logs/Transfer.hs
View file

@ -60,6 +60,13 @@ readLcDirection "upload" = Just Upload
readLcDirection "download" = Just Download readLcDirection "download" = Just Download
readLcDirection _ = Nothing readLcDirection _ = Nothing
{- Transfers that will accomplish the same task. -}
equivilantTransfer :: Transfer -> Transfer -> Bool
equivilantTransfer t1 t2
| transferDirection t1 == Download && transferDirection t2 == Download &&
transferUUID t1 == transferUUID t2 = True
| otherwise = t1 == t2
percentComplete :: Transfer -> TransferInfo -> Maybe Percentage percentComplete :: Transfer -> TransferInfo -> Maybe Percentage
percentComplete (Transfer { transferKey = key }) info = percentComplete (Transfer { transferKey = key }) info =
percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info) percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info)