WIP on making --quiet silence progress, and infra for concurrent progress bars

3 files changed, 21 insertions, 8 deletions

diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
index fe49d023a..27844c262 100644
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@@ -19,6 +19,7 @@ import Logs.Web
 import Types.UrlContents
 import Types.CleanupActions
 import Types.Key
+import Messages.Progress
 import Utility.Metered
 import Utility.Tmp
 import Backend.URL
@@ -291,11 +292,12 @@ runAria :: [CommandParam] -> Annex Bool
 runAria ps = liftIO . boolSystem "aria2c" =<< ariaParams ps
 
 -- Parse aria output to find "(n%)" and update the progress meter
--- with it. The output is also output to stdout.
+-- with it.
 ariaProgress :: Maybe Integer -> MeterUpdate -> [CommandParam] -> Annex Bool
 ariaProgress Nothing _ ps = runAria ps
-ariaProgress (Just sz) meter ps =
-	liftIO . commandMeter (parseAriaProgress sz) meter "aria2c"
+ariaProgress (Just sz) meter ps = do
+	h <- mkProgressHandler meter
+	liftIO . commandMeter (parseAriaProgress sz) h "aria2c"
 		=<< ariaParams ps
 
 parseAriaProgress :: Integer -> ProgressParser
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index 3addf2384..cbb78ee81 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -17,6 +17,7 @@ import CmdLine.GitAnnexShell.Fields (Field, fieldName)
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Types.Key
 import Remote.Helper.Messages
+import Messages.Progress
 import Utility.Metered
 import Utility.Rsync
 import Types.Remote
@@ -100,9 +101,14 @@ dropKey r key = onRemote r (boolSystem, return False) "dropkey"
 	[]
 
 rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool
-rsyncHelper callback params = do
+rsyncHelper m params = do
 	showOutput -- make way for progress bar
-	ifM (liftIO $ (maybe rsync rsyncProgress callback) params)
+	a <- case m of
+		Nothing -> return $ rsync params
+		Just meter -> do
+			h <- mkProgressHandler meter
+			return $ rsyncProgress h params
+	ifM (liftIO a)
 		( return True
 		, do
 			showLongNote "rsync failed -- run git annex again to resume file transfer"
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index f39081299..1e7b08892 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -31,6 +31,7 @@ import Remote.Rsync.RsyncUrl
 import Crypto
 import Utility.Rsync
 import Utility.CopyFile
+import Messages.Progress
 import Utility.Metered
 import Utility.PID
 import Annex.Perms
@@ -281,11 +282,15 @@ showResumable a = ifM a
 	)
 
 rsyncRemote :: Direction -> RsyncOpts -> Maybe MeterUpdate -> [CommandParam] -> Annex Bool
-rsyncRemote direction o callback params = do
+rsyncRemote direction o m params = do
 	showOutput -- make way for progress bar
-	liftIO $ (maybe rsync rsyncProgress callback) $
-		opts ++ [Params "--progress"] ++ params
+	case m of
+		Nothing -> liftIO $ rsync ps
+		Just meter -> do
+			h <- mkProgressHandler meter
+			liftIO $ rsyncProgress h ps
   where
+	ps = opts ++ [Params "--progress"] ++ params
 	opts
 		| direction == Download = rsyncDownloadOptions o
 		| otherwise = rsyncUploadOptions o