From e8626258f0422fb6487e79c58e5f10d51a3c1737 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 19 Feb 2018 15:28:38 -0400 Subject: send stderr to json when --json-error-messages enabled --- Messages/JSON.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'Messages/JSON.hs') 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 -- cgit v1.2.3