From 99525f8454ecdcc41b37d8fcae83502ea5044d43 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 29 Aug 2012 15:24:09 -0400
Subject: when canceling a transfer, also cancel all other downloads of the
 same key

---
 Assistant/TransferQueue.hs    | 7 ++++---
 Assistant/WebApp/DashBoard.hs | 7 +++----
 Logs/Transfer.hs              | 7 +++++++
 3 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs
index fe2c667f9..2b6f1d20e 100644
--- a/Assistant/TransferQueue.hs
+++ b/Assistant/TransferQueue.hs
@@ -140,12 +140,13 @@ getNextTransfer q dstatus acceptable = atomically $ do
 			return $ Just r
 		else return Nothing
 
-{- Removes a transfer from the queue, if present, and returns True if it
- - was present. -}
+{- Removes a transfer (as well as any equivilant transfers) from the queue,
+ - and returns True if anything was removed. -}
 dequeueTransfer :: TransferQueue -> DaemonStatusHandle -> Transfer -> IO Bool
 dequeueTransfer q dstatus t = 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 (queuelist q) l
 		return $ not $ null removed
diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs
index 8b430d4d0..f21295bf6 100644
--- a/Assistant/WebApp/DashBoard.hs
+++ b/Assistant/WebApp/DashBoard.hs
@@ -57,14 +57,13 @@ transfersDisplay warnNoScript = do
 		isrunning info = not $
 			transferPaused info || isNothing (startedTime info)
 
-{- Simplifies a list of transfers, avoiding display of redundant downloads,
- - that appear immediately after a download of the same key. -}
+{- Simplifies a list of transfers, avoiding display of redundant
+ - equivilant transfers. -}
 simplifyTransfers :: [(Transfer, TransferInfo)] -> [(Transfer, TransferInfo)]
 simplifyTransfers [] = []
 simplifyTransfers (x:[]) = [x]
 simplifyTransfers (v@(t1, _):r@((t2, _):l))
-	| transferDirection t1 == Download && transferDirection t2 == Download &&
-	  transferKey t1 == transferKey t2 = simplifyTransfers (v:l)
+	| equivilantTransfer t1 t2 = simplifyTransfers (v:l)
 	| otherwise = v : (simplifyTransfers r)
 
 {- Called by client to get a display of currently in process transfers.
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 642ee7ea1..ea56035d1 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -60,6 +60,13 @@ readLcDirection "upload" = Just Upload
 readLcDirection "download" = Just Download
 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 { transferKey = key }) info =
 	percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info)
-- 
cgit v1.2.3