aboutsummaryrefslogtreecommitdiff
path: root/Messages/Progress.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-09-09 12:57:42 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-09-09 12:57:42 -0400
commitcac7297784a4eb953f0d6108d7e67e97be9285ad (patch)
treeca0098b875209945e15de2f63f52463487eb5e43 /Messages/Progress.hs
parent70ad04b5fc21d39bdae85b08ec948359a28021e6 (diff)
disentangle concurrency and message type
This makes -Jn work with --json and --quiet, where before setting -Jn disabled those options. Concurrent json output is currently a mess though since threads output chunks over top of one-another.
Diffstat (limited to 'Messages/Progress.hs')
-rw-r--r--Messages/Progress.hs37
1 files changed, 18 insertions, 19 deletions
diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index f6541c191..fa11c1304 100644
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -32,11 +32,11 @@ import Data.Quantity
metered :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
metered othermeter key a = case keySize key of
Nothing -> nometer
- Just size -> withOutputType (go $ fromInteger size)
+ Just size -> withMessageState (go $ fromInteger size)
where
- go _ QuietOutput = nometer
- go _ JSONOutput = nometer
- go size NormalOutput = do
+ go _ (MessageState { outputType = QuietOutput }) = nometer
+ go _ (MessageState { outputType = JSONOutput }) = nometer
+ go size (MessageState { outputType = NormalOutput, concurrentOutputEnabled = False }) = do
showOutput
(progress, meter) <- mkmeter size
m <- liftIO $ rateLimitMeterUpdate 0.1 (Just size) $ \n -> do
@@ -45,9 +45,9 @@ metered othermeter key a = case keySize key of
r <- a (combinemeter m)
liftIO $ clearMeter stdout meter
return r
+ go size (MessageState { outputType = NormalOutput, concurrentOutputEnabled = True }) =
#if WITH_CONCURRENTOUTPUT
- go size o@(ConcurrentOutput {})
- | concurrentOutputEnabled o = withProgressRegion $ \r -> do
+ withProgressRegion $ \r -> do
(progress, meter) <- mkmeter size
m <- liftIO $ rateLimitMeterUpdate 0.1 (Just size) $ \n -> do
setP progress $ fromBytesProcessed n
@@ -55,9 +55,8 @@ metered othermeter key a = case keySize key of
Regions.setConsoleRegion r ("\n" ++ s)
a (combinemeter m)
#else
- go _size _o
+ nometer
#endif
- | otherwise = nometer
mkmeter size = do
progress <- liftIO $ newProgress "" size
@@ -73,18 +72,18 @@ metered othermeter key a = case keySize key of
{- Use when the progress meter is only desired for concurrent
- output; as when a command's own progress output is preferred. -}
concurrentMetered :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
-concurrentMetered combinemeterupdate key a = withOutputType go
- where
- go (ConcurrentOutput {}) = metered combinemeterupdate key a
- go _ = a (fromMaybe nullMeterUpdate combinemeterupdate)
+concurrentMetered combinemeterupdate key a =
+ withMessageState $ \s -> if concurrentOutputEnabled s
+ then metered combinemeterupdate key a
+ else a (fromMaybe nullMeterUpdate combinemeterupdate)
{- Poll file size to display meter, but only for concurrent output. -}
concurrentMeteredFile :: FilePath -> Maybe MeterUpdate -> Key -> Annex a -> Annex a
-concurrentMeteredFile file combinemeterupdate key a = withOutputType go
- where
- go (ConcurrentOutput {}) = metered combinemeterupdate key $ \p ->
- watchFileSize file p a
- go _ = a
+concurrentMeteredFile file combinemeterupdate key a =
+ withMessageState $ \s -> if concurrentOutputEnabled s
+ then metered combinemeterupdate key $ \p ->
+ watchFileSize file p a
+ else a
{- Progress dots. -}
showProgressDots :: Annex ()
@@ -123,9 +122,9 @@ mkStderrRelayer = do
- messing it up with interleaved stderr from a command.
-}
mkStderrEmitter :: Annex (String -> IO ())
-mkStderrEmitter = withOutputType go
+mkStderrEmitter = withMessageState go
where
#ifdef WITH_CONCURRENTOUTPUT
- go o | concurrentOutputEnabled o = return Console.errorConcurrent
+ go s | concurrentOutputEnabled s = return Console.errorConcurrent
#endif
go _ = return (hPutStrLn stderr)