always include error-messages field when --json-error-messages

Always include error-messages field, even if empty,
to make the json be self-documenting.

This was a design requirement for --json-error-messages.

This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
Joey Hess 2018-02-19 14:59:30 -04:00
parent 6583448bab
commit 63ff670cc5
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 19 additions and 5 deletions

View file

@ -11,7 +11,8 @@ import Common
import Annex
import Types.Messages
import Messages.Concurrent
import Messages.JSON
import qualified Messages.JSON as JSON
import Messages.JSON (JSONBuilder)
withMessageState :: (MessageState -> Annex a) -> Annex a
withMessageState a = Annex.getState Annex.output >>= a
@ -30,11 +31,11 @@ outputMessage' jsonoutputter jsonbuilder msg = withMessageState $ \s -> case out
-- 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 _
JSONOutput jsonoptions
| endjson -> do
Annex.changeState $ \st ->
st { Annex.output = s { jsonBuffer = Nothing } }
maybe noop (liftIO . flushed . emit) json
maybe noop (liftIO . flushed . JSON.emit . JSON.finalize jsonoptions) json
return True
| otherwise -> do
Annex.changeState $ \st ->
@ -53,7 +54,7 @@ bufferJSON jsonbuilder s = case outputType s of
outputJSON :: JSONBuilder -> MessageState -> Annex Bool
outputJSON jsonbuilder s = case outputType s of
JSONOutput _ -> do
maybe noop (liftIO . flushed . emit)
maybe noop (liftIO . flushed . JSON.emit)
(fst <$> jsonbuilder Nothing)
return True
_ -> return False

View file

@ -1,6 +1,6 @@
{- git-annex command-line JSON output and input
-
- Copyright 2011-2016 Joey Hess <id@joeyh.name>
- Copyright 2011-2018 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -14,6 +14,7 @@ module Messages.JSON (
none,
start,
end,
finalize,
note,
info,
add,
@ -37,6 +38,7 @@ import Data.Maybe
import Data.Monoid
import Prelude
import Types.Messages
import Key
import Utility.Metered
import Utility.Percentage
@ -74,6 +76,17 @@ 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 =
HM.insertWith combinearray "error-messages" (Array mempty) o
| otherwise = o
where
combinearray (Array new) (Array old) = Array (old <> new)
combinearray new _old = new
note :: String -> JSONBuilder
note _ Nothing = Nothing
note s (Just (o, e)) = Just (HM.insertWith combinelines "note" (toJSON s) o, e)