avoid sending uploads right back to where the download came from

Just an optimisation.
This commit is contained in:
Joey Hess 2012-09-18 14:24:51 -04:00
parent 3a0cffcfed
commit 9f05d19108
2 changed files with 13 additions and 4 deletions

View file

@ -11,6 +11,7 @@ module Assistant.TransferQueue (
newTransferQueue,
getTransferQueue,
queueTransfers,
queueTransfersMatching,
queueDeferredDownloads,
queueTransfer,
queueTransferAt,
@ -57,12 +58,18 @@ stubInfo f r = stubTransferInfo
{- Adds transfers to queue for some of the known remotes. -}
queueTransfers :: Schedule -> TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex ()
queueTransfers schedule q dstatus k f direction = do
queueTransfers = queueTransfersMatching (const True)
{- Adds transfers to queue for some of the known remotes, that match a
- predicate. -}
queueTransfersMatching :: (UUID -> Bool) -> Schedule -> TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex ()
queueTransfersMatching pred schedule q dstatus k f direction = do
rs <- sufficientremotes
=<< knownRemotes <$> liftIO (getDaemonStatus dstatus)
if null rs
let matchingrs = filter (pred . Remote.uuid) rs
if null matchingrs
then defer
else forM_ rs $ \r -> liftIO $
else forM_ matchingrs $ \r -> liftIO $
enqueue schedule q dstatus (gentransfer r) (stubInfo f r)
where
sufficientremotes rs