use a DList for the deferred downloads queue

This commit is contained in:
Joey Hess 2013-04-25 01:09:37 -04:00
parent 82a6db8fe8
commit c6da464051
3 changed files with 7 additions and 8 deletions

View file

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

View file

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

View file

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