more generic

Assistant/TransferQueue.hs

@@ -15,7 +15,7 @@ module Assistant.TransferQueue (
 	queueTransferAt,
 	queueTransferWhenSmall,
 	getNextTransfer,
-	dequeueTransfer,
+	dequeueTransfers,
 ) where
 
 import Common.Annex
@@ -140,20 +140,20 @@ getNextTransfer q dstatus acceptable = atomically $ do
 			return $ Just r
 		else return Nothing
 
-{- Removes a transfer (as well as any equivilant transfers) from the queue,
+{- Removes transfers matching a condition from the queue, and returns the
- - and returns True if anything was removed. -}
+ - removed transfers. -}
-dequeueTransfer :: TransferQueue -> DaemonStatusHandle -> Transfer -> IO Bool
+dequeueTransfers :: TransferQueue -> DaemonStatusHandle -> (Transfer -> Bool) -> IO [(Transfer, TransferInfo)]
-dequeueTransfer q dstatus t = do
+dequeueTransfers q dstatus c = do
-	ok <- atomically $ do
+	removed <- atomically $ do
-		(removed, ls) <- partition (equivilantTransfer t . fst)
+		(removed, ls) <- partition (c . fst)
 			<$> readTVar (queuelist q)
 		void $ writeTVar (queuesize q) (length ls)
 		void $ writeTVar (queuelist q) ls
 		drain
 		forM_ ls $ unGetTChan (queue q)
-		return $ not $ null removed
+		return removed
-	when ok $
+	unless (null removed) $
 		notifyTransfer dstatus
-	return ok
+	return removed
 	where
 		drain = maybe noop (const drain) =<< tryReadTChan (queue q)

Assistant/WebApp/DashBoard.hs

@@ -175,7 +175,8 @@ cancelTransfer pause t = do
 	liftIO $ do
 		unless pause $
 			{- remove queued transfer -}
-			void $ dequeueTransfer (transferQueue webapp) dstatus t
+			void $ dequeueTransfers (transferQueue webapp) dstatus $
+				equivilantTransfer t
 		{- stop running transfer -}
 		maybe noop (stop dstatus) (M.lookup t m)
 	where