diff options
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 20 |
1 files changed, 14 insertions, 6 deletions
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 454d179c4b..460301273f 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -21,6 +21,10 @@ module GHC.Tc.Errors.Ppr , inHsDocContext , TcRnMessageOpts(..) , pprTyThingUsedWrong + + -- | Useful when overriding message printing. + , messageWithInfoDiagnosticMessage + , messageWithHsDocContext ) where @@ -126,12 +130,8 @@ instance Diagnostic TcRnMessage where (tcOptsShowContext opts) (diagnosticMessage opts msg) TcRnWithHsDocContext ctxt msg - -> if tcOptsShowContext opts - then main_msg `unionDecoratedSDoc` ctxt_msg - else main_msg - where - main_msg = diagnosticMessage opts msg - ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + -> messageWithHsDocContext opts ctxt (diagnosticMessage opts msg) + TcRnSolverReport msg _ _ -> mkSimpleDecorated $ pprSolverReportWithCtxt msg TcRnRedundantConstraints redundants (info, show_info) @@ -3259,6 +3259,14 @@ messageWithInfoDiagnosticMessage unit_state ErrInfo{..} show_ctxt important = in (mapDecoratedSDoc (pprWithUnitState unit_state) important) `unionDecoratedSDoc` mkDecorated err_info' +messageWithHsDocContext :: TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc +messageWithHsDocContext opts ctxt main_msg = do + if tcOptsShowContext opts + then main_msg `unionDecoratedSDoc` ctxt_msg + else main_msg + where + ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + dodgy_msg :: Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc dodgy_msg kind tc ie = vcat [ text "The" <+> kind <+> text "item" <+> quotes (ppr ie) <+> text "suggests that" |