send stderr to json when --json-error-messages enabled
This commit is contained in:
parent
63ff670cc5
commit
39b59c341f
4 changed files with 17 additions and 6 deletions
|
@ -60,10 +60,14 @@ outputJSON jsonbuilder s = case outputType s of
|
|||
_ -> return False
|
||||
|
||||
outputError :: String -> Annex ()
|
||||
outputError msg = withMessageState $ \s ->
|
||||
if concurrentOutputEnabled s
|
||||
then concurrentMessage s True msg go
|
||||
else go
|
||||
outputError msg = withMessageState $ \s -> case (outputType s, jsonBuffer s) of
|
||||
(JSONOutput jsonoptions, Just jb) | jsonErrorMessages jsonoptions ->
|
||||
let jb' = Just (JSON.addErrorMessage [msg] jb)
|
||||
in Annex.changeState $ \st ->
|
||||
st { Annex.output = s { jsonBuffer = jb' }
|
||||
_
|
||||
| concurrentOutputEnabled s -> concurrentMessage s True msg go
|
||||
| otherwise -> go
|
||||
where
|
||||
go = liftIO $ do
|
||||
hFlush stdout
|
||||
|
|
|
@ -15,6 +15,7 @@ module Messages.JSON (
|
|||
start,
|
||||
end,
|
||||
finalize,
|
||||
addErrorMessage,
|
||||
note,
|
||||
info,
|
||||
add,
|
||||
|
@ -29,6 +30,7 @@ import Data.Aeson
|
|||
import Control.Applicative
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import System.IO
|
||||
|
@ -80,9 +82,12 @@ 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
|
||||
| jsonErrorMessages jsonoptions = addErrorMessage [] o
|
||||
| otherwise = o
|
||||
|
||||
addErrorMessage :: [String] -> Object -> Object
|
||||
addErrorMessage msg o =
|
||||
HM.insertWith combinearray "error-messages" (Array $ V.fromList msg ) o
|
||||
where
|
||||
combinearray (Array new) (Array old) = Array (old <> new)
|
||||
combinearray new _old = new
|
||||
|
|
1
debian/control
vendored
1
debian/control
vendored
|
@ -77,6 +77,7 @@ Build-Depends:
|
|||
libghc-mountpoints-dev,
|
||||
libghc-magic-dev,
|
||||
libghc-socks-dev,
|
||||
libghc-vector-dev,
|
||||
lsof [linux-any],
|
||||
ikiwiki,
|
||||
libimage-magick-perl,
|
||||
|
|
|
@ -350,6 +350,7 @@ Executable git-annex
|
|||
persistent,
|
||||
persistent-template,
|
||||
aeson,
|
||||
vector,
|
||||
tagsoup,
|
||||
unordered-containers,
|
||||
feed (>= 0.3.9),
|
||||
|
|
Loading…
Reference in a new issue