diff options
| -rw-r--r-- | Assistant/DaemonStatus.hs | 5 | ||||
| -rw-r--r-- | Assistant/TransferQueue.hs | 20 |
2 files changed, 17 insertions, 8 deletions
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index e5c25f4cd..b6c9d0a67 100644 --- 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 0afe3cb19..ac9ed3216 100644 --- 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 () |