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:
parent
6583448bab
commit
63ff670cc5
2 changed files with 19 additions and 5 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue