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
|
_ -> 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
|
||||||
|
|
|
@ -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
1
debian/control
vendored
|
@ -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,
|
||||||
|
|
|
@ -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),
|
||||||
|
|
Loading…
Reference in a new issue