Simon Hengel pushed to branch wip/sol/add-rendered-to-json-diagnostics at Glasgow Haskell Compiler / GHC
Commits:
8e9f2be1 by Simon Hengel at 2025-07-08T20:37:37+07:00
Include the rendered message in -fdiagnostics-as-json output
This implements #26173.
- - - - -
8 changed files:
- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Utils/Logger.hs
- docs/users_guide/9.14.1-notes.rst
- + docs/users_guide/diagnostics-as-json-schema-1_2.json
- docs/users_guide/using.rst
- testsuite/tests/driver/json.stderr
- testsuite/tests/driver/json_warn.stderr
Changes:
=====================================
compiler/GHC/Driver/Errors.hs
=====================================
@@ -10,6 +10,7 @@ import GHC.Prelude
import GHC.Types.SrcLoc (SrcSpan)
import GHC.Types.SourceError
import GHC.Types.Error
+import GHC.Utils.Json
import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Utils.Logger
@@ -22,9 +23,22 @@ printMessages logger msg_opts opts = mapM_ printMessage . sortMessages
printMessage :: MsgEnvelope a -> IO ()
printMessage message
- | log_diags_as_json = logJsonMsg logger messageClass message
+ | log_diags_as_json = do
+ decorated <- decorateDiagnostic logflags messageClass location doc
+ let
+ rendered :: String
+ rendered = renderWithContext (log_default_user_context logflags) decorated
+
+ jsonMessage :: JsonDoc
+ jsonMessage = jsonDiagnostic rendered message
+
+ logJsonMsg logger messageClass jsonMessage
+
| otherwise = logMsg logger messageClass location doc
where
+ logflags :: LogFlags
+ logflags = logFlags logger
+
doc :: SDoc
doc = updSDocContext (\_ -> ctx) (messageWithHints diagnostic)
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -73,6 +73,9 @@ module GHC.Types.Error
, mkLocMessage
, mkLocMessageWarningGroups
, getCaretDiagnostic
+
+ , jsonDiagnostic
+
-- * Queries
, isIntrinsicErrorMessage
, isExtrinsicErrorMessage
@@ -109,7 +112,7 @@ import GHC.Utils.Panic
import GHC.Version (cProjectVersion)
import Data.Bifunctor
-import Data.Foldable ( fold, toList )
+import Data.Foldable
import Data.List.NonEmpty ( NonEmpty (..) )
import qualified Data.List.NonEmpty as NE
import Data.List ( intercalate )
@@ -171,9 +174,6 @@ instance Diagnostic e => Outputable (Messages e) where
pprDiagnostic (errMsgDiagnostic envelope)
]
-instance (Diagnostic e) => ToJson (Messages e) where
- json msgs = JSArray . toList $ json <$> getMessages msgs
-
{- Note [Discarding Messages]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -573,7 +573,7 @@ instance ToJson DiagnosticCode where
{- Note [Diagnostic Message JSON Schema]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The below instance of ToJson must conform to the JSON schema
-specified in docs/users_guide/diagnostics-as-json-schema-1_1.json.
+specified in docs/users_guide/diagnostics-as-json-schema-1_2.json.
When the schema is altered, please bump the version.
If the content is altered in a backwards compatible way,
update the minor version (e.g. 1.3 ~> 1.4).
@@ -586,15 +586,17 @@ https://json-schema.org
-}
schemaVersion :: String
-schemaVersion = "1.1"
+schemaVersion = "1.2"
+
-- See Note [Diagnostic Message JSON Schema] before editing!
-instance Diagnostic e => ToJson (MsgEnvelope e) where
- json m = JSObject $ [
+jsonDiagnostic :: forall e. Diagnostic e => String -> MsgEnvelope e -> JsonDoc
+jsonDiagnostic rendered m = JSObject $ [
("version", JSString schemaVersion),
("ghcVersion", JSString $ "ghc-" ++ cProjectVersion),
("span", json $ errMsgSpan m),
("severity", json $ errMsgSeverity m),
("code", maybe JSNull json (diagnosticCode diag)),
+ ("rendered", JSString rendered),
("message", JSArray $ map renderToJSString diagMsg),
("hints", JSArray $ map (renderToJSString . ppr) (diagnosticHints diag) ) ]
++ [ ("reason", reasonJson)
=====================================
compiler/GHC/Utils/Logger.hs
=====================================
@@ -62,6 +62,8 @@ module GHC.Utils.Logger
, logJsonMsg
, logDumpMsg
+ , decorateDiagnostic
+
-- * Dumping
, defaultDumpAction
, putDumpFile
@@ -419,7 +421,7 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg
MCInfo -> printErrs msg
MCFatal -> printErrs msg
MCDiagnostic SevIgnore _ _ -> pure () -- suppress the message
- MCDiagnostic _sev _rea _code -> printDiagnostics
+ MCDiagnostic _sev _rea _code -> decorateDiagnostic logflags msg_class srcSpan msg >>= printErrs
where
printOut :: SDoc -> IO ()
printOut = defaultLogActionHPrintDoc logflags False out
@@ -430,23 +432,54 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg
putStrSDoc :: SDoc -> IO ()
putStrSDoc = defaultLogActionHPutStrDoc logflags False out
+-- This function is used by `defaultLogActionWithHandles` for non-JSON output,
+-- and also by `GHC.Driver.Errors.printMessages` to produce the `rendered`
+-- message on `-fdiagnostics-as-json`.
+--
+-- We would want to eventually consolidate this. However, this is currently
+-- not feasible for the following reasons:
+--
+-- 1. Some parts of the compiler sidestep `printMessages`, for that reason we
+-- can not decorate the message in `printMessages`.
+--
+-- 2. GHC uses two different code paths for JSON and non-JSON diagnostics. For
+-- that reason we can not decorate the message in `defaultLogActionWithHandles`.
+--
+-- See also Note [JSON Error Messages]:
+--
+-- `jsonLogAction` should be removed along with -ddump-json
+--
+-- Also note that (1) is the reason why some parts of the compiler produce
+-- diagnostics that don't respect `-fdiagnostics-as-json`.
+--
+-- The plan as I see it is as follows:
+--
+-- 1. Refactor all places in the compiler that report diagnostics to go
+-- through `GHC.Driver.Errors.printMessages`.
+--
+-- (It's easy to find all those places by looking for who creates
+-- MCDiagnostic, either directly or via `mkMCDiagnostic` or
+-- `errorDiagnostic`.)
+--
+-- 2. Get rid of `-ddump-json`, `jsonLogAction` and consolidate message
+-- decoration at one place (either `printMessages` or
+-- `defaultLogActionWithHandles`)
+--
+decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO SDoc
+decorateDiagnostic logflags msg_class srcSpan msg = addCaret
+ where
-- Pretty print the warning flag, if any (#10752)
message :: SDoc
message = mkLocMessageWarningGroups (log_show_warn_groups logflags) msg_class srcSpan msg
- printDiagnostics :: IO ()
- printDiagnostics = do
+ addCaret = do
caretDiagnostic <-
if log_show_caret logflags
then getCaretDiagnostic msg_class srcSpan
else pure empty
- printErrs $ getPprStyle $ \style ->
+ return $ getPprStyle $ \style ->
withPprStyle (setStyleColoured True style)
(message $+$ caretDiagnostic $+$ blankLine)
- -- careful (#2302): printErrs prints in UTF-8,
- -- whereas converting to string first and using
- -- hPutStr would just emit the low 8 bits of
- -- each unicode char.
-- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline.
defaultLogActionHPrintDoc :: LogFlags -> Bool -> Handle -> SDoc -> IO ()
@@ -611,8 +644,8 @@ defaultTraceAction logflags title doc x =
logMsg :: Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
logMsg logger mc loc msg = putLogMsg logger (logFlags logger) mc loc msg
-logJsonMsg :: ToJson a => Logger -> MessageClass -> a -> IO ()
-logJsonMsg logger mc d = putJsonLogMsg logger (logFlags logger) mc (json d)
+logJsonMsg :: Logger -> MessageClass -> JsonDoc -> IO ()
+logJsonMsg logger mc = putJsonLogMsg logger (logFlags logger) mc
-- | Dump something
logDumpFile :: Logger -> PprStyle -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
=====================================
docs/users_guide/9.14.1-notes.rst
=====================================
@@ -143,6 +143,11 @@ Compiler
were accessed using the generated record selector functions, marking the fields
as covered in coverage reports (:ghc-ticket:`17834`).
+- JSON diagnostics produced with (:ghc-flag:`-fdiagnostics-as-json`) now
+ include the `rendered` diagnostics message, in the exact same format as what
+ GHC would have produced without -fdiagnostics-as-json (including ANSI escape
+ sequences).
+
GHCi
~~~~
=====================================
docs/users_guide/diagnostics-as-json-schema-1_2.json
=====================================
@@ -0,0 +1,144 @@
+{
+ "$schema": "https://json-schema.org/draft/2020-12/schema",
+ "title": "JSON Diagnostic Schema",
+ "description": "A Schema for specifying GHC diagnostics output as JSON",
+ "type": "object",
+ "properties": {
+ "version": {
+ "description": "The current JSON schema version this object conforms to",
+ "type": "string"
+ },
+ "ghcVersion": {
+ "description": "The GHC version",
+ "type": "string"
+ },
+ "span": {
+ "oneOf": [
+ { "$ref": "#/$defs/span" },
+ { "type": "null" }
+ ]
+ },
+ "severity": {
+ "description": "The diagnostic severity",
+ "type": "string",
+ "enum": [
+ "Warning",
+ "Error"
+ ]
+ },
+ "code": {
+ "description": "The diagnostic code (if it exists)",
+ "type": [
+ "integer",
+ "null"
+ ]
+ },
+ "rendered": {
+ "description": "The rendered diagnostics message, in the exact same format as what GHC would have produced without -fdiagnostics-as-json (including ANSI escape sequences)",
+ "type": "string"
+ },
+ "message": {
+ "description": "The string output of the diagnostic message by GHC",
+ "type": "array",
+ "items": {
+ "type": "string"
+ }
+ },
+ "hints": {
+ "description": "The suggested fixes",
+ "type": "array",
+ "items": {
+ "type": "string"
+ }
+ },
+ "reason" : {
+ "description": "The GHC flag that was responsible for the emission of the diagnostic message",
+ "oneOf": [
+ {
+ "type": "object",
+ "description": "The diagnostic message was controlled by one or more GHC flags",
+ "properties": {
+ "flags": {
+ "type": "array",
+ "items": {
+ "description": "The name of a GHC flag controlling the diagnostic message",
+ "type": "string"
+ },
+ "minItems": 1
+ }
+ },
+ "required": ["flags"]
+ },
+ {
+ "type": "object",
+ "description": "The diagnostic message was controlled by a GHC diagnostic message category",
+ "properties": {
+ "category": {
+ "description": "The name of the GHC diagnostic message category controlling the diagnostic message",
+ "type": "string"
+ }
+ },
+ "required": ["category"]
+ }
+ ]
+ }
+ },
+
+ "$comment": "NOTE: \"rendered\" is not a required field so that the schema is backward compatible with version 1.1. If you bump the schema version to 2.0 the please also add \"rendered\" to the \"required\" fields.",
+ "required": [
+ "version",
+ "ghcVersion",
+ "span",
+ "severity",
+ "code",
+ "message",
+ "hints"
+ ],
+
+ "additionalProperties": false,
+ "$defs": {
+ "span": {
+ "description": "The span of the diagnostic",
+ "type": "object",
+ "properties": {
+ "file": {
+ "description": "The file in which the diagnostic occurs",
+ "type": "string"
+ },
+ "start": {
+ "description": "The start location of the diagnostic",
+ "$ref": "#/$defs/location"
+ },
+ "end": {
+ "description": "The end location of the diagnostic",
+ "$ref": "#/$defs/location"
+ }
+ },
+ "required": [
+ "file",
+ "start",
+ "end"
+ ],
+ "additionalProperties": false
+ },
+ "location": {
+ "description": "A location in a text file",
+ "type": "object",
+ "properties": {
+ "line": {
+ "description": "The line number",
+ "type": "integer"
+ },
+ "column": {
+ "description": "The column number",
+ "type": "integer"
+ }
+ },
+ "required": [
+ "line",
+ "column"
+ ],
+ "additionalProperties": false
+ }
+ }
+}
=====================================
docs/users_guide/using.rst
=====================================
@@ -1428,7 +1428,7 @@ messages and in GHCi:
a new line.
The structure of the output is described by a `JSON Schema https://json-schema.org/`_.
- The schema can be downloaded :download:`here