[Git][ghc/ghc][master] Include diagnostic reason in -fdiagnostics-as-json
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Nov 19 02:23:06 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
831aab22 by sheaf at 2024-11-18T21:22:36-05:00
Include diagnostic reason in -fdiagnostics-as-json
This commit ensures that the -fdiagnostics-as-json output includes the
diagnostic reason. This allows the full error message produced by GHC
to be re-constructed from the JSON output.
Fixes #25403
- - - - -
8 changed files:
- compiler/GHC/Types/Error.hs
- compiler/GHC/Unit/Module/Warnings.hs
- + docs/users_guide/diagnostics-as-json-schema-1_1.json
- docs/users_guide/using.rst
- testsuite/tests/driver/all.T
- testsuite/tests/driver/json.stderr
- testsuite/tests/driver/json_warn.hs
- testsuite/tests/driver/json_warn.stderr
Changes:
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -100,19 +100,23 @@ import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Hint
import GHC.Data.FastString (unpackFS)
import GHC.Data.StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)
+
+import GHC.Types.Hint.Ppr () -- Outputable instance
+import GHC.Unit.Module.Warnings (WarningCategory(..))
+
import GHC.Utils.Json
import GHC.Utils.Panic
-import GHC.Unit.Module.Warnings (WarningCategory)
+
+import GHC.Version (cProjectVersion)
import Data.Bifunctor
import Data.Foldable ( fold, toList )
import Data.List.NonEmpty ( NonEmpty (..) )
import qualified Data.List.NonEmpty as NE
import Data.List ( intercalate )
+import Data.Maybe ( maybeToList )
import Data.Typeable ( Typeable )
import Numeric.Natural ( Natural )
import Text.Printf ( printf )
-import GHC.Version (cProjectVersion)
-import GHC.Types.Hint.Ppr () -- Outputtable instance
{- Note [Messages]
~~~~~~~~~~~~~~~~~~
@@ -393,10 +397,8 @@ newtype ResolvedDiagnosticReason
pattern WarningWithFlag :: WarningFlag -> DiagnosticReason
pattern WarningWithFlag w = WarningWithFlags (w :| [])
-{-
-Note [Warnings controlled by multiple flags]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
+{- Note [Warnings controlled by multiple flags]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Diagnostics that started life as flag-controlled warnings have a
'diagnosticReason' of 'WarningWithFlags', giving the flags that control the
warning. Usually there is only one flag, but in a few cases multiple flags
@@ -563,11 +565,11 @@ 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_0.json.
+specified in docs/users_guide/diagnostics-as-json-schema-1_1.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).
-If the content is breaking, update the major version (e.g. 1.3 ~> 2.3).
+If the content is breaking, update the major version (e.g. 1.3 ~> 2.0).
When updating the schema, replace the above file and name it appropriately with
the version appended, and change the documentation of the -fdiagnostics-as-json
flag to reflect the new schema.
@@ -576,25 +578,41 @@ https://json-schema.org
-}
schemaVersion :: String
-schemaVersion = "1.0"
+schemaVersion = "1.1"
-- See Note [Diagnostic Message JSON Schema] before editing!
instance Diagnostic e => ToJson (MsgEnvelope e) where
- json m = JSObject [
+ json m = JSObject $ [
("version", JSString schemaVersion),
("ghcVersion", JSString $ "ghc-" ++ cProjectVersion),
("span", json $ errMsgSpan m),
("severity", json $ errMsgSeverity m),
("code", maybe JSNull json (diagnosticCode diag)),
("message", JSArray $ map renderToJSString diagMsg),
- ("hints", JSArray $ map (renderToJSString . ppr) (diagnosticHints diag) )
- ]
- where diag = errMsgDiagnostic m
- opts = defaultDiagnosticOpts @e
- style = mkErrStyle (errMsgContext m)
- ctx = defaultSDocContext {sdocStyle = style }
- diagMsg = filter (not . isEmpty ctx) (unDecorated (diagnosticMessage (opts) diag))
- renderToJSString :: SDoc -> JsonDoc
- renderToJSString = JSString . (renderWithContext ctx)
+ ("hints", JSArray $ map (renderToJSString . ppr) (diagnosticHints diag) ) ]
+ ++ [ ("reason", reasonJson)
+ | reasonJson <- maybeToList $ usefulReasonJson_maybe (errMsgReason m) ]
+ where
+ diag = errMsgDiagnostic m
+ opts = defaultDiagnosticOpts @e
+ style = mkErrStyle (errMsgContext m)
+ ctx = defaultSDocContext {sdocStyle = style }
+ diagMsg = filter (not . isEmpty ctx) (unDecorated (diagnosticMessage (opts) diag))
+ renderToJSString :: SDoc -> JsonDoc
+ renderToJSString = JSString . (renderWithContext ctx)
+
+ usefulReasonJson_maybe :: ResolvedDiagnosticReason -> Maybe JsonDoc
+ usefulReasonJson_maybe (ResolvedDiagnosticReason rea) =
+ case rea of
+ WarningWithoutFlag -> Nothing
+ ErrorWithoutFlag -> Nothing
+ WarningWithFlags flags ->
+ Just $ JSObject
+ [ ("flags", JSArray $ map (JSString . NE.head . warnFlagNames) (NE.toList flags))
+ ]
+ WarningWithCategory (WarningCategory cat) ->
+ Just $ JSObject
+ [ ("category", JSString $ unpackFS cat)
+ ]
instance Show (MsgEnvelope DiagnosticMessage) where
show = showMsgEnvelope
=====================================
compiler/GHC/Unit/Module/Warnings.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -130,7 +131,8 @@ fromWarningCategory wc = InWarningCategory noAnn NoSourceText (noLocA wc)
-- See Note [Warning categories]
newtype WarningCategory = WarningCategory FastString
- deriving (Binary, Data, Eq, Outputable, Show, Uniquable, NFData)
+ deriving stock Data
+ deriving newtype (Binary, Eq, Outputable, Show, Uniquable, NFData)
mkWarningCategory :: FastString -> WarningCategory
mkWarningCategory = WarningCategory
=====================================
docs/users_guide/diagnostics-as-json-schema-1_1.json
=====================================
@@ -0,0 +1,134 @@
+{
+ "$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": {
+ "$ref": "#/$defs/span"
+ },
+ "severity": {
+ "description": "The diagnostic severity",
+ "type": "string",
+ "enum": [
+ "Warning",
+ "Error"
+ ]
+ },
+ "code": {
+ "description": "The diagnostic code (if it exists)",
+ "type": [
+ "integer",
+ "null"
+ ]
+ },
+ "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"]
+ }
+ ]
+ }
+ },
+ "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
=====================================
@@ -1424,7 +1424,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 <diagnostics-as-json-schema-1_0.json>`.
+ The schema can be downloaded :download:`here <diagnostics-as-json-schema-1_1.json>`.
.. ghc-flag:: -fdiagnostics-color=⟨always|auto|never⟩
:shortdesc: Use colors in error messages
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -276,7 +276,7 @@ test('T12955', normal, makefile_test, [])
test('T12971', [when(opsys('mingw32'), fragile(17945)), ignore_stdout], makefile_test, [])
test('json_dump', normal, compile_fail, ['-ddump-json'])
test('json', normalise_version('ghc'), compile_fail, ['-fdiagnostics-as-json'])
-test('json_warn', normalise_version('ghc'), compile, ['-fdiagnostics-as-json -Wunused-matches'])
+test('json_warn', normalise_version('ghc'), compile, ['-fdiagnostics-as-json -Wunused-matches -Wx-partial'])
test('json2', normalise_version('ghc-internal', 'base','ghc-prim'), compile, ['-ddump-types -ddump-json -Wno-unsupported-llvm-version'])
test('T16167', [normalise_version('ghc'),req_interp,exit_code(1)], run_command,
['{compiler} -x hs -e ":set prog T16167.hs" -ddump-json T16167.hs'])
=====================================
testsuite/tests/driver/json.stderr
=====================================
@@ -1 +1 @@
-{"version":"1.0","ghcVersion":"ghc-9.11.20240329","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 `EmptyCase' extension"]}
+{"version":"1.1","ghcVersion":"ghc-9.13.20241113","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 `EmptyCase' extension"]}
=====================================
testsuite/tests/driver/json_warn.hs
=====================================
@@ -2,3 +2,6 @@ module Foo where
f :: Int -> Int
f x = 5
+
+g :: [a] -> a
+g = head
=====================================
testsuite/tests/driver/json_warn.stderr
=====================================
@@ -1 +1,2 @@
-{"version":"1.0","ghcVersion":"ghc-9.9.20230817","span":{"file":"json_warn.hs","start":{"line":4,"column":3},"end":{"line":4,"column":4}},"severity":"Warning","code":40910,"message":["Defined but not used: `x'"],"hints":[]}
+{"version":"1.1","ghcVersion":"ghc-9.13.20241113","span":{"file":"json_warn.hs","start":{"line":4,"column":3},"end":{"line":4,"column":4}},"severity":"Warning","code":40910,"message":["Defined but not used: `x'"],"hints":[],"reason":{"flags":["unused-matches"]}}
+{"version":"1.1","ghcVersion":"ghc-9.13.20241113","span":{"file":"json_warn.hs","start":{"line":7,"column":5},"end":{"line":7,"column":9}},"severity":"Warning","code":63394,"message":["In the use of `head'\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/831aab2238e682e2977b4959afa100df928cec09
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/831aab2238e682e2977b4959afa100df928cec09
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241118/b2cd1960/attachment-0001.html>
More information about the ghc-commits
mailing list