avoid queuing transfers that are currently running

This commit is contained in:
Joey Hess 2013-04-02 16:17:06 -04:00
parent 1f4fe92f61
commit 69a80a9a4d
2 changed files with 17 additions and 8 deletions

View file

@ -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