diff options
Diffstat (limited to 'compiler/GHC/Utils/Error.hs')
| -rw-r--r-- | compiler/GHC/Utils/Error.hs | 96 |
1 files changed, 41 insertions, 55 deletions
diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs index 99bff97a5b..7e614588f6 100644 --- a/compiler/GHC/Utils/Error.hs +++ b/compiler/GHC/Utils/Error.hs @@ -15,13 +15,13 @@ module GHC.Utils.Error ( Severity(..), -- * Messages - WarnMsg, + Diagnostic(..), MsgEnvelope(..), MessageClass(..), SDoc, DecoratedSDoc(unDecorated), - Messages, ErrorMessages, WarningMessages, - unionMessages, + Messages, + mkMessages, unionMessages, errorsFound, isEmptyMessages, -- ** Formatting @@ -33,9 +33,14 @@ module GHC.Utils.Error ( -- ** Construction emptyMessages, mkDecorated, mkLocMessage, mkLocMessageAnn, mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope, - mkShortMsgEnvelope, mkShortErrorMsgEnvelope, mkLongMsgEnvelope, + mkErrorMsgEnvelope, mkMCDiagnostic, errorDiagnostic, diagReasonSeverity, + mkPlainError, + mkPlainDiagnostic, + mkDecoratedError, + mkDecoratedDiagnostic, + -- * Utilities doIfSet, doIfSet_dyn, getCaretDiagnostic, @@ -97,6 +102,15 @@ diagReasonSeverity _ ErrorWithoutFlag +-- | Make a 'MessageClass' for a given 'DiagnosticReason', consulting the 'DynFlags'. +mkMCDiagnostic :: DynFlags -> DiagnosticReason -> MessageClass +mkMCDiagnostic dflags reason = MCDiagnostic (diagReasonSeverity dflags reason) reason + +-- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the +-- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag'. +errorDiagnostic :: MessageClass +errorDiagnostic = MCDiagnostic SevError ErrorWithoutFlag + -- -- Creating MsgEnvelope(s) -- @@ -115,6 +129,9 @@ mk_msg_envelope severity locn print_unqual err , errMsgSeverity = severity } +-- | Wrap a 'Diagnostic' in a 'MsgEnvelope', recording its location. +-- If you know your 'Diagnostic' is an error, consider using 'mkErrorMsgEnvelope', +-- which does not require looking at the 'DynFlags' mkMsgEnvelope :: Diagnostic e => DynFlags @@ -125,63 +142,34 @@ mkMsgEnvelope mkMsgEnvelope dflags locn print_unqual err = mk_msg_envelope (diagReasonSeverity dflags (diagnosticReason err)) locn print_unqual err --- | Make a 'MessageClass' for a given 'DiagnosticReason', consulting the 'DynFlags'. -mkMCDiagnostic :: DynFlags -> DiagnosticReason -> MessageClass -mkMCDiagnostic dflags reason = MCDiagnostic (diagReasonSeverity dflags reason) reason - --- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the --- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag'. -errorDiagnostic :: MessageClass -errorDiagnostic = MCDiagnostic SevError ErrorWithoutFlag - --- | A long (multi-line) diagnostic message. --- The 'Severity' will be calculated out of the 'DiagnosticReason', and will likely be --- incorrect in the presence of '-Werror'. -mkLongMsgEnvelope :: DynFlags - -> DiagnosticReason - -> SrcSpan - -> PrintUnqualified - -> SDoc - -> SDoc - -> MsgEnvelope DiagnosticMessage -mkLongMsgEnvelope dflags rea locn unqual msg extra = - mkMsgEnvelope dflags locn unqual (DiagnosticMessage (mkDecorated [msg,extra]) rea) - --- | A short (one-line) diagnostic message. --- Same 'Severity' considerations as for 'mkLongMsgEnvelope'. -mkShortMsgEnvelope :: DynFlags - -> DiagnosticReason - -> SrcSpan +-- | Wrap a 'Diagnostic' in a 'MsgEnvelope', recording its location. +-- Precondition: the diagnostic is, in fact, an error. That is, +-- @diagnosticReason msg == ErrorWithoutFlag@. +mkErrorMsgEnvelope :: Diagnostic e + => SrcSpan -> PrintUnqualified - -> SDoc - -> MsgEnvelope DiagnosticMessage -mkShortMsgEnvelope dflags rea locn unqual msg = - mkMsgEnvelope dflags locn unqual (DiagnosticMessage (mkDecorated [msg]) rea) - -mkShortErrorMsgEnvelope :: SrcSpan - -> PrintUnqualified - -> SDoc - -> MsgEnvelope DiagnosticMessage -mkShortErrorMsgEnvelope locn unqual msg = - mk_msg_envelope SevError locn unqual (DiagnosticMessage (mkDecorated [msg]) ErrorWithoutFlag) + -> e + -> MsgEnvelope e +mkErrorMsgEnvelope locn unqual msg = + mk_msg_envelope SevError locn unqual msg -- | Variant that doesn't care about qualified/unqualified names. --- Same 'Severity' considerations as for 'mkLongMsgEnvelope'. -mkPlainMsgEnvelope :: DynFlags - -> DiagnosticReason +mkPlainMsgEnvelope :: Diagnostic e + => DynFlags -> SrcSpan - -> SDoc - -> MsgEnvelope DiagnosticMessage -mkPlainMsgEnvelope dflags rea locn msg = - mkMsgEnvelope dflags locn alwaysQualify (DiagnosticMessage (mkDecorated [msg]) rea) + -> e + -> MsgEnvelope e +mkPlainMsgEnvelope dflags locn msg = + mkMsgEnvelope dflags locn alwaysQualify msg -- | Variant of 'mkPlainMsgEnvelope' which can be used when we are /sure/ we -- are constructing a diagnostic with a 'ErrorWithoutFlag' reason. -mkPlainErrorMsgEnvelope :: SrcSpan - -> SDoc - -> MsgEnvelope DiagnosticMessage +mkPlainErrorMsgEnvelope :: Diagnostic e + => SrcSpan + -> e + -> MsgEnvelope e mkPlainErrorMsgEnvelope locn msg = - mk_msg_envelope SevError locn alwaysQualify (DiagnosticMessage (mkDecorated [msg]) ErrorWithoutFlag) + mk_msg_envelope SevError locn alwaysQualify msg ------------------------- data Validity @@ -582,5 +570,3 @@ of the execution through the various labels) and ghc.totals.txt (total time spent in each label). -} - - |