diff options
| author |  Joey Hess <joey@kitenet.net> | 2013-04-25 01:09:37 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2013-04-25 01:26:23 -0400 |
| commit | 2efb559c7cdce21fb441343c26af4855b6ac842f (patch) | |
| tree | d8dab63676c7704e79ad83c680c9bf77f67b4439 /Assistant | |
| parent | 74c30fc1a6e88d926d07e12f4e7ffc7d897bf9f6 (diff) | |
use a DList for the deferred downloads queue
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Threads/Pusher.hs | 1 | ||||
| -rw-r--r-- | Assistant/TransferQueue.hs | 9 | ||||
| -rw-r--r-- | Assistant/Types/TransferQueue.hs | 5 |
3 files changed, 7 insertions, 8 deletions
diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index 57595b8c1..060f26cf5 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -9,7 +9,6 @@ module Assistant.Threads.Pusher where import Assistant.Common import Assistant.Commits -import Assistant.Types.Commits import Assistant.Pushes import Assistant.DaemonStatus import Assistant.Sync diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index ac9ed3216..e0b57a2ac 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -29,6 +29,7 @@ import Types.Remote import qualified Remote import qualified Types.Remote as Remote import Annex.Wanted +import Utility.TList import Control.Concurrent.STM import qualified Data.Map as M @@ -94,8 +95,7 @@ queueTransfersMatching matching reason schedule k f direction | direction == Download = do q <- getAssistant transferQueue void $ liftIO $ atomically $ - modifyTVar' (deferreddownloads q) $ - \l -> (k, f):l + consTList (deferreddownloads q) (k, f) | otherwise = noop {- Queues any deferred downloads that can now be accomplished, leaving @@ -103,12 +103,11 @@ queueTransfersMatching matching reason schedule k f direction queueDeferredDownloads :: Reason -> Schedule -> Assistant () queueDeferredDownloads reason schedule = do q <- getAssistant transferQueue - l <- liftIO $ atomically $ swapTVar (deferreddownloads q) [] + l <- liftIO $ atomically $ readTList (deferreddownloads q) rs <- syncDataRemotes <$> getDaemonStatus left <- filterM (queue rs) l unless (null left) $ - liftIO $ atomically $ modifyTVar' (deferreddownloads q) $ - \new -> new ++ left + liftIO $ atomically $ appendTList (deferreddownloads q) left where queue rs (k, f) = do uuids <- liftAnnex $ Remote.keyLocations k diff --git a/Assistant/Types/TransferQueue.hs b/Assistant/Types/TransferQueue.hs index 6620ebdf6..706c64bbb 100644 --- a/Assistant/Types/TransferQueue.hs +++ b/Assistant/Types/TransferQueue.hs @@ -12,11 +12,12 @@ import Logs.Transfer import Types.Remote import Control.Concurrent.STM +import Utility.TList data TransferQueue = TransferQueue { queuesize :: TVar Int , queuelist :: TVar [(Transfer, TransferInfo)] - , deferreddownloads :: TVar [(Key, AssociatedFile)] + , deferreddownloads :: TList (Key, AssociatedFile) } data Schedule = Next | Later @@ -26,4 +27,4 @@ newTransferQueue :: IO TransferQueue newTransferQueue = atomically $ TransferQueue <$> newTVar 0 <*> newTVar [] - <*> newTVar [] + <*> newTList |