mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

use a DList for the deferred downloads queue

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

1
Assistant/Threads/Pusher.hs
View file

@ -9,7 +9,6 @@ module Assistant.Threads.Pusher where
import Assistant.Common import Assistant.Common
import Assistant.Commits import Assistant.Commits
import Assistant.Types.Commits
import Assistant.Pushes import Assistant.Pushes
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Assistant.Sync import Assistant.Sync

9
Assistant/TransferQueue.hs
View file

@ -29,6 +29,7 @@ import Types.Remote
import qualified Remote import qualified Remote
import qualified Types.Remote as Remote import qualified Types.Remote as Remote
import Annex.Wanted import Annex.Wanted
import Utility.TList
import Control.Concurrent.STM import Control.Concurrent.STM
import qualified Data.Map as M import qualified Data.Map as M
@ -94,8 +95,7 @@ queueTransfersMatching matching reason schedule k f direction
| direction == Download = do | direction == Download = do
q <- getAssistant transferQueue q <- getAssistant transferQueue
void $ liftIO $ atomically $ void $ liftIO $ atomically $
modifyTVar' (deferreddownloads q) $ consTList (deferreddownloads q) (k, f)
\l -> (k, f):l
| otherwise = noop | otherwise = noop
{- Queues any deferred downloads that can now be accomplished, leaving {- 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 -> Assistant ()
queueDeferredDownloads reason schedule = do queueDeferredDownloads reason schedule = do
q <- getAssistant transferQueue q <- getAssistant transferQueue
l <- liftIO $ atomically $ swapTVar (deferreddownloads q) [] l <- liftIO $ atomically $ readTList (deferreddownloads q)
rs <- syncDataRemotes <$> getDaemonStatus rs <- syncDataRemotes <$> getDaemonStatus
left <- filterM (queue rs) l left <- filterM (queue rs) l
unless (null left) $ unless (null left) $
liftIO $ atomically $ modifyTVar' (deferreddownloads q) $ liftIO $ atomically $ appendTList (deferreddownloads q) left
\new -> new ++ left
where where
queue rs (k, f) = do queue rs (k, f) = do
uuids <- liftAnnex $ Remote.keyLocations k uuids <- liftAnnex $ Remote.keyLocations k

5
Assistant/Types/TransferQueue.hs
View file

@ -12,11 +12,12 @@ import Logs.Transfer
import Types.Remote import Types.Remote
import Control.Concurrent.STM import Control.Concurrent.STM
import Utility.TList
data TransferQueue = TransferQueue data TransferQueue = TransferQueue
{ queuesize :: TVar Int { queuesize :: TVar Int
, queuelist :: TVar [(Transfer, TransferInfo)] , queuelist :: TVar [(Transfer, TransferInfo)]
, deferreddownloads :: TVar [(Key, AssociatedFile)] , deferreddownloads :: TList (Key, AssociatedFile)
} }
data Schedule = Next | Later data Schedule = Next | Later
@ -26,4 +27,4 @@ newTransferQueue :: IO TransferQueue
newTransferQueue = atomically $ TransferQueue newTransferQueue = atomically $ TransferQueue
<$> newTVar 0 <$> newTVar 0
<*> newTVar [] <*> newTVar []
<*> newTVar [] <*> newTList