From e7f42e2ec7c269ff0377e4e92136a78a24a1b8a4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 3 Dec 2020 14:47:04 -0400
Subject: [PATCH] when serializing messages, include json objects

This is done always, it's up to the comsumer to decide if it wants to
output the json objects or the messages.

Messages.JSON.finalize changed to not need a JSONOptions.
As far as I can see, this does not change its behavior,
since addErrorMessage appends to any list that's already there.

This commit was sponsored by Ethan Aubin.
---
 Messages/Internal.hs | 29 +++++++++++++++++++----------
 Messages/JSON.hs     | 12 +++++-------
 Types/Messages.hs    |  5 ++++-
 3 files changed, 28 insertions(+), 18 deletions(-)

diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index 7c84b8431e..b2ae380699 100644
--- a/Messages/Internal.hs
+++ b/Messages/Internal.hs
@@ -29,26 +29,32 @@ outputMessage' jsonoutputter jsonbuilder msg = withMessageState $ \s -> case out
 		| otherwise -> liftIO $ flushed $ S.putStr msg
 	JSONOutput _ -> void $ jsonoutputter jsonbuilder s
 	QuietOutput -> q
-	SerializedOutput -> liftIO $ outputSerialized $ OutputMessage (decodeBS' msg)
+	SerializedOutput -> do
+		liftIO $ outputSerialized $ OutputMessage msg
+		void $ jsonoutputter jsonbuilder s
 
 -- Buffer changes to JSON until end is reached and then emit it.
 bufferJSON :: JSONBuilder -> MessageState -> Annex Bool
 bufferJSON jsonbuilder s = case outputType s of
-	JSONOutput jsonoptions
-		| endjson -> do
+	JSONOutput _ -> go (flushed . JSON.emit)
+	SerializedOutput -> go (outputSerialized . JSONObject . JSON.encode)
+	_ -> return False
+  where
+	go emitter
+		| endjson = do
 			Annex.changeState $ \st -> 
 				st { Annex.output = s { jsonBuffer = Nothing } }
-			maybe noop (liftIO . flushed . JSON.emit . JSON.finalize jsonoptions) json
+			maybe noop (liftIO . emitter . JSON.finalize) json
 			return True
-		| otherwise -> do
+		| otherwise = do
 			Annex.changeState $ \st ->
 			        st { Annex.output = s { jsonBuffer = json } }
 			return True
-	_ -> return False
-  where
+	
 	(json, endjson) = case jsonbuilder i of
 		Nothing -> (jsonBuffer s, False)
 		(Just (j, e)) -> (Just j, e)
+	
 	i = case jsonBuffer s of
 		Nothing -> Nothing
 		Just b -> Just (b, False)
@@ -56,11 +62,14 @@ bufferJSON jsonbuilder s = case outputType s of
 -- Immediately output JSON.
 outputJSON :: JSONBuilder -> MessageState -> Annex Bool
 outputJSON jsonbuilder s = case outputType s of
-	JSONOutput _ -> do
-		maybe noop (liftIO . flushed . JSON.emit)
+	JSONOutput _ -> go (flushed . JSON.emit)
+	SerializedOutput -> go (outputSerialized . JSONObject . JSON.encode)
+	_ -> return False
+  where
+	go emitter = do
+		maybe noop (liftIO . emitter)
 			(fst <$> jsonbuilder Nothing)
 		return True
-	_ -> return False
 
 outputError :: String -> Annex ()
 outputError msg = withMessageState $ \s -> case (outputType s, jsonBuffer s) of
diff --git a/Messages/JSON.hs b/Messages/JSON.hs
index 5c4726b2b2..4a6419b622 100644
--- a/Messages/JSON.hs
+++ b/Messages/JSON.hs
@@ -11,6 +11,7 @@ module Messages.JSON (
 	JSONBuilder,
 	JSONChunk(..),
 	emit,
+	encode,
 	none,
 	start,
 	end,
@@ -38,7 +39,6 @@ import Data.Maybe
 import Data.Monoid
 import Prelude
 
-import Types.Messages
 import Types.Command (SeekInput(..))
 import Key
 import Utility.Metered
@@ -82,12 +82,10 @@ end :: Bool -> JSONBuilder
 end b (Just (o, _)) = Just (HM.insert "success" (toJSON' b) o, True)
 end _ Nothing = Nothing
 
-finalize :: JSONOptions -> Object -> Object
-finalize jsonoptions o
-	-- Always include error-messages field, even if empty,
-	-- to make the json be self-documenting.
-	| jsonErrorMessages jsonoptions = addErrorMessage [] o
-	| otherwise = o
+-- Always include error-messages field, even if empty,
+-- to make the json be self-documenting.
+finalize :: Object -> Object
+finalize o = addErrorMessage [] o
 
 addErrorMessage :: [String] -> Object -> Object
 addErrorMessage msg o =
diff --git a/Types/Messages.hs b/Types/Messages.hs
index 22346120c8..273fd713b2 100644
--- a/Types/Messages.hs
+++ b/Types/Messages.hs
@@ -12,6 +12,8 @@ import Utility.Metered
 
 import Control.Concurrent
 import System.Console.Regions (ConsoleRegion)
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
 
 data OutputType
 	= NormalOutput
@@ -60,7 +62,8 @@ newMessageState = do
 		}
 
 data SerializedOutput
-	= OutputMessage String
+	= OutputMessage S.ByteString
 	| OutputError String
 	| ProgressMeter (Maybe Integer) MeterState MeterState
+	| JSONObject L.ByteString
 	deriving (Show, Read)