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,55 @@ 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 (`decorateDiagnostic` + `defaultLogActionHPrintDoc`) the
    444 
    +--    message in `printMessages`.
    445 
    +--
    446 
    +-- 2. GHC uses two different code paths for JSON and non-JSON diagnostics.  For
    447 
    +--    that reason we can decorate the message in `defaultLogActionWithHandles`.
    448 
    +--
    449 
    +--    See also Note [JSON Error Messages]:
    450 
    +--
    451 
    +--      `jsonLogAction` should be removed along with -ddump-json
    452 
    +--
    453 
    +-- Also note that (1) is the reason why some parts of the compiler produce
    454 
    +-- diagnostics that don't respect `-fdiagnostics-as-json`.
    455 
    +--
    456 
    +-- The plan as I see it is as follows:
    457 
    +--
    458 
    +--  1. Refactor all places in the compiler that report diagnostics to go
    459 
    +--     through `GHC.Driver.Errors.printMessages`.
    460 
    +--
    461 
    +--     (It's easy to find all those places by looking for who creates
    462 
    +--     MCDiagnostic, either directly or via `mkMCDiagnostic` or
    463 
    +--     `errorDiagnostic`.)
    464 
    +--
    465 
    +--  2. Get rid of `-ddump-json`, `jsonLogAction` and consolidate message
    466 
    +--     decoration at one place (either `printMessages` or
    467 
    +--     `defaultLogActionWithHandles`)
    468 
    +--
    469 
    +decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO SDoc
    470 
    +decorateDiagnostic logflags msg_class srcSpan msg = addCaret
    471 
    +    where
    433 472 
           -- Pretty print the warning flag, if any (#10752)
    434 473 
           message :: SDoc
    435 474 
           message = mkLocMessageWarningGroups (log_show_warn_groups logflags) msg_class srcSpan msg
    436 475
    437 
    -      printDiagnostics :: IO ()
    438 
    -      printDiagnostics = do
    476 
    +      addCaret = do
    439 477 
             caretDiagnostic <-
    440 478 
                 if log_show_caret logflags
    441 479 
                 then getCaretDiagnostic msg_class srcSpan
    442 480 
                 else pure empty
    443 
    -        printErrs $ getPprStyle $ \style ->
    481 
    +        return $ getPprStyle $ \style ->
    444 482 
               withPprStyle (setStyleColoured True style)
    445 483 
                 (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 484
    451 485 
     -- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline.
    452 486 
     defaultLogActionHPrintDoc :: LogFlags -> Bool -> Handle -> SDoc -> IO ()
    ... ... @@ -482,6 +516,8 @@ defaultLogActionHPutStrDoc logflags asciiSpace h d
    482 516 
     -- -ddump-json is being deprecated, `jsonLogAction` has been added in, but
    483 517 
     -- it should be removed along with -ddump-json. Similarly, the guard in
    484 518 
     -- `defaultLogAction` should be removed. This cleanup is tracked in #24113.
    519 
    +--
    520 
    +--
    485 521
    486 522 
     -- | Default action for 'dumpAction' hook
    487 523 
     defaultDumpAction :: DumpCache -> LogAction -> DumpAction
    ... ... @@ -611,8 +647,8 @@ defaultTraceAction logflags title doc x =
    611 647 
     logMsg :: Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
    612 648 
     logMsg logger mc loc msg = putLogMsg logger (logFlags logger) mc loc msg
    613 649
    614 
    -logJsonMsg :: ToJson a => Logger -> MessageClass -> a -> IO ()
    615 
    -logJsonMsg logger mc d = putJsonLogMsg logger (logFlags logger) mc  (json d)
    650 
    +logJsonMsg :: Logger -> MessageClass -> JsonDoc -> IO ()
    651 
    +logJsonMsg logger mc = putJsonLogMsg logger (logFlags logger) mc
    616 652
    617 653 
     -- | Dump something
    618 654 
     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 
    +{"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","version":"1.1","ghcVersion":"ghc-9.13.20250627","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"]}

  • 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 
    +{"rendered":"json_warn.hs:4:3: warning: [GHC-40910] [-Wunused-matches (in -Wextra)]\n    Defined but not used: \u2018x\u2019\n","version":"1.1","ghcVersion":"ghc-9.13.20250627","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 
    +{"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","version":"1.1","ghcVersion":"ghc-9.13.20250627","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"}}

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help