addurl, get: Added --json-progress option, which adds progress objects to the json output.

This doesn't work right when used with -J yet, and there is some really
ugly hand-crafting of part of the json output.

1 files changed, 7 insertions, 4 deletions

diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index 21d11d811..bf212b71b 100644
--- a/Messages/Internal.hs
+++ b/Messages/Internal.hs
@@ -26,20 +26,20 @@ outputMessage' endmessage json msg = withMessageState $ \s -> case outputType s
 	NormalOutput
 		| concurrentOutputEnabled s -> concurrentMessage s False msg q
 		| otherwise -> liftIO $ flushed $ putStr msg
-	JSONOutput -> void $ outputJSON json endmessage s
+	JSONOutput _ -> void $ outputJSON json endmessage s
 	QuietOutput -> q
 
 outputJSON :: IO () -> Bool -> MessageState -> Annex Bool
 outputJSON json endmessage s = case outputType s of
-	JSONOutput
-		| concurrentOutputEnabled s -> do
+	JSONOutput withprogress
+		| withprogress || concurrentOutputEnabled s -> do
 			-- 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
+						showJSONBuffer s
 						json
 				else Annex.changeState $ \st ->
 				        st { Annex.output = s { jsonBuffer = json : jsonBuffer s } }
@@ -49,6 +49,9 @@ outputJSON json endmessage s = case outputType s of
 			return True
 	_ -> return False
 
+showJSONBuffer :: MessageState -> IO ()
+showJSONBuffer s = sequence_ $ reverse $ jsonBuffer s
+
 outputError :: String -> Annex ()
 outputError msg = withMessageState $ \s ->
 	if concurrentOutputEnabled s