Simon Jakobi pushed to branch wip/sjakobi/multi-caret at Glasgow Haskell Compiler / GHC Commits: 3f4a9632 by Simon Jakobi at 2026-06-05T12:35:40+02:00 Read related spans from the message class in decorateDiagnostic The related locations are already carried by the MCDiagnostic message class, so decorateDiagnostic can take them from there rather than via a separate parameter. This removes the redundant argument at the call sites and makes the message class the single source of truth for the related spans. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com> - - - - - 2 changed files: - compiler/GHC/Driver/Errors.hs - compiler/GHC/Utils/Logger.hs Changes: ===================================== compiler/GHC/Driver/Errors.hs ===================================== @@ -47,7 +47,7 @@ printMessages logger msg_opts opts = mapM_ (printMessage logger msg_opts opts) . printMessage :: forall a. (Diagnostic a) => Logger -> DiagnosticOpts a -> DiagOpts -> MsgEnvelope a -> IO () printMessage logger msg_opts opts message | log_diags_as_json = do - decorated <- decorateDiagnostic logflags messageClass location relatedSpans doc + decorated <- decorateDiagnostic logflags messageClass location doc let rendered :: String rendered = renderWithContext (log_default_user_context logflags) decorated ===================================== compiler/GHC/Utils/Logger.hs ===================================== @@ -424,8 +424,8 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg MCInfo -> printErrs msg MCFatal -> printErrs msg MCDiagnostic SevIgnore _ _ _ -> pure () -- suppress the message - MCDiagnostic _sev _rea _code relatedSpans -> - decorateDiagnostic logflags msg_class srcSpan relatedSpans msg >>= printErrs + MCDiagnostic{} -> + decorateDiagnostic logflags msg_class srcSpan msg >>= printErrs where printOut = defaultLogActionHPrintDoc logflags False out printErrs = defaultLogActionHPrintDoc logflags False err @@ -465,13 +465,19 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg -- `defaultLogActionWithHandles`) -- -- This story is tracked by #24113. -decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> [SrcSpan] -> SDoc -> IO SDoc -decorateDiagnostic logflags msg_class srcSpan relatedSpans msg = addCaret +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 + -- The related locations are carried by the 'MCDiagnostic' message class. + relatedSpans :: [SrcSpan] + relatedSpans = case msg_class of + MCDiagnostic _ _ _ spans -> spans + _ -> [] + -- The primary span is always caret'd, with the related spans drawn as -- additional carets. Dedup so the primary isn't drawn twice when it -- also appears among the related spans. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f4a96323f7e2826bc5cc4ccad167308... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f4a96323f7e2826bc5cc4ccad167308... You're receiving this email because of your account on gitlab.haskell.org.