send stderr to json when --json-error-messages enabled

This commit is contained in:
Joey Hess 2018-02-19 15:28:38 -04:00
parent 63ff670cc5
commit 39b59c341f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 17 additions and 6 deletions

View file

@ -60,10 +60,14 @@ outputJSON jsonbuilder s = case outputType s of
_ -> return False _ -> return False
outputError :: String -> Annex () outputError :: String -> Annex ()
outputError msg = withMessageState $ \s -> outputError msg = withMessageState $ \s -> case (outputType s, jsonBuffer s) of
if concurrentOutputEnabled s (JSONOutput jsonoptions, Just jb) | jsonErrorMessages jsonoptions ->
then concurrentMessage s True msg go let jb' = Just (JSON.addErrorMessage [msg] jb)
else go in Annex.changeState $ \st ->
st { Annex.output = s { jsonBuffer = jb' }
_
| concurrentOutputEnabled s -> concurrentMessage s True msg go
| otherwise -> go
where where
go = liftIO $ do go = liftIO $ do
hFlush stdout hFlush stdout

View file

@ -15,6 +15,7 @@ module Messages.JSON (
start, start,
end, end,
finalize, finalize,
addErrorMessage,
note, note,
info, info,
add, add,
@ -29,6 +30,7 @@ import Data.Aeson
import Control.Applicative import Control.Applicative
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import System.IO import System.IO
@ -80,9 +82,12 @@ finalize :: JSONOptions -> Object -> Object
finalize jsonoptions o finalize jsonoptions o
-- Always include error-messages field, even if empty, -- Always include error-messages field, even if empty,
-- to make the json be self-documenting. -- to make the json be self-documenting.
| jsonErrorMessages jsonoptions = | jsonErrorMessages jsonoptions = addErrorMessage [] o
HM.insertWith combinearray "error-messages" (Array mempty) o
| otherwise = o | otherwise = o
addErrorMessage :: [String] -> Object -> Object
addErrorMessage msg o =
HM.insertWith combinearray "error-messages" (Array $ V.fromList msg ) o
where where
combinearray (Array new) (Array old) = Array (old <> new) combinearray (Array new) (Array old) = Array (old <> new)
combinearray new _old = new combinearray new _old = new

1
debian/control vendored
View file

@ -77,6 +77,7 @@ Build-Depends:
libghc-mountpoints-dev, libghc-mountpoints-dev,
libghc-magic-dev, libghc-magic-dev,
libghc-socks-dev, libghc-socks-dev,
libghc-vector-dev,
lsof [linux-any], lsof [linux-any],
ikiwiki, ikiwiki,
libimage-magick-perl, libimage-magick-perl,

View file

@ -350,6 +350,7 @@ Executable git-annex
persistent, persistent,
persistent-template, persistent-template,
aeson, aeson,
vector,
tagsoup, tagsoup,
unordered-containers, unordered-containers,
feed (>= 0.3.9), feed (>= 0.3.9),