diff options
author | Joey Hess <joey@kitenet.net> | 2013-03-13 13:05:30 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-03-13 13:11:49 -0400 |
commit | 3dde2f75fa5bcaf8a92665bd20936837fe02a931 (patch) | |
tree | 64d41a09af40774d729b1ce54c6eb0dc68c809df /Assistant | |
parent | d1b3a58ac750578d4c8986dead4bcd6a137fc023 (diff) |
tweak
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/Threads/Transferrer.hs | 16 | ||||
-rw-r--r-- | Assistant/TransferQueue.hs | 7 |
2 files changed, 15 insertions, 8 deletions
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs index d8212768a..e75b5acae 100644 --- a/Assistant/Threads/Transferrer.hs +++ b/Assistant/Threads/Transferrer.hs @@ -35,9 +35,13 @@ transfererThread = namedThread "Transferrer" $ do {- Skip transfers that are already running. -} notrunning = isNothing . startedTime -{- By the time this is called, the daemonstatus's transfer map should +{- By the time this is called, the daemonstatus's currentTransfers map should - already have been updated to include the transfer. -} -startTransfer :: FilePath -> Transfer -> TransferInfo -> Assistant (Maybe (Transfer, TransferInfo, Assistant ())) +startTransfer + :: FilePath + -> Transfer + -> TransferInfo + -> Assistant (Maybe (Transfer, TransferInfo, Assistant ())) startTransfer program t info = case (transferRemote info, associatedFile info) of (Just remote, Just file) -> ifM (liftAnnex $ shouldTransfer t info) ( do @@ -45,7 +49,8 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o notifyTransfer return $ Just (t, info, transferprocess remote file) , do - debug [ "Skipping unnecessary transfer:" , describeTransfer t info ] + debug [ "Skipping unnecessary transfer:", + describeTransfer t info ] void $ removeTransfer t finishedTransfer t (Just info) return Nothing @@ -57,8 +62,9 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o transferprocess remote file = void $ do (_, _, _, pid) - <- liftIO $ createProcess (proc program $ toCommand params) - { create_group = True } + <- liftIO $ createProcess + (proc program $ toCommand params) + { create_group = True } {- Alerts are only shown for successful transfers. - Transfers can temporarily fail for many reasons, - so there's no point in bothering the user about diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index bf2f5f03b..5974c70d1 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -58,14 +58,14 @@ queueTransfersMatching matching reason schedule k f direction | otherwise = go where go = do - rs <- liftAnnex . sufficientremotes + rs <- liftAnnex . selectremotes =<< syncDataRemotes <$> getDaemonStatus let matchingrs = filter (matching . Remote.uuid) rs if null matchingrs then defer else forM_ matchingrs $ \r -> enqueue reason schedule (gentransfer r) (stubInfo f r) - sufficientremotes rs + selectremotes rs {- Queue downloads from all remotes that - have the key, with the cheapest ones first. - More expensive ones will only be tried if @@ -107,7 +107,8 @@ queueDeferredDownloads reason schedule = do let sources = filter (\r -> uuid r `elem` uuids) rs unless (null sources) $ forM_ sources $ \r -> - enqueue reason schedule (gentransfer r) (stubInfo f r) + enqueue reason schedule + (gentransfer r) (stubInfo f r) return $ null sources where gentransfer r = Transfer |