diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-08-08 17:55:56 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-08-08 17:55:56 -0400 |
| commit | 20203b45b9dbf915851969b9c5f4c9cb6e71acb6 (patch) | |
| tree | 62b352950dd0f044f1b5aaee9baa4af2e02d80fd /Assistant/TransferQueue.hs | |
| parent | 09449792fa50686e2fb9af6c392b8644dddae5d6 (diff) | |
transfer canceling
Should work (untested) for transfers being run by other processes.
Not yet by transfers being run by the assistant. killThread does not
kill processes forked off by a thread. To fix this, will probably
need to make `git annex getkey` and `git annex sendkey` commands that
operate on keys, and write their own transfer info. Then the assistant
can run them, and kill them, as needed.
Diffstat (limited to 'Assistant/TransferQueue.hs')
| -rw-r--r-- | Assistant/TransferQueue.hs | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 40adc3520..865a82915 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -13,7 +13,8 @@ module Assistant.TransferQueue ( queueTransfers, queueTransfer, queueTransferAt, - getNextTransfer + getNextTransfer, + dequeueTransfer, ) where import Common.Annex @@ -30,7 +31,7 @@ import qualified Data.Map as M - in parallel to allow for reading. -} data TransferQueue = TransferQueue { queue :: TChan (Transfer, TransferInfo) - , queuesize :: TVar Integer + , queuesize :: TVar Int , queuelist :: TVar [(Transfer, TransferInfo)] } @@ -104,7 +105,7 @@ queueTransfer schedule q dstatus f t remote = {- Blocks until the queue is no larger than a given size, and then adds a - transfer to the queue. -} -queueTransferAt :: Integer -> Schedule -> TransferQueue -> DaemonStatusHandle -> AssociatedFile -> Transfer -> Remote -> IO () +queueTransferAt :: Int -> Schedule -> TransferQueue -> DaemonStatusHandle -> AssociatedFile -> Transfer -> Remote -> IO () queueTransferAt wantsz schedule q dstatus f t remote = do atomically $ do sz <- readTVar (queuesize q) @@ -132,3 +133,12 @@ getNextTransfer q dstatus acceptable = atomically $ do M.insertWith' const t info return $ Just r else return Nothing + +{- Removes a transfer from the queue, if present, and returns True if it + - was present. -} +dequeueTransfer :: TransferQueue -> Transfer -> IO Bool +dequeueTransfer q t = atomically $ do + (l, removed) <- partition (\i -> fst i /= t) <$> readTVar (queuelist q) + void $ writeTVar (queuesize q) (length l) + void $ writeTVar (queuelist q) l + return $ not $ null removed |