Simon Jakobi pushed to branch wip/sjakobi/multi-caret at Glasgow Haskell Compiler / GHC Commits: 518b59ad by Simon Jakobi at 2026-06-05T12:13:29+02:00 Centralize primary/caret span merge in decorateDiagnostic Move the nub (srcSpan :| relatedSpans) merge inside decorateDiagnostic so callers pass the bare related spans rather than pre-injecting the primary span. This stops passing the primary span twice at each call site and keeps the source span model in one place. Co-Authored-By: Claude Opus 4.8 - - - - - 2 changed files: - compiler/GHC/Driver/Errors.hs - compiler/GHC/Utils/Logger.hs Changes: ===================================== compiler/GHC/Driver/Errors.hs ===================================== @@ -15,7 +15,6 @@ import GHC.Utils.Json import GHC.Utils.Error import GHC.Utils.Outputable import GHC.Utils.Logger -import Data.List.NonEmpty (NonEmpty(..), nub) reportError :: Logger -> NamePprCtx -> DiagOpts -> SrcSpan -> SDoc -> IO () reportError logger nameContext opts span doc = do @@ -48,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 sourceSpans doc + decorated <- decorateDiagnostic logflags messageClass location relatedSpans doc let rendered :: String rendered = renderWithContext (log_default_user_context logflags) decorated @@ -84,9 +83,6 @@ printMessage logger msg_opts opts message relatedSpans :: [SrcSpan] relatedSpans = diagnosticRelatedLocations diagnostic - sourceSpans :: NonEmpty SrcSpan - sourceSpans = nub (location :| relatedSpans) - severity :: Severity severity = errMsgSeverity message ===================================== compiler/GHC/Utils/Logger.hs ===================================== @@ -425,7 +425,7 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg MCFatal -> printErrs msg MCDiagnostic SevIgnore _ _ _ -> pure () -- suppress the message MCDiagnostic _sev _rea _code relatedSpans -> - decorateDiagnostic logflags msg_class srcSpan (nub (srcSpan :| relatedSpans)) msg >>= printErrs + decorateDiagnostic logflags msg_class srcSpan relatedSpans msg >>= printErrs where printOut = defaultLogActionHPrintDoc logflags False out printErrs = defaultLogActionHPrintDoc logflags False err @@ -465,13 +465,20 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg -- `defaultLogActionWithHandles`) -- -- This story is tracked by #24113. -decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> NonEmpty SrcSpan -> SDoc -> IO SDoc -decorateDiagnostic logflags msg_class srcSpan sourceSpans msg = addCaret +decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> [SrcSpan] -> SDoc -> IO SDoc +decorateDiagnostic logflags msg_class srcSpan relatedSpans 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 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. + -- See Note [The source span model for diagnostics] in GHC.Types.Error. + sourceSpans :: NonEmpty SrcSpan + sourceSpans = nub (srcSpan :| relatedSpans) + addCaret :: IO SDoc addCaret = do caretDiagnostic <- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/518b59ad457ee71e6d4d5dbbf183d6af... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/518b59ad457ee71e6d4d5dbbf183d6af... You're receiving this email because of your account on gitlab.haskell.org.