diff options
author | 2015-04-03 16:48:30 -0400 | |
---|---|---|
committer | 2015-04-03 16:48:30 -0400 | |
commit | d660e2443b99817a33127443e5d7314c99c291fc (patch) | |
tree | 4ae14e3f1d2c58c4ffd075ccee9d6b59caa0665f /Utility/Metered.hs | |
parent | ff10867b8d11c734bc971f6fa4e86be94c15a7b1 (diff) |
WIP on making --quiet silence progress, and infra for concurrent progress bars
Diffstat (limited to 'Utility/Metered.hs')
-rw-r--r-- | Utility/Metered.hs | 31 |
1 files changed, 22 insertions, 9 deletions
diff --git a/Utility/Metered.hs b/Utility/Metered.hs index 7d6e71cdd..baeea0f59 100644 --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -18,6 +18,7 @@ import Foreign.Storable (Storable(sizeOf)) import System.Posix.Types import Data.Int import Data.Bits.Utils +import Control.Concurrent.Async {- An action that can be run repeatedly, updating it on the bytes processed. - @@ -146,7 +147,7 @@ defaultChunkSize = 32 * k - chunkOverhead chunkOverhead = 2 * sizeOf (undefined :: Int) -- GHC specific {- Parses the String looking for a command's progress output, and returns - - Maybe the number of bytes rsynced so far, and any any remainder of the + - Maybe the number of bytes done so far, and any any remainder of the - string that could be an incomplete progress output. That remainder - should be prepended to future output, and fed back in. This interface - allows the command's output to be read in any desired size chunk, or @@ -154,12 +155,23 @@ defaultChunkSize = 32 * k - chunkOverhead -} type ProgressParser = String -> (Maybe BytesProcessed, String) +data ProgressHandler = ProgressHandler + { quietMode :: Bool -- don't forward output to stdout + , stderrHandler :: Handle -> IO () -- callback to handle stderr + , meterUpdate :: MeterUpdate -- the progress meter to update + } + {- Runs a command and runs a ProgressParser on its output, in order - - to update the meter. The command's output is also sent to stdout. -} -commandMeter :: ProgressParser -> MeterUpdate -> FilePath -> [CommandParam] -> IO Bool -commandMeter progressparser meterupdate cmd params = liftIO $ catchBoolIO $ - withHandle StdoutHandle createProcessSuccess p $ - feedprogress zeroBytesProcessed [] + - to update a meter. + -} +commandMeter :: ProgressParser -> ProgressHandler -> FilePath -> [CommandParam] -> IO Bool +commandMeter progressparser progress cmd params = + liftIO $ catchBoolIO $ + withOEHandles createProcessSuccess p $ \(outh, errh) -> do + ep <- async $ (stderrHandler progress) errh + op <- async $ feedprogress zeroBytesProcessed [] outh + wait ep + wait op where p = proc cmd (toCommand params) @@ -168,13 +180,14 @@ commandMeter progressparser meterupdate cmd params = liftIO $ catchBoolIO $ if S.null b then return True else do - S.hPut stdout b - hFlush stdout + unless (quietMode progress) $ do + S.hPut stdout b + hFlush stdout let s = w82s (S.unpack b) let (mbytes, buf') = progressparser (buf++s) case mbytes of Nothing -> feedprogress prev buf' h (Just bytes) -> do when (bytes /= prev) $ - meterupdate bytes + (meterUpdate progress) bytes feedprogress bytes buf' h |