diff options
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Errors.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 9 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Errors/Types.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Gen/Splice.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/Monad.hs | 2 |
5 files changed, 10 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs index 8ca2d2c6da..0f19f57058 100644 --- a/compiler/GHC/Tc/Errors.hs +++ b/compiler/GHC/Tc/Errors.hs @@ -1105,7 +1105,7 @@ mkErrorTerm ctxt ct_loc ty (SolverReport { sr_important_msgs = important, sr_sup (TcRnSolverReport important ErrorWithoutFlag noHints) (Just ctxt) supp -- This will be reported at runtime, so we always want "error:" in the report, never "warning:" ; dflags <- getDynFlags - ; let err_msg = pprLocMsgEnvelope msg + ; let err_msg = pprLocMsgEnvelope undefined msg err_str = showSDoc dflags $ err_msg $$ text "(deferred type error)" diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 87f482a290..5eca678ddb 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage @@ -92,13 +93,15 @@ import GHC.Types.Name.Env instance Diagnostic TcRnMessage where - diagnosticMessage = \case + type DiagnosticOpts TcRnMessage = () + defaultDiagnosticOpts = () + diagnosticMessage m = \case TcRnUnknownMessage m - -> diagnosticMessage m + -> diagnosticMessage () m TcRnMessageWithInfo unit_state msg_with_info -> case msg_with_info of TcRnMessageDetailed err_info suppress_ctx msg - -> messageWithInfoDiagnosticMessage unit_state err_info suppress_ctx (diagnosticMessage msg) + -> messageWithInfoDiagnosticMessage unit_state err_info suppress_ctx (diagnosticMessage m msg) TcRnSolverReport msgs _ _ -> mkDecorated $ map pprSolverReportWithCtxt msgs diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index b257c97fc0..dd708aee18 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -175,7 +175,7 @@ data TcRnMessage where {-| Simply wraps a generic 'Diagnostic' message @a@. It can be used by plugins to provide custom diagnostic messages originated during typechecking/renaming. -} - TcRnUnknownMessage :: (Diagnostic a, Typeable a) => a -> TcRnMessage + TcRnUnknownMessage :: (DiagnosticOpts a ~ (), Diagnostic a, Typeable a) => a -> TcRnMessage {-| TcRnMessageWithInfo is a constructor which is used when extra information is needed to be provided in order to qualify a diagnostic and where it was originated (and why). diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index 4c6279a6d9..cc152a86b8 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -1224,7 +1224,7 @@ runMeta' show_code ppr_hs run_and_convert expr -- cases. ; logger <- getLogger ; diag_opts <- initDiagOpts <$> getDynFlags - ; liftIO $ printMessages logger diag_opts ds_msgs + ; liftIO $ printMessages logger () diag_opts ds_msgs ; ds_expr <- case mb_ds_expr of Nothing -> failM -- Case (a) from Note [Errors in desugaring a splice] diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index efe30fca02..b7eef860bb 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -1137,7 +1137,7 @@ reportDiagnostics = mapM_ reportDiagnostic reportDiagnostic :: MsgEnvelope TcRnMessage -> TcRn () reportDiagnostic msg - = do { traceTc "Adding diagnostic:" (pprLocMsgEnvelope msg) ; + = do { traceTc "Adding diagnostic:" (pprLocMsgEnvelope undefined msg) ; errs_var <- getErrsVar ; msgs <- readTcRef errs_var ; writeTcRef errs_var (msg `addMessage` msgs) } |