From 7be4468ffa5127f539712c72e202d19a9990984b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 9 Sep 2016 13:21:38 -0400 Subject: buffer json output until done when in concurrent mode --- Messages/Internal.hs | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) (limited to 'Messages') 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 + - Copyright 2010-2016 Joey Hess - - 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 -> -- cgit v1.2.3