avoid queuing transfers that are currently running

diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index e5c25f4cd7f13d984b7a84d8e5677527685d9326..b6c9d0a6715f26a7f1dc5d67139e73a00491c31d 100644 (file)
--- a/Assistant/DaemonStatus.hs
+++ b/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

diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs
index 0afe3cb19de6e1aac82d190363add242822ed123..ac9ed321686de39d160abb2c5f29daebb133a9fa 100644 (file)
--- a/Assistant/TransferQueue.hs
+++ b/Assistant/TransferQueue.hs
@@ -136,14 +136,18 @@ enqueue reason schedule t info
                notifyTransfer
        add modlist = do
                q <- getAssistant transferQueue
-               liftIO $ atomically $ do
-                       l <- readTVar (queuelist q)
-                       if (t `notElem` map fst l)
-                               then do 
-                                       void $ modifyTVar' (queuesize q) succ
-                                       void $ modifyTVar' (queuelist q) modlist
-                                       return True
-                               else return False
+               dstatus <- getAssistant daemonStatusHandle
+               liftIO $ atomically $ ifM (checkRunningTransferSTM dstatus t)
+                       ( return False
+                       , do
+                               l <- readTVar (queuelist q)
+                               if (t `notElem` map fst l)
+                                       then do 
+                                               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 ()