summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-03-13 13:05:30 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-03-13 13:11:49 -0400
commit3dde2f75fa5bcaf8a92665bd20936837fe02a931 (patch)
tree64d41a09af40774d729b1ce54c6eb0dc68c809df
parentd1b3a58ac750578d4c8986dead4bcd6a137fc023 (diff)
tweak
-rw-r--r--Assistant/Threads/Transferrer.hs16
-rw-r--r--Assistant/TransferQueue.hs7
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