diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2016-09-09 13:21:38 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2016-09-09 13:21:38 -0400 |
| commit | 7be4468ffa5127f539712c72e202d19a9990984b (patch) | |
| tree | 6a6bac032c7385289bd9ec5cc7033bbb8997be00 | |
| parent | cac7297784a4eb953f0d6108d7e67e97be9285ad (diff) | |
buffer json output until done when in concurrent mode
| -rw-r--r-- | CHANGELOG | 2 | ||||
| -rw-r--r-- | Messages.hs | 2 | ||||
| -rw-r--r-- | Messages/Internal.hs | 24 | ||||
| -rw-r--r-- | Types/Messages.hs | 2 |
4 files changed, 26 insertions, 4 deletions
@@ -4,6 +4,8 @@ git-annex (6.20160908) UNRELEASED; urgency=medium Was updating as frequently as changes were reported, up to hundreds of times per second, which used unncessary bandwidth when running git-annex over ssh etc. + * Make --json and --quiet work when used with -J. + Previously, -J override the other options. -- Joey Hess <id@joeyh.name> Thu, 08 Sep 2016 12:48:55 -0400 diff --git a/Messages.hs b/Messages.hs index 61702530f..b8764be55 100644 --- a/Messages.hs +++ b/Messages.hs @@ -122,7 +122,7 @@ showEndFail :: Annex () showEndFail = showEndResult False showEndResult :: Bool -> Annex () -showEndResult ok = outputMessage (JSON.end ok) $ endResult ok ++ "\n" +showEndResult ok = outputMessageFinal (JSON.end ok) $ endResult ok ++ "\n" endResult :: Bool -> String endResult True = "ok" diff --git a/Messages/Internal.hs b/Messages/Internal.hs index 5c5b19bd1..b8af2f73f 100644 --- a/Messages/Internal.hs +++ b/Messages/Internal.hs @@ -1,6 +1,6 @@ {- git-annex output messages, including concurrent output to display regions - - - Copyright 2010-2015 Joey Hess <id@joeyh.name> + - Copyright 2010-2016 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -16,12 +16,30 @@ withMessageState :: (MessageState -> Annex a) -> Annex a withMessageState a = Annex.getState Annex.output >>= a outputMessage :: IO () -> String -> Annex () -outputMessage json msg = withMessageState $ \s -> case outputType s of +outputMessage = outputMessage' False + +outputMessageFinal :: IO () -> String -> Annex () +outputMessageFinal = outputMessage' True + +outputMessage' :: Bool -> IO () -> String -> Annex () +outputMessage' endmessage json msg = withMessageState $ \s -> case outputType s of NormalOutput | concurrentOutputEnabled s -> concurrentMessage s False msg q | otherwise -> liftIO $ flushed $ putStr msg + JSONOutput + | concurrentOutputEnabled s -> + -- Buffer json fragments until end is reached. + if endmessage + then do + Annex.changeState $ \st -> + st { Annex.output = s { jsonBuffer = [] } } + liftIO $ flushed $ do + sequence_ $ reverse $ jsonBuffer s + json + else Annex.changeState $ \st -> + st { Annex.output = s { jsonBuffer = json : jsonBuffer s } } + | otherwise -> liftIO $ flushed json QuietOutput -> q - JSONOutput -> liftIO $ flushed json outputError :: String -> Annex () outputError msg = withMessageState $ \s -> diff --git a/Types/Messages.hs b/Types/Messages.hs index 597948426..368054af1 100644 --- a/Types/Messages.hs +++ b/Types/Messages.hs @@ -30,6 +30,7 @@ data MessageState = MessageState , consoleRegion :: Maybe ConsoleRegion , consoleRegionErrFlag :: Bool #endif + , jsonBuffer :: [IO ()] } instance Default MessageState @@ -43,4 +44,5 @@ instance Default MessageState , consoleRegion = Nothing , consoleRegionErrFlag = False #endif + , jsonBuffer = [] } |