diff options
| author | Alfredo Di Napoli <alfredo@well-typed.com> | 2021-01-19 10:21:21 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-01 14:06:11 -0500 |
| commit | c0709c1d1dcb60a238e9fc59ac33124e2a0c415d (patch) | |
| tree | 47c405562a633c3780664da4a1785feb85054eb6 /compiler/GHC/Parser | |
| parent | b1a17507229b00820b9552a423342f8c354267d4 (diff) | |
| download | haskell-c0709c1d1dcb60a238e9fc59ac33124e2a0c415d.tar.gz | |
Introduce the DecoratedSDoc type
This commit introduces a DecoratedSDoc type which replaces the old
ErrDoc, and hopefully better reflects the intent.
Diffstat (limited to 'compiler/GHC/Parser')
| -rw-r--r-- | compiler/GHC/Parser/Errors/Ppr.hs | 12 | ||||
| -rw-r--r-- | compiler/GHC/Parser/Header.hs | 2 |
2 files changed, 7 insertions, 7 deletions
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs index a923db2898..22103fa08b 100644 --- a/compiler/GHC/Parser/Errors/Ppr.hs +++ b/compiler/GHC/Parser/Errors/Ppr.hs @@ -24,25 +24,25 @@ import GHC.Hs.Type (pprLHsContext) import GHC.Builtin.Names (allNameStrings) import GHC.Builtin.Types (filterCTuple) -mkParserErr :: SrcSpan -> SDoc -> MsgEnvelope [SDoc] +mkParserErr :: SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc mkParserErr span doc = MsgEnvelope { errMsgSpan = span , errMsgContext = alwaysQualify - , errMsgDiagnostic = [doc] + , errMsgDiagnostic = mkDecorated [doc] , errMsgSeverity = SevError , errMsgReason = NoReason } -mkParserWarn :: WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope [SDoc] +mkParserWarn :: WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc mkParserWarn flag span doc = MsgEnvelope { errMsgSpan = span , errMsgContext = alwaysQualify - , errMsgDiagnostic = [doc] + , errMsgDiagnostic = mkDecorated [doc] , errMsgSeverity = SevWarning , errMsgReason = Reason flag } -pprWarning :: PsWarning -> MsgEnvelope [SDoc] +pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc pprWarning = \case PsWarnTab loc tc -> mkParserWarn Opt_WarnTabs loc $ @@ -128,7 +128,7 @@ pprWarning = \case OperatorWhitespaceOccurrence_Suffix -> mk_msg "suffix" OperatorWhitespaceOccurrence_TightInfix -> mk_msg "tight infix" -pprError :: PsError -> MsgEnvelope [SDoc] +pprError :: PsError -> MsgEnvelope DecoratedSDoc pprError err = mkParserErr (errLoc err) $ vcat (pp_err (errDesc err) : map pp_hint (errHints err)) diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs index 0af7a555d5..5d911a0b56 100644 --- a/compiler/GHC/Parser/Header.hs +++ b/compiler/GHC/Parser/Header.hs @@ -348,7 +348,7 @@ unsupportedExtnError dflags loc unsup = suggestions = fuzzyMatch unsup supported -optionsErrorMsgs :: [String] -> [Located String] -> FilePath -> Messages [SDoc] +optionsErrorMsgs :: [String] -> [Located String] -> FilePath -> Messages DecoratedSDoc optionsErrorMsgs unhandled_flags flags_lines _filename = mkMessages $ listToBag (map mkMsg unhandled_flags_lines) where unhandled_flags_lines :: [Located String] |