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.

1 files changed, 16 insertions, 23 deletions

diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index cb55a8c28..24efe0156 100644
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -49,33 +49,26 @@ showProgressDots :: Annex ()
 showProgressDots = handleMessage q $
 	flushed $ putStr "."
 
-{- Runs a command, that normally outputs progress to the specified handle.
+{- Runs a command, that may output progress to either stdout or
+ - stderr, as well as other messages.
  -
- - In quiet mode, normal output is suppressed. stderr is fed through the
- - mkStderrEmitter. If the progress is output to stderr, then stderr is
- - dropped, unless the command fails in which case the last line of output
- - to stderr will be shown.
+ - In quiet mode, the output is suppressed, except for error messages.
  -}
-progressCommand :: Handle -> FilePath -> [CommandParam] -> Annex Bool
-progressCommand progresshandle cmd params = undefined
+progressCommand :: FilePath -> [CommandParam] -> Annex Bool
+progressCommand cmd params = progressCommandEnv cmd params Nothing
 
-mkProgressHandler :: MeterUpdate -> Annex ProgressHandler
-mkProgressHandler meter = ProgressHandler
-	<$> commandProgressDisabled
-	<*> (stderrhandler <$> mkStderrEmitter)
-	<*> pure meter
-  where
-	stderrhandler emitter h = unlessM (hIsEOF h) $ do
-		void $ emitter =<< hGetLine h
-		stderrhandler emitter h
+progressCommandEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> Annex Bool
+progressCommandEnv cmd params environ = ifM commandProgressDisabled
+	( do
+		oh <- mkOutputHandler
+		liftIO $ demeterCommandEnv oh cmd params environ
+	, liftIO $ boolSystemEnv cmd params environ
+	)
 
-{- Should commands that normally output progress messages have that
- - output disabled? -}
-commandProgressDisabled :: Annex Bool
-commandProgressDisabled = withOutputType $ \t -> return $ case t of
-	QuietOutput -> True
-	ProgressOutput -> True
-	_ -> False
+mkOutputHandler :: Annex OutputHandler
+mkOutputHandler = OutputHandler
+	<$> commandProgressDisabled
+	<*> mkStderrEmitter
 
 {- Generates an IO action that can be used to emit stderr.
  -