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 `. + The schema can be downloaded :download:`here `. .. ghc-flag:: -fdiagnostics-color=⟨always|auto|never⟩ :shortdesc: Use colors in error messages ===================================== testsuite/tests/driver/json.stderr ===================================== @@ -1 +1 @@ -{"version":"1.1","ghcVersion":"ghc-9.13.20250529","span":{"file":"json.hs","start":{"line":9,"column":11},"end":{"line":9,"column":21}},"severity":"Error","code":48010,"message":["Empty list of alternatives in case expression"],"hints":["Perhaps you intended to use the \u2018EmptyCase\u2019 extension"]} +{"version":"1.2","ghcVersion":"ghc-9.13.20250627","span":{"file":"json.hs","start":{"line":9,"column":11},"end":{"line":9,"column":21}},"severity":"Error","code":48010,"rendered":"json.hs:9:11: error: [GHC-48010]\n Empty list of alternatives in case expression\n Suggested fix:\n Perhaps you intended to use the \u2018EmptyCase\u2019 extension\n","message":["Empty list of alternatives in case expression"],"hints":["Perhaps you intended to use the \u2018EmptyCase\u2019 extension"]} ===================================== testsuite/tests/driver/json_warn.stderr ===================================== @@ -1,2 +1,2 @@ -{"version":"1.1","ghcVersion":"ghc-9.13.20250529","span":{"file":"json_warn.hs","start":{"line":4,"column":3},"end":{"line":4,"column":4}},"severity":"Warning","code":40910,"message":["Defined but not used: \u2018x\u2019"],"hints":[],"reason":{"flags":["unused-matches"]}} -{"version":"1.1","ghcVersion":"ghc-9.13.20250529","span":{"file":"json_warn.hs","start":{"line":7,"column":5},"end":{"line":7,"column":9}},"severity":"Warning","code":63394,"message":["In the use of \u2018head\u2019\n(imported from Prelude, but defined in GHC.Internal.List):\n\"This is a partial function, it throws an error on empty lists. Use pattern matching, 'Data.List.uncons' or 'Data.Maybe.listToMaybe' instead. Consider refactoring to use \"Data.List.NonEmpty\".\""],"hints":[],"reason":{"category":"x-partial"}} +{"version":"1.2","ghcVersion":"ghc-9.13.20250627","span":{"file":"json_warn.hs","start":{"line":4,"column":3},"end":{"line":4,"column":4}},"severity":"Warning","code":40910,"rendered":"json_warn.hs:4:3: warning: [GHC-40910] [-Wunused-matches (in -Wextra)]\n Defined but not used: \u2018x\u2019\n","message":["Defined but not used: \u2018x\u2019"],"hints":[],"reason":{"flags":["unused-matches"]}} +{"version":"1.2","ghcVersion":"ghc-9.13.20250627","span":{"file":"json_warn.hs","start":{"line":7,"column":5},"end":{"line":7,"column":9}},"severity":"Warning","code":63394,"rendered":"json_warn.hs:7:5: warning: [GHC-63394] [-Wx-partial (in -Wextended-warnings)]\n In the use of \u2018head\u2019\n (imported from Prelude, but defined in GHC.Internal.List):\n \"This is a partial function, it throws an error on empty lists. Use pattern matching, 'Data.List.uncons' or 'Data.Maybe.listToMaybe' instead. Consider refactoring to use \"Data.List.NonEmpty\".\"\n","message":["In the use of \u2018head\u2019\n(imported from Prelude, but defined in GHC.Internal.List):\n\"This is a partial function, it throws an error on empty lists. Use pattern matching, 'Data.List.uncons' or 'Data.Maybe.listToMaybe' instead. Consider refactoring to use \"Data.List.NonEmpty\".\""],"hints":[],"reason":{"category":"x-partial"}} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e9f2be102e49c8452ceb14e41635202... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e9f2be102e49c8452ceb14e41635202... You're receiving this email because of your account on gitlab.haskell.org.