Simon Hengel pushed to branch wip/sol/add-rendered-to-json-diagnostics at Glasgow Haskell Compiler / GHC

Commits:

8 changed files:

Changes:

  • compiler/GHC/Driver/Errors.hs
    ... ... @@ -10,6 +10,7 @@ import GHC.Prelude
    10 10
     import GHC.Types.SrcLoc (SrcSpan)
    
    11 11
     import GHC.Types.SourceError
    
    12 12
     import GHC.Types.Error
    
    13
    +import GHC.Utils.Json
    
    13 14
     import GHC.Utils.Error
    
    14 15
     import GHC.Utils.Outputable
    
    15 16
     import GHC.Utils.Logger
    
    ... ... @@ -22,9 +23,22 @@ printMessages logger msg_opts opts = mapM_ printMessage . sortMessages
    22 23
     
    
    23 24
         printMessage :: MsgEnvelope a -> IO ()
    
    24 25
         printMessage message
    
    25
    -      | log_diags_as_json = logJsonMsg logger messageClass message
    
    26
    +      | log_diags_as_json = do
    
    27
    +          decorated <- decorateDiagnostic logflags messageClass location doc
    
    28
    +          let
    
    29
    +            rendered :: String
    
    30
    +            rendered = renderWithContext (log_default_user_context logflags) decorated
    
    31
    +
    
    32
    +            jsonMessage :: JsonDoc
    
    33
    +            jsonMessage = jsonDiagnostic rendered message
    
    34
    +
    
    35
    +          logJsonMsg logger messageClass jsonMessage
    
    36
    +
    
    26 37
           | otherwise = logMsg logger messageClass location doc
    
    27 38
             where
    
    39
    +          logflags :: LogFlags
    
    40
    +          logflags = logFlags logger
    
    41
    +
    
    28 42
               doc :: SDoc
    
    29 43
               doc = updSDocContext (\_ -> ctx) (messageWithHints diagnostic)
    
    30 44
     
    

  • compiler/GHC/Types/Error.hs
    ... ... @@ -73,6 +73,9 @@ module GHC.Types.Error
    73 73
        , mkLocMessage
    
    74 74
        , mkLocMessageWarningGroups
    
    75 75
        , getCaretDiagnostic
    
    76
    +
    
    77
    +   , jsonDiagnostic
    
    78
    +
    
    76 79
        -- * Queries
    
    77 80
        , isIntrinsicErrorMessage
    
    78 81
        , isExtrinsicErrorMessage
    
    ... ... @@ -109,7 +112,7 @@ import GHC.Utils.Panic
    109 112
     
    
    110 113
     import GHC.Version (cProjectVersion)
    
    111 114
     import Data.Bifunctor
    
    112
    -import Data.Foldable    ( fold, toList )
    
    115
    +import Data.Foldable
    
    113 116
     import Data.List.NonEmpty ( NonEmpty (..) )
    
    114 117
     import qualified Data.List.NonEmpty as NE
    
    115 118
     import Data.List ( intercalate )
    
    ... ... @@ -171,9 +174,6 @@ instance Diagnostic e => Outputable (Messages e) where
    171 174
                    pprDiagnostic (errMsgDiagnostic envelope)
    
    172 175
                  ]
    
    173 176
     
    
    174
    -instance (Diagnostic e) => ToJson (Messages e) where
    
    175
    -  json msgs =  JSArray . toList $ json <$> getMessages msgs
    
    176
    -
    
    177 177
     {- Note [Discarding Messages]
    
    178 178
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    179 179
     
    
    ... ... @@ -573,7 +573,7 @@ instance ToJson DiagnosticCode where
    573 573
     {- Note [Diagnostic Message JSON Schema]
    
    574 574
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    575 575
     The below instance of ToJson must conform to the JSON schema
    
    576
    -specified in docs/users_guide/diagnostics-as-json-schema-1_1.json.
    
    576
    +specified in docs/users_guide/diagnostics-as-json-schema-1_2.json.
    
    577 577
     When the schema is altered, please bump the version.
    
    578 578
     If the content is altered in a backwards compatible way,
    
    579 579
     update the minor version (e.g. 1.3 ~> 1.4).
    
    ... ... @@ -586,15 +586,17 @@ https://json-schema.org
    586 586
     -}
    
    587 587
     
    
    588 588
     schemaVersion :: String
    
    589
    -schemaVersion = "1.1"
    
    589
    +schemaVersion = "1.2"
    
    590
    +
    
    590 591
     -- See Note [Diagnostic Message JSON Schema] before editing!
    
    591
    -instance Diagnostic e => ToJson (MsgEnvelope e) where
    
    592
    -  json m = JSObject $ [
    
    592
    +jsonDiagnostic :: forall e. Diagnostic e => String -> MsgEnvelope e -> JsonDoc
    
    593
    +jsonDiagnostic rendered m = JSObject $ [
    
    593 594
         ("version", JSString schemaVersion),
    
    594 595
         ("ghcVersion", JSString $ "ghc-" ++ cProjectVersion),
    
    595 596
         ("span", json $ errMsgSpan m),
    
    596 597
         ("severity", json $ errMsgSeverity m),
    
    597 598
         ("code", maybe JSNull json (diagnosticCode diag)),
    
    599
    +    ("rendered", JSString rendered),
    
    598 600
         ("message", JSArray $ map renderToJSString diagMsg),
    
    599 601
         ("hints", JSArray $ map (renderToJSString . ppr) (diagnosticHints diag) ) ]
    
    600 602
         ++ [ ("reason", reasonJson)
    

  • compiler/GHC/Utils/Logger.hs
    ... ... @@ -62,6 +62,8 @@ module GHC.Utils.Logger
    62 62
         , logJsonMsg
    
    63 63
         , logDumpMsg
    
    64 64
     
    
    65
    +    , decorateDiagnostic
    
    66
    +
    
    65 67
         -- * Dumping
    
    66 68
         , defaultDumpAction
    
    67 69
         , putDumpFile
    
    ... ... @@ -419,7 +421,7 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg
    419 421
           MCInfo                       -> printErrs msg
    
    420 422
           MCFatal                      -> printErrs msg
    
    421 423
           MCDiagnostic SevIgnore _ _   -> pure () -- suppress the message
    
    422
    -      MCDiagnostic _sev _rea _code -> printDiagnostics
    
    424
    +      MCDiagnostic _sev _rea _code -> decorateDiagnostic logflags msg_class srcSpan msg >>= printErrs
    
    423 425
         where
    
    424 426
           printOut :: SDoc -> IO ()
    
    425 427
           printOut = defaultLogActionHPrintDoc logflags False out
    
    ... ... @@ -430,23 +432,54 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg
    430 432
           putStrSDoc :: SDoc -> IO ()
    
    431 433
           putStrSDoc = defaultLogActionHPutStrDoc logflags False out
    
    432 434
     
    
    435
    +-- This function is used by `defaultLogActionWithHandles` for non-JSON output,
    
    436
    +-- and also by `GHC.Driver.Errors.printMessages` to produce the `rendered`
    
    437
    +-- message on `-fdiagnostics-as-json`.
    
    438
    +--
    
    439
    +-- We would want to eventually consolidate this.  However, this is currently
    
    440
    +-- not feasible for the following reasons:
    
    441
    +--
    
    442
    +-- 1. Some parts of the compiler sidestep `printMessages`, for that reason we
    
    443
    +--    can not decorate the message in `printMessages`.
    
    444
    +--
    
    445
    +-- 2. GHC uses two different code paths for JSON and non-JSON diagnostics.  For
    
    446
    +--    that reason we can not decorate the message in `defaultLogActionWithHandles`.
    
    447
    +--
    
    448
    +--    See also Note [JSON Error Messages]:
    
    449
    +--
    
    450
    +--      `jsonLogAction` should be removed along with -ddump-json
    
    451
    +--
    
    452
    +-- Also note that (1) is the reason why some parts of the compiler produce
    
    453
    +-- diagnostics that don't respect `-fdiagnostics-as-json`.
    
    454
    +--
    
    455
    +-- The plan as I see it is as follows:
    
    456
    +--
    
    457
    +--  1. Refactor all places in the compiler that report diagnostics to go
    
    458
    +--     through `GHC.Driver.Errors.printMessages`.
    
    459
    +--
    
    460
    +--     (It's easy to find all those places by looking for who creates
    
    461
    +--     MCDiagnostic, either directly or via `mkMCDiagnostic` or
    
    462
    +--     `errorDiagnostic`.)
    
    463
    +--
    
    464
    +--  2. Get rid of `-ddump-json`, `jsonLogAction` and consolidate message
    
    465
    +--     decoration at one place (either `printMessages` or
    
    466
    +--     `defaultLogActionWithHandles`)
    
    467
    +--
    
    468
    +decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO SDoc
    
    469
    +decorateDiagnostic logflags msg_class srcSpan msg = addCaret
    
    470
    +    where
    
    433 471
           -- Pretty print the warning flag, if any (#10752)
    
    434 472
           message :: SDoc
    
    435 473
           message = mkLocMessageWarningGroups (log_show_warn_groups logflags) msg_class srcSpan msg
    
    436 474
     
    
    437
    -      printDiagnostics :: IO ()
    
    438
    -      printDiagnostics = do
    
    475
    +      addCaret = do
    
    439 476
             caretDiagnostic <-
    
    440 477
                 if log_show_caret logflags
    
    441 478
                 then getCaretDiagnostic msg_class srcSpan
    
    442 479
                 else pure empty
    
    443
    -        printErrs $ getPprStyle $ \style ->
    
    480
    +        return $ getPprStyle $ \style ->
    
    444 481
               withPprStyle (setStyleColoured True style)
    
    445 482
                 (message $+$ caretDiagnostic $+$ blankLine)
    
    446
    -        -- careful (#2302): printErrs prints in UTF-8,
    
    447
    -        -- whereas converting to string first and using
    
    448
    -        -- hPutStr would just emit the low 8 bits of
    
    449
    -        -- each unicode char.
    
    450 483
     
    
    451 484
     -- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline.
    
    452 485
     defaultLogActionHPrintDoc :: LogFlags -> Bool -> Handle -> SDoc -> IO ()
    
    ... ... @@ -611,8 +644,8 @@ defaultTraceAction logflags title doc x =
    611 644
     logMsg :: Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
    
    612 645
     logMsg logger mc loc msg = putLogMsg logger (logFlags logger) mc loc msg
    
    613 646
     
    
    614
    -logJsonMsg :: ToJson a => Logger -> MessageClass -> a -> IO ()
    
    615
    -logJsonMsg logger mc d = putJsonLogMsg logger (logFlags logger) mc  (json d)
    
    647
    +logJsonMsg :: Logger -> MessageClass -> JsonDoc -> IO ()
    
    648
    +logJsonMsg logger mc = putJsonLogMsg logger (logFlags logger) mc
    
    616 649
     
    
    617 650
     -- | Dump something
    
    618 651
     logDumpFile :: Logger -> PprStyle -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    

  • docs/users_guide/9.14.1-notes.rst
    ... ... @@ -143,6 +143,11 @@ Compiler
    143 143
       were accessed using the generated record selector functions, marking the fields
    
    144 144
       as covered in coverage reports (:ghc-ticket:`17834`).
    
    145 145
     
    
    146
    +- JSON diagnostics produced with (:ghc-flag:`-fdiagnostics-as-json`) now
    
    147
    +  include the `rendered` diagnostics message, in the exact same format as what
    
    148
    +  GHC would have produced without -fdiagnostics-as-json (including ANSI escape
    
    149
    +  sequences).
    
    150
    +
    
    146 151
     GHCi
    
    147 152
     ~~~~
    
    148 153
     
    

  • docs/users_guide/diagnostics-as-json-schema-1_2.json
    1
    +{
    
    2
    +  "$schema": "https://json-schema.org/draft/2020-12/schema",
    
    3
    +  "title": "JSON Diagnostic Schema",
    
    4
    +  "description": "A Schema for specifying GHC diagnostics output as JSON",
    
    5
    +  "type": "object",
    
    6
    +  "properties": {
    
    7
    +    "version": {
    
    8
    +      "description": "The current JSON schema version this object conforms to",
    
    9
    +      "type": "string"
    
    10
    +    },
    
    11
    +    "ghcVersion": {
    
    12
    +      "description": "The GHC version",
    
    13
    +      "type": "string"
    
    14
    +    },
    
    15
    +    "span": {
    
    16
    +      "oneOf": [
    
    17
    +        { "$ref": "#/$defs/span" },
    
    18
    +        { "type": "null" }
    
    19
    +      ]
    
    20
    +    },
    
    21
    +    "severity": {
    
    22
    +      "description": "The diagnostic severity",
    
    23
    +      "type": "string",
    
    24
    +      "enum": [
    
    25
    +        "Warning",
    
    26
    +        "Error"
    
    27
    +      ]
    
    28
    +    },
    
    29
    +    "code": {
    
    30
    +      "description": "The diagnostic code (if it exists)",
    
    31
    +      "type": [
    
    32
    +        "integer",
    
    33
    +        "null"
    
    34
    +      ]
    
    35
    +    },
    
    36
    +    "rendered": {
    
    37
    +      "description": "The rendered diagnostics message, in the exact same format as what GHC would have produced without -fdiagnostics-as-json (including ANSI escape sequences)",
    
    38
    +      "type": "string"
    
    39
    +    },
    
    40
    +    "message": {
    
    41
    +      "description": "The string output of the diagnostic message by GHC",
    
    42
    +      "type": "array",
    
    43
    +      "items": {
    
    44
    +        "type": "string"
    
    45
    +      }
    
    46
    +    },
    
    47
    +    "hints": {
    
    48
    +      "description": "The suggested fixes",
    
    49
    +      "type": "array",
    
    50
    +      "items": {
    
    51
    +        "type": "string"
    
    52
    +      }
    
    53
    +    },
    
    54
    +    "reason" : {
    
    55
    +      "description": "The GHC flag that was responsible for the emission of the diagnostic message",
    
    56
    +      "oneOf": [
    
    57
    +        {
    
    58
    +          "type": "object",
    
    59
    +          "description": "The diagnostic message was controlled by one or more GHC flags",
    
    60
    +          "properties": {
    
    61
    +            "flags": {
    
    62
    +              "type": "array",
    
    63
    +              "items": {
    
    64
    +                "description": "The name of a GHC flag controlling the diagnostic message",
    
    65
    +                "type": "string"
    
    66
    +              },
    
    67
    +              "minItems": 1
    
    68
    +            }
    
    69
    +          },
    
    70
    +          "required": ["flags"]
    
    71
    +        },
    
    72
    +        {
    
    73
    +          "type": "object",
    
    74
    +          "description": "The diagnostic message was controlled by a GHC diagnostic message category",
    
    75
    +          "properties": {
    
    76
    +            "category": {
    
    77
    +              "description": "The name of the GHC diagnostic message category controlling the diagnostic message",
    
    78
    +              "type": "string"
    
    79
    +            }
    
    80
    +          },
    
    81
    +          "required": ["category"]
    
    82
    +        }
    
    83
    +      ]
    
    84
    +    }
    
    85
    +  },
    
    86
    +
    
    87
    +  "$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.",
    
    88
    +  "required": [
    
    89
    +    "version",
    
    90
    +    "ghcVersion",
    
    91
    +    "span",
    
    92
    +    "severity",
    
    93
    +    "code",
    
    94
    +    "message",
    
    95
    +    "hints"
    
    96
    +  ],
    
    97
    +
    
    98
    +  "additionalProperties": false,
    
    99
    +  "$defs": {
    
    100
    +    "span": {
    
    101
    +      "description": "The span of the diagnostic",
    
    102
    +      "type": "object",
    
    103
    +      "properties": {
    
    104
    +        "file": {
    
    105
    +          "description": "The file in which the diagnostic occurs",
    
    106
    +          "type": "string"
    
    107
    +        },
    
    108
    +        "start": {
    
    109
    +          "description": "The start location of the diagnostic",
    
    110
    +          "$ref": "#/$defs/location"
    
    111
    +        },
    
    112
    +        "end": {
    
    113
    +          "description": "The end location of the diagnostic",
    
    114
    +          "$ref": "#/$defs/location"
    
    115
    +        }
    
    116
    +      },
    
    117
    +      "required": [
    
    118
    +        "file",
    
    119
    +        "start",
    
    120
    +        "end"
    
    121
    +      ],
    
    122
    +      "additionalProperties": false
    
    123
    +    },
    
    124
    +    "location": {
    
    125
    +      "description": "A location in a text file",
    
    126
    +      "type": "object",
    
    127
    +      "properties": {
    
    128
    +        "line": {
    
    129
    +          "description": "The line number",
    
    130
    +          "type": "integer"
    
    131
    +        },
    
    132
    +        "column": {
    
    133
    +          "description": "The column number",
    
    134
    +          "type": "integer"
    
    135
    +        }
    
    136
    +      },
    
    137
    +      "required": [
    
    138
    +        "line",
    
    139
    +        "column"
    
    140
    +      ],
    
    141
    +      "additionalProperties": false
    
    142
    +    }
    
    143
    +  }
    
    144
    +}

  • docs/users_guide/using.rst
    ... ... @@ -1428,7 +1428,7 @@ messages and in GHCi:
    1428 1428
         a new line.
    
    1429 1429
     
    
    1430 1430
         The structure of the output is described by a `JSON Schema <https://json-schema.org/>`_.
    
    1431
    -    The schema can be downloaded :download:`here <diagnostics-as-json-schema-1_1.json>`.
    
    1431
    +    The schema can be downloaded :download:`here <diagnostics-as-json-schema-1_2.json>`.
    
    1432 1432
     
    
    1433 1433
     .. ghc-flag:: -fdiagnostics-color=⟨always|auto|never⟩
    
    1434 1434
         :shortdesc: Use colors in error messages
    

  • testsuite/tests/driver/json.stderr
    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"]}
    1
    +{"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
    -{"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"]}}
    
    2
    -{"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"}}
    1
    +{"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"]}}
    
    2
    +{"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"}}