summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Rename/Names.hs120
-rw-r--r--compiler/GHC/Tc/Errors.hs170
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs168
-rw-r--r--compiler/GHC/Tc/Errors/Types.hs93
-rw-r--r--compiler/GHC/Tc/Types/Origin.hs2
-rw-r--r--testsuite/tests/driver/werror.stderr2
-rw-r--r--testsuite/tests/warnings/should_compile/Werror01.stderr1
-rw-r--r--testsuite/tests/warnings/should_fail/WerrorFail2.stderr2
8 files changed, 337 insertions, 221 deletions
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index b3360ad73b..d2573b2b25 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -50,8 +50,7 @@ import GHC.Builtin.Names
import GHC.Parser.PostProcess ( setRdrNameSpace )
import GHC.Core.Type
import GHC.Core.PatSyn
-import GHC.Core.TyCo.Ppr
-import GHC.Core.TyCon ( TyCon, tyConName, tyConKind )
+import GHC.Core.TyCon ( TyCon, tyConName )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Utils.Outputable as Outputable
@@ -1606,95 +1605,76 @@ There are four warning flags in play:
-- inferred type of the function
warnMissingSignatures :: TcGblEnv -> RnM ()
warnMissingSignatures gbl_env
- = do { let exports = availsToNameSet (tcg_exports gbl_env)
+ = do { warn_binds <- woptM Opt_WarnMissingSignatures
+ ; warn_pat_syns <- woptM Opt_WarnMissingPatternSynonymSignatures
+ ; let exports = availsToNameSet (tcg_exports gbl_env)
sig_ns = tcg_sigs gbl_env
-- We use sig_ns to exclude top-level bindings that are generated by GHC
binds = collectHsBindsBinders CollNoDictBinders $ tcg_binds gbl_env
pat_syns = tcg_patsyns gbl_env
- -- Warn about missing signatures
- -- Do this only when we have a type to offer
- ; warn_binds <- woptM Opt_WarnMissingSignatures
- ; warn_exported_binds <- woptM Opt_WarnMissingExportedSignatures
- ; warn_pat_syns <- woptM Opt_WarnMissingPatternSynonymSignatures
- ; warn_exported_pat_syns <- woptM Opt_WarnMissingExportedPatternSynonymSignatures
-
- -- See Note [Missing signatures]
- ; let add_sig_warns
- = when (warn_pat_syns || warn_exported_pat_syns)
- (mapM_ add_pat_syn_warn pat_syns) >>
- when (warn_binds || warn_exported_binds)
- (mapM_ add_bind_warn binds)
-
- add_pat_syn_warn p
- = when export_check $
- add_warn name flag $
- hang (text "Pattern synonym with no type signature:")
- 2 (text "pattern" <+> pprPrefixName name <+> dcolon <+> pp_ty)
- where
- name = patSynName p
- pp_ty = pprPatSynType p
- export_check = warn_pat_syns || name `elemNameSet` exports
- flag | warn_pat_syns
- = Opt_WarnMissingPatternSynonymSignatures
- | otherwise
- = Opt_WarnMissingExportedPatternSynonymSignatures
-
- add_bind_warn :: Id -> IOEnv (Env TcGblEnv TcLclEnv) ()
- add_bind_warn id
- = do { env <- tcInitTidyEnv -- Why not use emptyTidyEnv?
- ; let (_, ty) = tidyOpenType env (idType id)
- ty_msg = pprSigmaType ty
-
- ; when export_check $
- add_warn name flag $
- hang (text "Top-level binding with no type signature:")
- 2 (pprPrefixName name <+> dcolon <+> ty_msg) }
+ not_ghc_generated :: Name -> Bool
+ not_ghc_generated name = name `elemNameSet` sig_ns
+
+ add_binding_warn :: Id -> RnM ()
+ add_binding_warn id =
+ when (not_ghc_generated name) $
+ do { env <- tcInitTidyEnv -- Why not use emptyTidyEnv?
+ ; let (_, ty) = tidyOpenType env (idType id)
+ missing = MissingTopLevelBindingSig name ty
+ diag = TcRnMissingSignature missing exported warn_binds
+ ; addDiagnosticAt (getSrcSpan name) diag }
where
name = idName id
- export_check = warn_binds || name `elemNameSet` exports
- flag | warn_binds
- = Opt_WarnMissingSignatures
- | otherwise
- = Opt_WarnMissingExportedSignatures
-
- add_warn name flag msg
- = when not_ghc_generated $ do
- let dia = TcRnUnknownMessage $
- mkPlainDiagnostic (WarningWithFlag flag) noHints msg
- addDiagnosticAt (getSrcSpan name) dia
+ exported = if name `elemNameSet` exports
+ then IsExported
+ else IsNotExported
+
+ add_patsyn_warn :: PatSyn -> RnM ()
+ add_patsyn_warn ps =
+ when (not_ghc_generated name) $
+ addDiagnosticAt (getSrcSpan name)
+ (TcRnMissingSignature missing exported warn_pat_syns)
where
- not_ghc_generated
- = name `elemNameSet` sig_ns
+ name = patSynName ps
+ missing = MissingPatSynSig ps
+ exported = if name `elemNameSet` exports
+ then IsExported
+ else IsNotExported
- ; add_sig_warns }
+ -- Warn about missing signatures
+ -- Do this only when we have a type to offer
+ -- See Note [Missing signatures]
+ ; mapM_ add_binding_warn binds
+ ; mapM_ add_patsyn_warn pat_syns
+ }
-- | Warn the user about tycons that lack kind signatures.
-- Called /after/ type (and kind) inference, so that we can report the
-- inferred kinds.
warnMissingKindSignatures :: TcGblEnv -> RnM ()
warnMissingKindSignatures gbl_env
- = do { warn_missing_kind_sigs <- woptM Opt_WarnMissingKindSignatures
- ; cusks_enabled <- xoptM LangExt.CUSKs
- ; when (warn_missing_kind_sigs) (mapM_ (add_ty_warn cusks_enabled) tcs)
+ = do { cusks_enabled <- xoptM LangExt.CUSKs
+ ; mapM_ (add_ty_warn cusks_enabled) tcs
}
where
tcs = tcg_tcs gbl_env
ksig_ns = tcg_ksigs gbl_env
-
- add_ty_warn :: Bool -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
- add_ty_warn cusks_enabled tyCon = when (name `elemNameSet` ksig_ns) $ do
- let dia = TcRnUnknownMessage $
- mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingKindSignatures) noHints $
- hang msg 2 (text "type" <+> pprPrefixName name <+> dcolon <+> ki_msg)
- addDiagnosticAt (getSrcSpan name) dia
+ exports = availsToNameSet (tcg_exports gbl_env)
+ not_ghc_generated :: Name -> Bool
+ not_ghc_generated name = name `elemNameSet` ksig_ns
+
+ add_ty_warn :: Bool -> TyCon -> RnM ()
+ add_ty_warn cusks_enabled tyCon =
+ when (not_ghc_generated name) $
+ addDiagnosticAt (getSrcSpan name) diag
where
- msg | cusks_enabled = text "Top-level type constructor with no standalone kind signature or CUSK:"
- | otherwise = text "Top-level type constructor with no standalone kind signature:"
name = tyConName tyCon
- ki = tyConKind tyCon
- ki_msg :: SDoc
- ki_msg = pprKind ki
+ diag = TcRnMissingSignature missing exported False
+ missing = MissingTyConKindSig tyCon cusks_enabled
+ exported = if name `elemNameSet` exports
+ then IsExported
+ else IsNotExported
{-
*********************************************************
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 3474626289..a833e76661 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -13,7 +13,11 @@ module GHC.Tc.Errors(
reportUnsolved, reportAllUnsolved, warnAllUnsolved,
warnDefaulting,
- solverDepthErrorTcS
+ solverDepthErrorTcS,
+
+ -- * GHC API helper functions
+ solverReportMsg_ExpectedActuals,
+ solverReportInfo_ExpectedActuals
) where
import GHC.Prelude
@@ -28,6 +32,7 @@ import GHC.Rename.Unbound
import GHC.Tc.Types
import GHC.Tc.Utils.Monad
import GHC.Tc.Errors.Types
+import GHC.Tc.Errors.Ppr
import GHC.Tc.Types.Constraint
import GHC.Tc.Utils.TcMType
import GHC.Tc.Utils.Env( tcInitTidyEnv )
@@ -87,7 +92,6 @@ import Data.List.NonEmpty ( NonEmpty(..), (<|) )
import qualified Data.List.NonEmpty as NE ( map, reverse )
import Data.List ( sortBy )
import Data.Ord ( comparing )
-import GHC.Tc.Errors.Ppr
{-
@@ -263,9 +267,9 @@ report_unsolved type_errors expr_holes
-- Internal functions
--------------------------------------------
--- | Make a report from a single 'TcReportMsg'.
-important :: ReportErrCtxt -> TcReportMsg -> SolverReport
-important ctxt doc = mempty { sr_important_msgs = [ReportWithCtxt ctxt doc] }
+-- | Make a report from a single 'TcSolverReportMsg'.
+important :: SolverReportErrCtxt -> TcSolverReportMsg -> SolverReport
+important ctxt doc = mempty { sr_important_msgs = [SolverReportWithCtxt ctxt doc] }
mk_relevant_bindings :: RelevantBindings -> SolverReport
mk_relevant_bindings binds = mempty { sr_supplementary = [SupplementaryBindings binds] }
@@ -273,15 +277,15 @@ mk_relevant_bindings binds = mempty { sr_supplementary = [SupplementaryBindings
mk_report_hints :: [GhcHint] -> SolverReport
mk_report_hints hints = mempty { sr_hints = hints }
--- | Returns True <=> the ReportErrCtxt indicates that something is deferred
-deferringAnyBindings :: ReportErrCtxt -> Bool
+-- | Returns True <=> the SolverReportErrCtxt indicates that something is deferred
+deferringAnyBindings :: SolverReportErrCtxt -> Bool
-- Don't check cec_type_holes, as these don't cause bindings to be deferred
deferringAnyBindings (CEC { cec_defer_type_errors = ErrorWithoutFlag
, cec_expr_holes = ErrorWithoutFlag
, cec_out_of_scope_holes = ErrorWithoutFlag }) = False
deferringAnyBindings _ = True
-maybeSwitchOffDefer :: EvBindsVar -> ReportErrCtxt -> ReportErrCtxt
+maybeSwitchOffDefer :: EvBindsVar -> SolverReportErrCtxt -> SolverReportErrCtxt
-- Switch off defer-type-errors inside CoEvBindsVar
-- See Note [Failing equalities with no evidence bindings]
maybeSwitchOffDefer evb ctxt
@@ -329,7 +333,7 @@ error into a warning may allow subsequent warnings to appear that were
previously suppressed. (e.g. partial-sigs/should_fail/T14584)
-}
-reportImplic :: ReportErrCtxt -> Implication -> TcM ()
+reportImplic :: SolverReportErrCtxt -> Implication -> TcM ()
reportImplic ctxt implic@(Implic { ic_skols = tvs
, ic_given = given
, ic_wanted = wanted, ic_binds = evb
@@ -388,7 +392,7 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs
IC_BadTelescope -> True
_ -> False
-warnRedundantConstraints :: ReportErrCtxt -> TcLclEnv -> SkolemInfoAnon -> [EvVar] -> TcM ()
+warnRedundantConstraints :: SolverReportErrCtxt -> TcLclEnv -> SkolemInfoAnon -> [EvVar] -> TcM ()
-- See Note [Tracking redundant constraints] in GHC.Tc.Solver
warnRedundantConstraints ctxt env info ev_vars
| null redundant_evs
@@ -429,7 +433,7 @@ warnRedundantConstraints ctxt env info ev_vars
improving pred -- (transSuperClasses p) does not include p
= any isImprovementPred (pred : transSuperClasses pred)
-reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> SkolemInfoAnon -> [TcTyVar] -> TcM ()
+reportBadTelescope :: SolverReportErrCtxt -> TcLclEnv -> SkolemInfoAnon -> [TcTyVar] -> TcM ()
reportBadTelescope ctxt env (ForAllSkol telescope) skols
= do { msg <- mkErrorReport
env
@@ -438,7 +442,7 @@ reportBadTelescope ctxt env (ForAllSkol telescope) skols
[]
; reportDiagnostic msg }
where
- report = ReportWithCtxt ctxt $ BadTelescope telescope skols
+ report = SolverReportWithCtxt ctxt $ BadTelescope telescope skols
reportBadTelescope _ _ skol_info skols
= pprPanic "reportBadTelescope" (ppr skol_info $$ ppr skols)
@@ -460,7 +464,7 @@ But without the context we won't find beta := Zero.
This only matters in instance declarations..
-}
-reportWanteds :: ReportErrCtxt -> TcLevel -> WantedConstraints -> TcM ()
+reportWanteds :: SolverReportErrCtxt -> TcLevel -> WantedConstraints -> TcM ()
reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics
, wc_holes = holes })
= do { traceTc "reportWanteds" (vcat [ text "Simples =" <+> ppr simples
@@ -638,7 +642,7 @@ isTyFun_maybe ty = case tcSplitTyConApp_maybe ty of
--------------------------------------------
type Reporter
- = ReportErrCtxt -> [Ct] -> TcM ()
+ = SolverReportErrCtxt -> [Ct] -> TcM ()
type ReporterSpec
= ( String -- Name
, Ct -> Pred -> Bool -- Pick these ones
@@ -661,7 +665,7 @@ mkSkolReporter ctxt cts
| otherwise = False
reportHoles :: [Ct] -- other (tidied) constraints
- -> ReportErrCtxt -> [Hole] -> TcM ()
+ -> SolverReportErrCtxt -> [Hole] -> TcM ()
reportHoles tidy_cts ctxt holes
= do
diag_opts <- initDiagOpts <$> getDynFlags
@@ -734,7 +738,7 @@ mkUserTypeErrorReporter ctxt
; maybeReportError ctxt ct err
; addDeferredBinding ctxt err ct }
-mkUserTypeError :: Ct -> TcReportMsg
+mkUserTypeError :: Ct -> TcSolverReportMsg
mkUserTypeError ct =
case getUserTypeErrorMsg ct of
Just msg -> UserTypeError msg
@@ -754,7 +758,7 @@ mkGivenErrorReporter ctxt cts
; (eq_err_msgs, _hints) <- mkEqErr_help ctxt ct' ty1 ty2
-- The hints wouldn't help in this situation, so we discard them.
; let supplementary = [ SupplementaryBindings relevant_binds ]
- msg = TcRnInaccessibleCode implic (NE.reverse . NE.map (ReportWithCtxt ctxt) $ eq_err_msgs)
+ msg = TcRnInaccessibleCode implic (NE.reverse . NE.map (SolverReportWithCtxt ctxt) $ eq_err_msgs)
; msg <- mkErrorReport (ctLocEnv (ctLoc ct')) msg (Just ctxt) supplementary
; reportDiagnostic msg }
where
@@ -803,7 +807,7 @@ pattern match which binds some equality constraints. If we
find one, we report the insoluble Given.
-}
-mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM SolverReport)
+mkGroupReporter :: (SolverReportErrCtxt -> [Ct] -> TcM SolverReport)
-- Make error message for a group
-> Reporter -- Deal with lots of constraints
-- Group together errors from same location,
@@ -812,7 +816,7 @@ mkGroupReporter mk_err ctxt cts
= mapM_ (reportGroup mk_err ctxt . toList) (equivClasses cmp_loc cts)
-- Like mkGroupReporter, but doesn't actually print error messages
-mkSuppressReporter :: (ReportErrCtxt -> [Ct] -> TcM SolverReport)
+mkSuppressReporter :: (SolverReportErrCtxt -> [Ct] -> TcM SolverReport)
-> Reporter
mkSuppressReporter mk_err ctxt cts
= mapM_ (suppressGroup mk_err ctxt . toList) (equivClasses cmp_loc cts)
@@ -831,7 +835,7 @@ cmp_loc ct1 ct2 = get ct1 `compare` get ct2
-- Reduce duplication by reporting only one error from each
-- /starting/ location even if the end location differs
-reportGroup :: (ReportErrCtxt -> [Ct] -> TcM SolverReport) -> Reporter
+reportGroup :: (SolverReportErrCtxt -> [Ct] -> TcM SolverReport) -> Reporter
reportGroup mk_err ctxt cts
| ct1 : _ <- cts =
do { err <- mk_err ctxt cts
@@ -851,7 +855,7 @@ reportGroup mk_err ctxt cts
-- like reportGroup, but does not actually report messages. It still adds
-- -fdefer-type-errors bindings, though.
-suppressGroup :: (ReportErrCtxt -> [Ct] -> TcM SolverReport) -> Reporter
+suppressGroup :: (SolverReportErrCtxt -> [Ct] -> TcM SolverReport) -> Reporter
suppressGroup mk_err ctxt cts
= do { err <- mk_err ctxt cts
; traceTc "Suppressing errors for" (ppr cts)
@@ -864,7 +868,7 @@ nonDeferrableOrigin (UsageEnvironmentOf {}) = True
nonDeferrableOrigin (FixedRuntimeRepOrigin {}) = True
nonDeferrableOrigin _ = False
-maybeReportError :: ReportErrCtxt -> Ct -> SolverReport -> TcM ()
+maybeReportError :: SolverReportErrCtxt -> Ct -> SolverReport -> TcM ()
maybeReportError ctxt ct (SolverReport { sr_important_msgs = important, sr_supplementary = supp, sr_hints = hints })
= unless (cec_suppress ctxt) $ -- Some worse error has occurred, so suppress this diagnostic
do let reason | nonDeferrableOrigin (ctOrigin ct) = ErrorWithoutFlag
@@ -874,7 +878,7 @@ maybeReportError ctxt ct (SolverReport { sr_important_msgs = important, sr_suppl
msg <- mkErrorReport (ctLocEnv (ctLoc ct)) diag (Just ctxt) supp
reportDiagnostic msg
-addDeferredBinding :: ReportErrCtxt -> SolverReport -> Ct -> TcM ()
+addDeferredBinding :: SolverReportErrCtxt -> SolverReport -> Ct -> TcM ()
-- See Note [Deferring coercion errors to runtime]
addDeferredBinding ctxt err ct
| deferringAnyBindings ctxt
@@ -895,7 +899,7 @@ addDeferredBinding ctxt err ct
| otherwise -- Do not set any evidence for Given/Derived
= return ()
-mkErrorTerm :: ReportErrCtxt -> CtLoc -> Type -- of the error term
+mkErrorTerm :: SolverReportErrCtxt -> CtLoc -> Type -- of the error term
-> SolverReport -> TcM EvTerm
mkErrorTerm ctxt ct_loc ty (SolverReport { sr_important_msgs = important, sr_supplementary = supp })
= do { msg <- mkErrorReport
@@ -909,7 +913,7 @@ mkErrorTerm ctxt ct_loc ty (SolverReport { sr_important_msgs = important, sr_sup
; return $ evDelayedError ty err_str }
-tryReporters :: ReportErrCtxt -> [ReporterSpec] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
+tryReporters :: SolverReportErrCtxt -> [ReporterSpec] -> [Ct] -> TcM (SolverReportErrCtxt, [Ct])
-- Use the first reporter in the list whose predicate says True
tryReporters ctxt reporters cts
= do { let (vis_cts, invis_cts) = partition (isVisibleOrigin . ctOrigin) cts
@@ -931,7 +935,7 @@ tryReporters ctxt reporters cts
-- deferred bindings for them if we have -fdefer-type-errors
-- But suppress their error messages
-tryReporter :: ReportErrCtxt -> ReporterSpec -> [Ct] -> TcM (ReportErrCtxt, [Ct])
+tryReporter :: SolverReportErrCtxt -> ReporterSpec -> [Ct] -> TcM (SolverReportErrCtxt, [Ct])
tryReporter ctxt (str, keep_me, suppress_after, reporter) cts
| null yeses
= return (ctxt, cts)
@@ -951,7 +955,7 @@ tryReporter ctxt (str, keep_me, suppress_after, reporter) cts
mkErrorReport :: TcLclEnv
-> TcRnMessage
-- ^ The main payload of the message.
- -> Maybe ReportErrCtxt
+ -> Maybe SolverReportErrCtxt
-- ^ The context to add, after the main diagnostic
-- but before the supplementary information.
-- Nothing <=> don't add any context.
@@ -1122,7 +1126,7 @@ solve it.
************************************************************************
-}
-mkIrredErr :: ReportErrCtxt -> [Ct] -> TcM SolverReport
+mkIrredErr :: SolverReportErrCtxt -> [Ct] -> TcM SolverReport
mkIrredErr ctxt cts
= do { (ctxt, binds_msg, ct1) <- relevantBindings True ctxt ct1
; let msg = important ctxt $
@@ -1167,7 +1171,7 @@ See also 'reportUnsolved'.
----------------
-- | Constructs a new hole error, unless this is deferred. See Note [Constructing Hole Errors].
-mkHoleError :: NameEnv Type -> [Ct] -> ReportErrCtxt -> Hole -> TcM (MsgEnvelope TcRnMessage)
+mkHoleError :: NameEnv Type -> [Ct] -> SolverReportErrCtxt -> Hole -> TcM (MsgEnvelope TcRnMessage)
mkHoleError _ _tidy_simples ctxt hole@(Hole { hole_occ = occ, hole_loc = ct_loc })
| isOutOfScopeHole hole
= do { dflags <- getDynFlags
@@ -1179,7 +1183,7 @@ mkHoleError _ _tidy_simples ctxt hole@(Hole { hole_occ = occ, hole_loc = ct_loc
= unknownNameSuggestions WL_Anything
dflags hpt curr_mod rdr_env
(tcl_rdr lcl_env) imp_info (mkRdrUnqual occ)
- errs = [ReportWithCtxt ctxt (ReportHoleError hole $ OutOfScopeHole imp_errs)]
+ errs = [SolverReportWithCtxt ctxt (ReportHoleError hole $ OutOfScopeHole imp_errs)]
report = SolverReport errs [] hints
; maybeAddDeferredBindings ctxt hole report
@@ -1213,7 +1217,7 @@ mkHoleError lcl_name_cache tidy_simples ctxt
; (grouped_skvs, other_tvs) <- zonkAndGroupSkolTvs hole_ty
; let reason | ExprHole _ <- sort = cec_expr_holes ctxt
| otherwise = cec_type_holes ctxt
- errs = [ReportWithCtxt ctxt $ ReportHoleError hole $ HoleError sort other_tvs grouped_skvs]
+ errs = [SolverReportWithCtxt ctxt $ ReportHoleError hole $ HoleError sort other_tvs grouped_skvs]
supp = [ SupplementaryBindings rel_binds
, SupplementaryCts relevant_cts
, SupplementaryHoleFits hole_fits ]
@@ -1254,7 +1258,7 @@ so that the correct 'Severity' can be computed out of that later on.
-- | Adds deferred bindings (as errors).
-- See Note [Adding deferred bindings].
-maybeAddDeferredBindings :: ReportErrCtxt
+maybeAddDeferredBindings :: SolverReportErrCtxt
-> Hole
-> SolverReport
-> TcM ()
@@ -1271,13 +1275,13 @@ maybeAddDeferredBindings ctxt hole report = do
writeMutVar ref err_tm
_ -> pure ()
--- We unwrap the ReportErrCtxt here, to avoid introducing a loop in module
+-- We unwrap the SolverReportErrCtxt here, to avoid introducing a loop in module
-- imports
-validHoleFits :: ReportErrCtxt -- ^ The context we're in, i.e. the
+validHoleFits :: SolverReportErrCtxt -- ^ The context we're in, i.e. the
-- implications and the tidy environment
-> [Ct] -- ^ Unsolved simple constraints
-> Hole -- ^ The hole
- -> TcM (ReportErrCtxt, ValidHoleFits)
+ -> TcM (SolverReportErrCtxt, ValidHoleFits)
-- ^ We return the new context
-- with a possibly updated
-- tidy environment, and
@@ -1288,7 +1292,7 @@ validHoleFits ctxt@(CEC {cec_encl = implics
; return (ctxt {cec_tidy = tidy_env}, fits) }
-- See Note [Constraints include ...]
-givenConstraints :: ReportErrCtxt -> [(Type, RealSrcSpan)]
+givenConstraints :: SolverReportErrCtxt -> [(Type, RealSrcSpan)]
givenConstraints ctxt
= do { implic@Implic{ ic_given = given } <- cec_encl ctxt
; constraint <- given
@@ -1296,7 +1300,7 @@ givenConstraints ctxt
----------------
-mkIPErr :: ReportErrCtxt -> [Ct] -> TcM SolverReport
+mkIPErr :: SolverReportErrCtxt -> [Ct] -> TcM SolverReport
mkIPErr ctxt cts
= do { (ctxt, binds_msg, ct1) <- relevantBindings True ctxt ct1
; let msg = important ctxt $ UnboundImplicitParams (ct1 :| others)
@@ -1310,7 +1314,7 @@ mkIPErr ctxt cts
-- Wanted constraints arising from representation-polymorphism checks.
--
-- See Note [Reporting representation-polymorphism errors] in GHC.Tc.Types.Origin.
-mkFRRErr :: ReportErrCtxt -> [Ct] -> TcM SolverReport
+mkFRRErr :: SolverReportErrCtxt -> [Ct] -> TcM SolverReport
mkFRRErr ctxt cts
= do { -- Zonking/tidying.
; origs <-
@@ -1392,11 +1396,11 @@ any more. So we don't assert that it is.
-- Don't have multiple equality errors from the same location
-- E.g. (Int,Bool) ~ (Bool,Int) one error will do!
-mkEqErr :: ReportErrCtxt -> [Ct] -> TcM SolverReport
+mkEqErr :: SolverReportErrCtxt -> [Ct] -> TcM SolverReport
mkEqErr ctxt (ct:_) = mkEqErr1 ctxt ct
mkEqErr _ [] = panic "mkEqErr"
-mkEqErr1 :: ReportErrCtxt -> Ct -> TcM SolverReport
+mkEqErr1 :: SolverReportErrCtxt -> Ct -> TcM SolverReport
mkEqErr1 ctxt ct -- Wanted or derived;
-- givens handled in mkGivenErrorReporter
= do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct
@@ -1458,9 +1462,9 @@ mkCoercibleExplanation rdr_env fam_envs ty1 ty2
= False
-- | Accumulated messages in reverse order.
-type AccReportMsgs = NonEmpty TcReportMsg
+type AccReportMsgs = NonEmpty TcSolverReportMsg
-mkEqErr_help :: ReportErrCtxt
+mkEqErr_help :: SolverReportErrCtxt
-> Ct
-> TcType -> TcType -> TcM (AccReportMsgs, [GhcHint])
mkEqErr_help ctxt ct ty1 ty2
@@ -1471,16 +1475,16 @@ mkEqErr_help ctxt ct ty1 ty2
| otherwise
= return (reportEqErr ctxt ct ty1 ty2 :| [], [])
-reportEqErr :: ReportErrCtxt
+reportEqErr :: SolverReportErrCtxt
-> Ct
- -> TcType -> TcType -> TcReportMsg
+ -> TcType -> TcType -> TcSolverReportMsg
reportEqErr ctxt ct ty1 ty2
= mkTcReportWithInfo mismatch eqInfos
where
mismatch = misMatchOrCND False ctxt ct ty1 ty2
eqInfos = eqInfoMsgs ct ty1 ty2
-mkTyVarEqErr :: ReportErrCtxt -> Ct
+mkTyVarEqErr :: SolverReportErrCtxt -> Ct
-> TcTyVar -> TcType -> TcM (AccReportMsgs, [GhcHint])
-- tv1 and ty2 are already tidied
mkTyVarEqErr ctxt ct tv1 ty2
@@ -1488,7 +1492,7 @@ mkTyVarEqErr ctxt ct tv1 ty2
; dflags <- getDynFlags
; mkTyVarEqErr' dflags ctxt ct tv1 ty2 }
-mkTyVarEqErr' :: DynFlags -> ReportErrCtxt -> Ct
+mkTyVarEqErr' :: DynFlags -> SolverReportErrCtxt -> Ct
-> TcTyVar -> TcType -> TcM (AccReportMsgs, [GhcHint])
mkTyVarEqErr' dflags ctxt ct tv1 ty2
-- impredicativity is a simple error to understand; try it first
@@ -1585,7 +1589,7 @@ mkTyVarEqErr' dflags ctxt ct tv1 ty2
insoluble_occurs_check = check_eq_result `cterHasProblem` cteInsolubleOccurs
-eqInfoMsgs :: Ct -> TcType -> TcType -> [TcReportInfo]
+eqInfoMsgs :: Ct -> TcType -> TcType -> [TcSolverReportInfo]
-- Report (a) ambiguity if either side is a type function application
-- e.g. F a0 ~ Int
-- (b) warning about injectivity if both sides are the same
@@ -1612,8 +1616,8 @@ eqInfoMsgs ct ty1 ty2
| otherwise
= Nothing
-misMatchOrCND :: Bool -> ReportErrCtxt -> Ct
- -> TcType -> TcType -> TcReportMsg
+misMatchOrCND :: Bool -> SolverReportErrCtxt -> Ct
+ -> TcType -> TcType -> TcSolverReportMsg
-- If oriented then ty1 is actual, ty2 is expected
misMatchOrCND insoluble_occurs_check ctxt ct ty1 ty2
| insoluble_occurs_check -- See Note [Insoluble occurs check]
@@ -1639,7 +1643,7 @@ misMatchOrCND insoluble_occurs_check ctxt ct ty1 ty2
-- always be another unsolved wanted around, which will ordinarily suppress
-- this message. But this can still be printed out with -fdefer-type-errors
-- (sigh), so we must produce a message.
-mkBlockedEqErr :: ReportErrCtxt -> [Ct] -> TcM SolverReport
+mkBlockedEqErr :: SolverReportErrCtxt -> [Ct] -> TcM SolverReport
mkBlockedEqErr ctxt (ct:_) = return $ important ctxt (BlockedEquality ct)
mkBlockedEqErr _ [] = panic "mkBlockedEqErr no constraints"
@@ -1683,7 +1687,7 @@ addition to superclasses (see Note [Remove redundant provided dicts]
in GHC.Tc.TyCl.PatSyn).
-}
-extraTyVarEqInfo :: TcTyVar -> TcType -> TcM [TcReportInfo]
+extraTyVarEqInfo :: TcTyVar -> TcType -> TcM [TcSolverReportInfo]
-- Add on extra info about skolem constants
-- NB: The types themselves are already tidied
extraTyVarEqInfo tv1 ty2
@@ -1693,7 +1697,7 @@ extraTyVarEqInfo tv1 ty2
Just (tv, _) -> (:[]) <$> extraTyVarInfo tv
Nothing -> return []
-extraTyVarInfo :: TcTyVar -> TcM TcReportInfo
+extraTyVarInfo :: TcTyVar -> TcM TcSolverReportInfo
extraTyVarInfo tv = assertPpr (isTyVar tv) (ppr tv) $
case tcTyVarDetails tv of
SkolemTv skol_info lvl overlaps -> do
@@ -1702,7 +1706,7 @@ extraTyVarInfo tv = assertPpr (isTyVar tv) (ppr tv) $
_ -> return $ TyVarInfo tv
-suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> Maybe GhcHint
+suggestAddSig :: SolverReportErrCtxt -> TcType -> TcType -> Maybe GhcHint
-- See Note [Suggest adding a type signature]
suggestAddSig ctxt ty1 _ty2
| bndr : bndrs <- inferred_bndrs
@@ -1729,7 +1733,7 @@ suggestAddSig ctxt ty1 _ty2
--------------------
-mkMismatchMsg :: Ct -> Type -> Type -> TcReportMsg
+mkMismatchMsg :: Ct -> Type -> Type -> TcSolverReportMsg
mkMismatchMsg ct ty1 ty2 =
case ctOrigin ct of
TypeEqOrigin { uo_actual, uo_expected, uo_thing = mb_thing } ->
@@ -1794,7 +1798,7 @@ This is done in misMatchOrCND (via the insoluble_occurs_check arg)
want to be as draconian with them.)
-}
-sameOccExtras :: TcType -> TcType -> [TcReportInfo]
+sameOccExtras :: TcType -> TcType -> [TcSolverReportInfo]
-- See Note [Disambiguating (X ~ X) errors]
sameOccExtras ty1 ty2
| Just (tc1, _) <- tcSplitTyConApp_maybe ty1
@@ -1876,7 +1880,7 @@ Warn of loopy local equalities that were dropped.
************************************************************************
-}
-mkDictErr :: HasDebugCallStack => ReportErrCtxt -> [Ct] -> TcM SolverReport
+mkDictErr :: HasDebugCallStack => SolverReportErrCtxt -> [Ct] -> TcM SolverReport
mkDictErr ctxt cts
= assert (not (null cts)) $
do { inst_envs <- tcGetInstEnvs
@@ -1921,8 +1925,8 @@ mkDictErr ctxt cts
-- - One match, one or more unifiers: report "Overlapping instances for", show the
-- matching and unifying instances, and say "The choice depends on the instantion of ...,
-- and the result of evaluating ...".
-mk_dict_err :: HasCallStack => ReportErrCtxt -> (Ct, ClsInstLookupResult)
- -> TcM TcReportMsg
+mk_dict_err :: HasCallStack => SolverReportErrCtxt -> (Ct, ClsInstLookupResult)
+ -> TcM TcSolverReportMsg
-- Report an overlap error if this class constraint results
-- from an overlap (returning Left clas), otherwise return (Right pred)
mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped))
@@ -1986,12 +1990,12 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped))
HasFieldOrigin name -> Just (mkVarOccFS name)
_ -> Nothing
- cannot_resolve_msg :: Ct -> [ClsInst] -> RelevantBindings -> [ImportError] -> [GhcHint] -> TcReportMsg
+ cannot_resolve_msg :: Ct -> [ClsInst] -> RelevantBindings -> [ImportError] -> [GhcHint] -> TcSolverReportMsg
cannot_resolve_msg ct candidate_insts binds imp_errs field_suggestions
= CannotResolveInstance ct (getPotentialUnifiers unifiers) candidate_insts imp_errs field_suggestions binds
-- Overlap errors.
- overlap_msg, safe_haskell_msg :: TcReportMsg
+ overlap_msg, safe_haskell_msg :: TcSolverReportMsg
-- Normal overlap error
overlap_msg
= assert (not (null matches)) $ OverlappingInstances ct ispecs (getPotentialUnifiers unifiers)
@@ -2101,8 +2105,8 @@ getAmbigTkvs ct
relevantBindings :: Bool -- True <=> filter by tyvar; False <=> no filtering
-- See #8191
- -> ReportErrCtxt -> Ct
- -> TcM (ReportErrCtxt, RelevantBindings, Ct)
+ -> SolverReportErrCtxt -> Ct
+ -> TcM (SolverReportErrCtxt, RelevantBindings, Ct)
-- Also returns the zonked and tidied CtOrigin of the constraint
relevantBindings want_filtering ctxt ct
= do { traceTc "relevantBindings" (ppr ct)
@@ -2261,3 +2265,45 @@ solverDepthErrorTcS loc ty
, text "(any upper bound you could choose might fail unpredictably with"
, text " minor updates to GHC, so disabling the check is recommended if"
, text " you're sure that type checking should terminate)" ]
+
+{-**********************************************************************
+* *
+ GHC API helper functions
+* *
+**********************************************************************-}
+
+-- | If the 'TcSolverReportMsg' is a type mismatch between
+-- an actual and an expected type, return the actual and expected types
+-- (in that order).
+--
+-- Prefer using this over manually inspecting the 'TcSolverReportMsg' datatype
+-- if you just want this information, as the datatype itself is subject to change
+-- across GHC versions.
+solverReportMsg_ExpectedActuals :: TcSolverReportMsg -> [(Type, Type)]
+solverReportMsg_ExpectedActuals
+ = \case
+ TcReportWithInfo msg infos ->
+ solverReportMsg_ExpectedActuals msg
+ ++ (solverReportInfo_ExpectedActuals =<< toList infos)
+ Mismatch { mismatch_ty1 = exp, mismatch_ty2 = act } ->
+ [(exp, act)]
+ KindMismatch { kmismatch_expected = exp, kmismatch_actual = act } ->
+ [(exp, act)]
+ TypeEqMismatch { teq_mismatch_expected = exp, teq_mismatch_actual = act } ->
+ [(exp,act)]
+ _ -> []
+
+-- | Retrieves all @"expected"/"actual"@ messages from a 'TcSolverReportInfo'.
+--
+-- Prefer using this over inspecting the 'TcSolverReportInfo' datatype if
+-- you just need this information, as the datatype itself is subject to change
+-- across GHC versions.
+solverReportInfo_ExpectedActuals :: TcSolverReportInfo -> [(Type, Type)]
+solverReportInfo_ExpectedActuals
+ = \case
+ ExpectedActual { ea_expected = exp, ea_actual = act } ->
+ [(exp, act)]
+ ExpectedActualAfterTySynExpansion
+ { ea_expanded_expected = exp, ea_expanded_actual = act } ->
+ [(exp, act)]
+ _ -> []
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index edd4b127ee..d1ea6d93e2 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -29,6 +29,7 @@ import GHC.Core.InstEnv
import GHC.Core.TyCo.Rep (Type(..))
import GHC.Core.TyCo.Ppr (pprWithExplicitKindsWhen,
pprSourceTyCon, pprTyVars, pprWithTYPE)
+import GHC.Core.PatSyn ( patSynName, pprPatSynType )
import GHC.Core.Predicate
import GHC.Core.Type
@@ -91,7 +92,7 @@ instance Diagnostic TcRnMessage where
-> messageWithInfoDiagnosticMessage unit_state err_info (diagnosticMessage msg)
TcRnSolverReport msgs _ _
-> mkDecorated $
- map pprReportWithCtxt msgs
+ map pprSolverReportWithCtxt msgs
TcRnRedundantConstraints redundants (info, show_info)
-> mkSimpleDecorated $
text "Redundant constraint" <> plural redundants <> colon
@@ -101,7 +102,7 @@ instance Diagnostic TcRnMessage where
-> mkSimpleDecorated $
hang (text "Inaccessible code in")
2 (ppr (ic_info implic))
- $$ vcat (map pprReportWithCtxt (NE.toList contras))
+ $$ vcat (map pprSolverReportWithCtxt (NE.toList contras))
TcRnTypeDoesNotHaveFixedRuntimeRep ty prov (ErrInfo extra supplementary)
-> mkDecorated [pprTypeDoesNotHaveFixedRuntimeRep ty prov, extra, supplementary]
TcRnImplicitLift id_or_name ErrInfo{..}
@@ -230,6 +231,24 @@ instance Diagnostic TcRnMessage where
hang (text "Can't quantify over" <+> quotes (ppr n))
2 (hang (text "bound by the partial type signature:")
2 (ppr fn_name <+> dcolon <+> ppr hs_ty))
+ TcRnMissingSignature what _ _ ->
+ mkSimpleDecorated $
+ case what of
+ MissingPatSynSig p ->
+ hang (text "Pattern synonym with no type signature:")
+ 2 (text "pattern" <+> pprPrefixName (patSynName p) <+> dcolon <+> pprPatSynType p)
+ MissingTopLevelBindingSig name ty ->
+ hang (text "Top-level binding with no type signature:")
+ 2 (pprPrefixName name <+> dcolon <+> pprSigmaType ty)
+ MissingTyConKindSig tc cusks_enabled ->
+ hang msg
+ 2 (text "type" <+> pprPrefixName (tyConName tc) <+> dcolon <+> pprKind (tyConKind tc))
+ where
+ msg | cusks_enabled
+ = text "Top-level type constructor with no standalone kind signature or CUSK:"
+ | otherwise
+ = text "Top-level type constructor with no standalone kind signature:"
+
TcRnPolymorphicBinderMissingSig n ty
-> mkSimpleDecorated $
sep [ text "Polymorphic local binding with no type signature:"
@@ -701,6 +720,8 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnPartialTypeSigBadQuantifier{}
-> ErrorWithoutFlag
+ TcRnMissingSignature what exported overridden
+ -> WarningWithFlag $ missingSignatureWarningFlag what exported overridden
TcRnPolymorphicBinderMissingSig{}
-> WarningWithFlag Opt_WarnMissingLocalSignatures
TcRnOverloadedSig{}
@@ -937,6 +958,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnPartialTypeSigBadQuantifier{}
-> noHints
+ TcRnMissingSignature {}
+ -> noHints
TcRnPolymorphicBinderMissingSig{}
-> noHints
TcRnOverloadedSig{}
@@ -1230,6 +1253,23 @@ formatExportItemError exportedThing reason =
, quotes exportedThing
, text reason ]
+-- | What warning flag is associated with the given missing signature?
+missingSignatureWarningFlag :: MissingSignature -> Exported -> Bool -> WarningFlag
+missingSignatureWarningFlag (MissingTopLevelBindingSig {}) exported overridden
+ | IsExported <- exported
+ , not overridden
+ = Opt_WarnMissingExportedSignatures
+ | otherwise
+ = Opt_WarnMissingSignatures
+missingSignatureWarningFlag (MissingPatSynSig {}) exported overridden
+ | IsExported <- exported
+ , not overridden
+ = Opt_WarnMissingExportedPatternSynonymSignatures
+ | otherwise
+ = Opt_WarnMissingPatternSynonymSignatures
+missingSignatureWarningFlag (MissingTyConKindSig {}) _ _
+ = Opt_WarnMissingKindSignatures
+
useDerivingStrategies :: GhcHint
useDerivingStrategies =
useExtensionInOrderTo (text "to pick a different strategy") LangExt.DerivingStrategies
@@ -1439,11 +1479,11 @@ derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving pprHerald = \cas
{- *********************************************************************
* *
- Outputable ReportErrCtxt (for debugging)
+ Outputable SolverReportErrCtxt (for debugging)
* *
**********************************************************************-}
-instance Outputable ReportErrCtxt where
+instance Outputable SolverReportErrCtxt where
ppr (CEC { cec_binds = bvar
, cec_defer_type_errors = dte
, cec_expr_holes = eh
@@ -1464,34 +1504,34 @@ instance Outputable ReportErrCtxt where
{- *********************************************************************
* *
- Outputting TcReportMsg errors
+ Outputting TcSolverReportMsg errors
* *
**********************************************************************-}
--- | Pretty-print a 'ReportWithCtxt', containing a 'TcReportMsg'
--- with its enclosing 'ReportErrCtxt'.
-pprReportWithCtxt :: ReportWithCtxt -> SDoc
-pprReportWithCtxt (ReportWithCtxt { reportContext = ctxt, reportContent = msg })
- = pprTcReportMsg ctxt msg
+-- | Pretty-print a 'SolverReportWithCtxt', containing a 'TcSolverReportMsg'
+-- with its enclosing 'SolverReportErrCtxt'.
+pprSolverReportWithCtxt :: SolverReportWithCtxt -> SDoc
+pprSolverReportWithCtxt (SolverReportWithCtxt { reportContext = ctxt, reportContent = msg })
+ = pprTcSolverReportMsg ctxt msg
--- | Pretty-print a 'TcReportMsg', with its enclosing 'ReportErrCtxt'.
-pprTcReportMsg :: ReportErrCtxt -> TcReportMsg -> SDoc
-pprTcReportMsg ctxt (TcReportWithInfo msg (info :| infos)) =
+-- | Pretty-print a 'TcSolverReportMsg', with its enclosing 'SolverReportErrCtxt'.
+pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
+pprTcSolverReportMsg ctxt (TcReportWithInfo msg (info :| infos)) =
vcat
- ( pprTcReportMsg ctxt msg
- : pprTcReportInfo ctxt info
- : map (pprTcReportInfo ctxt) infos )
-pprTcReportMsg _ (BadTelescope telescope skols) =
+ ( pprTcSolverReportMsg ctxt msg
+ : pprTcSolverReportInfo ctxt info
+ : map (pprTcSolverReportInfo ctxt) infos )
+pprTcSolverReportMsg _ (BadTelescope telescope skols) =
hang (text "These kind and type variables:" <+> ppr telescope $$
text "are out of dependency order. Perhaps try this ordering:")
2 (pprTyVars sorted_tvs)
where
sorted_tvs = scopedSort skols
-pprTcReportMsg _ (UserTypeError ty) =
+pprTcSolverReportMsg _ (UserTypeError ty) =
pprUserTypeErrorTy ty
-pprTcReportMsg ctxt (ReportHoleError hole err) =
+pprTcSolverReportMsg ctxt (ReportHoleError hole err) =
pprHoleError ctxt hole err
-pprTcReportMsg _ (CannotUnifyWithPolytype ct tv1 ty2) =
+pprTcSolverReportMsg _ (CannotUnifyWithPolytype ct tv1 ty2) =
vcat [ (if isSkolemTyVar tv1
then text "Cannot equate type variable"
else text "Cannot instantiate unification variable")
@@ -1500,7 +1540,7 @@ pprTcReportMsg _ (CannotUnifyWithPolytype ct tv1 ty2) =
where
what = text $ levelString $
ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel
-pprTcReportMsg _
+pprTcSolverReportMsg _
(Mismatch { mismatch_ea = add_ea
, mismatch_ct = ct
, mismatch_ty1 = ty1
@@ -1547,7 +1587,7 @@ pprTcReportMsg _
add_space s1 s2 | null s1 = s2
| null s2 = s1
| otherwise = s1 ++ (' ' : s2)
-pprTcReportMsg _
+pprTcSolverReportMsg _
(KindMismatch { kmismatch_what = thing
, kmismatch_expected = exp
, kmismatch_actual = act })
@@ -1563,7 +1603,7 @@ pprTcReportMsg _
| otherwise = text "kind" <+> quotes (ppr exp)
-pprTcReportMsg ctxt
+pprTcSolverReportMsg ctxt
(TypeEqMismatch { teq_mismatch_ppr_explicit_kinds = ppr_explicit_kinds
, teq_mismatch_ct = ct
, teq_mismatch_ty1 = ty1
@@ -1589,17 +1629,17 @@ pprTcReportMsg ctxt
, quotes (pprWithTYPE act) ]
| Just nargs_msg <- num_args_msg
, Right ea_msg <- mk_ea_msg ctxt (Just ct) level orig
- = nargs_msg $$ pprTcReportMsg ctxt ea_msg
+ = nargs_msg $$ pprTcSolverReportMsg ctxt ea_msg
| -- pprTrace "check" (ppr ea_looks_same $$ ppr exp $$ ppr act $$ ppr ty1 $$ ppr ty2) $
ea_looks_same ty1 ty2 exp act
, Right ea_msg <- mk_ea_msg ctxt (Just ct) level orig
- = pprTcReportMsg ctxt ea_msg
+ = pprTcSolverReportMsg ctxt ea_msg
-- The mismatched types are /inside/ exp and act
| let mismatch_err = Mismatch False ct ty1 ty2
errs = case mk_ea_msg ctxt Nothing level orig of
Left ea_info -> [ mkTcReportWithInfo mismatch_err ea_info ]
Right ea_err -> [ mismatch_err, ea_err ]
- = vcat $ map (pprTcReportMsg ctxt) errs
+ = vcat $ map (pprTcSolverReportMsg ctxt) errs
ct_loc = ctLoc ct
orig = ctOrigin ct
@@ -1620,7 +1660,7 @@ pprTcReportMsg ctxt
n | n > 0 -- we don't know how many args there are, so don't
-- recommend removing args that aren't
, Just thing <- mb_thing
- -> Just $ pprTcReportMsg ctxt (ExpectingMoreArguments n thing)
+ -> Just $ pprTcSolverReportMsg ctxt (ExpectingMoreArguments n thing)
_ -> Nothing
_ -> Nothing
@@ -1628,7 +1668,7 @@ pprTcReportMsg ctxt
maybe_num_args_msg = num_args_msg `orElse` empty
count_args ty = count isVisibleBinder $ fst $ splitPiTys ty
-pprTcReportMsg _ (FixedRuntimeRepError origs_and_tys) =
+pprTcSolverReportMsg _ (FixedRuntimeRepError origs_and_tys) =
let
-- Assemble the error message: pair up each origin with the corresponding type, e.g.
-- • FixedRuntimeRep origin msg 1 ...
@@ -1643,7 +1683,7 @@ pprTcReportMsg _ (FixedRuntimeRepError origs_and_tys) =
,nest 2 $ ppr ty <+> dcolon <+> pprWithTYPE (typeKind ty)]
in
vcat $ map (uncurry combine_origin_ty) origs_and_tys
-pprTcReportMsg _ (SkolemEscape ct implic esc_skols) =
+pprTcSolverReportMsg _ (SkolemEscape ct implic esc_skols) =
let
esc_doc = sep [ text "because" <+> what <+> text "variable" <> plural esc_skols
<+> pprQuotedList esc_skols
@@ -1664,40 +1704,40 @@ pprTcReportMsg _ (SkolemEscape ct implic esc_skols) =
where
what = text $ levelString $
ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel
-pprTcReportMsg _ (UntouchableVariable tv implic)
+pprTcSolverReportMsg _ (UntouchableVariable tv implic)
| Implic { ic_given = given, ic_info = skol_info } <- implic
= sep [ quotes (ppr tv) <+> text "is untouchable"
, nest 2 $ text "inside the constraints:" <+> pprEvVarTheta given
, nest 2 $ text "bound by" <+> ppr skol_info
, nest 2 $ text "at" <+>
ppr (getLclEnvLoc (ic_env implic)) ]
-pprTcReportMsg _ (BlockedEquality ct) =
+pprTcSolverReportMsg _ (BlockedEquality ct) =
vcat [ hang (text "Cannot use equality for substitution:")
2 (ppr (ctPred ct))
, text "Doing so would be ill-kinded." ]
-pprTcReportMsg _ (ExpectingMoreArguments n thing) =
+pprTcSolverReportMsg _ (ExpectingMoreArguments n thing) =
text "Expecting" <+> speakN (abs n) <+>
more <+> quotes (ppr thing)
where
more
| n == 1 = text "more argument to"
| otherwise = text "more arguments to" -- n > 1
-pprTcReportMsg ctxt (UnboundImplicitParams (ct :| cts)) =
+pprTcSolverReportMsg ctxt (UnboundImplicitParams (ct :| cts)) =
let givens = getUserGivens ctxt
in if null givens
then addArising (ctOrigin ct) $
sep [ text "Unbound implicit parameter" <> plural preds
, nest 2 (pprParendTheta preds) ]
- else pprTcReportMsg ctxt (CouldNotDeduce givens (ct :| cts) Nothing)
+ else pprTcSolverReportMsg ctxt (CouldNotDeduce givens (ct :| cts) Nothing)
where
preds = map ctPred (ct : cts)
-pprTcReportMsg ctxt (CouldNotDeduce useful_givens (ct :| others) mb_extra)
+pprTcSolverReportMsg ctxt (CouldNotDeduce useful_givens (ct :| others) mb_extra)
= main_msg $$
case supplementary of
Left infos
- -> vcat (map (pprTcReportInfo ctxt) infos)
+ -> vcat (map (pprTcSolverReportInfo ctxt) infos)
Right other_msg
- -> pprTcReportMsg ctxt other_msg
+ -> pprTcSolverReportMsg ctxt other_msg
where
main_msg
| null useful_givens
@@ -1725,21 +1765,21 @@ pprTcReportMsg ctxt (CouldNotDeduce useful_givens (ct :| others) mb_extra)
= text "Could not deduce" <+> pprParendType wanted
| otherwise
= text "Could not deduce:" <+> pprTheta wanteds
-pprTcReportMsg ctxt (AmbiguityPreventsSolvingCt ct ambigs) =
- pprTcReportInfo ctxt (Ambiguity True ambigs) <+>
+pprTcSolverReportMsg ctxt (AmbiguityPreventsSolvingCt ct ambigs) =
+ pprTcSolverReportInfo ctxt (Ambiguity True ambigs) <+>
pprArising (ctOrigin ct) $$
text "prevents the constraint" <+> quotes (pprParendType $ ctPred ct)
<+> text "from being solved."
-pprTcReportMsg ctxt@(CEC {cec_encl = implics})
+pprTcSolverReportMsg ctxt@(CEC {cec_encl = implics})
(CannotResolveInstance ct unifiers candidates imp_errs suggs binds)
=
vcat
- [ pprTcReportMsg ctxt no_inst_msg
+ [ pprTcSolverReportMsg ctxt no_inst_msg
, nest 2 extra_note
, mb_patsyn_prov `orElse` empty
, ppWhen (has_ambigs && not (null unifiers && null useful_givens))
(vcat [ ppUnless lead_with_ambig $
- pprTcReportInfo ctxt (Ambiguity False (ambig_kvs, ambig_tvs))
+ pprTcSolverReportInfo ctxt (Ambiguity False (ambig_kvs, ambig_tvs))
, pprRelevantBindings binds
, potential_msg ])
, ppWhen (isNothing mb_patsyn_prov) $
@@ -1769,7 +1809,7 @@ pprTcReportMsg ctxt@(CEC {cec_encl = implics})
&& not (null unifiers)
&& null useful_givens
- no_inst_msg :: TcReportMsg
+ no_inst_msg :: TcSolverReportMsg
no_inst_msg
| lead_with_ambig
= AmbiguityPreventsSolvingCt ct (ambig_kvs, ambig_tvs)
@@ -1826,7 +1866,7 @@ pprTcReportMsg ctxt@(CEC {cec_encl = implics})
= hang (text "use a standalone 'deriving instance' declaration,")
2 (text "so you can specify the instance context yourself")
-pprTcReportMsg (CEC {cec_encl = implics}) (OverlappingInstances ct matches unifiers) =
+pprTcSolverReportMsg (CEC {cec_encl = implics}) (OverlappingInstances ct matches unifiers) =
vcat
[ addArising orig $
(text "Overlapping instances for"
@@ -1886,7 +1926,7 @@ pprTcReportMsg (CEC {cec_encl = implics}) (OverlappingInstances ct matches unifi
Just (clas', tys') -> clas' == clas
&& isJust (tcMatchTys tys tys')
Nothing -> False
-pprTcReportMsg _ (UnsafeOverlap ct matches unsafe_overlapped) =
+pprTcSolverReportMsg _ (UnsafeOverlap ct matches unsafe_overlapped) =
vcat [ addArising orig (text "Unsafe overlapping instances for"
<+> pprType (mkClassPred clas tys))
, sep [text "The matching instance is:",
@@ -2093,13 +2133,13 @@ we want to give it a bit of structure. Here's the plan
{- *********************************************************************
* *
- Outputting TcReportInfo
+ Outputting TcSolverReportInfo
* *
**********************************************************************-}
--- | Pretty-print an informational message, to accompany a 'TcReportMsg'.
-pprTcReportInfo :: ReportErrCtxt -> TcReportInfo -> SDoc
-pprTcReportInfo _ (Ambiguity prepend_msg (ambig_kvs, ambig_tvs)) = msg
+-- | Pretty-print an informational message, to accompany a 'TcSolverReportMsg'.
+pprTcSolverReportInfo :: SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
+pprTcSolverReportInfo _ (Ambiguity prepend_msg (ambig_kvs, ambig_tvs)) = msg
where
msg | any isRuntimeUnkSkol ambig_kvs -- See Note [Runtime skolems]
@@ -2122,21 +2162,21 @@ pprTcReportInfo _ (Ambiguity prepend_msg (ambig_kvs, ambig_tvs)) = msg
| otherwise -- "The type variable 't0' is ambiguous"
= text "The" <+> what <+> text "variable" <> plural tkvs
<+> pprQuotedList tkvs <+> isOrAre tkvs <+> text "ambiguous"
-pprTcReportInfo ctxt (TyVarInfo tv ) =
+pprTcSolverReportInfo ctxt (TyVarInfo tv ) =
case tcTyVarDetails tv of
SkolemTv sk_info _ _ -> pprSkols ctxt [(getSkolemInfo sk_info, [tv])]
RuntimeUnk {} -> quotes (ppr tv) <+> text "is an interactive-debugger skolem"
MetaTv {} -> empty
-pprTcReportInfo _ (NonInjectiveTyFam tc) =
+pprTcSolverReportInfo _ (NonInjectiveTyFam tc) =
text "NB:" <+> quotes (ppr tc)
<+> text "is a non-injective type family"
-pprTcReportInfo _ (ReportCoercibleMsg msg) =
+pprTcSolverReportInfo _ (ReportCoercibleMsg msg) =
pprCoercibleMsg msg
-pprTcReportInfo _ (ExpectedActual { ea_expected = exp, ea_actual = act }) =
+pprTcSolverReportInfo _ (ExpectedActual { ea_expected = exp, ea_actual = act }) =
vcat
[ text "Expected:" <+> ppr exp
, text " Actual:" <+> ppr act ]
-pprTcReportInfo _
+pprTcSolverReportInfo _
(ExpectedActualAfterTySynExpansion
{ ea_expanded_expected = exp
, ea_expanded_actual = act } )
@@ -2144,7 +2184,7 @@ pprTcReportInfo _
[ text "Type synonyms expanded:"
, text "Expected type:" <+> ppr exp
, text " Actual type:" <+> ppr act ]
-pprTcReportInfo ctxt (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k) =
+pprTcSolverReportInfo ctxt (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k) =
sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions ->
if printExplicitCoercions
|| not (cty1 `pickyEqType` cty2)
@@ -2160,9 +2200,9 @@ pprTcReportInfo ctxt (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k) =
sub_whats = text (levelString sub_t_or_k) <> char 's'
supplementary =
case mk_supplementary_ea_msg ctxt sub_t_or_k cty1 cty2 sub_o of
- Left infos -> vcat $ map (pprTcReportInfo ctxt) infos
- Right msg -> pprTcReportMsg ctxt msg
-pprTcReportInfo _ (SameOcc same_pkg n1 n2) =
+ Left infos -> vcat $ map (pprTcSolverReportInfo ctxt) infos
+ Right msg -> pprTcSolverReportMsg ctxt msg
+pprTcSolverReportInfo _ (SameOcc same_pkg n1 n2) =
text "NB:" <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2)
where
ppr_from same_pkg nm
@@ -2178,7 +2218,7 @@ pprTcReportInfo _ (SameOcc same_pkg n1 n2) =
pkg = moduleUnit mod
mod = nameModule nm
loc = nameSrcSpan nm
-pprTcReportInfo ctxt (OccursCheckInterestingTyVars (tv :| tvs)) =
+pprTcSolverReportInfo ctxt (OccursCheckInterestingTyVars (tv :| tvs)) =
hang (text "Type variable kinds:") 2 $
vcat (map (tyvar_binding . tidyTyCoVarOcc (cec_tidy ctxt))
(tv:tvs))
@@ -2205,7 +2245,7 @@ pprCoercibleMsg (OutOfScopeNewtypeConstructor tc dc) =
* *
**********************************************************************-}
-pprHoleError :: ReportErrCtxt -> Hole -> HoleError -> SDoc
+pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc
pprHoleError _ (Hole { hole_ty, hole_occ = occ }) (OutOfScopeHole imp_errs)
= out_of_scope_msg $$ vcat (map ppr imp_errs)
where
@@ -2508,7 +2548,7 @@ tidySigSkol env cx ty tv_prs
| otherwise
= tidyVarBndr env tv
-pprSkols :: ReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
+pprSkols :: SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
pprSkols ctxt zonked_ty_vars
=
let tidy_ty_vars = map (bimap (tidySkolemInfoAnon (cec_tidy ctxt)) id) zonked_ty_vars
@@ -2551,8 +2591,8 @@ skolsSpan skol_tvs = foldr1 combineSrcSpans (map getSrcSpan skol_tvs)
* *
**********************************************************************-}
-mk_supplementary_ea_msg :: ReportErrCtxt -> TypeOrKind
- -> Type -> Type -> CtOrigin -> Either [TcReportInfo] TcReportMsg
+mk_supplementary_ea_msg :: SolverReportErrCtxt -> TypeOrKind
+ -> Type -> Type -> CtOrigin -> Either [TcSolverReportInfo] TcSolverReportMsg
mk_supplementary_ea_msg ctxt level ty1 ty2 orig
| TypeEqOrigin { uo_expected = exp, uo_actual = act } <- orig
, not (ea_looks_same ty1 ty2 exp act)
@@ -2574,7 +2614,7 @@ ea_looks_same ty1 ty2 exp act
-- when the types really look the same. However,
-- (TYPE 'LiftedRep) and Type both print the same way.
-mk_ea_msg :: ReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> Either [TcReportInfo] TcReportMsg
+mk_ea_msg :: SolverReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> Either [TcSolverReportInfo] TcSolverReportMsg
-- Constructs a "Couldn't match" message
-- The (Maybe Ct) says whether this is the main top-level message (Just)
-- or a supplementary message (Nothing)
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index e292d864d8..c244c4c2a4 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -1,4 +1,6 @@
{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+
module GHC.Tc.Errors.Types (
-- * Main types
TcRnMessage(..)
@@ -31,12 +33,14 @@ module GHC.Tc.Errors.Types (
, associatedTyLastVarInKind
, AssociatedTyNotParamOverLastTyVar(..)
, associatedTyNotParamOverLastTyVar
+ , MissingSignature(..)
+ , Exported(..)
, SolverReport(..), SolverReportSupplementary(..)
- , ReportWithCtxt(..)
- , ReportErrCtxt(..)
+ , SolverReportWithCtxt(..)
+ , SolverReportErrCtxt(..)
, getUserGivens, discardProvCtxtGivens
- , TcReportMsg(..), TcReportInfo(..)
+ , TcSolverReportMsg(..), TcSolverReportInfo(..)
, CND_Extra(..)
, mkTcReportWithInfo
, FitsMbSuppressed(..)
@@ -77,6 +81,7 @@ import GHC.Core.ConLike (ConLike)
import GHC.Core.DataCon (DataCon)
import GHC.Core.FamInstEnv (FamInst)
import GHC.Core.InstEnv (ClsInst)
+import GHC.Core.PatSyn (PatSyn)
import GHC.Core.TyCon (TyCon, TyConFlavour)
import GHC.Core.Type (Kind, Type, ThetaType, PredType)
import GHC.Unit.State (UnitState)
@@ -164,10 +169,10 @@ data TcRnMessage where
{-| TcRnSolverReport is the constructor used to report unsolved constraints
after constraint solving, as well as other errors such as hole fit errors.
- See the documentation of the 'TcReportMsg' datatype for an overview
+ See the documentation of the 'TcSolverReportMsg' datatype for an overview
of the different errors.
-}
- TcRnSolverReport :: [ReportWithCtxt]
+ TcRnSolverReport :: [SolverReportWithCtxt]
-> DiagnosticReason
-> [GhcHint]
-> TcRnMessage
@@ -202,7 +207,7 @@ data TcRnMessage where
Test cases: T7293, T7294, T15558, T17646, T18572, T18610, tcfail167.
-}
TcRnInaccessibleCode :: Implication -- ^ The implication containing a contradiction.
- -> NE.NonEmpty ReportWithCtxt -- ^ The contradiction(s).
+ -> NE.NonEmpty SolverReportWithCtxt -- ^ The contradiction(s).
-> TcRnMessage
{-| A type which was expected to have a fixed runtime representation
@@ -601,6 +606,27 @@ data TcRnMessage where
-> Name -- ^ function name
-> LHsSigWcType GhcRn -> TcRnMessage
+ {-| TcRnMissingSignature is a warning that occurs when a top-level binding
+ or a pattern synonym does not have a type signature.
+
+ Controlled by the flags:
+ -Wmissing-signatures
+ -Wmissing-exported-signatures
+ -Wmissing-pattern-synonym-signatures
+ -Wmissing-exported-pattern-synonym-signatures
+ -Wmissing-kind-signatures
+
+ Test cases:
+ T11077 (top-level bindings)
+ T12484 (pattern synonyms)
+ T19564 (kind signatures)
+ -}
+ TcRnMissingSignature :: MissingSignature
+ -> Exported
+ -> Bool -- ^ True: -Wmissing-signatures overrides -Wmissing-exported-signatures,
+ -- or -Wmissing-pattern-synonym-signatures overrides -Wmissing-exported-pattern-synonym-signatures
+ -> TcRnMessage
+
{-| TcRnPolymorphicBinderMissingSig is a warning controlled by -Wmissing-local-signatures
that occurs when a local polymorphic binding lacks a type signature.
@@ -1825,6 +1851,29 @@ associatedTyNotParamOverLastTyVar :: Maybe TyCon -> AssociatedTyNotParamOverLast
associatedTyNotParamOverLastTyVar (Just tc) = YesAssociatedTyNotParamOverLastTyVar tc
associatedTyNotParamOverLastTyVar Nothing = NoAssociatedTyNotParamOverLastTyVar
+-- | What kind of thing is missing a type signature?
+--
+-- Used for reporting @"missing signature"@ warnings, see
+-- 'tcRnMissingSignature'.
+data MissingSignature
+ = MissingTopLevelBindingSig Name Type
+ | MissingPatSynSig PatSyn
+ | MissingTyConKindSig
+ TyCon
+ Bool -- ^ whether -XCUSKs is enabled
+
+-- | Is the object we are dealing with exported or not?
+--
+-- Used for reporting @"missing signature"@ warnings, see
+-- 'TcRnMissingSignature'.
+data Exported
+ = IsNotExported
+ | IsExported
+
+instance Outputable Exported where
+ ppr IsNotExported = text "IsNotExported"
+ ppr IsExported = text "IsExported"
+
--------------------------------------------------------------------------------
-- Errors used in GHC.Tc.Errors
@@ -1854,7 +1903,7 @@ See 'GHC.Tc.Errors.Types.SolverReport' and 'GHC.Tc.Errors.mkErrorReport'.
-- See Note [Error report] for details.
data SolverReport
= SolverReport
- { sr_important_msgs :: [ReportWithCtxt]
+ { sr_important_msgs :: [SolverReportWithCtxt]
, sr_supplementary :: [SolverReportSupplementary]
, sr_hints :: [GhcHint]
}
@@ -1868,15 +1917,15 @@ data SolverReportSupplementary
| SupplementaryHoleFits ValidHoleFits
| SupplementaryCts [(PredType, RealSrcSpan)]
--- | A 'TcReportMsg', together with context (e.g. enclosing implication constraints)
+-- | A 'TcSolverReportMsg', together with context (e.g. enclosing implication constraints)
-- that are needed in order to report it.
-data ReportWithCtxt =
- ReportWithCtxt
- { reportContext :: ReportErrCtxt
+data SolverReportWithCtxt =
+ SolverReportWithCtxt
+ { reportContext :: SolverReportErrCtxt
-- ^ Context for what we wish to report.
-- This can change as we enter implications, so is
-- stored alongside the content.
- , reportContent :: TcReportMsg
+ , reportContent :: TcSolverReportMsg
-- ^ The content of the message to report.
}
@@ -1888,9 +1937,9 @@ instance Monoid SolverReport where
mempty = SolverReport [] [] []
mappend = (Semigroup.<>)
--- | Context needed when reporting a 'TcReportMsg', such as
+-- | Context needed when reporting a 'TcSolverReportMsg', such as
-- the enclosing implication constraints or whether we are deferring type errors.
-data ReportErrCtxt
+data SolverReportErrCtxt
= CEC { cec_encl :: [Implication] -- ^ Enclosing implications
-- (innermost first)
-- ic_skols and givens are tidied, rest are not
@@ -1918,7 +1967,7 @@ data ReportErrCtxt
-- See Note [Suppressing error messages]
}
-getUserGivens :: ReportErrCtxt -> [UserGiven]
+getUserGivens :: SolverReportErrCtxt -> [UserGiven]
-- One item for each enclosing implication
getUserGivens (CEC {cec_encl = implics}) = getUserGivensFromImplics implics
@@ -1980,7 +2029,7 @@ discardProvCtxtGivens orig givens -- See Note [discardProvCtxtGivens]
-- | An error reported after constraint solving.
-- This is usually, some sort of unsolved constraint error,
-- but we try to be specific about the precise problem we encountered.
-data TcReportMsg
+data TcSolverReportMsg
-- NB: this datatype is only a first step in refactoring GHC.Tc.Errors
-- to use the diagnostic infrastructure (TcRnMessage etc).
-- If you see possible improvements, please go right ahead!
@@ -1988,7 +2037,7 @@ data TcReportMsg
-- | Wrap a message with additional information.
--
-- Prefer using the 'mkTcReportWithInfo' smart constructor
- = TcReportWithInfo TcReportMsg (NE.NonEmpty TcReportInfo)
+ = TcReportWithInfo TcSolverReportMsg (NE.NonEmpty TcSolverReportInfo)
-- | Quantified variables appear out of dependency order.
--
@@ -2174,12 +2223,12 @@ data TcReportMsg
-- which is then passed on to 'mk_supplementary_ea_msg'.
data CND_Extra = CND_Extra TypeOrKind Type Type
--- | Additional information that can be appended to an existing 'TcReportMsg'.
-data TcReportInfo
+-- | Additional information that can be appended to an existing 'TcSolverReportMsg'.
+data TcSolverReportInfo
-- NB: this datatype is only a first step in refactoring GHC.Tc.Errors
-- to use the diagnostic infrastructure (TcRnMessage etc).
-- It would be better for these constructors to not be so closely tied
- -- to the constructors of 'TcReportMsg'.
+ -- to the constructors of 'TcSolverReportMsg'.
-- If you see possible improvements, please go right ahead!
-- | Some type variables remained ambiguous: print them to the user.
@@ -2337,8 +2386,8 @@ data PotentialInstances
, unifiers :: [ClsInst]
}
--- | Append additional information to a `TcReportMsg`.
-mkTcReportWithInfo :: TcReportMsg -> [TcReportInfo] -> TcReportMsg
+-- | Append additional information to a `TcSolverReportMsg`.
+mkTcReportWithInfo :: TcSolverReportMsg -> [TcSolverReportInfo] -> TcSolverReportMsg
mkTcReportWithInfo msg []
= msg
mkTcReportWithInfo (TcReportWithInfo msg (prev NE.:| prevs)) infos
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index bfaa1a0675..7edd94439b 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -431,7 +431,7 @@ data TypedThing
-- | Some kind of type variable binder.
--
--- Used for reporting errors, in 'SkolemInfo' and 'TcReportMsg'.
+-- Used for reporting errors, in 'SkolemInfo' and 'TcSolverReportMsg'.
data TyVarBndrs
= forall flag. OutputableBndrFlag flag 'Renamed =>
HsTyVarBndrsRn [HsTyVarBndr flag GhcRn]
diff --git a/testsuite/tests/driver/werror.stderr b/testsuite/tests/driver/werror.stderr
index 2ca8354a91..c74e2e02a5 100644
--- a/testsuite/tests/driver/werror.stderr
+++ b/testsuite/tests/driver/werror.stderr
@@ -21,7 +21,7 @@ werror.hs:10:1: error: [-Wunused-top-binds (in -Wextra, -Wunused-binds), -Werror
werror.hs:10:1: error: [-Wincomplete-patterns (in -Wextra), -Werror=incomplete-patterns]
Pattern match(es) are non-exhaustive
- In an equation for ‘f’: Patterns of type ‘[a]’ not matched: (_:_)
+ In an equation for ‘f’: Patterns of type ‘[a]’ not matched: (_:_)
werror.hs:11:1: error: [-Woverlapping-patterns (in -Wdefault), -Werror=overlapping-patterns]
Pattern match is redundant
diff --git a/testsuite/tests/warnings/should_compile/Werror01.stderr b/testsuite/tests/warnings/should_compile/Werror01.stderr
index 91fcc8449f..1cebb3f0d0 100644
--- a/testsuite/tests/warnings/should_compile/Werror01.stderr
+++ b/testsuite/tests/warnings/should_compile/Werror01.stderr
@@ -1,2 +1,3 @@
+
Werror01.hs:5:1: warning: [-Wmissing-signatures (in -Wall)]
Top-level binding with no type signature: foo :: () -> ()
diff --git a/testsuite/tests/warnings/should_fail/WerrorFail2.stderr b/testsuite/tests/warnings/should_fail/WerrorFail2.stderr
index 68c642107b..c3bc935392 100644
--- a/testsuite/tests/warnings/should_fail/WerrorFail2.stderr
+++ b/testsuite/tests/warnings/should_fail/WerrorFail2.stderr
@@ -4,7 +4,7 @@ WerrorFail2.hs:15:1: warning: [-Wmissing-signatures (in -Wall)]
WerrorFail2.hs:15:10: error: [-Wincomplete-patterns (in -Wextra), -Werror=incomplete-patterns]
Pattern match(es) are non-exhaustive
- In a case alternative: Patterns of type ‘S’ not matched: C2 _
+ In a case alternative: Patterns of type ‘S’ not matched: C2 _
WerrorFail2.hs:19:1: warning: [-Wmissing-signatures (in -Wall)]
Top-level binding with no type signature: printRec :: IO ()