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

2 files changed, 15 insertions, 6 deletions

diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index 3731af16d..734b146b3 100644
--- a/Messages/Internal.hs
+++ b/Messages/Internal.hs
@@ -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
diff --git a/Messages/JSON.hs b/Messages/JSON.hs
index 1fe989f7f..48e48ec73 100644
--- a/Messages/JSON.hs
+++ b/Messages/JSON.hs
@@ -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