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.
