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.

diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index 7c84b8431eb653194e6c35880a08ebc0a3bd934b..b2ae380699506ebdd04a3ea1e72d0e54da1c38da 100644 (file)
--- 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 5c4726b2b27eccb512a9beb7b5c5dfdd636eeaec..4a6419b622259417041136a48e6e50e40cab671e 100644 (file)
--- 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 22346120c8b2ea2f97243485bcb76ca349bd2129..273fd713b2c9bd56256298ae2a51300df46ae609 100644 (file)
--- 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)