diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2015-04-04 14:53:17 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2015-04-04 14:54:03 -0400 |
| commit | 8815f95d1ad0413ca35e6873f4b7b272bac629db (patch) | |
| tree | 00701e81efc5d7725d28e8fe68754fe778312188 /Utility/Metered.hs | |
| parent | 092e6b0f3f61ad3ede912a00bbbeb635ab9bc267 (diff) | |
relay external special remote stderr through progress suppression machinery (eep!)
It sounds worse than it is. ;)
Some external special remotes may run commands that display progress on
stderr. If git-annex is run with --quiet, this should filter out such
displays while letting the errors through.
Diffstat (limited to 'Utility/Metered.hs')
| -rw-r--r-- | Utility/Metered.hs | 23 |
1 files changed, 12 insertions, 11 deletions
diff --git a/Utility/Metered.hs b/Utility/Metered.hs index a4f0f88ee..54f038f81 100644 --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -197,10 +197,6 @@ commandMeter progressparser oh meterupdate cmd params = catchBoolIO $ {- Runs a command, that may display one or more progress meters on - either stdout or stderr, and prevents the meters from being displayed. - - - To suppress progress output, while displaying other messages, - - filter out lines that contain \r (typically used to reset to the - - beginning of the line when updating a progress display). - - - The other command output is handled as configured by the OutputHandler. -} demeterCommand :: OutputHandler -> FilePath -> [CommandParam] -> IO Bool @@ -209,8 +205,8 @@ demeterCommand oh cmd params = demeterCommandEnv oh cmd params Nothing demeterCommandEnv :: OutputHandler -> FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool demeterCommandEnv oh cmd params environ = catchBoolIO $ withOEHandles createProcessSuccess p $ \(outh, errh) -> do - ep <- async $ avoidprogress errh $ stderrHandler oh - op <- async $ avoidprogress outh $ \l -> + ep <- async $ avoidProgress True errh $ stderrHandler oh + op <- async $ avoidProgress True outh $ \l -> unless (quietMode oh) $ putStrLn l wait ep @@ -220,8 +216,13 @@ demeterCommandEnv oh cmd params environ = catchBoolIO $ p = (proc cmd (toCommand params)) { env = environ } - avoidprogress h emitter = unlessM (hIsEOF h) $ do - s <- hGetLine h - unless ('\r' `elem` s) $ - emitter s - avoidprogress h emitter +{- To suppress progress output, while displaying other messages, + - filter out lines that contain \r (typically used to reset to the + - beginning of the line when updating a progress display). + -} +avoidProgress :: Bool -> Handle -> (String -> IO ()) -> IO () +avoidProgress doavoid h emitter = unlessM (hIsEOF h) $ do + s <- hGetLine h + unless (doavoid && '\r' `elem` s) $ + emitter s + avoidProgress doavoid h emitter |