mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

disentangle concurrency and message type

Browse source 
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.
This commit is contained in:
Joey Hess 2016-09-09 12:57:42 -04:00
parent 8e9267a1ed
commit 8ef494a833
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
12 changed files with 96 additions and 84 deletions
Download patch file Download diff file Expand all files Collapse all files

37
Messages/Progress.hs
View file

@ -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)