diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2022-06-15 14:37:19 +0100 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2022-06-15 14:39:08 +0100 |
| commit | 8cf400096013a00e8dee4401a582769fdf0044f5 (patch) | |
| tree | bc328101abfd1521776ac58079232c9501cb685f /compiler/GHC/Utils/Error.hs | |
| parent | 127e8cbb3529937b4c3e9ea762ae885d92de6d8d (diff) | |
| download | haskell-wip/diagnostics-context.tar.gz | |
diagnostics: Allow configuration at runtime (setup)wip/diagnostics-context
Ticket #21722
Diffstat (limited to 'compiler/GHC/Utils/Error.hs')
| -rw-r--r-- | compiler/GHC/Utils/Error.hs | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs index 8c044c5af9..58514066c4 100644 --- a/compiler/GHC/Utils/Error.hs +++ b/compiler/GHC/Utils/Error.hs @@ -228,20 +228,20 @@ formatBulleted ctx (unDecorated -> docs) msgs = filter (not . Outputable.isEmpty ctx) docs starred = (bullet<+>) -pprMessages :: Diagnostic e => Messages e -> SDoc -pprMessages = vcat . pprMsgEnvelopeBagWithLoc . getMessages +pprMessages :: Diagnostic e => DiagnosticOpts e -> Messages e -> SDoc +pprMessages e = vcat . pprMsgEnvelopeBagWithLoc e . getMessages -pprMsgEnvelopeBagWithLoc :: Diagnostic e => Bag (MsgEnvelope e) -> [SDoc] -pprMsgEnvelopeBagWithLoc bag = [ pprLocMsgEnvelope item | item <- sortMsgBag Nothing bag ] +pprMsgEnvelopeBagWithLoc :: Diagnostic e => DiagnosticOpts e -> Bag (MsgEnvelope e) -> [SDoc] +pprMsgEnvelopeBagWithLoc e bag = [ pprLocMsgEnvelope e item | item <- sortMsgBag Nothing bag ] -pprLocMsgEnvelope :: Diagnostic e => MsgEnvelope e -> SDoc -pprLocMsgEnvelope (MsgEnvelope { errMsgSpan = s +pprLocMsgEnvelope :: Diagnostic e => DiagnosticOpts e -> MsgEnvelope e -> SDoc +pprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s , errMsgDiagnostic = e , errMsgSeverity = sev , errMsgContext = unqual }) = sdocWithContext $ \ctx -> withErrStyle unqual $ - mkLocMessage (MCDiagnostic sev (diagnosticReason e)) s (formatBulleted ctx $ diagnosticMessage e) + mkLocMessage (MCDiagnostic sev (diagnosticReason e)) s (formatBulleted ctx $ diagnosticMessage opts e) sortMsgBag :: Maybe DiagOpts -> Bag (MsgEnvelope e) -> [MsgEnvelope e] sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList |