well along the way to fully quiet --quiet

Came up with a generic way to filter out progress messages while keeping
errors, for commands that use stderr for both.

--json mode will disable command outputs too.

5 files changed, 19 insertions, 14 deletions

diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
index 27844c262..2770f30ae 100644
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@@ -289,15 +289,15 @@ ariaParams ps = do
 	return (ps ++ opts)
 
 runAria :: [CommandParam] -> Annex Bool
-runAria ps = liftIO . boolSystem "aria2c" =<< ariaParams ps
+runAria ps = progressCommand "aria2c" =<< ariaParams ps
 
 -- Parse aria output to find "(n%)" and update the progress meter
 -- with it.
 ariaProgress :: Maybe Integer -> MeterUpdate -> [CommandParam] -> Annex Bool
 ariaProgress Nothing _ ps = runAria ps
 ariaProgress (Just sz) meter ps = do
-	h <- mkProgressHandler meter
-	liftIO . commandMeter (parseAriaProgress sz) h "aria2c"
+	oh <- mkOutputHandler
+	liftIO . commandMeter (parseAriaProgress sz) oh meter "aria2c"
 		=<< ariaParams ps
 
 parseAriaProgress :: Integer -> ProgressParser
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 01501dc9e..42f17e921 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -121,18 +121,22 @@ bup command buprepo params = do
 	showOutput -- make way for bup output
 	liftIO $ boolSystem "bup" $ bupParams command buprepo params
 
-bupSplitParams :: Remote -> BupRepo -> Key -> [CommandParam] -> Annex [CommandParam]
-bupSplitParams r buprepo k src = do
+bupSplitParams :: Remote -> BupRepo -> Key -> [CommandParam] -> [CommandParam]
+bupSplitParams r buprepo k src =
 	let os = map Param $ remoteAnnexBupSplitOptions $ gitconfig r
-	showOutput -- make way for bup output
-	return $ bupParams "split" buprepo 
+	in bupParams "split" buprepo 
 		(os ++ [Param "-q", Param "-n", Param (bupRef k)] ++ src)
 
 store :: Remote -> BupRepo -> Storer
 store r buprepo = byteStorer $ \k b p -> do
-	params <- bupSplitParams r buprepo k []
+	let params = bupSplitParams r buprepo k []
+	showOutput -- make way for bup output
 	let cmd = proc "bup" (toCommand params)
-	liftIO $ withHandle StdinHandle createProcessSuccess cmd $ \h -> do
+	runner <- ifM commandProgressDisabled
+		( return feedWithQuietOutput
+		, return (withHandle StdinHandle)
+		)
+	liftIO $ runner createProcessSuccess cmd $ \h -> do
 		meteredWrite p h b
 		return True
 
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index cbb78ee81..546e28048 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -106,8 +106,8 @@ rsyncHelper m params = do
 	a <- case m of
 		Nothing -> return $ rsync params
 		Just meter -> do
-			h <- mkProgressHandler meter
-			return $ rsyncProgress h params
+			oh <- mkOutputHandler
+			return $ rsyncProgress oh meter params
 	ifM (liftIO a)
 		( return True
 		, do
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 592564772..6df326295 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -17,6 +17,7 @@ import Config.Cost
 import Annex.UUID
 import Remote.Helper.Special
 import Utility.Env
+import Messages.Progress
 
 import qualified Data.Map as M
 
@@ -113,7 +114,7 @@ runHook hook action k f a = maybe (return False) run =<< lookupHook hook action
   where
 	run command = do
 		showOutput -- make way for hook output
-		ifM (liftIO $ boolSystemEnv "sh" [Param "-c", Param command] =<< hookEnv action k f)
+		ifM (progressCommandEnv "sh" [Param "-c", Param command] =<< liftIO (hookEnv action k f))
 			( a
 			, do
 				warning $ hook ++ " hook exited nonzero!"
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 1e7b08892..a882e081d 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -287,8 +287,8 @@ rsyncRemote direction o m params = do
 	case m of
 		Nothing -> liftIO $ rsync ps
 		Just meter -> do
-			h <- mkProgressHandler meter
-			liftIO $ rsyncProgress h ps
+			oh <- mkOutputHandler
+			liftIO $ rsyncProgress oh meter ps
   where
 	ps = opts ++ [Params "--progress"] ++ params
 	opts