Simon Jakobi pushed to branch wip/sjakobi/multi-caret at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • compiler/GHC/Driver/Errors.hs
    ... ... @@ -15,7 +15,6 @@ import GHC.Utils.Json
    15 15
     import GHC.Utils.Error
    
    16 16
     import GHC.Utils.Outputable
    
    17 17
     import GHC.Utils.Logger
    
    18
    -import Data.List.NonEmpty (NonEmpty(..), nub)
    
    19 18
     
    
    20 19
     reportError :: Logger -> NamePprCtx -> DiagOpts -> SrcSpan -> SDoc -> IO ()
    
    21 20
     reportError logger nameContext opts span doc = do
    
    ... ... @@ -48,7 +47,7 @@ printMessages logger msg_opts opts = mapM_ (printMessage logger msg_opts opts) .
    48 47
     printMessage :: forall a. (Diagnostic a) => Logger -> DiagnosticOpts a -> DiagOpts -> MsgEnvelope a -> IO ()
    
    49 48
     printMessage logger msg_opts opts message
    
    50 49
       | log_diags_as_json = do
    
    51
    -      decorated <- decorateDiagnostic logflags messageClass location sourceSpans doc
    
    50
    +      decorated <- decorateDiagnostic logflags messageClass location relatedSpans doc
    
    52 51
           let
    
    53 52
             rendered :: String
    
    54 53
             rendered = renderWithContext (log_default_user_context logflags) decorated
    
    ... ... @@ -84,9 +83,6 @@ printMessage logger msg_opts opts message
    84 83
         relatedSpans :: [SrcSpan]
    
    85 84
         relatedSpans = diagnosticRelatedLocations diagnostic
    
    86 85
     
    
    87
    -    sourceSpans :: NonEmpty SrcSpan
    
    88
    -    sourceSpans = nub (location :| relatedSpans)
    
    89
    -
    
    90 86
         severity :: Severity
    
    91 87
         severity = errMsgSeverity message
    
    92 88
     
    

  • compiler/GHC/Utils/Logger.hs
    ... ... @@ -425,7 +425,7 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg
    425 425
           MCFatal                      -> printErrs msg
    
    426 426
           MCDiagnostic SevIgnore _ _ _ -> pure () -- suppress the message
    
    427 427
           MCDiagnostic _sev _rea _code relatedSpans ->
    
    428
    -        decorateDiagnostic logflags msg_class srcSpan (nub (srcSpan :| relatedSpans)) msg >>= printErrs
    
    428
    +        decorateDiagnostic logflags msg_class srcSpan relatedSpans msg >>= printErrs
    
    429 429
         where
    
    430 430
           printOut   = defaultLogActionHPrintDoc  logflags False out
    
    431 431
           printErrs  = defaultLogActionHPrintDoc  logflags False err
    
    ... ... @@ -465,13 +465,20 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg
    465 465
     --     `defaultLogActionWithHandles`)
    
    466 466
     --
    
    467 467
     -- This story is tracked by #24113.
    
    468
    -decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> NonEmpty SrcSpan -> SDoc -> IO SDoc
    
    469
    -decorateDiagnostic logflags msg_class srcSpan sourceSpans msg = addCaret
    
    468
    +decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> [SrcSpan] -> SDoc -> IO SDoc
    
    469
    +decorateDiagnostic logflags msg_class srcSpan relatedSpans msg = addCaret
    
    470 470
         where
    
    471 471
           -- Pretty print the warning flag, if any (#10752)
    
    472 472
           message :: SDoc
    
    473 473
           message = mkLocMessageWarningGroups (log_show_warn_groups logflags) msg_class srcSpan msg
    
    474 474
     
    
    475
    +      -- The primary span is always caret'd, with the related spans drawn as
    
    476
    +      -- additional carets.  Dedup so the primary isn't drawn twice when it
    
    477
    +      -- also appears among the related spans.
    
    478
    +      -- See Note [The source span model for diagnostics] in GHC.Types.Error.
    
    479
    +      sourceSpans :: NonEmpty SrcSpan
    
    480
    +      sourceSpans = nub (srcSpan :| relatedSpans)
    
    481
    +
    
    475 482
           addCaret :: IO SDoc
    
    476 483
           addCaret = do
    
    477 484
             caretDiagnostic <-