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 /Messages | |
| parent | cac7297784a4eb953f0d6108d7e67e97be9285ad (diff) | |
buffer json output until done when in concurrent mode
Diffstat (limited to 'Messages')
| -rw-r--r-- | Messages/Internal.hs | 24 |
1 files changed, 21 insertions, 3 deletions
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 -> |