avoid queuing transfers that are currently running

Assistant/DaemonStatus.hs

@@ -151,6 +151,11 @@ adjustTransfersSTM dstatus a = do
 	s <- takeTMVar dstatus
 	putTMVar dstatus $ s { currentTransfers = a (currentTransfers s) }
 
+{- Checks if a transfer is currently running. -}
+checkRunningTransferSTM :: DaemonStatusHandle -> Transfer -> STM Bool
+checkRunningTransferSTM dstatus t = M.member t . currentTransfers
+	<$> readTMVar dstatus
+
 {- Alters a transfer's info, if the transfer is in the map. -}
 alterTransferInfo :: Transfer -> (TransferInfo -> TransferInfo) -> Assistant ()
 alterTransferInfo t a = updateTransferInfo' $ M.adjust a t

Assistant/TransferQueue.hs

@@ -136,14 +136,18 @@ enqueue reason schedule t info
 		notifyTransfer
 	add modlist = do
 		q <- getAssistant transferQueue
-		liftIO $ atomically $ do
+		dstatus <- getAssistant daemonStatusHandle
-			l <- readTVar (queuelist q)
+		liftIO $ atomically $ ifM (checkRunningTransferSTM dstatus t)
-			if (t `notElem` map fst l)
+			( return False
-				then do	
+			, do
-					void $ modifyTVar' (queuesize q) succ
+				l <- readTVar (queuelist q)
-					void $ modifyTVar' (queuelist q) modlist
+				if (t `notElem` map fst l)
-					return True
+					then do	
-				else return False
+						void $ modifyTVar' (queuesize q) succ
+						void $ modifyTVar' (queuelist q) modlist
+						return True
+					else return False
+			)
 
 {- Adds a transfer to the queue. -}
 queueTransfer :: Reason -> Schedule -> AssociatedFile -> Transfer -> Remote -> Assistant ()