From f161e890dfd41fd9735f4e259fffe2ce6d00ec1a Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Mon, 17 Jan 2022 10:45:35 +0100
Subject: [PATCH] Use diagnostic infrastructure in GHC.Tc.Errors
---
compiler/GHC/Parser/Errors/Ppr.hs | 11 +-
compiler/GHC/Parser/Errors/Types.hs | 3 +-
compiler/GHC/Parser/PostProcess.hs | 4 +-
compiler/GHC/Rename/Env.hs | 105 +-
compiler/GHC/Rename/HsType.hs | 7 +-
compiler/GHC/Rename/Module.hs | 13 +-
compiler/GHC/Rename/Pat.hs | 4 +-
compiler/GHC/Rename/Unbound.hs | 239 +-
compiler/GHC/Rename/Utils.hs | 8 +-
compiler/GHC/Tc/Errors.hs | 1950 ++++-------------
compiler/GHC/Tc/Errors/Hole.hs | 46 +-
compiler/GHC/Tc/Errors/Hole.hs-boot | 4 +-
compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot | 24 +-
compiler/GHC/Tc/Errors/Ppr.hs | 1437 +++++++++++-
compiler/GHC/Tc/Errors/Types.hs | 718 +++++-
compiler/GHC/Tc/Gen/App.hs | 4 +-
compiler/GHC/Tc/Gen/Expr.hs | 2 +-
compiler/GHC/Tc/Gen/Head.hs | 53 +-
compiler/GHC/Tc/Gen/HsType.hs | 10 +-
compiler/GHC/Tc/Gen/Pat.hs | 2 +-
compiler/GHC/Tc/TyCl.hs | 2 +-
compiler/GHC/Tc/TyCl/Instance.hs | 2 +-
compiler/GHC/Tc/Types/Constraint.hs | 18 +-
compiler/GHC/Tc/Types/Origin.hs | 41 +-
compiler/GHC/Tc/Utils/Unify.hs | 33 +-
compiler/GHC/Tc/Utils/Unify.hs-boot | 7 +-
compiler/GHC/Types/Hint.hs | 170 +-
compiler/GHC/Types/Hint/Ppr.hs | 115 +-
compiler/GHC/Types/Name/Reader.hs | 82 +-
.../backpack/should_fail/bkpfail24.stderr | 8 +-
.../backpack/should_fail/bkpfail44.stderr | 6 +-
.../backpack/should_fail/bkpfail49.stderr | 8 +-
.../dependent/should_fail/RenamingStar.stderr | 5 +-
testsuite/tests/gadt/T15558.stderr | 4 +-
testsuite/tests/gadt/T7293.stderr | 4 +-
testsuite/tests/gadt/T7294.stderr | 4 +-
testsuite/tests/gadt/gadt-escape1.stderr | 4 +-
testsuite/tests/gadt/gadt13.stderr | 4 +-
testsuite/tests/gadt/gadt7.stderr | 4 +-
.../tests/ghci/prog009/ghci.prog009.stderr | 4 +-
testsuite/tests/ghci/scripts/Defer02.stderr | 4 +-
testsuite/tests/ghci/scripts/T20455.stderr | 5 +-
testsuite/tests/ghci/scripts/T2452.stderr | 4 +-
testsuite/tests/ghci/scripts/T5564.stderr | 9 +-
testsuite/tests/ghci/scripts/T8485.stderr | 3 +-
testsuite/tests/ghci/scripts/T8639.stderr | 4 +-
testsuite/tests/ghci/scripts/ghci036.stderr | 4 +-
testsuite/tests/impredicative/T17332.stderr | 2 +-
.../should_compile/PushedInAsGivens.stderr | 2 +-
.../should_compile/T12538.stderr | 2 +-
.../should_compile/T3208b.stderr | 2 +-
.../indexed-types/should_fail/T2627b.stderr | 2 +-
.../indexed-types/should_fail/T2664.stderr | 2 +-
.../indexed-types/should_fail/T3440.stderr | 2 +-
.../indexed-types/should_fail/T4093a.stderr | 2 +-
.../indexed-types/should_fail/T4093b.stderr | 2 +-
testsuite/tests/module/mod101.stderr | 4 +-
testsuite/tests/module/mod102.stderr | 4 +-
testsuite/tests/module/mod114.stderr | 5 +-
testsuite/tests/module/mod121.stderr | 4 +-
testsuite/tests/module/mod124.stderr | 5 +-
testsuite/tests/module/mod125.stderr | 5 +-
testsuite/tests/module/mod126.stderr | 5 +-
testsuite/tests/module/mod127.stderr | 5 +-
testsuite/tests/module/mod130.stderr | 5 +-
testsuite/tests/module/mod132.stderr | 2 +-
testsuite/tests/module/mod134.stderr | 13 +-
testsuite/tests/module/mod136.stderr | 7 +-
testsuite/tests/module/mod160.stderr | 5 +-
testsuite/tests/module/mod29.stderr | 5 +-
testsuite/tests/module/mod36.stderr | 5 +-
testsuite/tests/module/mod4.stderr | 2 +-
testsuite/tests/module/mod62.stderr | 2 +-
testsuite/tests/module/mod73.stderr | 11 +-
testsuite/tests/module/mod74.stderr | 2 +-
testsuite/tests/module/mod87.stderr | 7 +-
testsuite/tests/module/mod88.stderr | 5 +-
testsuite/tests/module/mod97.stderr | 7 +-
.../overloadedrecflds/ghci/T19314.stdout | 18 +-
.../should_fail/NFSExport.stderr | 5 +-
.../should_fail/NFSSuppressed.stderr | 9 +-
.../tests/parser/should_fail/T17045.stderr | 5 +-
.../tests/parser/should_fail/T8501c.stderr | 8 +-
.../parser/should_fail/readFail001.stderr | 8 +-
.../NamedExtraConstraintsWildcard.stderr | 2 +-
.../partial-sigs/should_fail/T14584.stderr | 2 +-
.../should_fail/WildcardInADTContext2.stderr | 2 +-
.../tests/patsyn/should_fail/T13470.stderr | 2 +-
.../tests/patsyn/should_fail/T15685.stderr | 4 +-
.../tests/patsyn/should_fail/T15695.stderr | 2 +-
.../records-nofieldselectors.stderr | 7 +-
.../pmcheck/should_compile/T17646.stderr | 4 +-
.../pmcheck/should_compile/T18572.stderr | 7 +-
.../pmcheck/should_compile/T18610.stderr | 4 +-
testsuite/tests/polykinds/T18451.stderr | 6 +-
testsuite/tests/polykinds/T7230.stderr | 2 +-
testsuite/tests/polykinds/T7438.stderr | 4 +-
testsuite/tests/polykinds/T7594.stderr | 4 +-
.../qualifieddo/should_fail/qdofail003.stderr | 7 +-
.../qualifieddo/should_fail/qdofail004.stderr | 7 +-
.../quantified-constraints/T19921.stderr | 2 +-
.../rename/prog002/rename.prog002.stderr | 5 +-
.../tests/rename/should_compile/T9778.stderr | 2 +-
.../tests/rename/should_fail/T10618.stderr | 5 +-
.../tests/rename/should_fail/T10781.stderr | 2 +-
.../tests/rename/should_fail/T11071.stderr | 53 +-
.../tests/rename/should_fail/T11071a.stderr | 30 +-
.../tests/rename/should_fail/T12681.stderr | 2 +-
.../tests/rename/should_fail/T13568.stderr | 4 +-
.../tests/rename/should_fail/T14225.stderr | 3 +-
.../tests/rename/should_fail/T15539.stderr | 5 +-
.../tests/rename/should_fail/T15607.stderr | 5 +-
.../tests/rename/should_fail/T16504.stderr | 6 +-
.../tests/rename/should_fail/T19843b.stderr | 6 +-
.../tests/rename/should_fail/T19843c.stderr | 2 +-
.../tests/rename/should_fail/T19843d.stderr | 2 +-
.../tests/rename/should_fail/T19843e.stderr | 2 +-
.../tests/rename/should_fail/T19843f.stderr | 4 +-
.../tests/rename/should_fail/T19843g.stderr | 2 +-
.../tests/rename/should_fail/T19843h.stderr | 34 +-
.../tests/rename/should_fail/T19843i.stderr | 7 +-
.../tests/rename/should_fail/T19843j.stderr | 9 +-
.../tests/rename/should_fail/T19843k.stderr | 4 +-
.../tests/rename/should_fail/T19843l.stderr | 4 +-
.../tests/rename/should_fail/T19843m.stderr | 7 +-
.../tests/rename/should_fail/T2901.stderr | 2 +-
.../tests/rename/should_fail/T2993.stderr | 4 +-
.../tests/rename/should_fail/T495.stderr | 3 +-
.../tests/rename/should_fail/T5001b.stderr | 3 +-
.../tests/rename/should_fail/T5372.stderr | 2 +-
.../tests/rename/should_fail/T5533.stderr | 3 +-
.../tests/rename/should_fail/T5657.stderr | 2 +-
.../tests/rename/should_fail/T7906.stderr | 3 +-
.../tests/rename/should_fail/T7937.stderr | 4 +-
.../tests/rename/should_fail/T9177.stderr | 9 +-
.../tests/rename/should_fail/T9436.stderr | 4 +-
.../tests/rename/should_fail/rnfail022.stderr | 5 +-
.../tests/rename/should_fail/rnfail030.stderr | 5 +-
.../tests/rename/should_fail/rnfail031.stderr | 5 +-
.../tests/rename/should_fail/rnfail032.stderr | 13 +-
.../tests/rename/should_fail/rnfail033.stderr | 13 +-
.../tests/rename/should_fail/rnfail034.stderr | 2 +-
testsuite/tests/safeHaskell/ghci/p16.stderr | 4 +-
testsuite/tests/safeHaskell/ghci/p4.stderr | 2 +-
testsuite/tests/safeHaskell/ghci/p6.stderr | 4 +-
testsuite/tests/th/T11680.stderr | 22 +-
testsuite/tests/th/T11941.stderr | 7 +-
testsuite/tests/th/T13837.stderr | 9 +-
testsuite/tests/th/T18102.stderr | 10 +-
testsuite/tests/th/T2713.stderr | 10 +-
testsuite/tests/th/T5971.stderr | 9 +-
testsuite/tests/th/T7241.stderr | 9 +-
.../typecheck/should_compile/T13651.stderr | 2 +-
.../typecheck/should_compile/T9939.stderr | 24 +-
.../typecheck/should_compile/tc214.stderr | 8 +-
.../should_compile/valid_hole_fits.stderr | 14 +-
.../should_fail/GivenForallLoop.stderr | 2 +-
.../tests/typecheck/should_fail/T10285.stderr | 2 +-
.../tests/typecheck/should_fail/T10534.stderr | 2 +-
.../typecheck/should_fail/T12178a.stderr | 3 +-
.../typecheck/should_fail/T12785b.stderr | 2 +-
.../tests/typecheck/should_fail/T13640.stderr | 11 +-
.../tests/typecheck/should_fail/T15361.stderr | 2 +-
.../tests/typecheck/should_fail/T19978.stderr | 8 +-
.../tests/typecheck/should_fail/T5853.stderr | 2 +-
.../tests/typecheck/should_fail/T7525.stderr | 2 +-
.../tests/typecheck/should_fail/T9109.stderr | 4 +-
.../typecheck/should_fail/tcfail046.stderr | 2 +-
.../typecheck/should_fail/tcfail062.stderr | 10 +-
.../typecheck/should_fail/tcfail167.stderr | 4 +-
.../typecheck/should_run/Typeable1.stderr | 6 +-
171 files changed, 3526 insertions(+), 2413 deletions(-)
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index 138a24ccd5ae..fe9f74eb7305 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -14,10 +14,11 @@ import GHC.Parser.Errors.Basic
import GHC.Parser.Errors.Types
import GHC.Parser.Types
import GHC.Types.Basic
+import GHC.Types.Hint
import GHC.Types.Error
import GHC.Types.Hint.Ppr (perhapsAsPat)
import GHC.Types.SrcLoc
-import GHC.Types.Name.Reader (opIsAt, starInfo, rdrNameOcc, mkUnqual)
+import GHC.Types.Name.Reader ( opIsAt, rdrNameOcc, mkUnqual )
import GHC.Types.Name.Occurrence (isSymOcc, occNameFS, varName)
import GHC.Utils.Outputable
import GHC.Utils.Misc
@@ -272,10 +273,9 @@ instance Diagnostic PsMessage where
(ppr v)
PsErrTupleSectionInPat
-> mkSimpleDecorated $ text "Tuple section in pattern context"
- PsErrOpFewArgs (StarIsType star_is_type) op
+ PsErrOpFewArgs _ op
-> mkSimpleDecorated $
text "Operator applied to too few arguments:" <+> ppr op
- $$ starInfo star_is_type op
PsErrVarForTyCon name
-> mkSimpleDecorated $
text "Expecting a type constructor but found a variable,"
@@ -610,7 +610,7 @@ instance Diagnostic PsMessage where
PsWarnHaddockInvalidPos -> noHints
PsWarnHaddockIgnoreMulti -> noHints
PsWarnStarBinder -> [SuggestQualifyStarOperator]
- PsWarnStarIsType -> [SuggestUseTypeFromDataKind]
+ PsWarnStarIsType -> [SuggestUseTypeFromDataKind Nothing]
PsWarnUnrecognisedPragma -> noHints
PsWarnImportPreQualified -> [ SuggestQualifiedAfterModuleName
, suggestExtension LangExt.ImportQualifiedPost]
@@ -668,7 +668,8 @@ instance Diagnostic PsMessage where
PsErrUnsupportedBoxedSumPat{} -> noHints
PsErrUnexpectedQualifiedConstructor{} -> noHints
PsErrTupleSectionInPat{} -> noHints
- PsErrOpFewArgs{} -> noHints
+ PsErrOpFewArgs star_is_type op
+ -> noStarIsTypeHints star_is_type op
PsErrVarForTyCon{} -> noHints
PsErrMalformedEntityString -> noHints
PsErrDotsInRecordUpdate -> noHints
diff --git a/compiler/GHC/Parser/Errors/Types.hs b/compiler/GHC/Parser/Errors/Types.hs
index d39048c441b0..d50b21d7adb3 100644
--- a/compiler/GHC/Parser/Errors/Types.hs
+++ b/compiler/GHC/Parser/Errors/Types.hs
@@ -12,6 +12,7 @@ import GHC.Hs
import GHC.Parser.Types
import GHC.Parser.Errors.Basic
import GHC.Types.Error
+import GHC.Types.Hint
import GHC.Types.Name.Occurrence (OccName)
import GHC.Types.Name.Reader
import GHC.Unit.Module.Name
@@ -452,8 +453,6 @@ data PsMessage
| PsErrInvalidCApiImport
-newtype StarIsType = StarIsType Bool
-
-- | Extra details about a parse error, which helps
-- us in determining which should be the hints to
-- suggest.
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index aab72310ac65..83b55f5632ee 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -126,6 +126,7 @@ import GHC.Unit.Module (ModuleName)
import GHC.Types.Basic
import GHC.Types.Error
import GHC.Types.Fixity
+import GHC.Types.Hint
import GHC.Types.SourceText
import GHC.Parser.Types
import GHC.Parser.Lexer
@@ -2788,8 +2789,9 @@ warnStarIsType span = addPsMessage span PsWarnStarIsType
failOpFewArgs :: MonadP m => LocatedN RdrName -> m a
failOpFewArgs (L loc op) =
do { star_is_type <- getBit StarIsTypeBit
+ ; let is_star_type = if star_is_type then StarIsType else StarIsNotType
; addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $
- (PsErrOpFewArgs (StarIsType star_is_type) op) }
+ (PsErrOpFewArgs is_star_type op) }
-----------------------------------------------------------------------------
-- Misc utils
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index b666defcb322..a3c126222f4d 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -73,6 +73,7 @@ import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Types.Avail
+import GHC.Types.Hint
import GHC.Types.Error
import GHC.Unit.Module
import GHC.Unit.Module.ModIface
@@ -97,10 +98,9 @@ import GHC.Rename.Unbound
import GHC.Rename.Utils
import qualified Data.Semigroup as Semi
import Data.Either ( partitionEithers )
-import Data.List ( find, sortBy )
+import Data.List ( find )
import qualified Data.List.NonEmpty as NE
import Control.Arrow ( first )
-import Data.Function
import GHC.Types.FieldLabel
import GHC.Data.Bag
import GHC.Types.PkgQual
@@ -300,7 +300,7 @@ lookupLocatedTopBndrRnN = wrapLocMA (lookupTopBndrRn WL_Anything)
-- | Lookup an @Exact@ @RdrName@. See Note [Looking up Exact RdrNames].
-- This never adds an error, but it may return one, see
-- Note [Errors in lookup functions]
-lookupExactOcc_either :: Name -> RnM (Either SDoc Name)
+lookupExactOcc_either :: Name -> RnM (Either NotInScopeError Name)
lookupExactOcc_either name
| Just thing <- wiredInNameTyThing_maybe name
, Just tycon <- case thing of
@@ -341,28 +341,12 @@ lookupExactOcc_either name
; th_topnames <- readTcRef th_topnames_var
; if name `elemNameSet` th_topnames
then return (Right name)
- else return (Left (exactNameErr name))
+ else return (Left (NoExactName name))
}
}
- gres -> return (Left (sameNameErr gres)) -- Ugh! See Note [Template Haskell ambiguity]
- }
-
-sameNameErr :: [GlobalRdrElt] -> SDoc
-sameNameErr [] = panic "addSameNameErr: empty list"
-sameNameErr gres@(_ : _)
- = hang (text "Same exact name in multiple name-spaces:")
- 2 (vcat (map pp_one sorted_names) $$ th_hint)
- where
- sorted_names = sortBy (SrcLoc.leftmost_smallest `on` nameSrcSpan) (map greMangledName gres)
- pp_one name
- = hang (pprNameSpace (occNameSpace (getOccName name))
- <+> quotes (ppr name) <> comma)
- 2 (text "declared at:" <+> ppr (nameSrcLoc name))
-
- th_hint = vcat [ text "Probable cause: you bound a unique Template Haskell name (NameU),"
- , text "perhaps via newName, in different name-spaces."
- , text "If that's it, then -ddump-splices might be useful" ]
+ gres -> return (Left (SameName gres)) -- Ugh! See Note [Template Haskell ambiguity]
+ }
-----------------------------------------------
lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
@@ -393,7 +377,7 @@ lookupInstDeclBndr cls what rdr
-- when it's used
cls doc rdr
; case mb_name of
- Left err -> do { addErr (TcRnUnknownMessage $ mkPlainError noHints err)
+ Left err -> do { addErr (mkTcRnNotInScope rdr err)
; return (mkUnboundNameRdr rdr) }
Right nm -> return nm }
where
@@ -441,7 +425,7 @@ lookupExactOrOrig rdr_name res k
; case men of
FoundExactOrOrig n -> return (res n)
ExactOrOrigError e ->
- do { addErr (TcRnUnknownMessage $ mkPlainError noHints e)
+ do { addErr (mkTcRnNotInScope rdr_name e)
; return (res (mkUnboundNameRdr rdr_name)) }
NotExactOrOrig -> k }
@@ -457,9 +441,9 @@ lookupExactOrOrig_maybe rdr_name res k
NotExactOrOrig -> k }
data ExactOrOrigResult = FoundExactOrOrig Name -- ^ Found an Exact Or Orig Name
- | ExactOrOrigError SDoc -- ^ The RdrName was an Exact
- -- or Orig, but there was an
- -- error looking up the Name
+ | ExactOrOrigError NotInScopeError -- ^ The RdrName was an Exact
+ -- or Orig, but there was an
+ -- error looking up the Name
| NotExactOrOrig -- ^ The RdrName is neither an Exact nor
-- Orig
@@ -848,7 +832,7 @@ lookupSubBndrOcc :: Bool
-> Name -- Parent
-> SDoc
-> RdrName
- -> RnM (Either SDoc Name)
+ -> RnM (Either NotInScopeError Name)
-- Find all the things the rdr-name maps to
-- and pick the one with the right parent namep
lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = do
@@ -857,12 +841,12 @@ lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = do
-- This happens for built-in classes, see mod052 for example
lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name
case res of
- NameNotFound -> return (Left (unknownSubordinateErr doc rdr_name))
+ NameNotFound -> return (Left (UnknownSubordinate doc))
FoundChild _p child -> return (Right (greNameMangledName child))
IncorrectParent {}
-- See [Mismatched class methods and associated type families]
-- in TcInstDecls.
- -> return $ Left (unknownSubordinateErr doc rdr_name)
+ -> return $ Left (UnknownSubordinate doc)
{-
Note [Family instance binders]
@@ -1087,17 +1071,14 @@ lookup_demoted rdr_name
-- Maybe it's the name of a *data* constructor
= do { data_kinds <- xoptM LangExt.DataKinds
; star_is_type <- xoptM LangExt.StarIsType
- ; let star_info = starInfo star_is_type rdr_name
+ ; let is_star_type = if star_is_type then StarIsType else StarIsNotType
+ star_is_type_hints = noStarIsTypeHints is_star_type rdr_name
; if data_kinds
then do { mb_demoted_name <- lookupOccRn_maybe demoted_rdr
; case mb_demoted_name of
- Nothing -> unboundNameX looking_for rdr_name star_info
+ Nothing -> unboundNameX looking_for rdr_name star_is_type_hints
Just demoted_name ->
- do { let msg = TcRnUnknownMessage $
- mkPlainDiagnostic (WarningWithFlag Opt_WarnUntickedPromotedConstructors)
- noHints
- (untickedPromConstrWarn demoted_name)
- ; addDiagnostic msg
+ do { addDiagnostic $ TcRnUntickedPromotedConstructor demoted_name
; return demoted_name } }
else do { -- We need to check if a data constructor of this name is
-- in scope to give good error messages. However, we do
@@ -1105,8 +1086,11 @@ lookup_demoted rdr_name
-- constructor happens to be out of scope! See #13947.
mb_demoted_name <- discardErrs $
lookupOccRn_maybe demoted_rdr
- ; let suggestion | isJust mb_demoted_name = suggest_dk
- | otherwise = star_info
+ ; let suggestion | isJust mb_demoted_name
+ , let additional = text "to refer to the data constructor of that name?"
+ = [SuggestExtension $ SuggestSingleExtension additional LangExt.DataKinds]
+ | otherwise
+ = star_is_type_hints
; unboundNameX looking_for rdr_name suggestion } }
| otherwise
@@ -1114,14 +1098,6 @@ lookup_demoted rdr_name
where
looking_for = LF WL_Constructor WL_Anywhere
- suggest_dk = text "A data constructor of that name is in scope; did you mean DataKinds?"
- untickedPromConstrWarn name =
- text "Unticked promoted constructor" <> colon <+> quotes (ppr name) <> dot
- $$
- hsep [ text "Use"
- , quotes (char '\'' <> ppr name)
- , text "instead of"
- , quotes (ppr name) <> dot ]
-- If the given RdrName can be promoted to the type level and its promoted variant is in scope,
-- lookup_promoted returns the corresponding type-level Name.
@@ -1822,7 +1798,7 @@ lookupSigCtxtOccRnN ctxt what
= wrapLocMA $ \ rdr_name ->
do { mb_name <- lookupBindGroupOcc ctxt what rdr_name
; case mb_name of
- Left err -> do { addErr (TcRnUnknownMessage $ mkPlainError noHints err)
+ Left err -> do { addErr (mkTcRnNotInScope rdr_name err)
; return (mkUnboundNameRdr rdr_name) }
Right name -> return name }
@@ -1835,13 +1811,13 @@ lookupSigCtxtOccRn ctxt what
= wrapLocMA $ \ rdr_name ->
do { mb_name <- lookupBindGroupOcc ctxt what rdr_name
; case mb_name of
- Left err -> do { addErr (TcRnUnknownMessage $ mkPlainError noHints err)
+ Left err -> do { addErr (mkTcRnNotInScope rdr_name err)
; return (mkUnboundNameRdr rdr_name) }
Right name -> return name }
lookupBindGroupOcc :: HsSigCtxt
-> SDoc
- -> RdrName -> RnM (Either SDoc Name)
+ -> RdrName -> RnM (Either NotInScopeError Name)
-- Looks up the RdrName, expecting it to resolve to one of the
-- bound names passed in. If not, return an appropriate error message
--
@@ -1903,31 +1879,23 @@ lookupBindGroupOcc ctxt what rdr_name
| otherwise -> bale_out_with local_msg
Nothing -> bale_out_with candidates_msg }
- bale_out_with msg
- = return (Left (sep [ text "The" <+> what
- <+> text "for" <+> quotes (ppr rdr_name)
- , nest 2 $ text "lacks an accompanying binding"]
- $$ nest 2 msg))
+ bale_out_with hints = return (Left $ MissingBinding what hints)
- local_msg = parens $ text "The" <+> what <+> text "must be given where"
- <+> quotes (ppr rdr_name) <+> text "is declared"
+ local_msg = [SuggestMoveToDeclarationSite what rdr_name]
-- Identify all similar names and produce a message listing them
- candidates :: [Name] -> SDoc
+ candidates :: [Name] -> [GhcHint]
candidates names_in_scope
- = case similar_names of
- [] -> Outputable.empty
- [n] -> text "Perhaps you meant" <+> pp_item n
- _ -> sep [ text "Perhaps you meant one of these:"
- , nest 2 (pprWithCommas pp_item similar_names) ]
+ | (nm : nms) <- map SimilarName similar_names
+ = [SuggestSimilarNames rdr_name (nm NE.:| nms)]
+ | otherwise
+ = []
where
similar_names
= fuzzyLookup (unpackFS $ occNameFS $ rdrNameOcc rdr_name)
$ map (\x -> ((unpackFS $ occNameFS $ nameOccName x), x))
names_in_scope
- pp_item x = quotes (ppr x) <+> parens (pprDefinedAt x)
-
---------------
lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
@@ -1939,7 +1907,7 @@ lookupLocalTcNames ctxt what rdr_name
= do { mb_gres <- mapM lookup (dataTcOccs rdr_name)
; let (errs, names) = partitionEithers mb_gres
; when (null names) $
- addErr (TcRnUnknownMessage $ mkPlainError noHints (head errs)) -- Bleat about one only
+ addErr (head errs) -- Bleat about one only
; return names }
where
lookup rdr = do { this_mod <- getModule
@@ -1950,10 +1918,11 @@ lookupLocalTcNames ctxt what rdr_name
guard_builtin_syntax this_mod rdr (Right name)
| Just _ <- isBuiltInOcc_maybe (occName rdr)
, this_mod /= nameModule name
- = Left (hsep [text "Illegal", what, text "of built-in syntax:", ppr rdr])
+ = Left $ TcRnIllegalBuiltinSyntax what rdr
| otherwise
= Right (rdr, name)
- guard_builtin_syntax _ _ (Left err) = Left err
+ guard_builtin_syntax _ _ (Left err)
+ = Left $ mkTcRnNotInScope rdr_name err
dataTcOccs :: RdrName -> [RdrName]
-- Return both the given name and the same name promoted to the TcClsName
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 6740e024301c..145e6f08ec18 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -51,12 +51,12 @@ import GHC.Rename.Env
import GHC.Rename.Utils ( HsDocContext(..), inHsDocContext, withHsDocContext
, mapFvRn, pprHsDocContext, bindLocalNamesFV
, typeAppErr, newLocalBndrRn, checkDupRdrNamesN
- , checkShadowedRdrNames
- , warnForallIdentifier )
+ , checkShadowedRdrNames, warnForallIdentifier )
import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn
, lookupTyFixityRn )
import GHC.Rename.Unbound ( notInScopeErr, WhereLooking(WL_LocalOnly) )
import GHC.Tc.Errors.Types
+import GHC.Tc.Errors.Ppr ( pprScopeError )
import GHC.Tc.Utils.Monad
import GHC.Types.Name.Reader
import GHC.Builtin.Names
@@ -752,10 +752,11 @@ rnHsTyKi env (XHsType ty)
check_in_scope :: RdrName -> RnM ()
check_in_scope rdr_name = do
mb_name <- lookupLocalOccRn_maybe rdr_name
+ -- TODO: refactor this to avoid TcRnUnknownMessage
when (isNothing mb_name) $
addErr $ TcRnUnknownMessage $ mkPlainError noHints $
withHsDocContext (rtke_ctxt env) $
- notInScopeErr WL_LocalOnly rdr_name
+ pprScopeError rdr_name (notInScopeErr WL_LocalOnly rdr_name)
rnHsTyKi env ty@(HsExplicitListTy _ ip tys)
= do { data_kinds <- xoptM LangExt.DataKinds
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index d2f5463d58e8..5884747609d1 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -31,10 +31,9 @@ import GHC.Rename.Env
import GHC.Rename.Utils ( HsDocContext(..), mapFvRn, bindLocalNames
, checkDupRdrNamesN, bindLocalNamesFV
, checkShadowedRdrNames, warnUnusedTypePatterns
- , warnForallIdentifier
, newLocalBndrsRn
, withHsDocContext, noNestedForallsContextsErr
- , addNoNestedForallsContextsErr, checkInferredVars )
+ , addNoNestedForallsContextsErr, checkInferredVars, warnForallIdentifier )
import GHC.Rename.Unbound ( mkUnboundName, notInScopeErr, WhereLooking(WL_Global) )
import GHC.Rename.Names
import GHC.Tc.Errors.Types
@@ -68,6 +67,7 @@ import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..)
import GHC.Types.Unique.Set
import GHC.Data.OrdList
import qualified GHC.LanguageExtensions as LangExt
+import GHC.Tc.Errors.Ppr (pprScopeError)
import Control.Monad
import Control.Arrow ( first )
@@ -1353,9 +1353,12 @@ badRuleLhsErr name lhs bad_e
$$
text "LHS must be of form (f e1 .. en) where f is not forall'd"
where
- err = case bad_e of
- HsUnboundVar _ uv -> notInScopeErr WL_Global (mkRdrUnqual uv)
- _ -> text "Illegal expression:" <+> ppr bad_e
+ err =
+ case bad_e of
+ HsUnboundVar _ uv ->
+ let rdr = mkRdrUnqual uv
+ in pprScopeError rdr $ notInScopeErr WL_Global (mkRdrUnqual uv)
+ _ -> text "Illegal expression:" <+> ppr bad_e
{- **************************************************************
* *
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 79eeaa347706..2062b2e23a2b 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -53,10 +53,10 @@ import GHC.Tc.Utils.Zonk ( hsOverLitName )
import GHC.Rename.Env
import GHC.Rename.Fixity
import GHC.Rename.Utils ( HsDocContext(..), newLocalBndrRn, bindLocalNames
- , warnUnusedMatches, warnForallIdentifier
+ , warnUnusedMatches, newLocalBndrRn
, checkUnusedRecordWildcard
, checkDupNames, checkDupAndShadowedNames
- , wrapGenSpan, genHsApps, genLHsVar, genHsIntegralLit )
+ , wrapGenSpan, genHsApps, genLHsVar, genHsIntegralLit, warnForallIdentifier )
import GHC.Rename.HsType
import GHC.Builtin.Names
import GHC.Types.Avail ( greNameMangledName )
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index 6139ee8a8e1f..5774698375ea 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
{-
This module contains helper functions for reporting and creating
@@ -18,7 +20,6 @@ module GHC.Rename.Unbound
, unboundNameX
, notInScopeErr
, nameSpacesRelated
- , exactNameErr
)
where
@@ -30,7 +31,6 @@ import GHC.Driver.Ppr
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
import GHC.Builtin.Names ( mkUnboundName, isUnboundName, getUnique)
-import GHC.Utils.Outputable as Outputable
import GHC.Utils.Misc
import GHC.Data.Maybe
@@ -38,7 +38,10 @@ import GHC.Data.FastString
import qualified GHC.LanguageExtensions as LangExt
-import GHC.Types.Error
+import GHC.Types.Hint
+ ( GhcHint (SuggestExtension, RemindFieldSelectorSuppressed, ImportSuggestion, SuggestSimilarNames)
+ , LanguageExtensionHint (SuggestSingleExtension)
+ , ImportSuggestion(..), SimilarName(..), HowInScope(..) )
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Name
import GHC.Types.Name.Reader
@@ -48,9 +51,12 @@ import GHC.Unit.Module
import GHC.Unit.Module.Imported
import GHC.Unit.Home.ModInfo
+import GHC.Data.Bag
+import GHC.Utils.Outputable (empty)
+
import Data.List (sortBy, partition, nub)
+import Data.List.NonEmpty ( pattern (:|), NonEmpty )
import Data.Function ( on )
-import GHC.Data.Bag
{-
************************************************************************
@@ -96,113 +102,89 @@ reportUnboundName :: RdrName -> RnM Name
reportUnboundName = reportUnboundName' WL_Anything
unboundName :: LookingFor -> RdrName -> RnM Name
-unboundName lf rdr = unboundNameX lf rdr Outputable.empty
+unboundName lf rdr = unboundNameX lf rdr []
-unboundNameX :: LookingFor -> RdrName -> SDoc -> RnM Name
-unboundNameX looking_for rdr_name extra
+unboundNameX :: LookingFor -> RdrName -> [GhcHint] -> RnM Name
+unboundNameX looking_for rdr_name hints
= do { dflags <- getDynFlags
; let show_helpful_errors = gopt Opt_HelpfulErrors dflags
- err = notInScopeErr (lf_where looking_for) rdr_name $$ extra
+ err = notInScopeErr (lf_where looking_for) rdr_name
; if not show_helpful_errors
- then addErr (TcRnUnknownMessage $ mkPlainError noHints err)
+ then addErr $ TcRnNotInScope err rdr_name [] hints
else do { local_env <- getLocalRdrEnv
; global_env <- getGlobalRdrEnv
; impInfo <- getImports
; currmod <- getModule
; hpt <- getHpt
- ; let suggestions = unknownNameSuggestions_ looking_for
- dflags hpt currmod global_env local_env impInfo
- rdr_name
- ; addErr (TcRnUnknownMessage $ mkPlainError noHints (err $$ suggestions)) }
+ ; let (imp_errs, suggs) =
+ unknownNameSuggestions_ looking_for
+ dflags hpt currmod global_env local_env impInfo
+ rdr_name
+ ; addErr $
+ TcRnNotInScope err rdr_name imp_errs (hints ++ suggs) }
; return (mkUnboundNameRdr rdr_name) }
-notInScopeErr :: WhereLooking -> RdrName -> SDoc
-notInScopeErr where_look rdr_name
- | Just name <- isExact_maybe rdr_name = exactNameErr name
- | WL_LocalTop <- where_look = hang (text "No top-level binding for")
- 2 (what <+> quotes (ppr rdr_name) <+> text "in this module")
- | otherwise = hang (text "Not in scope:")
- 2 (what <+> quotes (ppr rdr_name))
- where
- what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
-
-type HowInScope = Either SrcSpan ImpDeclSpec
- -- Left loc => locally bound at loc
- -- Right ispec => imported as specified by ispec
+notInScopeErr :: WhereLooking -> RdrName -> NotInScopeError
+notInScopeErr where_look rdr_name
+ | Just name <- isExact_maybe rdr_name
+ = NoExactName name
+ | WL_LocalTop <- where_look
+ = NoTopLevelBinding
+ | otherwise
+ = NotInScope
-- | Called from the typechecker ("GHC.Tc.Errors") when we find an unbound variable
unknownNameSuggestions :: WhatLooking -> DynFlags
-> HomePackageTable -> Module
-> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails
- -> RdrName -> SDoc
+ -> RdrName -> ([ImportError], [GhcHint])
unknownNameSuggestions what_look = unknownNameSuggestions_ (LF what_look WL_Anywhere)
unknownNameSuggestions_ :: LookingFor -> DynFlags
-> HomePackageTable -> Module
-> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails
- -> RdrName -> SDoc
+ -> RdrName -> ([ImportError], [GhcHint])
unknownNameSuggestions_ looking_for dflags hpt curr_mod global_env local_env
- imports tried_rdr_name =
- similarNameSuggestions looking_for dflags global_env local_env tried_rdr_name $$
- importSuggestions looking_for global_env hpt
- curr_mod imports tried_rdr_name $$
- extensionSuggestions tried_rdr_name $$
- fieldSelectorSuggestions global_env tried_rdr_name
+ imports tried_rdr_name = (imp_errs, suggs)
+ where
+ suggs = mconcat
+ [ if_ne (SuggestSimilarNames tried_rdr_name) $
+ similarNameSuggestions looking_for dflags global_env local_env tried_rdr_name
+ , map ImportSuggestion imp_suggs
+ , extensionSuggestions tried_rdr_name
+ , fieldSelectorSuggestions global_env tried_rdr_name ]
+ (imp_errs, imp_suggs) = importSuggestions looking_for global_env hpt curr_mod imports tried_rdr_name
+
+ if_ne :: (NonEmpty a -> b) -> [a] -> [b]
+ if_ne _ [] = []
+ if_ne f (a : as) = [f (a :| as)]
-- | When the name is in scope as field whose selector has been suppressed by
-- NoFieldSelectors, display a helpful message explaining this.
-fieldSelectorSuggestions :: GlobalRdrEnv -> RdrName -> SDoc
+fieldSelectorSuggestions :: GlobalRdrEnv -> RdrName -> [GhcHint]
fieldSelectorSuggestions global_env tried_rdr_name
- | null gres = Outputable.empty
- | otherwise = text "NB:"
- <+> quotes (ppr tried_rdr_name)
- <+> text "is a field selector" <+> whose
- $$ text "that has been suppressed by NoFieldSelectors"
+ | null gres = []
+ | otherwise = [RemindFieldSelectorSuppressed tried_rdr_name parents]
where
gres = filter isNoFieldSelectorGRE $
lookupGRE_RdrName' tried_rdr_name global_env
parents = [ parent | ParentIs parent <- map gre_par gres ]
- -- parents may be empty if this is a pattern synonym field without a selector
- whose | null parents = empty
- | otherwise = text "belonging to the type" <> plural parents
- <+> pprQuotedList parents
-
similarNameSuggestions :: LookingFor -> DynFlags
-> GlobalRdrEnv -> LocalRdrEnv
- -> RdrName -> SDoc
+ -> RdrName -> [SimilarName]
similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
local_env tried_rdr_name
- = case suggest of
- [] -> Outputable.empty
- [p] -> perhaps <+> pp_item p
- ps -> sep [ perhaps <+> text "one of these:"
- , nest 2 (pprWithCommas pp_item ps) ]
+ = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities
where
- all_possibilities :: [(String, (RdrName, HowInScope))]
+ all_possibilities :: [(String, SimilarName)]
all_possibilities = case what_look of
WL_None -> []
- _ -> [ (showPpr dflags r, (r, Left loc))
+ _ -> [ (showPpr dflags r, SimilarRdrName r (LocallyBoundAt loc))
| (r,loc) <- local_possibilities local_env ]
++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ]
- suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities
- perhaps = text "Perhaps you meant"
-
- pp_item :: (RdrName, HowInScope) -> SDoc
- pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' -- Locally defined
- where loc' = case loc of
- UnhelpfulSpan l -> parens (ppr l)
- RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
- pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+> -- Imported
- parens (text "imported from" <+> ppr (is_mod is))
-
- pp_ns :: RdrName -> SDoc
- pp_ns rdr | ns /= tried_ns = pprNameSpace ns
- | otherwise = Outputable.empty
- where ns = rdrNameSpace rdr
-
tried_occ = rdrNameOcc tried_rdr_name
tried_is_sym = isSymOcc tried_occ
tried_ns = occNameSpace tried_occ
@@ -228,9 +210,9 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
, let occ = nameOccName name
, correct_name_space occ]
- global_possibilities :: GlobalRdrEnv -> [(RdrName, (RdrName, HowInScope))]
+ global_possibilities :: GlobalRdrEnv -> [(RdrName, SimilarName)]
global_possibilities global_env
- | tried_is_qual = [ (rdr_qual, (rdr_qual, how))
+ | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual how)
| gre <- globalRdrEnvElts global_env
, isGreOk looking_for gre
, let occ = greOccName gre
@@ -238,14 +220,14 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
, (mod, how) <- qualsInScope gre
, let rdr_qual = mkRdrQual mod occ ]
- | otherwise = [ (rdr_unqual, pair)
+ | otherwise = [ (rdr_unqual, sim)
| gre <- globalRdrEnvElts global_env
, isGreOk looking_for gre
, let occ = greOccName gre
rdr_unqual = mkRdrUnqual occ
, correct_name_space occ
- , pair <- case (unquals_in_scope gre, quals_only gre) of
- (how:_, _) -> [ (rdr_unqual, how) ]
+ , sim <- case (unquals_in_scope gre, quals_only gre) of
+ (how:_, _) -> [ SimilarRdrName rdr_unqual how ]
([], pr:_) -> [ pr ] -- See Note [Only-quals]
([], []) -> [] ]
@@ -262,98 +244,43 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
--------------------
unquals_in_scope :: GlobalRdrElt -> [HowInScope]
unquals_in_scope (gre@GRE { gre_lcl = lcl, gre_imp = is })
- | lcl = [ Left (greDefinitionSrcSpan gre) ]
- | otherwise = [ Right ispec
+ | lcl = [ LocallyBoundAt (greDefinitionSrcSpan gre) ]
+ | otherwise = [ ImportedBy ispec
| i <- bagToList is, let ispec = is_decl i
, not (is_qual ispec) ]
--------------------
- quals_only :: GlobalRdrElt -> [(RdrName, HowInScope)]
+ quals_only :: GlobalRdrElt -> [SimilarName]
-- Ones for which *only* the qualified version is in scope
quals_only (gre@GRE { gre_imp = is })
- = [ (mkRdrQual (is_as ispec) (greOccName gre), Right ispec)
+ = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (ImportedBy ispec))
| i <- bagToList is, let ispec = is_decl i, is_qual ispec ]
--- | Generate helpful suggestions if a qualified name Mod.foo is not in scope.
+
+-- | Generate errors and helpful suggestions if a qualified name Mod.foo is not in scope.
importSuggestions :: LookingFor
-> GlobalRdrEnv
-> HomePackageTable -> Module
- -> ImportAvails -> RdrName -> SDoc
+ -> ImportAvails -> RdrName -> ([ImportError], [ImportSuggestion])
importSuggestions looking_for global_env hpt currMod imports rdr_name
- | WL_LocalOnly <- lf_where looking_for = Outputable.empty
- | WL_LocalTop <- lf_where looking_for = Outputable.empty
- | not (isQual rdr_name || isUnqual rdr_name) = Outputable.empty
+ | WL_LocalOnly <- lf_where looking_for = ([], [])
+ | WL_LocalTop <- lf_where looking_for = ([], [])
+ | not (isQual rdr_name || isUnqual rdr_name) = ([], [])
| null interesting_imports
, Just name <- mod_name
, show_not_imported_line name
- = hsep
- [ text "No module named"
- , quotes (ppr name)
- , text "is imported."
- ]
+ = ([MissingModule name], [])
| is_qualified
, null helpful_imports
- , [(mod,_)] <- interesting_imports
- = hsep
- [ text "Module"
- , quotes (ppr mod)
- , text "does not export"
- , quotes (ppr occ_name) <> dot
- ]
- | is_qualified
- , null helpful_imports
- , not (null interesting_imports)
- , mods <- map fst interesting_imports
- = hsep
- [ text "Neither"
- , quotedListWithNor (map ppr mods)
- , text "exports"
- , quotes (ppr occ_name) <> dot
- ]
- | [(mod,imv)] <- helpful_imports_non_hiding
- = fsep
- [ text "Perhaps you want to add"
- , quotes (ppr occ_name)
- , text "to the import list"
- , text "in the import of"
- , quotes (ppr mod)
- , parens (ppr (imv_span imv)) <> dot
- ]
- | not (null helpful_imports_non_hiding)
- = fsep
- [ text "Perhaps you want to add"
- , quotes (ppr occ_name)
- , text "to one of these import lists:"
- ]
- $$
- nest 2 (vcat
- [ quotes (ppr mod) <+> parens (ppr (imv_span imv))
- | (mod,imv) <- helpful_imports_non_hiding
- ])
- | [(mod,imv)] <- helpful_imports_hiding
- = fsep
- [ text "Perhaps you want to remove"
- , quotes (ppr occ_name)
- , text "from the explicit hiding list"
- , text "in the import of"
- , quotes (ppr mod)
- , parens (ppr (imv_span imv)) <> dot
- ]
- | not (null helpful_imports_hiding)
- = fsep
- [ text "Perhaps you want to remove"
- , quotes (ppr occ_name)
- , text "from the hiding clauses"
- , text "in one of these imports:"
- ]
- $$
- nest 2 (vcat
- [ quotes (ppr mod) <+> parens (ppr (imv_span imv))
- | (mod,imv) <- helpful_imports_hiding
- ])
+ , (mod : mods) <- map fst interesting_imports
+ = ([ModulesDoNotExport (mod :| mods) occ_name], [])
+ | mod : mods <- helpful_imports_non_hiding
+ = ([], [CouldImportFrom (mod :| mods) occ_name])
+ | mod : mods <- helpful_imports_hiding
+ = ([], [CouldUnhideFrom (mod :| mods) occ_name])
| otherwise
- = Outputable.empty
+ = ([], [])
where
is_qualified = isQual rdr_name
(mod_name, occ_name) = case rdr_name of
@@ -409,20 +336,21 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
, (mod, _) <- qualsInScope gre
]
-extensionSuggestions :: RdrName -> SDoc
+extensionSuggestions :: RdrName -> [GhcHint]
extensionSuggestions rdrName
| rdrName == mkUnqual varName (fsLit "mdo") ||
rdrName == mkUnqual varName (fsLit "rec")
- = text "Perhaps you meant to use RecursiveDo"
- | otherwise = Outputable.empty
+ = [SuggestExtension $ SuggestSingleExtension empty LangExt.RecursiveDo]
+ | otherwise
+ = []
qualsInScope :: GlobalRdrElt -> [(ModuleName, HowInScope)]
-- Ones for which the qualified version is in scope
qualsInScope gre@GRE { gre_lcl = lcl, gre_imp = is }
| lcl = case greDefinitionModule gre of
Nothing -> []
- Just m -> [(moduleName m, Left (greDefinitionSrcSpan gre))]
- | otherwise = [ (is_as ispec, Right ispec)
+ Just m -> [(moduleName m, LocallyBoundAt (greDefinitionSrcSpan gre))]
+ | otherwise = [ (is_as ispec, ImportedBy ispec)
| i <- bagToList is, let ispec = is_decl i ]
isGreOk :: LookingFor -> GlobalRdrElt -> Bool
@@ -510,10 +438,3 @@ there are 2 cases, where we hide the last "no module is imported" line:
and we have to check the current module in the last added entry of
the HomePackageTable. (See test T15611b)
-}
-
-exactNameErr :: Name -> SDoc
-exactNameErr name =
- hang (text "The exact Name" <+> quotes (ppr name) <+> text "is not in scope")
- 2 (vcat [ text "Probable cause: you used a unique Template Haskell name (NameU), "
- , text "perhaps via newName, but did not bind it"
- , text "If that's it, then -ddump-splices might be useful" ])
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 4041b0b6c874..0c2d426450f4 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -18,7 +18,7 @@ module GHC.Rename.Utils (
warnForallIdentifier,
checkUnusedRecordWildcard,
mkFieldEnv,
- unknownSubordinateErr, badQualBndrErr, typeAppErr,
+ badQualBndrErr, typeAppErr,
wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genAppType,
genHsIntegralLit, genHsTyLit,
HsDocContext(..), pprHsDocContext,
@@ -595,12 +595,6 @@ addNameClashErrRn rdr_name gres
num_non_flds = length non_flds
-unknownSubordinateErr :: SDoc -> RdrName -> SDoc
-unknownSubordinateErr doc op -- Doc is "method of class" or
- -- "field of constructor"
- = quotes (ppr op) <+> text "is not a (visible)" <+> doc
-
-
dupNamesErr :: Outputable n => (n -> SrcSpan) -> NE.NonEmpty n -> RnM ()
dupNamesErr get_loc names
= addErrAt big_loc $ TcRnUnknownMessage $ mkPlainError noHints $
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 0d84dddb1e0c..b08fd6b3a83d 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
@@ -20,6 +21,8 @@ import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Driver.Config.Diagnostic
+import GHC.Rename.Unbound
+
import GHC.Tc.Types
import GHC.Tc.Utils.Monad
import GHC.Tc.Errors.Types
@@ -33,7 +36,7 @@ import GHC.Tc.Types.Evidence
import GHC.Tc.Types.EvTerm
import GHC.Tc.Instance.Family
import GHC.Tc.Utils.Instantiate
-import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits )
+import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits, getHoleFitDispConfig, pprHoleFit )
import GHC.Types.Name
import GHC.Types.Name.Reader ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual
@@ -43,30 +46,22 @@ import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Types.Name.Env
-import GHC.Types.Name.Set
import GHC.Types.SrcLoc
import GHC.Types.Basic
import GHC.Types.Error
-import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
-import GHC.Rename.Unbound ( unknownNameSuggestions, WhatLooking(..) )
+--import GHC.Rename.Unbound ( unknownNameSuggestions, WhatLooking(..) )
import GHC.Unit.Module
-import GHC.Hs.Binds ( PatSynBind(..) )
-import GHC.Builtin.Names ( typeableClassName, pretendNameIsInScope )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Core.Predicate
import GHC.Core.Type
import GHC.Core.Coercion
-import GHC.Core.TyCo.Rep
-import GHC.Core.TyCo.Ppr ( pprTyVars, pprWithExplicitKindsWhen, pprSourceTyCon
- , pprWithTYPE )
-import GHC.Core.Unify ( tcMatchTys )
+import GHC.Core.TyCo.Ppr ( pprTyVars
+ )
import GHC.Core.InstEnv
import GHC.Core.TyCon
-import GHC.Core.Class
import GHC.Core.DataCon
-import GHC.Core.ConLike ( ConLike(..))
import GHC.Utils.Error (diagReasonSeverity, pprLocMsgEnvelope )
import GHC.Utils.Misc
@@ -76,8 +71,6 @@ import GHC.Utils.Panic.Plain
import GHC.Utils.FV ( fvVarList, unionFV )
import GHC.Data.Bag
-import GHC.Data.FastString
-import GHC.Utils.Trace (pprTraceUserWarning)
import GHC.Data.List.SetOps ( equivClasses, nubOrdBy )
import GHC.Data.Maybe
import qualified GHC.Data.Strict as Strict
@@ -86,12 +79,9 @@ import Control.Monad ( unless, when, foldM, forM_ )
import Data.Foldable ( toList )
import Data.Functor ( (<&>) )
import Data.Function ( on )
-import Data.List ( groupBy, partition, mapAccumL
- , sortBy, tails, unfoldr )
-import Data.Ord ( comparing )
--- import Data.Semigroup ( Semigroup )
-import qualified Data.Semigroup as Semigroup
-
+import Data.List ( partition, mapAccumL )
+import Data.List.NonEmpty ( NonEmpty(..), (<|) )
+import qualified Data.List.NonEmpty as NE ( map, reverse )
{-
************************************************************************
@@ -265,102 +255,15 @@ report_unsolved type_errors expr_holes
-- Internal functions
--------------------------------------------
--- | An error Report collects messages categorised by their importance.
--- See Note [Error report] for details.
-data Report
- = Report { report_important :: [SDoc]
- , report_relevant_bindings :: [SDoc]
- , report_valid_hole_fits :: [SDoc]
- }
-
-instance Outputable Report where -- Debugging only
- ppr (Report { report_important = imp
- , report_relevant_bindings = rel
- , report_valid_hole_fits = val })
- = vcat [ text "important:" <+> vcat imp
- , text "relevant:" <+> vcat rel
- , text "valid:" <+> vcat val ]
-
-{- Note [Error report]
-~~~~~~~~~~~~~~~~~~~~~~
-The idea is that error msgs are divided into three parts: the main msg, the
-context block ("In the second argument of ..."), and the relevant bindings
-block, which are displayed in that order, with a mark to divide them. The
-the main msg ('report_important') varies depending on the error
-in question, but context and relevant bindings are always the same, which
-should simplify visual parsing.
-
-The context is added when the Report is passed off to 'mkErrorReport'.
-Unfortunately, unlike the context, the relevant bindings are added in
-multiple places so they have to be in the Report.
--}
+-- | Make a report from a single 'TcReportMsg'.
+important :: ReportErrCtxt -> TcReportMsg -> SolverReport
+important ctxt doc = mempty { sr_important_msgs = [ReportWithCtxt ctxt doc] }
+
+mk_relevant_bindings :: RelevantBindings -> SolverReport
+mk_relevant_bindings binds = mempty { sr_supplementary = [SupplementaryBindings binds] }
-instance Semigroup Report where
- Report a1 b1 c1 <> Report a2 b2 c2 = Report (a1 ++ a2) (b1 ++ b2) (c1 ++ c2)
-
-instance Monoid Report where
- mempty = Report [] [] []
- mappend = (Semigroup.<>)
-
--- | Put a doc into the important msgs block.
-important :: SDoc -> Report
-important doc = mempty { report_important = [doc] }
-
--- | Put a doc into the relevant bindings block.
-mk_relevant_bindings :: SDoc -> Report
-mk_relevant_bindings doc = mempty { report_relevant_bindings = [doc] }
-
--- | Put a doc into the valid hole fits block.
-valid_hole_fits :: SDoc -> Report
-valid_hole_fits docs = mempty { report_valid_hole_fits = [docs] }
-
-data ReportErrCtxt
- = CEC { cec_encl :: [Implication] -- Enclosing implications
- -- (innermost first)
- -- ic_skols and givens are tidied, rest are not
- , cec_tidy :: TidyEnv
-
- , cec_binds :: EvBindsVar -- Make some errors (depending on cec_defer)
- -- into warnings, and emit evidence bindings
- -- into 'cec_binds' for unsolved constraints
-
- , cec_defer_type_errors :: DiagnosticReason -- Defer type errors until runtime
-
- -- cec_expr_holes is a union of:
- -- cec_type_holes - a set of typed holes: '_', '_a', '_foo'
- -- cec_out_of_scope_holes - a set of variables which are
- -- out of scope: 'x', 'y', 'bar'
- , cec_expr_holes :: DiagnosticReason -- Holes in expressions.
- , cec_type_holes :: DiagnosticReason -- Holes in types.
- , cec_out_of_scope_holes :: DiagnosticReason -- Out of scope holes.
-
- , cec_warn_redundant :: Bool -- True <=> -Wredundant-constraints
- , cec_expand_syns :: Bool -- True <=> -fprint-expanded-synonyms
-
- , cec_suppress :: Bool -- True <=> More important errors have occurred,
- -- so create bindings if need be, but
- -- don't issue any more errors/warnings
- -- See Note [Suppressing error messages]
- }
-
-instance Outputable ReportErrCtxt where
- ppr (CEC { cec_binds = bvar
- , cec_defer_type_errors = dte
- , cec_expr_holes = eh
- , cec_type_holes = th
- , cec_out_of_scope_holes = osh
- , cec_warn_redundant = wr
- , cec_expand_syns = es
- , cec_suppress = sup })
- = text "CEC" <+> braces (vcat
- [ text "cec_binds" <+> equals <+> ppr bvar
- , text "cec_defer_type_errors" <+> equals <+> ppr dte
- , text "cec_expr_holes" <+> equals <+> ppr eh
- , text "cec_type_holes" <+> equals <+> ppr th
- , text "cec_out_of_scope_holes" <+> equals <+> ppr osh
- , text "cec_warn_redundant" <+> equals <+> ppr wr
- , text "cec_expand_syns" <+> equals <+> ppr es
- , text "cec_suppress" <+> equals <+> ppr sup ])
+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
@@ -479,23 +382,28 @@ warnRedundantConstraints ctxt env info ev_vars
| null redundant_evs
= return ()
- | SigSkol user_ctxt _ _ <- info
+ | SigSkol user_ctxt _ _ <- info
= setLclEnv env $ -- We want to add "In the type signature for f"
-- to the error context, which is a bit tiresome
setSrcSpan (redundantConstraintsSpan user_ctxt) $
- addErrCtxt (text "In" <+> ppr info) $
- do { env <- getLclEnv
- ; msg <- mkErrorReport (WarningWithFlag Opt_WarnRedundantConstraints) ctxt env (important doc)
- ; reportDiagnostic msg }
+ report_redundant_msg True
| otherwise -- But for InstSkol there already *is* a surrounding
-- "In the instance declaration for Eq [a]" context
-- and we don't want to say it twice. Seems a bit ad-hoc
- = do { msg <- mkErrorReport (WarningWithFlag Opt_WarnRedundantConstraints) ctxt env (important doc)
- ; reportDiagnostic msg }
+ = report_redundant_msg False
where
- doc = text "Redundant constraint" <> plural redundant_evs <> colon
- <+> pprEvVarTheta redundant_evs
+ report_redundant_msg :: Bool -- ^ whether to add "In ..." to the diagnostic
+ -> TcRn ()
+ report_redundant_msg show_info
+ = do { lcl_env <- getLclEnv
+ ; msg <-
+ mkErrorReport
+ lcl_env
+ (TcRnRedundantConstraints redundant_evs (info, show_info))
+ (Just ctxt)
+ []
+ ; reportDiagnostic msg }
redundant_evs =
filterOut is_type_error $
@@ -511,14 +419,14 @@ warnRedundantConstraints ctxt env info ev_vars
reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [TcTyVar] -> TcM ()
reportBadTelescope ctxt env (ForAllSkol telescope) skols
- = do { msg <- mkErrorReport ErrorWithoutFlag ctxt env (important doc)
+ = do { msg <- mkErrorReport
+ env
+ (TcRnSolverReport [report] ErrorWithoutFlag noHints)
+ (Just ctxt)
+ []
; reportDiagnostic msg }
where
- doc = hang (text "These kind and type variables:" <+> telescope $$
- text "are out of dependency order. Perhaps try this ordering:")
- 2 (pprTyVars sorted_tvs)
-
- sorted_tvs = scopedSort skols
+ report = ReportWithCtxt ctxt $ BadTelescope telescope skols
reportBadTelescope _ _ skol_info skols
= pprPanic "reportBadTelescope" (ppr skol_info $$ ppr skols)
@@ -810,21 +718,20 @@ machinery, in cases where it is definitely going to be a no-op.
mkUserTypeErrorReporter :: Reporter
mkUserTypeErrorReporter ctxt
- = mapM_ $ \ct -> do { let err = mkUserTypeError ct
+ = mapM_ $ \ct -> do { let err = important ctxt $ mkUserTypeError ct
; maybeReportError ctxt ct err
; addDeferredBinding ctxt err ct }
-mkUserTypeError :: Ct -> Report
-mkUserTypeError ct = important
- $ pprUserTypeErrorTy
- $ case getUserTypeErrorMsg ct of
- Just msg -> msg
- Nothing -> pprPanic "mkUserTypeError" (ppr ct)
+mkUserTypeError :: Ct -> TcReportMsg
+mkUserTypeError ct =
+ case getUserTypeErrorMsg ct of
+ Just msg -> UserTypeError msg
+ Nothing -> pprPanic "mkUserTypeError" (ppr ct)
mkGivenErrorReporter :: Reporter
-- See Note [Given errors]
mkGivenErrorReporter ctxt cts
- = do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct
+ = do { (ctxt, relevant_binds, ct) <- relevantBindings True ctxt ct
; let (implic:_) = cec_encl ctxt
-- Always non-empty when mkGivenErrorReporter is called
ct' = setCtLoc ct (setCtLocEnv (ctLoc ct) (ic_env implic))
@@ -832,17 +739,12 @@ mkGivenErrorReporter ctxt cts
-- with one from the immediately-enclosing implication.
-- See Note [Inaccessible code]
- inaccessible_msg = hang (text "Inaccessible code in")
- 2 (ppr (ic_info implic))
- report = important inaccessible_msg `mappend`
- mk_relevant_bindings binds_msg
-
- ; report <- mkEqErr_help ctxt report ct' ty1 ty2
- ; err <- mkErrorReport (WarningWithFlag Opt_WarnInaccessibleCode) ctxt
- (ctLocEnv (ctLoc ct')) report
-
- ; traceTc "mkGivenErrorReporter" (ppr ct)
- ; reportDiagnostic err }
+ ; (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 <- mkErrorReport (ctLocEnv (ctLoc ct')) msg (Just ctxt) supplementary
+ ; reportDiagnostic msg }
where
(ct : _ ) = cts -- Never empty
(ty1, ty2) = getEqPredTys (ctPred ct)
@@ -889,7 +791,7 @@ pattern match which binds some equality constraints. If we
find one, we report the insoluble Given.
-}
-mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM Report)
+mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM SolverReport)
-- Make error message for a group
-> Reporter -- Deal with lots of constraints
-- Group together errors from same location,
@@ -898,7 +800,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 Report)
+mkSuppressReporter :: (ReportErrCtxt -> [Ct] -> TcM SolverReport)
-> Reporter
mkSuppressReporter mk_err ctxt cts
= mapM_ (suppressGroup mk_err ctxt . toList) (equivClasses cmp_loc cts)
@@ -917,7 +819,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 Report) -> Reporter
+reportGroup :: (ReportErrCtxt -> [Ct] -> TcM SolverReport) -> Reporter
reportGroup mk_err ctxt cts
| ct1 : _ <- cts =
do { err <- mk_err ctxt cts
@@ -937,7 +839,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 Report) -> Reporter
+suppressGroup :: (ReportErrCtxt -> [Ct] -> TcM SolverReport) -> Reporter
suppressGroup mk_err ctxt cts
= do { err <- mk_err ctxt cts
; traceTc "Suppressing errors for" (ppr cts)
@@ -950,16 +852,17 @@ nonDeferrableOrigin (UsageEnvironmentOf {}) = True
nonDeferrableOrigin (FixedRuntimeRepOrigin {}) = True
nonDeferrableOrigin _ = False
-maybeReportError :: ReportErrCtxt -> Ct -> Report -> TcM ()
-maybeReportError ctxt ct report
+maybeReportError :: ReportErrCtxt -> 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
| otherwise = cec_defer_type_errors ctxt
-- See Note [No deferring for multiplicity errors]
- msg <- mkErrorReport reason ctxt (ctLocEnv (ctLoc ct)) report
+ diag = TcRnSolverReport important reason hints
+ msg <- mkErrorReport (ctLocEnv (ctLoc ct)) diag (Just ctxt) supp
reportDiagnostic msg
-addDeferredBinding :: ReportErrCtxt -> Report -> Ct -> TcM ()
+addDeferredBinding :: ReportErrCtxt -> SolverReport -> Ct -> TcM ()
-- See Note [Deferring coercion errors to runtime]
addDeferredBinding ctxt err ct
| deferringAnyBindings ctxt
@@ -981,9 +884,11 @@ addDeferredBinding ctxt err ct
= return ()
mkErrorTerm :: ReportErrCtxt -> CtLoc -> Type -- of the error term
- -> Report -> TcM EvTerm
-mkErrorTerm ctxt ct_loc ty report
- = do { msg <- mkErrorReport ErrorWithoutFlag ctxt (ctLocEnv ct_loc) report
+ -> SolverReport -> TcM EvTerm
+mkErrorTerm ctxt ct_loc ty (SolverReport { sr_important_msgs = important, sr_supplementary = supp })
+ = do { msg <- mkErrorReport
+ (ctLocEnv ct_loc)
+ (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
@@ -1029,75 +934,79 @@ tryReporter ctxt (str, keep_me, suppress_after, reporter) cts
where
(yeses, nos) = partition (\ct -> keep_me ct (classifyPredType (ctPred ct))) cts
-pprArising :: CtOrigin -> SDoc
--- Used for the main, top-level error message
--- We've done special processing for TypeEq, KindEq, givens
-pprArising (TypeEqOrigin {}) = empty
-pprArising (KindEqOrigin {}) = empty
-pprArising orig | isGivenOrigin orig = empty
- | otherwise = pprCtOrigin orig
-
--- Add the "arising from..." part to a message about bunch of dicts
-addArising :: CtOrigin -> SDoc -> SDoc
-addArising orig msg = hang msg 2 (pprArising orig)
-
-pprWithArising :: [Ct] -> (CtLoc, SDoc)
--- Print something like
--- (Eq a) arising from a use of x at y
--- (Show a) arising from a use of p at q
--- Also return a location for the error message
--- Works for Wanted/Derived only
-pprWithArising []
- = panic "pprWithArising"
-pprWithArising (ct:cts)
- | null cts
- = (loc, addArising (ctLocOrigin loc)
- (pprTheta [ctPred ct]))
- | otherwise
- = (loc, vcat (map ppr_one (ct:cts)))
- where
- loc = ctLoc ct
- ppr_one ct' = hang (parens (pprType (ctPred ct')))
- 2 (pprCtLoc (ctLoc ct'))
-
-mkErrorReport :: DiagnosticReason
- -> ReportErrCtxt
- -> TcLclEnv
- -> Report
+-- | Wrap an input 'TcRnMessage' with additional contextual information,
+-- such as relevant bindings or valid hole fits.
+mkErrorReport :: TcLclEnv
+ -> TcRnMessage
+ -- ^ The main payload of the message.
+ -> Maybe ReportErrCtxt
+ -- ^ The context to add, after the main diagnostic
+ -- but before the supplementary information.
+ -- Nothing <=> don't add any context.
+ -> [SolverReportSupplementary]
+ -- ^ Supplementary information, to be added at the end of the message.
-> TcM (MsgEnvelope TcRnMessage)
-mkErrorReport rea ctxt tcl_env (Report important relevant_bindings valid_subs)
- = do { context <- mkErrInfo (cec_tidy ctxt) (tcl_ctxt tcl_env)
- ; unit_state <- hsc_units <$> getTopEnv ;
- ; let err_info = ErrInfo context (vcat $ relevant_bindings ++ valid_subs)
- ; let msg = TcRnUnknownMessage $ mkPlainDiagnostic rea noHints (vcat important)
+mkErrorReport tcl_env msg mb_ctxt supplementary
+ = do { mb_context <- traverse (\ ctxt -> mkErrInfo (cec_tidy ctxt) (tcl_ctxt tcl_env)) mb_ctxt
+ ; unit_state <- hsc_units <$> getTopEnv
+ ; hfdc <- getHoleFitDispConfig
+ ; let
+ err_info =
+ ErrInfo
+ (fromMaybe empty mb_context)
+ (vcat $ map (pprSolverReportSupplementary hfdc) supplementary)
; mkTcRnMessage
(RealSrcSpan (tcl_loc tcl_env) Strict.Nothing)
- (TcRnMessageWithInfo unit_state $ TcRnMessageDetailed err_info msg)
- }
-
--- This version does not include the context
-mkErrorReportNC :: DiagnosticReason
- -> TcLclEnv
- -> Report
- -> TcM (MsgEnvelope TcRnMessage)
-mkErrorReportNC rea tcl_env (Report important relevant_bindings valid_subs)
- = do { unit_state <- hsc_units <$> getTopEnv ;
- ; let err_info = ErrInfo O.empty (vcat $ relevant_bindings ++ valid_subs)
- ; let msg = TcRnUnknownMessage $ mkPlainDiagnostic rea noHints (vcat important)
- ; mkTcRnMessage
- (RealSrcSpan (tcl_loc tcl_env) Strict.Nothing)
- (TcRnMessageWithInfo unit_state $ TcRnMessageDetailed err_info msg)
- }
-
-type UserGiven = Implication
+ (TcRnMessageWithInfo unit_state $ TcRnMessageDetailed err_info msg) }
+
+-- | Pretty-print supplementary information, to add to an error report.
+pprSolverReportSupplementary :: HoleFitDispConfig -> SolverReportSupplementary -> SDoc
+-- This function should be in "GHC.Tc.Errors.Ppr",
+-- but we need it here because 'TcRnMessageDetails' needs an 'SDoc'.
+pprSolverReportSupplementary hfdc = \case
+ SupplementaryBindings binds -> pprRelevantBindings binds
+ SupplementaryHoleFits fits -> pprValidHoleFits hfdc fits
+ SupplementaryCts cts -> pprConstraintsInclude cts
+
+-- | Display a collection of valid hole fits.
+pprValidHoleFits :: HoleFitDispConfig -> ValidHoleFits -> SDoc
+-- This function should be in "GHC.Tc.Errors.Ppr",
+-- but we need it here because 'TcRnMessageDetails' needs an 'SDoc'.
+pprValidHoleFits hfdc (ValidHoleFits (Fits fits discarded_fits) (Fits refs discarded_refs))
+ = fits_msg $$ refs_msg
-getUserGivens :: ReportErrCtxt -> [UserGiven]
--- One item for each enclosing implication
-getUserGivens (CEC {cec_encl = implics}) = getUserGivensFromImplics implics
-
-getUserGivensFromImplics :: [Implication] -> [UserGiven]
-getUserGivensFromImplics implics
- = reverse (filterOut (null . ic_given) implics)
+ where
+ fits_msg, refs_msg, fits_discard_msg, refs_discard_msg :: SDoc
+ fits_msg = ppUnless (null fits) $
+ hang (text "Valid hole fits include") 2 $
+ vcat (map (pprHoleFit hfdc) fits)
+ $$ ppWhen discarded_fits fits_discard_msg
+ refs_msg = ppUnless (null refs) $
+ hang (text "Valid refinement hole fits include") 2 $
+ vcat (map (pprHoleFit hfdc) refs)
+ $$ ppWhen discarded_refs refs_discard_msg
+ fits_discard_msg =
+ text "(Some hole fits suppressed;" <+>
+ text "use -fmax-valid-hole-fits=N" <+>
+ text "or -fno-max-valid-hole-fits)"
+ refs_discard_msg =
+ text "(Some refinement hole fits suppressed;" <+>
+ text "use -fmax-refinement-hole-fits=N" <+>
+ text "or -fno-max-refinement-hole-fits)"
+
+-- | Add a "Constraints include..." message.
+--
+-- See Note [Constraints include ...]
+pprConstraintsInclude :: [(PredType, RealSrcSpan)] -> SDoc
+-- This function should be in "GHC.Tc.Errors.Ppr",
+-- but we need it here because 'TcRnMessageDetails' needs an 'SDoc'.
+pprConstraintsInclude cts
+ = ppUnless (null cts) $
+ hang (text "Constraints include")
+ 2 (vcat $ map pprConstraint cts)
+ where
+ pprConstraint (constraint, loc) =
+ ppr constraint <+> nest 2 (parens (text "from" <+> ppr loc))
{- Note [Always warn with -fdefer-type-errors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1201,14 +1110,14 @@ solve it.
************************************************************************
-}
-mkIrredErr :: ReportErrCtxt -> [Ct] -> TcM Report
+mkIrredErr :: ReportErrCtxt -> [Ct] -> TcM SolverReport
mkIrredErr ctxt cts
= do { (ctxt, binds_msg, ct1) <- relevantBindings True ctxt ct1
- ; let orig = ctOrigin ct1
- msg = couldNotDeduce (getUserGivens ctxt) (map ctPred cts, orig)
+ ; let msg = important ctxt $
+ CouldNotDeduce (getUserGivens ctxt) (ct1 :| others) Nothing
; return $ msg `mappend` mk_relevant_bindings binds_msg }
where
- (ct1:_) = cts
+ ct1:others = cts
{- Note [Constructing Hole Errors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1247,122 +1156,63 @@ 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 _ _tidy_simples ctxt hole@(Hole { hole_occ = occ
- , hole_ty = hole_ty
- , hole_loc = ct_loc })
+mkHoleError _ _tidy_simples ctxt hole@(Hole { hole_occ = occ, hole_loc = ct_loc })
| isOutOfScopeHole hole
= do { dflags <- getDynFlags
; rdr_env <- getGlobalRdrEnv
; imp_info <- getImports
; curr_mod <- getModule
; hpt <- getHpt
- ; let err = important out_of_scope_msg `mappend`
- (mk_relevant_bindings $
- unknownNameSuggestions WL_Anything dflags hpt curr_mod rdr_env
- (tcl_rdr lcl_env) imp_info (mkRdrUnqual occ))
-
- ; maybeAddDeferredBindings ctxt hole err
- ; mkErrorReportNC (cec_out_of_scope_holes ctxt) lcl_env err
- -- Use NC variant: the context is generally not helpful here
+ ; let (imp_errs, hints)
+ = 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)]
+ report = SolverReport errs [] hints
+
+ ; maybeAddDeferredBindings ctxt hole report
+ ; mkErrorReport lcl_env (TcRnSolverReport errs (cec_out_of_scope_holes ctxt) hints) Nothing []
+ -- Pass the value 'Nothing' for the context, as it's generally not helpful
+ -- to include the context here.
}
where
- herald | isDataOcc occ = text "Data constructor not in scope:"
- | otherwise = text "Variable not in scope:"
-
- out_of_scope_msg -- Print v :: ty only if the type has structure
- | boring_type = hang herald 2 (ppr occ)
- | otherwise = hang herald 2 (pp_occ_with_type occ hole_ty)
-
- lcl_env = ctLocEnv ct_loc
- boring_type = isTyVarTy hole_ty
+ lcl_env = ctLocEnv ct_loc
-- general case: not an out-of-scope error
-mkHoleError lcl_name_cache tidy_simples ctxt hole@(Hole { hole_occ = occ
- , hole_ty = hole_ty
- , hole_sort = sort
- , hole_loc = ct_loc })
- = do { binds_msg
+mkHoleError lcl_name_cache tidy_simples ctxt
+ hole@(Hole { hole_ty = hole_ty
+ , hole_sort = sort
+ , hole_loc = ct_loc })
+ = do { rel_binds
<- relevant_bindings False lcl_env lcl_name_cache (tyCoVarsOfType hole_ty)
-- The 'False' means "don't filter the bindings"; see Trac #8191
; show_hole_constraints <- goptM Opt_ShowHoleConstraints
- ; let constraints_msg
+ ; let relevant_cts
| ExprHole _ <- sort, show_hole_constraints
- = givenConstraintsMsg ctxt
+ = givenConstraints ctxt
| otherwise
- = empty
+ = []
; show_valid_hole_fits <- goptM Opt_ShowValidHoleFits
- ; (ctxt, sub_msg) <- if show_valid_hole_fits
- then validHoleFits ctxt tidy_simples hole
- else return (ctxt, empty)
+ ; (ctxt, hole_fits) <- if show_valid_hole_fits
+ then validHoleFits ctxt tidy_simples hole
+ else return (ctxt, noValidHoleFits)
- ; let err = important hole_msg `mappend`
- mk_relevant_bindings (binds_msg $$ constraints_msg) `mappend`
- valid_hole_fits sub_msg
+ ; let reason | ExprHole _ <- sort = cec_expr_holes ctxt
+ | otherwise = cec_type_holes ctxt
+ errs = [ReportWithCtxt ctxt $ ReportHoleError hole $ HoleError sort]
+ supp = [ SupplementaryBindings rel_binds
+ , SupplementaryCts relevant_cts
+ , SupplementaryHoleFits hole_fits ]
- ; maybeAddDeferredBindings ctxt hole err
+ ; maybeAddDeferredBindings ctxt hole (SolverReport errs supp [])
- ; let holes | ExprHole _ <- sort = cec_expr_holes ctxt
- | otherwise = cec_type_holes ctxt
- ; mkErrorReport holes ctxt lcl_env err
+ ; mkErrorReport lcl_env (TcRnSolverReport errs reason noHints) (Just ctxt) supp
}
where
- lcl_env = ctLocEnv ct_loc
- hole_kind = tcTypeKind hole_ty
- tyvars = tyCoVarsOfTypeList hole_ty
-
- hole_msg = case sort of
- ExprHole _ -> vcat [ hang (text "Found hole:")
- 2 (pp_occ_with_type occ hole_ty)
- , tyvars_msg, expr_hole_hint ]
- TypeHole -> vcat [ hang (text "Found type wildcard" <+> quotes (ppr occ))
- 2 (text "standing for" <+> quotes pp_hole_type_with_kind)
- , tyvars_msg, type_hole_hint ]
- ConstraintHole -> vcat [ hang (text "Found extra-constraints wildcard standing for")
- 2 (quotes $ pprType hole_ty) -- always kind constraint
- , tyvars_msg, type_hole_hint ]
-
- pp_hole_type_with_kind
- | isLiftedTypeKind hole_kind
- || isCoVarType hole_ty -- Don't print the kind of unlifted
- -- equalities (#15039)
- = pprType hole_ty
- | otherwise
- = pprType hole_ty <+> dcolon <+> pprKind hole_kind
-
- tyvars_msg = ppUnless (null tyvars) $
- text "Where:" <+> (vcat (map loc_msg other_tvs)
- $$ pprSkols ctxt skol_tvs)
- where
- (skol_tvs, other_tvs) = partition is_skol tyvars
- is_skol tv = isTcTyVar tv && isSkolemTyVar tv
- -- Coercion variables can be free in the
- -- hole, via kind casts
-
- type_hole_hint
- | ErrorWithoutFlag <- cec_type_holes ctxt
- = text "To use the inferred type, enable PartialTypeSignatures"
- | otherwise
- = empty
-
- expr_hole_hint -- Give hint for, say, f x = _x
- | lengthFS (occNameFS occ) > 1 -- Don't give this hint for plain "_"
- = text "Or perhaps" <+> quotes (ppr occ)
- <+> text "is mis-spelled, or not in scope"
- | otherwise
- = empty
-
- loc_msg tv
- | isTyVar tv
- = case tcTyVarDetails tv of
- MetaTv {} -> quotes (ppr tv) <+> text "is an ambiguous type variable"
- _ -> empty -- Skolems dealt with already
- | otherwise -- A coercion variable can be free in the hole type
- = ppWhenOption sdocPrintExplicitCoercions $
- quotes (ppr tv) <+> text "is a coercion variable"
-
+ lcl_env = ctLocEnv ct_loc
{- Note [Adding deferred bindings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1379,7 +1229,7 @@ so that the correct 'Severity' can be computed out of that later on.
-- See Note [Adding deferred bindings].
maybeAddDeferredBindings :: ReportErrCtxt
-> Hole
- -> Report
+ -> SolverReport
-> TcM ()
maybeAddDeferredBindings ctxt hole report = do
case hole_sort hole of
@@ -1394,57 +1244,38 @@ maybeAddDeferredBindings ctxt hole report = do
writeMutVar ref err_tm
_ -> pure ()
-pp_occ_with_type :: OccName -> Type -> SDoc
-pp_occ_with_type occ hole_ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hole_ty)
-
-- We unwrap the ReportErrCtxt here, to avoid introducing a loop in module
-- imports
-validHoleFits :: ReportErrCtxt -- The context we're in, i.e. the
- -- implications and the tidy environment
- -> [Ct] -- Unsolved simple constraints
- -> Hole -- The hole
- -> TcM (ReportErrCtxt, SDoc) -- We return the new context
- -- with a possibly updated
- -- tidy environment, and
- -- the message.
+validHoleFits :: ReportErrCtxt -- ^ The context we're in, i.e. the
+ -- implications and the tidy environment
+ -> [Ct] -- ^ Unsolved simple constraints
+ -> Hole -- ^ The hole
+ -> TcM (ReportErrCtxt, ValidHoleFits)
+ -- ^ We return the new context
+ -- with a possibly updated
+ -- tidy environment, and
+ -- the valid hole fits.
validHoleFits ctxt@(CEC {cec_encl = implics
, cec_tidy = lcl_env}) simps hole
- = do { (tidy_env, msg) <- findValidHoleFits lcl_env implics simps hole
- ; return (ctxt {cec_tidy = tidy_env}, msg) }
+ = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics simps hole
+ ; return (ctxt {cec_tidy = tidy_env}, fits) }
-- See Note [Constraints include ...]
-givenConstraintsMsg :: ReportErrCtxt -> SDoc
-givenConstraintsMsg ctxt =
- let constraints :: [(Type, RealSrcSpan)]
- constraints =
- do { implic@Implic{ ic_given = given } <- cec_encl ctxt
- ; constraint <- given
- ; return (varType constraint, tcl_loc (ic_env implic)) }
-
- pprConstraint (constraint, loc) =
- ppr constraint <+> nest 2 (parens (text "from" <+> ppr loc))
-
- in ppUnless (null constraints) $
- hang (text "Constraints include")
- 2 (vcat $ map pprConstraint constraints)
+givenConstraints :: ReportErrCtxt -> [(Type, RealSrcSpan)]
+givenConstraints ctxt
+ = do { implic@Implic{ ic_given = given } <- cec_encl ctxt
+ ; constraint <- given
+ ; return (varType constraint, tcl_loc (ic_env implic)) }
----------------
-mkIPErr :: ReportErrCtxt -> [Ct] -> TcM Report
+
+mkIPErr :: ReportErrCtxt -> [Ct] -> TcM SolverReport
mkIPErr ctxt cts
= do { (ctxt, binds_msg, ct1) <- relevantBindings True ctxt ct1
- ; let orig = ctOrigin ct1
- preds = map ctPred cts
- givens = getUserGivens ctxt
- msg | null givens
- = important $ addArising orig $
- sep [ text "Unbound implicit parameter" <> plural cts
- , nest 2 (pprParendTheta preds) ]
- | otherwise
- = couldNotDeduce givens (preds, orig)
-
+ ; let msg = important ctxt $ UnboundImplicitParams (ct1 :| others)
; return $ msg `mappend` mk_relevant_bindings binds_msg }
where
- (ct1:_) = cts
+ ct1:others = cts
----------------
@@ -1452,7 +1283,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 Report
+mkFRRErr :: ReportErrCtxt -> [Ct] -> TcM SolverReport
mkFRRErr ctxt cts
= do { -- Zonking/tidying.
; origs <-
@@ -1460,36 +1291,18 @@ mkFRRErr ctxt cts
zonkTidyOrigins (cec_tidy ctxt) (map ctOrigin cts)
<&>
-- Then remove duplicates: only retain one 'CtOrigin' per representation-polymorphic type.
- (nubOrdBy (nonDetCmpType `on` frr_type) . snd)
-
+ (nubOrdBy (nonDetCmpType `on` (snd . frr_orig_and_type)) . snd)
-- Obtain all the errors we want to report (constraints with FixedRuntimeRep origin),
-- with the corresponding types:
-- ty1 :: TYPE rep1, ty2 :: TYPE rep2, ...
- ; let tys = map frr_type origs
- kis = map typeKind tys
-
- -- Assemble the error message: pair up each origin with the corresponding type, e.g.
- -- • FixedRuntimeRep origin msg 1 ...
- -- a :: TYPE r1
- -- • FixedRuntimeRep origin msg 2 ...
- -- b :: TYPE r2
-
- combine_origin_ty_ki :: CtOrigin -> Type -> Kind -> SDoc
- combine_origin_ty_ki orig ty ki =
- -- Add bullet points if there is more than one error.
- (if length tys > 1 then (bullet <+>) else id) $
- vcat [pprArising orig <> colon
- ,nest 2 $ ppr ty <+> dcolon <+> pprWithTYPE ki]
-
- msg :: SDoc
- msg = vcat $ zipWith3 combine_origin_ty_ki origs tys kis
-
- ; return $ important msg }
+ ; let origs_and_tys = map frr_orig_and_type origs
+
+ ; return $ important ctxt $ FixedRuntimeRepError origs_and_tys }
where
- frr_type :: CtOrigin -> Type
- frr_type (FixedRuntimeRepOrigin ty _) = ty
- frr_type orig
+ frr_orig_and_type :: CtOrigin -> (FRROrigin, Type)
+ frr_orig_and_type (FixedRuntimeRepOrigin ty frr_orig) = (frr_orig, ty)
+ frr_orig_and_type orig
= pprPanic "mkFRRErr: not a FixedRuntimeRep origin"
(text "origin =" <+> ppr orig)
@@ -1552,61 +1365,59 @@ 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 Report
+mkEqErr :: ReportErrCtxt -> [Ct] -> TcM SolverReport
mkEqErr ctxt (ct:_) = mkEqErr1 ctxt ct
mkEqErr _ [] = panic "mkEqErr"
-mkEqErr1 :: ReportErrCtxt -> Ct -> TcM Report
+mkEqErr1 :: ReportErrCtxt -> Ct -> TcM SolverReport
mkEqErr1 ctxt ct -- Wanted or derived;
-- givens handled in mkGivenErrorReporter
= do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct
; rdr_env <- getGlobalRdrEnv
; fam_envs <- tcGetFamInstEnvs
- ; let coercible_msg = case ctEqRel ct of
- NomEq -> empty
- ReprEq -> mkCoercibleExplanation rdr_env fam_envs ty1 ty2
+ ; let mb_coercible_msg = case ctEqRel ct of
+ NomEq -> Nothing
+ ReprEq -> ReportCoercibleMsg <$> mkCoercibleExplanation rdr_env fam_envs ty1 ty2
; traceTc "mkEqErr1" (ppr ct $$ pprCtOrigin (ctOrigin ct))
- ; let report = mconcat [ important coercible_msg
- , mk_relevant_bindings binds_msg]
- ; mkEqErr_help ctxt report ct ty1 ty2 }
+ ; (last_msg :| prev_msgs, hints) <- mkEqErr_help ctxt ct ty1 ty2
+ ; let
+ report = foldMap (important ctxt) (reverse prev_msgs)
+ `mappend` (important ctxt $ mkTcReportWithInfo last_msg $ maybeToList mb_coercible_msg)
+ `mappend` (mk_relevant_bindings binds_msg)
+ `mappend` (mk_report_hints hints)
+ ; return report }
where
(ty1, ty2) = getEqPredTys (ctPred ct)
-- | This function tries to reconstruct why a "Coercible ty1 ty2" constraint
-- is left over.
mkCoercibleExplanation :: GlobalRdrEnv -> FamInstEnvs
- -> TcType -> TcType -> SDoc
+ -> TcType -> TcType -> Maybe CoercibleMsg
mkCoercibleExplanation rdr_env fam_envs ty1 ty2
| Just (tc, tys) <- tcSplitTyConApp_maybe ty1
, (rep_tc, _, _) <- tcLookupDataFamInst fam_envs tc tys
, Just msg <- coercible_msg_for_tycon rep_tc
- = msg
+ = Just msg
| Just (tc, tys) <- splitTyConApp_maybe ty2
, (rep_tc, _, _) <- tcLookupDataFamInst fam_envs tc tys
, Just msg <- coercible_msg_for_tycon rep_tc
- = msg
+ = Just msg
| Just (s1, _) <- tcSplitAppTy_maybe ty1
, Just (s2, _) <- tcSplitAppTy_maybe ty2
, s1 `eqType` s2
, has_unknown_roles s1
- = hang (text "NB: We cannot know what roles the parameters to" <+>
- quotes (ppr s1) <+> text "have;")
- 2 (text "we must assume that the role is nominal")
+ = Just $ UnknownRoles s1
| otherwise
- = empty
+ = Nothing
where
coercible_msg_for_tycon tc
| isAbstractTyCon tc
- = Just $ hsep [ text "NB: The type constructor"
- , quotes (pprSourceTyCon tc)
- , text "is abstract" ]
+ = Just $ TyConIsAbstract tc
| isNewTyCon tc
, [data_con] <- tyConDataCons tc
, let dc_name = dataConName data_con
, isNothing (lookupGRE_Name rdr_env dc_name)
- = Just $ hang (text "The data constructor" <+> quotes (ppr dc_name))
- 2 (sep [ text "of newtype" <+> quotes (pprSourceTyCon tc)
- , text "is not in scope" ])
+ = Just $ OutOfScopeNewtypeConstructor tc data_con
| otherwise = Nothing
has_unknown_roles ty
@@ -1619,83 +1430,78 @@ mkCoercibleExplanation rdr_env fam_envs ty1 ty2
| otherwise
= False
-mkEqErr_help :: ReportErrCtxt -> Report
+-- | Accumulated messages in reverse order.
+type AccReportMsgs = NonEmpty TcReportMsg
+
+mkEqErr_help :: ReportErrCtxt
-> Ct
- -> TcType -> TcType -> TcM Report
-mkEqErr_help ctxt report ct ty1 ty2
+ -> TcType -> TcType -> TcM (AccReportMsgs, [GhcHint])
+mkEqErr_help ctxt ct ty1 ty2
| Just (tv1, _) <- tcGetCastedTyVar_maybe ty1
- = mkTyVarEqErr ctxt report ct tv1 ty2
+ = mkTyVarEqErr ctxt ct tv1 ty2
| Just (tv2, _) <- tcGetCastedTyVar_maybe ty2
- = mkTyVarEqErr ctxt report ct tv2 ty1
+ = mkTyVarEqErr ctxt ct tv2 ty1
| otherwise
- = return $ reportEqErr ctxt report ct ty1 ty2
+ = return (reportEqErr ctxt ct ty1 ty2 :| [], [])
-reportEqErr :: ReportErrCtxt -> Report
+reportEqErr :: ReportErrCtxt
-> Ct
- -> TcType -> TcType -> Report
-reportEqErr ctxt report ct ty1 ty2
- = mconcat [misMatch, report, eqInfo]
+ -> TcType -> TcType -> TcReportMsg
+reportEqErr ctxt ct ty1 ty2
+ = mkTcReportWithInfo mismatch eqInfos
where
- misMatch = misMatchOrCND False ctxt ct ty1 ty2
- eqInfo = mkEqInfoMsg ct ty1 ty2
+ mismatch = misMatchOrCND False ctxt ct ty1 ty2
+ eqInfos = eqInfoMsgs ct ty1 ty2
-mkTyVarEqErr :: ReportErrCtxt -> Report -> Ct
- -> TcTyVar -> TcType -> TcM Report
+mkTyVarEqErr :: ReportErrCtxt -> Ct
+ -> TcTyVar -> TcType -> TcM (AccReportMsgs, [GhcHint])
-- tv1 and ty2 are already tidied
-mkTyVarEqErr ctxt report ct tv1 ty2
+mkTyVarEqErr ctxt ct tv1 ty2
= do { traceTc "mkTyVarEqErr" (ppr ct $$ ppr tv1 $$ ppr ty2)
; dflags <- getDynFlags
- ; return $ mkTyVarEqErr' dflags ctxt report ct tv1 ty2 }
+ ; return $ mkTyVarEqErr' dflags ctxt ct tv1 ty2 }
-mkTyVarEqErr' :: DynFlags -> ReportErrCtxt -> Report -> Ct
- -> TcTyVar -> TcType -> Report
-mkTyVarEqErr' dflags ctxt report ct tv1 ty2
+mkTyVarEqErr' :: DynFlags -> ReportErrCtxt -> Ct
+ -> TcTyVar -> TcType -> (AccReportMsgs, [GhcHint])
+mkTyVarEqErr' dflags ctxt ct tv1 ty2
-- impredicativity is a simple error to understand; try it first
| check_eq_result `cterHasProblem` cteImpredicative
- = let msg = vcat [ (if isSkolemTyVar tv1
- then text "Cannot equate type variable"
- else text "Cannot instantiate unification variable")
- <+> quotes (ppr tv1)
- , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) ]
- in
- -- Unlike the other reports, this discards the old 'report_important'
+ , let
+ poly_msg = CannotUnifyWithPolytype ct tv1 ty2
+ tyvar_eq_info = extraTyVarEqInfo tv1 ty2
+ poly_msg_with_info
+ | isSkolemTyVar tv1
+ = mkTcReportWithInfo poly_msg tyvar_eq_info
+ | otherwise
+ = poly_msg
+ = -- Unlike the other reports, this discards the old 'report_important'
-- instead of augmenting it. This is because the details are not likely
-- to be helpful since this is just an unimplemented feature.
- mconcat [ headline_msg
- , important msg
- , if isSkolemTyVar tv1 then extraTyVarEqInfo ctxt tv1 ty2 else mempty
- , report ]
+ (poly_msg_with_info <| headline_msg :| [], [])
| isSkolemTyVar tv1 -- ty2 won't be a meta-tyvar; we would have
-- swapped in Solver.Canonical.canEqTyVarHomo
|| isTyVarTyVar tv1 && not (isTyVarTy ty2)
|| ctEqRel ct == ReprEq
-- The cases below don't really apply to ReprEq (except occurs check)
- = mconcat [ headline_msg
- , extraTyVarEqInfo ctxt tv1 ty2
- , suggestAddSig ctxt ty1 ty2
- , report
- ]
+ = (mkTcReportWithInfo headline_msg tv_extra :| [], add_sig)
| cterHasOccursCheck check_eq_result
-- We report an "occurs check" even for a ~ F t a, where F is a type
-- function; it's not insoluble (because in principle F could reduce)
-- but we have certainly been unable to solve it
- = let extra2 = mkEqInfoMsg ct ty1 ty2
+ = let extras2 = eqInfoMsgs ct ty1 ty2
interesting_tyvars = filter (not . noFreeVarsOfType . tyVarKind) $
filter isTyVar $
fvVarList $
tyCoFVsOfType ty1 `unionFV` tyCoFVsOfType ty2
- extra3 = mk_relevant_bindings $
- ppWhen (not (null interesting_tyvars)) $
- hang (text "Type variable kinds:") 2 $
- vcat (map (tyvar_binding . tidyTyCoVarOcc (cec_tidy ctxt))
- interesting_tyvars)
- tyvar_binding tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv)
- in
- mconcat [headline_msg, extra2, extra3, report]
+ extras3 = case interesting_tyvars of
+ [] -> []
+ (tv : tvs) -> [OccursCheckInterestingTyVars (tv :| tvs)]
+
+ in (mkTcReportWithInfo headline_msg (extras2 ++ extras3) :| [], [])
-- If the immediately-enclosing implication has 'tv' a skolem, and
-- we know by now its an InferSkol kind of skolem, then presumably
@@ -1704,35 +1510,14 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2
| (implic:_) <- cec_encl ctxt
, Implic { ic_skols = skols } <- implic
, tv1 `elem` skols
- = mconcat [ misMatchMsg ctxt ct ty1 ty2
- , extraTyVarEqInfo ctxt tv1 ty2
- , report
- ]
+ = (mkTcReportWithInfo mismatch_msg tv_extra :| [], [])
-- Check for skolem escape
| (implic:_) <- cec_encl ctxt -- Get the innermost context
- , Implic { ic_skols = skols, ic_info = skol_info } <- implic
+ , Implic { ic_skols = skols } <- implic
, let esc_skols = filter (`elemVarSet` (tyCoVarsOfType ty2)) skols
, not (null esc_skols)
- = let msg = misMatchMsg ctxt ct ty1 ty2
- esc_doc = sep [ text "because" <+> what <+> text "variable" <> plural esc_skols
- <+> pprQuotedList esc_skols
- , text "would escape" <+>
- if isSingleton esc_skols then text "its scope"
- else text "their scope" ]
- tv_extra = important $
- vcat [ nest 2 $ esc_doc
- , sep [ (if isSingleton esc_skols
- then text "This (rigid, skolem)" <+>
- what <+> text "variable is"
- else text "These (rigid, skolem)" <+>
- what <+> text "variables are")
- <+> text "bound by"
- , nest 2 $ ppr skol_info
- , nest 2 $ text "at" <+>
- ppr (tcl_loc (ic_env implic)) ] ]
- in
- mconcat [msg, tv_extra, report]
+ = (SkolemEscape ct implic esc_skols :| [mismatch_msg], [])
-- Nastiest case: attempt to unify an untouchable variable
-- So tv is a meta tyvar (or started that way before we
@@ -1740,29 +1525,23 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2
-- meta tyvar or a TyVarTv, else it'd have been unified
-- See Note [Error messages for untouchables]
| (implic:_) <- cec_encl ctxt -- Get the innermost context
- , Implic { ic_given = given, ic_tclvl = lvl, ic_info = skol_info } <- implic
+ , Implic { ic_tclvl = lvl } <- implic
= assertPpr (not (isTouchableMetaTyVar lvl tv1))
(ppr tv1 $$ ppr lvl) $ -- See Note [Error messages for untouchables]
- let msg = misMatchMsg ctxt ct ty1 ty2
- tclvl_extra = important $
- nest 2 $
- sep [ quotes (ppr tv1) <+> text "is untouchable"
- , nest 2 $ text "inside the constraints:" <+> pprEvVarTheta given
- , nest 2 $ text "bound by" <+> ppr skol_info
- , nest 2 $ text "at" <+>
- ppr (tcl_loc (ic_env implic)) ]
- tv_extra = extraTyVarEqInfo ctxt tv1 ty2
- add_sig = suggestAddSig ctxt ty1 ty2
+ let tclvl_extra = UntouchableVariable tv1 implic
in
- mconcat [msg, tclvl_extra, tv_extra, add_sig, report]
+ (mkTcReportWithInfo tclvl_extra tv_extra :| [mismatch_msg], add_sig)
| otherwise
- = reportEqErr ctxt report ct (mkTyVarTy tv1) ty2
+ = (reportEqErr ctxt ct (mkTyVarTy tv1) ty2 :| [], [])
-- This *can* happen (#6123)
-- Consider an ambiguous top-level constraint (a ~ F a)
-- Not an occurs check, because F is a type function.
where
headline_msg = misMatchOrCND insoluble_occurs_check ctxt ct ty1 ty2
+ mismatch_msg = mkMismatchMsg ct ty1 ty2
+ tv_extra = extraTyVarEqInfo tv1 ty2
+ add_sig = maybeToList $ suggestAddSig ctxt ty1 ty2
ty1 = mkTyVarTy tv1
@@ -1774,42 +1553,37 @@ mkTyVarEqErr' dflags ctxt report ct tv1 ty2
-- variable is on the right, so we don't get useful info for the CIrredCan,
-- and have to compute the result of checkTyVarEq here.
-
insoluble_occurs_check = check_eq_result `cterHasProblem` cteInsolubleOccurs
- what = text $ levelString $
- ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel
-
-levelString :: TypeOrKind -> String
-levelString TypeLevel = "type"
-levelString KindLevel = "kind"
-
-mkEqInfoMsg :: Ct -> TcType -> TcType -> Report
+eqInfoMsgs :: Ct -> TcType -> TcType -> [TcReportInfo]
-- 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
-- type function application F a ~ F b
-- See Note [Non-injective type functions]
-mkEqInfoMsg ct ty1 ty2
- = important (tyfun_msg $$ ambig_msg)
+eqInfoMsgs ct ty1 ty2
+ = catMaybes [tyfun_msg, ambig_msg]
where
mb_fun1 = isTyFun_maybe ty1
mb_fun2 = isTyFun_maybe ty2
+ (ambig_kvs, ambig_tvs) = getAmbigTkvs ct
ambig_msg | isJust mb_fun1 || isJust mb_fun2
- = snd (mkAmbigMsg False ct)
- | otherwise = empty
+ , not (null ambig_kvs && null ambig_tvs)
+ = Just $ Ambiguity False (ambig_kvs, ambig_tvs)
+ | otherwise
+ = Nothing
tyfun_msg | Just tc1 <- mb_fun1
, Just tc2 <- mb_fun2
, tc1 == tc2
, not (isInjectiveTyCon tc1 Nominal)
- = text "NB:" <+> quotes (ppr tc1)
- <+> text "is a non-injective type family"
- | otherwise = empty
+ = Just $ NonInjectiveTyFam tc1
+ | otherwise
+ = Nothing
misMatchOrCND :: Bool -> ReportErrCtxt -> Ct
- -> TcType -> TcType -> Report
+ -> TcType -> TcType -> TcReportMsg
-- 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]
@@ -1818,56 +1592,26 @@ misMatchOrCND insoluble_occurs_check ctxt ct ty1 ty2
|| null givens
= -- If the equality is unconditionally insoluble
-- or there is no context, don't report the context
- misMatchMsg ctxt ct ty1 ty2
+ mkMismatchMsg ct ty1 ty2
| otherwise
- = mconcat [ couldNotDeduce givens ([eq_pred], orig)
- , important $ mk_supplementary_ea_msg ctxt level ty1 ty2 orig ]
+ = CouldNotDeduce givens (ct :| []) (Just $ CND_Extra level ty1 ty2)
+
where
ev = ctEvidence ct
- eq_pred = ctEvPred ev
- orig = ctEvOrigin ev
level = ctLocTypeOrKind_maybe (ctEvLoc ev) `orElse` TypeLevel
givens = [ given | given <- getUserGivens ctxt, ic_given_eqs given /= NoGivenEqs ]
-- Keep only UserGivens that have some equalities.
-- See Note [Suppress redundant givens during error reporting]
-couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> Report
-couldNotDeduce givens (wanteds, orig)
- = important $
- vcat [ addArising orig (text "Could not deduce:" <+> pprTheta wanteds)
- , vcat (pp_givens givens)]
-
-pp_givens :: [UserGiven] -> [SDoc]
-pp_givens givens
- = case givens of
- [] -> []
- (g:gs) -> ppr_given (text "from the context:") g
- : map (ppr_given (text "or from:")) gs
- where
- ppr_given herald implic@(Implic { ic_given = gs, ic_info = skol_info })
- = hang (herald <+> pprEvVarTheta (mkMinimalBySCs evVarPred gs))
- -- See Note [Suppress redundant givens during error reporting]
- -- for why we use mkMinimalBySCs above.
- 2 (sep [ text "bound by" <+> ppr skol_info
- , text "at" <+> ppr (tcl_loc (ic_env implic)) ])
-
-- These are for the "blocked" equalities, as described in TcCanonical
-- Note [Equalities with incompatible kinds], wrinkle (2). There should
-- 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 Report
-mkBlockedEqErr _ (ct:_) = return $ important msg
- where
- msg = vcat [ hang (text "Cannot use equality for substitution:")
- 2 (ppr (ctPred ct))
- , text "Doing so would be ill-kinded." ]
- -- This is a terrible message. Perhaps worse, if the user
- -- has -fprint-explicit-kinds on, they will see that the two
- -- sides have the same kind, as there is an invisible cast.
- -- I really don't know how to do better.
-mkBlockedEqErr _ [] = panic "mkBlockedEqErr no constraints"
+mkBlockedEqErr :: ReportErrCtxt -> [Ct] -> TcM SolverReport
+mkBlockedEqErr ctxt (ct:_) = return $ important ctxt (BlockedEquality ct)
+mkBlockedEqErr _ [] = panic "mkBlockedEqErr no constraints"
{-
Note [Suppress redundant givens during error reporting]
@@ -1909,37 +1653,31 @@ addition to superclasses (see Note [Remove redundant provided dicts]
in GHC.Tc.TyCl.PatSyn).
-}
-extraTyVarEqInfo :: ReportErrCtxt -> TcTyVar -> TcType -> Report
+extraTyVarEqInfo :: TcTyVar -> TcType -> [TcReportInfo]
-- Add on extra info about skolem constants
-- NB: The types themselves are already tidied
-extraTyVarEqInfo ctxt tv1 ty2
- = important (extraTyVarInfo ctxt tv1 $$ ty_extra ty2)
+extraTyVarEqInfo tv1 ty2
+ = extraTyVarInfo tv1 : ty_extra ty2
where
ty_extra ty = case tcGetCastedTyVar_maybe ty of
- Just (tv, _) -> extraTyVarInfo ctxt tv
- Nothing -> empty
-
-extraTyVarInfo :: ReportErrCtxt -> TcTyVar -> SDoc
-extraTyVarInfo ctxt tv
- = assertPpr (isTyVar tv) (ppr tv) $
- case tcTyVarDetails tv of
- SkolemTv {} -> pprSkols ctxt [tv]
- RuntimeUnk {} -> quotes (ppr tv) <+> text "is an interactive-debugger skolem"
- MetaTv {} -> empty
-
-suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> Report
+ Just (tv, _) -> [extraTyVarInfo tv]
+ Nothing -> []
+
+extraTyVarInfo :: TcTyVar -> TcReportInfo
+extraTyVarInfo tv = assertPpr (isTyVar tv) (ppr tv) $ TyVarInfo tv
+
+suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> Maybe GhcHint
-- See Note [Suggest adding a type signature]
suggestAddSig ctxt ty1 _ty2
- | null inferred_bndrs -- No let-bound inferred binders in context
- = mempty
- | [bndr] <- inferred_bndrs
- = important $ text "Possible fix: add a type signature for" <+> quotes (ppr bndr)
+ | bndr : bndrs <- inferred_bndrs
+ = Just $ SuggestAddTypeSignatures $ NamedBindings (bndr :| bndrs)
| otherwise
- = important $ text "Possible fix: add type signatures for some or all of" <+> (ppr inferred_bndrs)
+ = Nothing
where
- inferred_bndrs = case tcGetTyVar_maybe ty1 of
- Just tv | isSkolemTyVar tv -> find (cec_encl ctxt) False tv
- _ -> []
+ inferred_bndrs =
+ case tcGetTyVar_maybe ty1 of
+ Just tv | isSkolemTyVar tv -> find (cec_encl ctxt) False tv
+ _ -> []
-- 'find' returns the binders of an InferSkol for 'tv',
-- provided there is an intervening implication with
@@ -1954,224 +1692,35 @@ suggestAddSig ctxt ty1 _ty2
= find implics (seen_eqs || ic_given_eqs implic /= NoGivenEqs) tv
--------------------
-misMatchMsg :: ReportErrCtxt -> Ct -> TcType -> TcType -> Report
--- Types are already tidy
--- If oriented then ty1 is actual, ty2 is expected
-misMatchMsg ctxt ct ty1 ty2
- = important $
- addArising orig $
- pprWithExplicitKindsWhenMismatch ty1 ty2 orig $
- sep [ case orig of
- TypeEqOrigin {} -> tk_eq_msg ctxt ct ty1 ty2 orig
- KindEqOrigin {} -> tk_eq_msg ctxt ct ty1 ty2 orig
- _ -> headline_eq_msg False ct ty1 ty2
- , sameOccExtra ty2 ty1 ]
- where
- orig = ctOrigin ct
-
-headline_eq_msg :: Bool -> Ct -> Type -> Type -> SDoc
--- Generates the main "Could't match 't1' against 't2'
--- headline message
-headline_eq_msg add_ea ct ty1 ty2
-
- | (isLiftedRuntimeRep ty1 && isUnliftedRuntimeRep ty2) ||
- (isLiftedRuntimeRep ty2 && isUnliftedRuntimeRep ty1) ||
- (isLiftedLevity ty1 && isUnliftedLevity ty2) ||
- (isLiftedLevity ty2 && isUnliftedLevity ty1)
- = text "Couldn't match a lifted type with an unlifted type"
-
- | isAtomicTy ty1 || isAtomicTy ty2
- = -- Print with quotes
- sep [ text herald1 <+> quotes (ppr ty1)
- , nest padding $
- text herald2 <+> quotes (ppr ty2) ]
-
- | otherwise
- = -- Print with vertical layout
- vcat [ text herald1 <> colon <+> ppr ty1
- , nest padding $
- text herald2 <> colon <+> ppr ty2 ]
- where
- herald1 = conc [ "Couldn't match"
- , if is_repr then "representation of" else ""
- , if add_ea then "expected" else ""
- , what ]
- herald2 = conc [ "with"
- , if is_repr then "that of" else ""
- , if add_ea then ("actual " ++ what) else "" ]
-
- padding = length herald1 - length herald2
-
- is_repr = case ctEqRel ct of { ReprEq -> True; NomEq -> False }
-
- what = levelString (ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel)
-
- conc :: [String] -> String
- conc = foldr1 add_space
-
- add_space :: String -> String -> String
- add_space s1 s2 | null s1 = s2
- | null s2 = s1
- | otherwise = s1 ++ (' ' : s2)
-
-
-tk_eq_msg :: ReportErrCtxt
- -> Ct -> Type -> Type -> CtOrigin -> SDoc
-tk_eq_msg ctxt ct ty1 ty2 orig@(TypeEqOrigin { uo_actual = act
- , uo_expected = exp
- , uo_thing = mb_thing })
- -- We can use the TypeEqOrigin to
- -- improve the error message quite a lot
-
- | isUnliftedTypeKind act, isLiftedTypeKind exp
- = sep [ text "Expecting a lifted type, but"
- , thing_msg mb_thing (text "an") (text "unlifted") ]
-
- | isLiftedTypeKind act, isUnliftedTypeKind exp
- = sep [ text "Expecting an unlifted type, but"
- , thing_msg mb_thing (text "a") (text "lifted") ]
-
- | tcIsLiftedTypeKind exp
- = maybe_num_args_msg $$
- sep [ text "Expected a type, but"
- , case mb_thing of
- Nothing -> text "found something with kind"
- Just thing -> quotes thing <+> text "has kind"
- , quotes (pprWithTYPE act) ]
-
- | Just nargs_msg <- num_args_msg
- = nargs_msg $$
- mk_ea_msg ctxt (Just ct) level orig
-
- | -- pprTrace "check" (ppr ea_looks_same $$ ppr exp $$ ppr act $$ ppr ty1 $$ ppr ty2) $
- ea_looks_same ty1 ty2 exp act
- = mk_ea_msg ctxt (Just ct) level orig
- | otherwise -- The mismatched types are /inside/ exp and act
- = vcat [ headline_eq_msg False ct ty1 ty2
- , mk_ea_msg ctxt Nothing level orig ]
-
- where
- ct_loc = ctLoc ct
- level = ctLocTypeOrKind_maybe ct_loc `orElse` TypeLevel
-
- thing_msg (Just thing) _ levity = quotes thing <+> text "is" <+> levity
- thing_msg Nothing an levity = text "got" <+> an <+> levity <+> text "type"
-
- num_args_msg = case level of
- KindLevel
- | not (isMetaTyVarTy exp) && not (isMetaTyVarTy act)
- -- if one is a meta-tyvar, then it's possible that the user
- -- has asked for something impredicative, and we couldn't unify.
- -- Don't bother with counting arguments.
- -> let n_act = count_args act
- n_exp = count_args exp in
- case n_act - n_exp of
- 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 $ text "Expecting" <+> speakN (abs n) <+>
- more <+> quotes thing
- where
- more
- | n == 1 = text "more argument to"
- | otherwise = text "more arguments to" -- n > 1
- _ -> Nothing
-
- _ -> Nothing
-
- maybe_num_args_msg = num_args_msg `orElse` empty
-
- count_args ty = count isVisibleBinder $ fst $ splitPiTys ty
-
-tk_eq_msg ctxt ct ty1 ty2
- (KindEqOrigin cty1 cty2 sub_o mb_sub_t_or_k)
- = vcat [ headline_eq_msg False ct ty1 ty2
- , supplementary_msg ]
- where
- sub_t_or_k = mb_sub_t_or_k `orElse` TypeLevel
- sub_whats = text (levelString sub_t_or_k) <> char 's'
- -- "types" or "kinds"
-
- supplementary_msg
- = sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions ->
- if printExplicitCoercions
- || not (cty1 `pickyEqType` cty2)
- then vcat [ hang (text "When matching" <+> sub_whats)
- 2 (vcat [ ppr cty1 <+> dcolon <+>
- ppr (tcTypeKind cty1)
- , ppr cty2 <+> dcolon <+>
- ppr (tcTypeKind cty2) ])
- , mk_supplementary_ea_msg ctxt sub_t_or_k cty1 cty2 sub_o ]
- else text "When matching the kind of" <+> quotes (ppr cty1)
-
-tk_eq_msg _ _ _ _ _ = panic "typeeq_mismatch_msg"
-
-ea_looks_same :: Type -> Type -> Type -> Type -> Bool
--- True if the faulting types (ty1, ty2) look the same as
--- the expected/actual types (exp, act).
--- If so, we don't want to redundantly report the latter
-ea_looks_same ty1 ty2 exp act
- = (act `looks_same` ty1 && exp `looks_same` ty2) ||
- (exp `looks_same` ty1 && act `looks_same` ty2)
+mkMismatchMsg :: Ct -> Type -> Type -> TcReportMsg
+mkMismatchMsg ct ty1 ty2 =
+ case ctOrigin ct of
+ TypeEqOrigin { uo_actual, uo_expected, uo_thing = mb_thing } ->
+ mkTcReportWithInfo
+ (TypeEqMismatch
+ { teq_mismatch_ppr_explicit_kinds = ppr_explicit_kinds
+ , teq_mismatch_ct = ct
+ , teq_mismatch_ty1 = ty1
+ , teq_mismatch_ty2 = ty2
+ , teq_mismatch_actual = uo_actual
+ , teq_mismatch_expected = uo_expected
+ , teq_mismatch_what = mb_thing})
+ extras
+ KindEqOrigin cty1 cty2 sub_o mb_sub_t_or_k ->
+ mkTcReportWithInfo (Mismatch False ct ty1 ty2)
+ (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k : extras)
+ _ ->
+ mkTcReportWithInfo
+ (Mismatch False ct ty1 ty2)
+ extras
where
- looks_same t1 t2 = t1 `pickyEqType` t2
- || t1 `eqType` liftedTypeKind && t2 `eqType` liftedTypeKind
- -- pickyEqType is sensitive to synonyms, so only replies True
- -- when the types really look the same. However,
- -- (TYPE 'LiftedRep) and Type both print the same way.
-
-mk_supplementary_ea_msg :: ReportErrCtxt -> TypeOrKind
- -> Type -> Type -> CtOrigin -> SDoc
-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)
- = mk_ea_msg ctxt Nothing level orig
- | otherwise
- = empty
-
-mk_ea_msg :: ReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> SDoc
--- Constructs a "Couldn't match" message
--- The (Maybe Ct) says whether this is the main top-level message (Just)
--- or a supplementary message (Nothing)
-mk_ea_msg ctxt at_top level
- (TypeEqOrigin { uo_actual = act, uo_expected = exp, uo_thing = mb_thing })
- | Just thing <- mb_thing
- , KindLevel <- level
- = hang (text "Expected" <+> kind_desc <> comma)
- 2 (text "but" <+> quotes thing <+> text "has kind" <+>
- quotes (ppr act))
-
- | otherwise
- = vcat [ case at_top of
- Just ct -> headline_eq_msg True ct exp act
- Nothing -> supplementary_ea_msg
- , ppWhen expand_syns expandedTys ]
-
- where
- supplementary_ea_msg = vcat [ text "Expected:" <+> ppr exp
- , text " Actual:" <+> ppr act ]
-
- kind_desc | tcIsConstraintKind exp = text "a constraint"
- | Just arg <- kindRep_maybe exp -- TYPE t0
- , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case
- True -> text "kind" <+> quotes (ppr exp)
- False -> text "a type"
- | otherwise = text "kind" <+> quotes (ppr exp)
-
- expand_syns = cec_expand_syns ctxt
-
- expandedTys = ppUnless (expTy1 `pickyEqType` exp && expTy2 `pickyEqType` act) $ vcat
- [ text "Type synonyms expanded:"
- , text "Expected type:" <+> ppr expTy1
- , text " Actual type:" <+> ppr expTy2 ]
-
- (expTy1, expTy2) = expandSynonymsToMatch exp act
-
-mk_ea_msg _ _ _ _ = empty
+ orig = ctOrigin ct
+ extras = sameOccExtras ty2 ty1
+ ppr_explicit_kinds = shouldPprWithExplicitKinds ty1 ty2 orig
--- | Prints explicit kinds (with @-fprint-explicit-kinds@) in an 'SDoc' when a
--- type mismatch occurs to due invisible kind arguments.
+-- | Whether to prints explicit kinds (with @-fprint-explicit-kinds@)
+-- in an 'SDoc' when a type mismatch occurs to due invisible kind arguments.
--
-- This function first checks to see if the 'CtOrigin' argument is a
-- 'TypeEqOrigin', and if so, uses the expected/actual types from that to
@@ -2180,18 +1729,16 @@ mk_ea_msg _ _ _ _ = empty
-- mismatch occurred in an invisible argument position or not). If the
-- 'CtOrigin' is not a 'TypeEqOrigin', fall back on the actual mismatched types
-- themselves.
-pprWithExplicitKindsWhenMismatch :: Type -> Type -> CtOrigin
- -> SDoc -> SDoc
-pprWithExplicitKindsWhenMismatch ty1 ty2 ct
- = pprWithExplicitKindsWhen show_kinds
+shouldPprWithExplicitKinds :: Type -> Type -> CtOrigin -> Bool
+shouldPprWithExplicitKinds ty1 ty2 ct
+ = tcEqTypeVis act_ty exp_ty
+ -- True when the visible bit of the types look the same,
+ -- so we want to show the kinds in the displayed type.
where
(act_ty, exp_ty) = case ct of
TypeEqOrigin { uo_actual = act
, uo_expected = exp } -> (act, exp)
_ -> (ty1, ty2)
- show_kinds = tcEqTypeVis act_ty exp_ty
- -- True when the visible bit of the types look the same,
- -- so we want to show the kinds in the displayed type
{- Note [Insoluble occurs check]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2209,165 +1756,11 @@ This is done in misMatchOrCND (via the insoluble_occurs_check arg)
(NB: there are potentially-soluble ones, like (a ~ F a b), and we don't
want to be as draconian with them.)
-
-Note [Expanding type synonyms to make types similar]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-In type error messages, if -fprint-expanded-types is used, we want to expand
-type synonyms to make expected and found types as similar as possible, but we
-shouldn't expand types too much to make type messages even more verbose and
-harder to understand. The whole point here is to make the difference in expected
-and found types clearer.
-
-`expandSynonymsToMatch` does this, it takes two types, and expands type synonyms
-only as much as necessary. Given two types t1 and t2:
-
- * If they're already same, it just returns the types.
-
- * If they're in form `C1 t1_1 .. t1_n` and `C2 t2_1 .. t2_m` (C1 and C2 are
- type constructors), it expands C1 and C2 if they're different type synonyms.
- Then it recursively does the same thing on expanded types. If C1 and C2 are
- same, then it applies the same procedure to arguments of C1 and arguments of
- C2 to make them as similar as possible.
-
- Most important thing here is to keep number of synonym expansions at
- minimum. For example, if t1 is `T (T3, T5, Int)` and t2 is `T (T5, T3,
- Bool)` where T5 = T4, T4 = T3, ..., T1 = X, it returns `T (T3, T3, Int)` and
- `T (T3, T3, Bool)`.
-
- * Otherwise types don't have same shapes and so the difference is clearly
- visible. It doesn't do any expansions and show these types.
-
-Note that we only expand top-layer type synonyms. Only when top-layer
-constructors are the same we start expanding inner type synonyms.
-
-Suppose top-layer type synonyms of t1 and t2 can expand N and M times,
-respectively. If their type-synonym-expanded forms will meet at some point (i.e.
-will have same shapes according to `sameShapes` function), it's possible to find
-where they meet in O(N+M) top-layer type synonym expansions and O(min(N,M))
-comparisons. We first collect all the top-layer expansions of t1 and t2 in two
-lists, then drop the prefix of the longer list so that they have same lengths.
-Then we search through both lists in parallel, and return the first pair of
-types that have same shapes. Inner types of these two types with same shapes
-are then expanded using the same algorithm.
-
-In case they don't meet, we return the last pair of types in the lists, which
-has top-layer type synonyms completely expanded. (in this case the inner types
-are not expanded at all, as the current form already shows the type error)
-}
--- | Expand type synonyms in given types only enough to make them as similar as
--- possible. Returned types are the same in terms of used type synonyms.
---
--- To expand all synonyms, see 'Type.expandTypeSynonyms'.
---
--- See `ExpandSynsFail` tests in tests testsuite/tests/typecheck/should_fail for
--- some examples of how this should work.
-expandSynonymsToMatch :: Type -> Type -> (Type, Type)
-expandSynonymsToMatch ty1 ty2 = (ty1_ret, ty2_ret)
- where
- (ty1_ret, ty2_ret) = go ty1 ty2
-
- -- | Returns (type synonym expanded version of first type,
- -- type synonym expanded version of second type)
- go :: Type -> Type -> (Type, Type)
- go t1 t2
- | t1 `pickyEqType` t2 =
- -- Types are same, nothing to do
- (t1, t2)
-
- go (TyConApp tc1 tys1) (TyConApp tc2 tys2)
- | tc1 == tc2
- , tys1 `equalLength` tys2 =
- -- Type constructors are same. They may be synonyms, but we don't
- -- expand further. The lengths of tys1 and tys2 must be equal;
- -- for example, with type S a = a, we don't want
- -- to zip (S Monad Int) and (S Bool).
- let (tys1', tys2') =
- unzip (zipWithEqual "expandSynonymsToMatch" go tys1 tys2)
- in (TyConApp tc1 tys1', TyConApp tc2 tys2')
-
- go (AppTy t1_1 t1_2) (AppTy t2_1 t2_2) =
- let (t1_1', t2_1') = go t1_1 t2_1
- (t1_2', t2_2') = go t1_2 t2_2
- in (mkAppTy t1_1' t1_2', mkAppTy t2_1' t2_2')
-
- go ty1@(FunTy _ w1 t1_1 t1_2) ty2@(FunTy _ w2 t2_1 t2_2) | w1 `eqType` w2 =
- let (t1_1', t2_1') = go t1_1 t2_1
- (t1_2', t2_2') = go t1_2 t2_2
- in ( ty1 { ft_arg = t1_1', ft_res = t1_2' }
- , ty2 { ft_arg = t2_1', ft_res = t2_2' })
-
- go (ForAllTy b1 t1) (ForAllTy b2 t2) =
- -- NOTE: We may have a bug here, but we just can't reproduce it easily.
- -- See D1016 comments for details and our attempts at producing a test
- -- case. Short version: We probably need RnEnv2 to really get this right.
- let (t1', t2') = go t1 t2
- in (ForAllTy b1 t1', ForAllTy b2 t2')
-
- go (CastTy ty1 _) ty2 = go ty1 ty2
- go ty1 (CastTy ty2 _) = go ty1 ty2
-
- go t1 t2 =
- -- See Note [Expanding type synonyms to make types similar] for how this
- -- works
- let
- t1_exp_tys = t1 : tyExpansions t1
- t2_exp_tys = t2 : tyExpansions t2
- t1_exps = length t1_exp_tys
- t2_exps = length t2_exp_tys
- dif = abs (t1_exps - t2_exps)
- in
- followExpansions $
- zipEqual "expandSynonymsToMatch.go"
- (if t1_exps > t2_exps then drop dif t1_exp_tys else t1_exp_tys)
- (if t2_exps > t1_exps then drop dif t2_exp_tys else t2_exp_tys)
-
- -- | Expand the top layer type synonyms repeatedly, collect expansions in a
- -- list. The list does not include the original type.
- --
- -- Example, if you have:
- --
- -- type T10 = T9
- -- type T9 = T8
- -- ...
- -- type T0 = Int
- --
- -- `tyExpansions T10` returns [T9, T8, T7, ... Int]
- --
- -- This only expands the top layer, so if you have:
- --
- -- type M a = Maybe a
- --
- -- `tyExpansions (M T10)` returns [Maybe T10] (T10 is not expanded)
- tyExpansions :: Type -> [Type]
- tyExpansions = unfoldr (\t -> (\x -> (x, x)) `fmap` tcView t)
-
- -- | Drop the type pairs until types in a pair look alike (i.e. the outer
- -- constructors are the same).
- followExpansions :: [(Type, Type)] -> (Type, Type)
- followExpansions [] = pprPanic "followExpansions" empty
- followExpansions [(t1, t2)]
- | sameShapes t1 t2 = go t1 t2 -- expand subtrees
- | otherwise = (t1, t2) -- the difference is already visible
- followExpansions ((t1, t2) : tss)
- -- Traverse subtrees when the outer shapes are the same
- | sameShapes t1 t2 = go t1 t2
- -- Otherwise follow the expansions until they look alike
- | otherwise = followExpansions tss
-
- sameShapes :: Type -> Type -> Bool
- sameShapes AppTy{} AppTy{} = True
- sameShapes (TyConApp tc1 _) (TyConApp tc2 _) = tc1 == tc2
- sameShapes (FunTy {}) (FunTy {}) = True
- sameShapes (ForAllTy {}) (ForAllTy {}) = True
- sameShapes (CastTy ty1 _) ty2 = sameShapes ty1 ty2
- sameShapes ty1 (CastTy ty2 _) = sameShapes ty1 ty2
- sameShapes _ _ = False
-
-sameOccExtra :: TcType -> TcType -> SDoc
+sameOccExtras :: TcType -> TcType -> [TcReportInfo]
-- See Note [Disambiguating (X ~ X) errors]
-sameOccExtra ty1 ty2
+sameOccExtras ty1 ty2
| Just (tc1, _) <- tcSplitTyConApp_maybe ty1
, Just (tc2, _) <- tcSplitTyConApp_maybe ty2
, let n1 = tyConName tc1
@@ -2376,23 +1769,9 @@ sameOccExtra ty1 ty2
same_pkg = moduleUnit (nameModule n1) == moduleUnit (nameModule n2)
, n1 /= n2 -- Different Names
, same_occ -- but same OccName
- = text "NB:" <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2)
+ = [SameOcc same_pkg n1 n2]
| otherwise
- = empty
- where
- ppr_from same_pkg nm
- | isGoodSrcSpan loc
- = hang (quotes (ppr nm) <+> text "is defined at")
- 2 (ppr loc)
- | otherwise -- Imported things have an UnhelpfulSrcSpan
- = hang (quotes (ppr nm))
- 2 (sep [ text "is defined in" <+> quotes (ppr (moduleName mod))
- , ppUnless (same_pkg || pkg == mainUnit) $
- nest 4 $ text "in package" <+> quotes (ppr pkg) ])
- where
- pkg = moduleUnit mod
- mod = nameModule nm
- loc = nameSrcSpan nm
+ = []
{- Note [Suggest adding a type signature]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2461,7 +1840,7 @@ Warn of loopy local equalities that were dropped.
************************************************************************
-}
-mkDictErr :: HasDebugCallStack => ReportErrCtxt -> [Ct] -> TcM Report
+mkDictErr :: HasDebugCallStack => ReportErrCtxt -> [Ct] -> TcM SolverReport
mkDictErr ctxt cts
= assert (not (null cts)) $
do { inst_envs <- tcGetInstEnvs
@@ -2475,7 +1854,7 @@ mkDictErr ctxt cts
-- have the same source-location origin, to try avoid a cascade
-- of error from one location
; err <- mk_dict_err ctxt (head (no_inst_cts ++ overlap_cts))
- ; return $ important err }
+ ; return $ important ctxt err }
where
no_givens = null (getUserGivens ctxt)
@@ -2507,30 +1886,27 @@ mkDictErr ctxt cts
-- 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 SDoc
+ -> TcM TcReportMsg
-- Report an overlap error if this class constraint results
-- from an overlap (returning Left clas), otherwise return (Right pred)
-mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_overlapped))
+mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped))
| null matches -- No matches but perhaps several unifiers
- = do { (_, binds_msg, ct) <- relevantBindings True ctxt ct
+ = do { (_, rel_binds, ct) <- relevantBindings True ctxt ct
; candidate_insts <- get_candidate_instances
- ; field_suggestions <- record_field_suggestions
- ; return (cannot_resolve_msg ct candidate_insts binds_msg field_suggestions) }
+ ; (imp_errs, field_suggestions) <- record_field_suggestions
+ ; return (cannot_resolve_msg ct candidate_insts rel_binds imp_errs field_suggestions) }
| null unsafe_overlapped -- Some matches => overlap errors
- = return overlap_msg
+ = return $ overlap_msg
| otherwise
- = return safe_haskell_msg
+ = return $ safe_haskell_msg
where
orig = ctOrigin ct
pred = ctPred ct
(clas, tys) = getClassPredTys pred
ispecs = [ispec | (ispec, _) <- matches]
unsafe_ispecs = [ispec | (ispec, _) <- unsafe_overlapped]
- useful_givens = discardProvCtxtGivens orig (getUserGivensFromImplics implics)
- -- useful_givens are the enclosing implications with non-empty givens,
- -- modulo the horrid discardProvCtxtGivens
get_candidate_instances :: TcM [ClsInst]
-- See Note [Report candidate instances]
@@ -2553,18 +1929,18 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
| otherwise = False
-- See Note [Out-of-scope fields with -XOverloadedRecordDot]
- record_field_suggestions :: TcM SDoc
- record_field_suggestions = flip (maybe $ return empty) record_field $ \name ->
+ record_field_suggestions :: TcM ([ImportError], [GhcHint])
+ record_field_suggestions = flip (maybe $ return ([], noHints)) record_field $ \name ->
do { glb_env <- getGlobalRdrEnv
; lcl_env <- getLocalRdrEnv
; if occ_name_in_scope glb_env lcl_env name
- then return empty
- else do { dflags <- getDynFlags
- ; imp_info <- getImports
- ; curr_mod <- getModule
- ; hpt <- getHpt
- ; return (unknownNameSuggestions WL_RecField dflags hpt curr_mod
- glb_env emptyLocalRdrEnv imp_info (mkRdrUnqual name)) } }
+ then return ([], noHints)
+ else do { dflags <- getDynFlags
+ ; imp_info <- getImports
+ ; curr_mod <- getModule
+ ; hpt <- getHpt
+ ; return (unknownNameSuggestions WL_RecField dflags hpt curr_mod
+ glb_env emptyLocalRdrEnv imp_info (mkRdrUnqual name)) } }
occ_name_in_scope glb_env lcl_env occ_name = not $
null (lookupGlobalRdrEnv glb_env occ_name) &&
@@ -2574,232 +1950,22 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
HasFieldOrigin name -> Just (mkVarOccFS name)
_ -> Nothing
- cannot_resolve_msg :: Ct -> [ClsInst] -> SDoc -> SDoc -> SDoc
- cannot_resolve_msg ct candidate_insts binds_msg field_suggestions
- = vcat [ no_inst_msg
- , nest 2 extra_note
- , vcat (pp_givens useful_givens)
- , mb_patsyn_prov `orElse` empty
- , ppWhen (has_ambig_tvs && not (null unifiers && null useful_givens))
- (vcat [ ppUnless lead_with_ambig ambig_msg, binds_msg, potential_msg ])
-
- , ppWhen (isNothing mb_patsyn_prov) $
- -- Don't suggest fixes for the provided context of a pattern
- -- synonym; the right fix is to bind more in the pattern
- show_fixes (ctxtFixes has_ambig_tvs pred implics
- ++ drv_fixes)
- , ppWhen (not (null candidate_insts))
- (hang (text "There are instances for similar types:")
- 2 (vcat (map ppr candidate_insts)))
- -- See Note [Report candidate instances]
- , field_suggestions ]
- where
- orig = ctOrigin ct
- -- See Note [Highlighting ambiguous type variables]
- lead_with_ambig = has_ambig_tvs && not (any isRuntimeUnkSkol ambig_tvs)
- && not (null unifiers) && null useful_givens
-
- (has_ambig_tvs, ambig_msg) = mkAmbigMsg lead_with_ambig ct
- ambig_tvs = uncurry (++) (getAmbigTkvs ct)
-
- no_inst_msg
- | lead_with_ambig
- = ambig_msg <+> pprArising orig
- $$ text "prevents the constraint" <+> quotes (pprParendType pred)
- <+> text "from being solved."
-
- | null useful_givens
- = addArising orig $ text "No instance for"
- <+> pprParendType pred
-
- | otherwise
- = addArising orig $ text "Could not deduce"
- <+> pprParendType pred
-
- potential_msg
- = ppWhen (not (null unifiers) && want_potential orig) $
- potential_hdr $$
- potentialInstancesErrMsg (PotentialInstances { matches = [], unifiers })
-
- potential_hdr
- = ppWhen lead_with_ambig $
- text "Probable fix: use a type annotation to specify what"
- <+> pprQuotedList ambig_tvs <+> text "should be."
-
- mb_patsyn_prov :: Maybe SDoc
- mb_patsyn_prov
- | not lead_with_ambig
- , ProvCtxtOrigin PSB{ psb_def = L _ pat } <- orig
- = Just (vcat [ text "In other words, a successful match on the pattern"
- , nest 2 $ ppr pat
- , text "does not provide the constraint" <+> pprParendType pred ])
- | otherwise = Nothing
-
- -- Report "potential instances" only when the constraint arises
- -- directly from the user's use of an overloaded function
- want_potential (TypeEqOrigin {}) = False
- want_potential _ = True
-
- extra_note | any isFunTy (filterOutInvisibleTypes (classTyCon clas) tys)
- = text "(maybe you haven't applied a function to enough arguments?)"
- | className clas == typeableClassName -- Avoid mysterious "No instance for (Typeable T)
- , [_,ty] <- tys -- Look for (Typeable (k->*) (T k))
- , Just (tc,_) <- tcSplitTyConApp_maybe ty
- , not (isTypeFamilyTyCon tc)
- = hang (text "GHC can't yet do polykinded")
- 2 (text "Typeable" <+>
- parens (ppr ty <+> dcolon <+> ppr (tcTypeKind ty)))
- | otherwise
- = empty
-
- drv_fixes = case orig of
- DerivClauseOrigin -> [drv_fix False]
- StandAloneDerivOrigin -> [drv_fix True]
- DerivOriginDC _ _ standalone -> [drv_fix standalone]
- DerivOriginCoerce _ _ _ standalone -> [drv_fix standalone]
- _ -> []
-
- drv_fix standalone_wildcard
- | standalone_wildcard
- = text "fill in the wildcard constraint yourself"
- | otherwise
- = hang (text "use a standalone 'deriving instance' declaration,")
- 2 (text "so you can specify the instance context yourself")
+ cannot_resolve_msg :: Ct -> [ClsInst] -> RelevantBindings -> [ImportError] -> [GhcHint] -> TcReportMsg
+ cannot_resolve_msg ct candidate_insts binds imp_errs field_suggestions
+ = CannotResolveInstance ct unifiers candidate_insts imp_errs field_suggestions binds
+ -- Overlap errors.
+ overlap_msg, safe_haskell_msg :: TcReportMsg
-- Normal overlap error
overlap_msg
- = assert (not (null matches)) $
- vcat [ addArising orig (text "Overlapping instances for"
- <+> pprType (mkClassPred clas tys))
-
- , ppUnless (null matching_givens) $
- sep [text "Matching givens (or their superclasses):"
- , nest 2 (vcat matching_givens)]
-
- , potentialInstancesErrMsg
- (PotentialInstances { matches = map fst matches, unifiers })
-
- , ppWhen (null matching_givens && isSingleton matches && null unifiers) $
- -- Intuitively, some given matched the wanted in their
- -- flattened or rewritten (from given equalities) form
- -- but the matcher can't figure that out because the
- -- constraints are non-flat and non-rewritten so we
- -- simply report back the whole given
- -- context. Accelerate Smart.hs showed this problem.
- sep [ text "There exists a (perhaps superclass) match:"
- , nest 2 (vcat (pp_givens useful_givens))]
-
- , ppWhen (isSingleton matches) $
- parens (vcat [ ppUnless (null tyCoVars) $
- text "The choice depends on the instantiation of" <+>
- quotes (pprWithCommas ppr tyCoVars)
- , ppUnless (null famTyCons) $
- if (null tyCoVars)
- then
- text "The choice depends on the result of evaluating" <+>
- quotes (pprWithCommas ppr famTyCons)
- else
- text "and the result of evaluating" <+>
- quotes (pprWithCommas ppr famTyCons)
- , ppWhen (null (matching_givens)) $
- vcat [ text "To pick the first instance above, use IncoherentInstances"
- , text "when compiling the other instance declarations"]
- ])]
- where
- tyCoVars = tyCoVarsOfTypesList tys
- famTyCons = filter isFamilyTyCon $ concatMap (nonDetEltsUniqSet . tyConsOfType) tys
-
- matching_givens = mapMaybe matchable useful_givens
-
- matchable implic@(Implic { ic_given = evvars, ic_info = skol_info })
- = case ev_vars_matching of
- [] -> Nothing
- _ -> Just $ hang (pprTheta ev_vars_matching)
- 2 (sep [ text "bound by" <+> ppr skol_info
- , text "at" <+>
- ppr (tcl_loc (ic_env implic)) ])
- where ev_vars_matching = [ pred
- | ev_var <- evvars
- , let pred = evVarPred ev_var
- , any can_match (pred : transSuperClasses pred) ]
- can_match pred
- = case getClassPredTys_maybe pred of
- Just (clas', tys') -> clas' == clas
- && isJust (tcMatchTys tys tys')
- Nothing -> False
+ = assert (not (null matches)) $ OverlappingInstances ct ispecs unifiers
-- Overlap error because of Safe Haskell (first
-- match should be the most specific match)
safe_haskell_msg
= assert (matches `lengthIs` 1 && not (null unsafe_ispecs)) $
- vcat [ addArising orig (text "Unsafe overlapping instances for"
- <+> pprType (mkClassPred clas tys))
- , sep [text "The matching instance is:",
- nest 2 (pprInstance $ head ispecs)]
- , vcat [ text "It is compiled in a Safe module and as such can only"
- , text "overlap instances from the same module, however it"
- , text "overlaps the following instances from different" <+>
- text "modules:"
- , nest 2 (vcat [pprInstances $ unsafe_ispecs])
- ]
- ]
-
-
-ctxtFixes :: Bool -> PredType -> [Implication] -> [SDoc]
-ctxtFixes has_ambig_tvs pred implics
- | not has_ambig_tvs
- , isTyVarClassPred pred
- , (skol:skols) <- usefulContext implics pred
- , let what | null skols
- , SigSkol (PatSynCtxt {}) _ _ <- skol
- = text "\"required\""
- | otherwise
- = empty
- = [sep [ text "add" <+> pprParendType pred
- <+> text "to the" <+> what <+> text "context of"
- , nest 2 $ ppr_skol skol $$
- vcat [ text "or" <+> ppr_skol skol
- | skol <- skols ] ] ]
- | otherwise = []
- where
- ppr_skol (PatSkol (RealDataCon dc) _) = text "the data constructor" <+> quotes (ppr dc)
- ppr_skol (PatSkol (PatSynCon ps) _) = text "the pattern synonym" <+> quotes (ppr ps)
- ppr_skol skol_info = ppr skol_info
-
-discardProvCtxtGivens :: CtOrigin -> [UserGiven] -> [UserGiven]
-discardProvCtxtGivens orig givens -- See Note [discardProvCtxtGivens]
- | ProvCtxtOrigin (PSB {psb_id = L _ name}) <- orig
- = filterOut (discard name) givens
- | otherwise
- = givens
- where
- discard n (Implic { ic_info = SigSkol (PatSynCtxt n') _ _ }) = n == n'
- discard _ _ = False
-
-usefulContext :: [Implication] -> PredType -> [SkolemInfo]
--- usefulContext picks out the implications whose context
--- the programmer might plausibly augment to solve 'pred'
-usefulContext implics pred
- = go implics
- where
- pred_tvs = tyCoVarsOfType pred
- go [] = []
- go (ic : ics)
- | implausible ic = rest
- | otherwise = ic_info ic : rest
- where
- -- Stop when the context binds a variable free in the predicate
- rest | any (`elemVarSet` pred_tvs) (ic_skols ic) = []
- | otherwise = go ics
-
- implausible ic
- | null (ic_skols ic) = True
- | implausible_info (ic_info ic) = True
- | otherwise = False
-
- implausible_info (SigSkol (InfSigCtxt {}) _ _) = True
- implausible_info _ = False
- -- Do not suggest adding constraints to an *inferred* type signature
+ UnsafeOverlap ct ispecs unsafe_ispecs
+
{- Note [Report candidate instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2829,47 +1995,6 @@ from being solved:
Once these conditions are satisfied, we can safely say that ambiguity prevents
the constraint from being solved.
-Note [discardProvCtxtGivens]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In most situations we call all enclosing implications "useful". There is one
-exception, and that is when the constraint that causes the error is from the
-"provided" context of a pattern synonym declaration:
-
- pattern Pat :: (Num a, Eq a) => Show a => a -> Maybe a
- -- required => provided => type
- pattern Pat x <- (Just x, 4)
-
-When checking the pattern RHS we must check that it does actually bind all
-the claimed "provided" constraints; in this case, does the pattern (Just x, 4)
-bind the (Show a) constraint. Answer: no!
-
-But the implication we generate for this will look like
- forall a. (Num a, Eq a) => [W] Show a
-because when checking the pattern we must make the required
-constraints available, since they are needed to match the pattern (in
-this case the literal '4' needs (Num a, Eq a)).
-
-BUT we don't want to suggest adding (Show a) to the "required" constraints
-of the pattern synonym, thus:
- pattern Pat :: (Num a, Eq a, Show a) => Show a => a -> Maybe a
-It would then typecheck but it's silly. We want the /pattern/ to bind
-the alleged "provided" constraints, Show a.
-
-So we suppress that Implication in discardProvCtxtGivens. It's
-painfully ad-hoc but the truth is that adding it to the "required"
-constraints would work. Suppressing it solves two problems. First,
-we never tell the user that we could not deduce a "provided"
-constraint from the "required" context. Second, we never give a
-possible fix that suggests to add a "provided" constraint to the
-"required" context.
-
-For example, without this distinction the above code gives a bad error
-message (showing both problems):
-
- error: Could not deduce (Show a) ... from the context: (Eq a)
- ... Possible fix: add (Show a) to the context of
- the signature for pattern synonym `Pat' ...
-
Note [Out-of-scope fields with -XOverloadedRecordDot]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With -XOverloadedRecordDot, when a field isn't in scope, the error that appears
@@ -2899,202 +2024,6 @@ results in
in the import of ‘Data.Monoid’
-}
-show_fixes :: [SDoc] -> SDoc
-show_fixes [] = empty
-show_fixes (f:fs) = sep [ text "Possible fix:"
- , nest 2 (vcat (f : map (text "or" <+>) fs))]
-
-
--- | This datatype collates instances that match or unifier,
--- in order to report an error message for an unsolved typeclass constraint.
-data PotentialInstances
- = PotentialInstances
- { matches :: [ClsInst]
- , unifiers :: [ClsInst]
- }
-
--- | Directly display the given matching and unifying instances,
--- with a header for each: `Matching instances`/`Potentially matching instances`.
-pprPotentialInstances :: (ClsInst -> SDoc) -> PotentialInstances -> SDoc
-pprPotentialInstances ppr_inst (PotentialInstances { matches, unifiers }) =
- vcat
- [ ppWhen (not $ null matches) $
- text "Matching instance" <> plural matches <> colon $$
- nest 2 (vcat (map ppr_inst matches))
- , ppWhen (not $ null unifiers) $
- (text "Potentially matching instance" <> plural unifiers <> colon) $$
- nest 2 (vcat (map ppr_inst unifiers))
- ]
-
--- | Display a summary of available instances, omitting those involving
--- out-of-scope types, in order to explain why we couldn't solve a particular
--- constraint, e.g. due to instance overlap or out-of-scope types.
---
--- To directly display a collection of matching/unifying instances,
--- use 'pprPotentialInstances'.
-potentialInstancesErrMsg :: PotentialInstances -> SDoc
--- See Note [Displaying potential instances]
-potentialInstancesErrMsg potentials =
- sdocOption sdocPrintPotentialInstances $ \print_insts ->
- getPprStyle $ \sty ->
- potentials_msg_with_options potentials print_insts sty
-
--- | Display a summary of available instances, omitting out-of-scope ones.
---
--- Use 'potentialInstancesErrMsg' to automatically set the pretty-printing
--- options.
-potentials_msg_with_options :: PotentialInstances
- -> Bool -- ^ Whether to print /all/ potential instances
- -> PprStyle
- -> SDoc
-potentials_msg_with_options
- (PotentialInstances { matches, unifiers })
- show_all_potentials sty
- | null matches && null unifiers
- = empty
-
- | null show_these_matches && null show_these_unifiers
- = vcat [ not_in_scope_msg empty
- , flag_hint ]
-
- | otherwise
- = vcat [ pprPotentialInstances
- pprInstance -- print instance + location info
- (PotentialInstances
- { matches = show_these_matches
- , unifiers = show_these_unifiers })
- , overlapping_but_not_more_specific_msg sorted_matches
- , nest 2 $ vcat
- [ ppWhen (n_in_scope_hidden > 0) $
- text "...plus"
- <+> speakNOf n_in_scope_hidden (text "other")
- , ppWhen (not_in_scopes > 0) $
- not_in_scope_msg (text "...plus")
- , flag_hint ] ]
- where
- n_show_matches, n_show_unifiers :: Int
- n_show_matches = 3
- n_show_unifiers = 2
-
- (in_scope_matches, not_in_scope_matches) = partition inst_in_scope matches
- (in_scope_unifiers, not_in_scope_unifiers) = partition inst_in_scope unifiers
- sorted_matches = sortBy fuzzyClsInstCmp in_scope_matches
- sorted_unifiers = sortBy fuzzyClsInstCmp in_scope_unifiers
- (show_these_matches, show_these_unifiers)
- | show_all_potentials = (sorted_matches, sorted_unifiers)
- | otherwise = (take n_show_matches sorted_matches
- ,take n_show_unifiers sorted_unifiers)
- n_in_scope_hidden
- = length sorted_matches + length sorted_unifiers
- - length show_these_matches - length show_these_unifiers
-
- -- "in scope" means that all the type constructors
- -- are lexically in scope; these instances are likely
- -- to be more useful
- inst_in_scope :: ClsInst -> Bool
- inst_in_scope cls_inst = nameSetAll name_in_scope $
- orphNamesOfTypes (is_tys cls_inst)
-
- name_in_scope name
- | pretendNameIsInScope name
- = True -- E.g. (->); see Note [pretendNameIsInScope] in GHC.Builtin.Names
- | Just mod <- nameModule_maybe name
- = qual_in_scope (qualName sty mod (nameOccName name))
- | otherwise
- = True
-
- qual_in_scope :: QualifyName -> Bool
- qual_in_scope NameUnqual = True
- qual_in_scope (NameQual {}) = True
- qual_in_scope _ = False
-
- not_in_scopes :: Int
- not_in_scopes = length not_in_scope_matches + length not_in_scope_unifiers
-
- not_in_scope_msg herald =
- hang (herald <+> speakNOf not_in_scopes (text "instance")
- <+> text "involving out-of-scope types")
- 2 (ppWhen show_all_potentials $
- pprPotentialInstances
- pprInstanceHdr -- only print the header, not the instance location info
- (PotentialInstances
- { matches = not_in_scope_matches
- , unifiers = not_in_scope_unifiers
- }))
-
- flag_hint = ppUnless (show_all_potentials
- || (equalLength show_these_matches matches
- && equalLength show_these_unifiers unifiers)) $
- text "(use -fprint-potential-instances to see them all)"
-
--- | Compute a message informing the user of any instances that are overlapped
--- but were not discarded because the instance overlapping them wasn't
--- strictly more specific.
-overlapping_but_not_more_specific_msg :: [ClsInst] -> SDoc
-overlapping_but_not_more_specific_msg insts
- -- Only print one example of "overlapping but not strictly more specific",
- -- to avoid information overload.
- | overlap : _ <- overlapping_but_not_more_specific
- = overlap_header $$ ppr_overlapping overlap
- | otherwise
- = empty
- where
- overlap_header :: SDoc
- overlap_header
- | [_] <- overlapping_but_not_more_specific
- = text "An overlapping instance can only be chosen when it is strictly more specific."
- | otherwise
- = text "Overlapping instances can only be chosen when they are strictly more specific."
- overlapping_but_not_more_specific :: [(ClsInst, ClsInst)]
- overlapping_but_not_more_specific
- = nubOrdBy (comparing (is_dfun . fst))
- [ (overlapper, overlappee)
- | these <- groupBy ((==) `on` is_cls_nm) insts
- -- Take all pairs of distinct instances...
- , one:others <- tails these -- if `these = [inst_1, inst_2, ...]`
- , other <- others -- then we get pairs `(one, other) = (inst_i, inst_j)` with `i < j`
- -- ... such that one instance in the pair overlaps the other...
- , let mb_overlapping
- | hasOverlappingFlag (overlapMode $ is_flag one)
- || hasOverlappableFlag (overlapMode $ is_flag other)
- = [(one, other)]
- | hasOverlappingFlag (overlapMode $ is_flag other)
- || hasOverlappableFlag (overlapMode $ is_flag one)
- = [(other, one)]
- | otherwise
- = []
- , (overlapper, overlappee) <- mb_overlapping
- -- ... but the overlapper is not more specific than the overlappee.
- , not (overlapper `more_specific_than` overlappee)
- ]
- more_specific_than :: ClsInst -> ClsInst -> Bool
- is1 `more_specific_than` is2
- = isJust (tcMatchTys (is_tys is1) (is_tys is2))
- ppr_overlapping :: (ClsInst, ClsInst) -> SDoc
- ppr_overlapping (overlapper, overlappee)
- = text "The first instance that follows overlaps the second, but is not more specific than it:"
- $$ nest 2 (vcat $ map pprInstanceHdr [overlapper, overlappee])
-
-{- Note [Displaying potential instances]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When showing a list of instances for
- - overlapping instances (show ones that match)
- - no such instance (show ones that could match)
-we want to give it a bit of structure. Here's the plan
-
-* Say that an instance is "in scope" if all of the
- type constructors it mentions are lexically in scope.
- These are the ones most likely to be useful to the programmer.
-
-* Show at most n_show in-scope instances,
- and summarise the rest ("plus N others")
-
-* Summarise the not-in-scope instances ("plus 4 not in scope")
-
-* Add the flag -fshow-potential-instances which replaces the
- summary with the full list
--}
-
{-
Note [Kind arguments in error messages]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -3118,59 +2047,6 @@ the above error message would instead be displayed as:
Which makes it clearer that the culprit is the mismatch between `k2` and `k20`.
-}
-mkAmbigMsg :: Bool -- True when message has to be at beginning of sentence
- -> Ct -> (Bool, SDoc)
-mkAmbigMsg prepend_msg ct
- | null ambig_kvs && null ambig_tvs = (False, empty)
- | otherwise = (True, msg)
- where
- (ambig_kvs, ambig_tvs) = getAmbigTkvs ct
-
- msg | any isRuntimeUnkSkol ambig_kvs -- See Note [Runtime skolems]
- || any isRuntimeUnkSkol ambig_tvs
- = vcat [ text "Cannot resolve unknown runtime type"
- <> plural ambig_tvs <+> pprQuotedList ambig_tvs
- , text "Use :print or :force to determine these types"]
-
- | not (null ambig_tvs)
- = pp_ambig (text "type") ambig_tvs
-
- | otherwise
- = pp_ambig (text "kind") ambig_kvs
-
- pp_ambig what tkvs
- | prepend_msg -- "Ambiguous type variable 't0'"
- = text "Ambiguous" <+> what <+> text "variable"
- <> plural tkvs <+> pprQuotedList tkvs
-
- | otherwise -- "The type variable 't0' is ambiguous"
- = text "The" <+> what <+> text "variable" <> plural tkvs
- <+> pprQuotedList tkvs <+> isOrAre tkvs <+> text "ambiguous"
-
-pprSkols :: ReportErrCtxt -> [TcTyVar] -> SDoc
-pprSkols ctxt tvs
- = vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs))
- where
- pp_one (UnkSkol, tvs)
- = vcat [ hang (pprQuotedList tvs)
- 2 (is_or_are tvs "a" "(rigid, skolem)")
- , nest 2 (text "of unknown origin")
- , nest 2 (text "bound at" <+> ppr (foldr1 combineSrcSpans (map getSrcSpan tvs)))
- ]
- pp_one (RuntimeUnkSkol, tvs)
- = hang (pprQuotedList tvs)
- 2 (is_or_are tvs "an" "unknown runtime")
- pp_one (skol_info, tvs)
- = vcat [ hang (pprQuotedList tvs)
- 2 (is_or_are tvs "a" "rigid" <+> text "bound by")
- , nest 2 (pprSkolInfo skol_info)
- , nest 2 (text "at" <+> ppr (foldr1 combineSrcSpans (map getSrcSpan tvs))) ]
-
- is_or_are [_] article adjective = text "is" <+> text article <+> text adjective
- <+> text "type variable"
- is_or_are _ _ adjective = text "are" <+> text adjective
- <+> text "type variables"
-
getAmbigTkvs :: Ct -> ([Var],[Var])
getAmbigTkvs ct
= partition (`elemVarSet` dep_tkv_set) ambig_tkvs
@@ -3178,32 +2054,6 @@ getAmbigTkvs ct
tkvs = tyCoVarsOfCtList ct
ambig_tkvs = filter isAmbiguousTyVar tkvs
dep_tkv_set = tyCoVarsOfTypes (map tyVarKind tkvs)
-
-getSkolemInfo :: [Implication] -> [TcTyVar]
- -> [(SkolemInfo, [TcTyVar])] -- #14628
--- Get the skolem info for some type variables
--- from the implication constraints that bind them.
---
--- In the returned (skolem, tvs) pairs, the 'tvs' part is non-empty
-getSkolemInfo _ []
- = []
-
-getSkolemInfo [] tvs
- | all isRuntimeUnkSkol tvs = [(RuntimeUnkSkol, tvs)] -- #14628
- | otherwise = -- See https://gitlab.haskell.org/ghc/ghc/-/issues?label_name[]=No%20skolem%20info
- pprTraceUserWarning msg [(UnkSkol,tvs)]
- where
- msg = text "No skolem info - we could not find the origin of the following variables" <+> ppr tvs
- $$ text "This should not happen, please report it as a bug following the instructions at:"
- $$ text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug"
-
-
-getSkolemInfo (implic:implics) tvs
- | null tvs_here = getSkolemInfo implics tvs
- | otherwise = (ic_info implic, tvs_here) : getSkolemInfo implics tvs_other
- where
- (tvs_here, tvs_other) = partition (`elem` ic_skols implic) tvs
-
-----------------------
-- relevantBindings looks at the value environment and finds values whose
-- types mention any of the offending type variables. It has to be
@@ -3216,7 +2066,7 @@ getSkolemInfo (implic:implics) tvs
relevantBindings :: Bool -- True <=> filter by tyvar; False <=> no filtering
-- See #8191
-> ReportErrCtxt -> Ct
- -> TcM (ReportErrCtxt, SDoc, Ct)
+ -> TcM (ReportErrCtxt, RelevantBindings, Ct)
-- Also returns the zonked and tidied CtOrigin of the constraint
relevantBindings want_filtering ctxt ct
= do { traceTc "relevantBindings" (ppr ct)
@@ -3235,9 +2085,9 @@ relevantBindings want_filtering ctxt ct
; (env2, lcl_name_cache) <- zonkTidyTcLclEnvs env1 [lcl_env]
- ; doc <- relevant_bindings want_filtering lcl_env lcl_name_cache ct_fvs
+ ; relev_bds <- relevant_bindings want_filtering lcl_env lcl_name_cache ct_fvs
; let ctxt' = ctxt { cec_tidy = env2 }
- ; return (ctxt', doc, ct') }
+ ; return (ctxt', relev_bds, ct') }
where
loc = ctLoc ct
lcl_env = ctLocEnv loc
@@ -3247,7 +2097,7 @@ relevant_bindings :: Bool
-> TcLclEnv
-> NameEnv Type -- Cache of already zonked and tidied types
-> TyCoVarSet
- -> TcM SDoc
+ -> TcM RelevantBindings
relevant_bindings want_filtering lcl_env lcl_name_env ct_tvs
= do { dflags <- getDynFlags
; traceTc "relevant_bindings" $
@@ -3257,18 +2107,12 @@ relevant_bindings want_filtering lcl_env lcl_name_env ct_tvs
, pprWithCommas id
[ ppr id | TcIdBndr_ExpType id _ _ <- tcl_bndrs lcl_env ] ]
- ; (docs, discards)
- <- go dflags (maxRelevantBinds dflags)
- emptyVarSet [] False
+ ; go dflags (maxRelevantBinds dflags)
+ emptyVarSet (RelevantBindings [] False)
(removeBindingShadowing $ tcl_bndrs lcl_env)
-- tcl_bndrs has the innermost bindings first,
-- which are probably the most relevant ones
-
- ; let doc = ppUnless (null docs) $
- hang (text "Relevant bindings include")
- 2 (vcat docs $$ ppWhen discards discardMsg)
-
- ; return doc }
+ }
where
run_out :: Maybe Int -> Bool
run_out Nothing = False
@@ -3278,14 +2122,13 @@ relevant_bindings want_filtering lcl_env lcl_name_env ct_tvs
dec_max = fmap (\n -> n - 1)
- go :: DynFlags -> Maybe Int -> TcTyVarSet -> [SDoc]
- -> Bool -- True <=> some filtered out due to lack of fuel
+ go :: DynFlags -> Maybe Int -> TcTyVarSet
+ -> RelevantBindings
-> [TcBinder]
- -> TcM ([SDoc], Bool) -- The bool says if we filtered any out
- -- because of lack of fuel
- go _ _ _ docs discards []
- = return (reverse docs, discards)
- go dflags n_left tvs_seen docs discards (tc_bndr : tc_bndrs)
+ -> TcM RelevantBindings
+ go _ _ _ (RelevantBindings bds discards) []
+ = return $ RelevantBindings (reverse bds) discards
+ go dflags n_left tvs_seen rels@(RelevantBindings bds discards) (tc_bndr : tc_bndrs)
= case tc_bndr of
TcTvBndr {} -> discard_it
TcIdBndr id top_lvl -> go2 (idName id) top_lvl
@@ -3301,17 +2144,14 @@ relevant_bindings want_filtering lcl_env lcl_name_env ct_tvs
Nothing -> discard_it -- No info; discard
}
where
- discard_it = go dflags n_left tvs_seen docs
- discards tc_bndrs
+ discard_it = go dflags n_left tvs_seen rels tc_bndrs
go2 id_name top_lvl
= do { let tidy_ty = case lookupNameEnv lcl_name_env id_name of
Just tty -> tty
Nothing -> pprPanic "relevant_bindings" (ppr id_name)
; traceTc "relevantBindings 1" (ppr id_name <+> dcolon <+> ppr tidy_ty)
; let id_tvs = tyCoVarsOfType tidy_ty
- doc = sep [ pprPrefixOcc id_name <+> dcolon <+> ppr tidy_ty
- , nest 2 (parens (text "bound at"
- <+> ppr (getSrcLoc id_name)))]
+ bd = (id_name, tidy_ty)
new_seen = tvs_seen `unionVarSet` id_tvs
; if (want_filtering && not (hasPprDebug dflags)
@@ -3328,44 +2168,26 @@ relevant_bindings want_filtering lcl_env lcl_name_env ct_tvs
else if run_out n_left && id_tvs `subVarSet` tvs_seen
-- We've run out of n_left fuel and this binding only
-- mentions already-seen type variables, so discard it
- then go dflags n_left tvs_seen docs
- True -- Record that we have now discarded something
+ then go dflags n_left tvs_seen (RelevantBindings bds True) -- Record that we have now discarded something
tc_bndrs
-- Keep this binding, decrement fuel
else go dflags (dec_max n_left) new_seen
- (doc:docs) discards tc_bndrs }
-
-
-discardMsg :: SDoc
-discardMsg = text "(Some bindings suppressed;" <+>
- text "use -fmax-relevant-binds=N or -fno-max-relevant-binds)"
+ (RelevantBindings (bd:bds) discards) tc_bndrs }
-----------------------
warnDefaulting :: TcTyVar -> [Ct] -> Type -> TcM ()
-warnDefaulting the_tv wanteds default_ty
+warnDefaulting _ [] _
+ = panic "warnDefaulting: empty Wanteds"
+warnDefaulting the_tv wanteds@(ct:_) default_ty
= do { warn_default <- woptM Opt_WarnTypeDefaults
; env0 <- tcInitTidyEnv
; let tidy_env = tidyFreeTyCoVars env0 $
tyCoVarsOfCtsList (listToBag wanteds)
tidy_wanteds = map (tidyCt tidy_env) wanteds
tidy_tv = lookupVarEnv (snd tidy_env) the_tv
- (loc, ppr_wanteds) = pprWithArising tidy_wanteds
- warn_msg =
- hang (hsep $ [ text "Defaulting" ]
- ++
- (case tidy_tv of
- Nothing -> []
- Just tv -> [text "the type variable"
- , quotes (ppr tv)])
- ++
- [ text "to type"
- , quotes (ppr default_ty)
- , text "in the following constraint" <> plural tidy_wanteds ])
- 2
- ppr_wanteds
- ; let diag = TcRnUnknownMessage $
- mkPlainDiagnostic (WarningWithFlag Opt_WarnTypeDefaults) noHints warn_msg
+ diag = TcRnWarnDefaulting tidy_wanteds tidy_tv default_ty
+ loc = ctLoc ct
; setCtLocM loc $ diagnosticTc warn_default diag }
{-
diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs
index d1c727da35d9..7d1388c1127a 100644
--- a/compiler/GHC/Tc/Errors/Hole.hs
+++ b/compiler/GHC/Tc/Errors/Hole.hs
@@ -32,6 +32,8 @@ where
import GHC.Prelude
+import GHC.Tc.Errors.Types ( HoleFitDispConfig(..), FitsMbSuppressed(..)
+ , ValidHoleFits(..), noValidHoleFits )
import GHC.Tc.Types
import GHC.Tc.Utils.Monad
import GHC.Tc.Types.Constraint
@@ -413,12 +415,6 @@ fits like (`id (_ :: a)` and `head (_ :: [a])`) when looking for fits of type
`a`, where `a` is a skolem.
-}
-data HoleFitDispConfig = HFDC { showWrap :: Bool
- , showWrapVars :: Bool
- , showType :: Bool
- , showProv :: Bool
- , showMatches :: Bool }
-
-- We read the various -no-show-*-of-hole-fits flags
-- and set the display config accordingly.
getHoleFitDispConfig :: TcM HoleFitDispConfig
@@ -560,14 +556,13 @@ findValidHoleFits :: TidyEnv -- ^ The tidy_env for zonking
-- ^ The unsolved simple constraints in the implication for
-- the hole.
-> Hole
- -> TcM (TidyEnv, SDoc)
+ -> TcM (TidyEnv, ValidHoleFits)
findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
, hole_loc = ct_loc
, hole_ty = hole_ty }) =
do { rdr_env <- getGlobalRdrEnv
; lclBinds <- getLocalBindings tidy_env ct_loc
; maxVSubs <- maxValidHoleFits <$> getDynFlags
- ; hfdc <- getHoleFitDispConfig
; sortingAlg <- getHoleFitSortingAlg
; dflags <- getDynFlags
; hfPlugs <- tcg_hf_plugins <$> getGblEnv
@@ -607,12 +602,11 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
; let (pVDisc, limited_subs) = possiblyDiscard maxVSubs plugin_handled_subs
vDiscards = pVDisc || searchDiscards
; subs_with_docs <- addHoleFitDocs limited_subs
- ; let vMsg = ppUnless (null subs_with_docs) $
- hang (text "Valid hole fits include") 2 $
- vcat (map (pprHoleFit hfdc) subs_with_docs)
- $$ ppWhen vDiscards subsDiscardMsg
+ ; let subs = Fits subs_with_docs vDiscards
-- Refinement hole fits. See Note [Valid refinement hole fits include ...]
- ; (tidy_env, refMsg) <- if refLevel >= Just 0 then
+ ; (tidy_env, rsubs) <-
+ if refLevel >= Just 0
+ then
do { maxRSubs <- maxRefHoleFits <$> getDynFlags
-- We can use from just, since we know that Nothing >= _ is False.
; let refLvls = [1..(fromJust refLevel)]
@@ -640,14 +634,11 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
possiblyDiscard maxRSubs $ plugin_handled_rsubs
rDiscards = pRDisc || any fst refDs
; rsubs_with_docs <- addHoleFitDocs exact_last_rfits
- ; return (tidy_env,
- ppUnless (null rsubs_with_docs) $
- hang (text "Valid refinement hole fits include") 2 $
- vcat (map (pprHoleFit hfdc) rsubs_with_docs)
- $$ ppWhen rDiscards refSubsDiscardMsg) }
- else return (tidy_env, empty)
+ ; return (tidy_env, Fits rsubs_with_docs rDiscards) }
+ else return (tidy_env, Fits [] False)
; traceTc "findingValidHoleFitsFor }" empty
- ; return (tidy_env, vMsg $$ refMsg) }
+ ; let hole_fits = ValidHoleFits subs rsubs
+ ; return (tidy_env, hole_fits) }
where
-- We extract the TcLevel from the constraint.
hole_lvl = ctLocLevel ct_loc
@@ -688,19 +679,6 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
<*> sortHoleFitsByGraph (sort gblFits)
where (lclFits, gblFits) = span hfIsLcl subs
- subsDiscardMsg :: SDoc
- subsDiscardMsg =
- text "(Some hole fits suppressed;" <+>
- text "use -fmax-valid-hole-fits=N" <+>
- text "or -fno-max-valid-hole-fits)"
-
- refSubsDiscardMsg :: SDoc
- refSubsDiscardMsg =
- text "(Some refinement hole fits suppressed;" <+>
- text "use -fmax-refinement-hole-fits=N" <+>
- text "or -fno-max-refinement-hole-fits)"
-
-
-- Based on the flags, we might possibly discard some or all the
-- fits we've found.
possiblyDiscard :: Maybe Int -> [HoleFit] -> (Bool, [HoleFit])
@@ -709,7 +687,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
-- We don't (as of yet) handle holes in types, only in expressions.
-findValidHoleFits env _ _ _ = return (env, empty)
+findValidHoleFits env _ _ _ = return (env, noValidHoleFits)
-- See Note [Relevant constraints]
relevantCts :: Type -> [Ct] -> [Ct]
diff --git a/compiler/GHC/Tc/Errors/Hole.hs-boot b/compiler/GHC/Tc/Errors/Hole.hs-boot
index 8c4bfce54666..94d3f51c5803 100644
--- a/compiler/GHC/Tc/Errors/Hole.hs-boot
+++ b/compiler/GHC/Tc/Errors/Hole.hs-boot
@@ -5,6 +5,7 @@
module GHC.Tc.Errors.Hole where
import GHC.Types.Var ( Id )
+import GHC.Tc.Errors.Types ( HoleFitDispConfig, ValidHoleFits )
import GHC.Tc.Types ( TcM )
import GHC.Tc.Types.Constraint ( Ct, CtLoc, Hole, Implication )
import GHC.Utils.Outputable ( SDoc )
@@ -18,7 +19,7 @@ import Data.Maybe ( Maybe )
import Data.Int ( Int )
findValidHoleFits :: TidyEnv -> [Implication] -> [Ct] -> Hole
- -> TcM (TidyEnv, SDoc)
+ -> TcM (TidyEnv, ValidHoleFits)
tcCheckHoleFit :: TypedHole -> TcSigmaType -> TcSigmaType
-> TcM (Bool, HsWrapper)
@@ -30,7 +31,6 @@ tcFilterHoleFits :: Maybe Int -> TypedHole -> (TcType, [TcTyVar])
getLocalBindings :: TidyEnv -> CtLoc -> TcM [Id]
addHoleFitDocs :: [HoleFit] -> TcM [HoleFit]
-data HoleFitDispConfig
data HoleFitSortingAlg
pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc
diff --git a/compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot b/compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot
index 25d3f81aeb6f..f27d71b41bd5 100644
--- a/compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot
+++ b/compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot
@@ -4,7 +4,27 @@
-- + which needs 'GHC.Tc.Types'
module GHC.Tc.Errors.Hole.FitTypes where
--- Build ordering
-import GHC.Base()
+import GHC.Base (Int, Maybe)
+import {-# SOURCE #-} GHC.Types.Var (Id)
+import GHC.Types.Name (Name)
+import GHC.Types.Name.Reader (GlobalRdrElt)
+import GHC.Tc.Utils.TcType (TcType)
+import GHC.Hs.Doc (HsDocString)
+import GHC.Utils.Outputable (SDoc)
+
+data HoleFitCandidate
+ = IdHFCand Id
+ | NameHFCand Name
+ | GreHFCand GlobalRdrElt
data HoleFitPlugin
+data HoleFit =
+ HoleFit { hfId :: Id
+ , hfCand :: HoleFitCandidate
+ , hfType :: TcType
+ , hfRefLvl :: Int
+ , hfWrap :: [TcType]
+ , hfMatches :: [TcType]
+ , hfDoc :: Maybe HsDocString
+ }
+ | RawHoleFit SDoc
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index eb7a03febb79..0fc6407da4fb 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1,59 +1,104 @@
{-# LANGUAGE LambdaCase #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage
+{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
-module GHC.Tc.Errors.Ppr ( pprTypeDoesNotHaveFixedRuntimeRep )
+{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage
+
+module GHC.Tc.Errors.Ppr
+ ( pprTypeDoesNotHaveFixedRuntimeRep
+ , pprScopeError
+ )
where
import GHC.Prelude
-import Data.Maybe (isJust)
-
import GHC.Builtin.Names
-import GHC.Core.Class (Class(..))
-import GHC.Core.Coercion (pprCoAxBranchUser)
+
+import GHC.Core.Coercion
+import GHC.Core.Unify ( tcMatchTys )
+import GHC.Core.TyCon
+import GHC.Core.Class
+import GHC.Core.DataCon
import GHC.Core.Coercion.Axiom (coAxiomTyCon, coAxiomSingleBranch)
-import GHC.Core.DataCon (DataCon)
+import GHC.Core.ConLike
import GHC.Core.FamInstEnv (famInstAxiom)
import GHC.Core.InstEnv
-import GHC.Core.TyCon (isNewTyCon)
-import GHC.Core.TyCo.Ppr (pprKind, pprParendType, pprType,
- pprWithExplicitKindsWhen, pprTheta, pprClassPred, pprTypeApp,
- pprSourceTyCon)
+import GHC.Core.TyCo.Rep (Type(..))
+import GHC.Core.TyCo.Ppr (pprWithExplicitKindsWhen,
+ pprSourceTyCon, pprTyVars, pprWithTYPE)
+import GHC.Core.Predicate
import GHC.Core.Type
-import GHC.Data.Bag
+
+import GHC.Driver.Flags
+
+import GHC.Hs
+
import GHC.Tc.Errors.Types
+import GHC.Tc.Types.Constraint
+import {-# SOURCE #-} GHC.Tc.Types (getLclEnvLoc)
+import GHC.Tc.Types.Origin
import GHC.Tc.Types.Rank (Rank(..))
-import GHC.Tc.Utils.TcType (TcType, tcSplitForAllTyVars, mkClassPred)
-import GHC.Types.Basic (UnboxedTupleOrSum(..), unboxedTupleOrSumExtension)
+import GHC.Tc.Utils.TcType
import GHC.Types.Error
-import GHC.Types.FieldLabel (FieldLabelString, flIsOverloaded, flSelector)
-import GHC.Types.Id (isRecordSelector)
+import GHC.Types.FieldLabel (flIsOverloaded)
+import GHC.Types.Hint.Ppr () -- Outputable GhcHint
+import GHC.Types.Basic
+import GHC.Types.Id
import GHC.Types.Name
-import GHC.Types.Name.Reader (GreName(..), pprNameProvenance)
-import GHC.Types.SrcLoc (GenLocated(..), unLoc)
+import GHC.Types.Name.Reader ( GreName(..), pprNameProvenance
+ , RdrName, rdrNameOcc, greMangledName )
+import GHC.Types.Name.Set
+import GHC.Types.SrcLoc
import GHC.Types.TyThing
-import GHC.Types.Var.Env (emptyTidyEnv)
-import GHC.Types.Var.Set (pprVarSet, pluralVarSet)
-import GHC.Driver.Flags
-import GHC.Hs
-import GHC.Utils.Misc (capitalise)
-import GHC.Utils.Outputable
+import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
+import GHC.Types.Var
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
+
import GHC.Unit.State (pprWithUnitState, UnitState)
+import GHC.Unit.Module
+
+import GHC.Data.Bag
+import GHC.Data.FastString
+import GHC.Data.List.SetOps ( nubOrdBy )
+import GHC.Data.Maybe
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+
import qualified GHC.LanguageExtensions as LangExt
+
+import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
+import Data.Function (on)
+import Data.List ( groupBy, sortBy, tails
+ , partition, unfoldr )
+import Data.Ord ( comparing )
instance Diagnostic TcRnMessage where
diagnosticMessage = \case
TcRnUnknownMessage m
-> diagnosticMessage m
- TcRnTypeDoesNotHaveFixedRuntimeRep ty prov (ErrInfo extra supplementary)
- -> mkDecorated [pprTypeDoesNotHaveFixedRuntimeRep ty prov, extra, supplementary]
TcRnMessageWithInfo unit_state msg_with_info
-> case msg_with_info of
TcRnMessageDetailed err_info msg
-> messageWithInfoDiagnosticMessage unit_state err_info (diagnosticMessage msg)
+ TcRnSolverReport msgs _ _
+ -> mkDecorated $
+ map pprReportWithCtxt msgs
+ TcRnRedundantConstraints redundants (info, show_info)
+ -> mkSimpleDecorated $
+ text "Redundant constraint" <> plural redundants <> colon
+ <+> pprEvVarTheta redundants
+ $$ if show_info then text "In" <+> ppr info else empty
+ TcRnInaccessibleCode implic contras
+ -> mkSimpleDecorated $
+ hang (text "Inaccessible code in")
+ 2 (ppr (ic_info implic))
+ $$ vcat (map pprReportWithCtxt (NE.toList contras))
+ TcRnTypeDoesNotHaveFixedRuntimeRep ty prov (ErrInfo extra supplementary)
+ -> mkDecorated [pprTypeDoesNotHaveFixedRuntimeRep ty prov, extra, supplementary]
TcRnImplicitLift id_or_name ErrInfo{..}
-> mkDecorated $
( text "The variable" <+> quotes (ppr id_or_name) <+>
@@ -546,15 +591,45 @@ instance Diagnostic TcRnMessage where
= text "Illegal term-level use of the" <+> what
ns = nameNameSpace name
what = pprNameSpace ns <+> quotes (ppr name)
+ TcRnNotInScope err name imp_errs _
+ -> mkSimpleDecorated $
+ pprScopeError name err $$ vcat (map ppr imp_errs)
+ TcRnUntickedPromotedConstructor name
+ -> mkSimpleDecorated $
+ text "Unticked promoted constructor" <> colon <+> quotes (ppr name) <> dot
+ TcRnIllegalBuiltinSyntax what rdr_name
+ -> mkSimpleDecorated $
+ hsep [text "Illegal", what, text "of built-in syntax:", ppr rdr_name]
+ TcRnWarnDefaulting tidy_wanteds tidy_tv default_ty
+ -> mkSimpleDecorated $
+ hang (hsep $ [ text "Defaulting" ]
+ ++
+ (case tidy_tv of
+ Nothing -> []
+ Just tv -> [text "the type variable"
+ , quotes (ppr tv)])
+ ++
+ [ text "to type"
+ , quotes (ppr default_ty)
+ , text "in the following constraint" <> plural tidy_wanteds ])
+ 2
+ (pprWithArising tidy_wanteds)
+
diagnosticReason = \case
TcRnUnknownMessage m
-> diagnosticReason m
- TcRnTypeDoesNotHaveFixedRuntimeRep{}
- -> ErrorWithoutFlag
TcRnMessageWithInfo _ msg_with_info
-> case msg_with_info of
TcRnMessageDetailed _ m -> diagnosticReason m
+ TcRnSolverReport _ reason _
+ -> reason -- Error, or a Warning if we are deferring type errors
+ TcRnRedundantConstraints {}
+ -> WarningWithFlag Opt_WarnRedundantConstraints
+ TcRnInaccessibleCode {}
+ -> WarningWithFlag Opt_WarnInaccessibleCode
+ TcRnTypeDoesNotHaveFixedRuntimeRep{}
+ -> ErrorWithoutFlag
TcRnImplicitLift{}
-> WarningWithFlag Opt_WarnImplicitLift
TcRnUnusedPatternBinds{}
@@ -768,15 +843,29 @@ instance Diagnostic TcRnMessage where
-> WarningWithFlag Opt_WarnGADTMonoLocalBinds
TcRnIncorrectNameSpace {}
-> ErrorWithoutFlag
+ TcRnNotInScope {}
+ -> ErrorWithoutFlag
+ TcRnUntickedPromotedConstructor {}
+ -> WarningWithFlag Opt_WarnUntickedPromotedConstructors
+ TcRnIllegalBuiltinSyntax {}
+ -> ErrorWithoutFlag
+ TcRnWarnDefaulting {}
+ -> WarningWithFlag Opt_WarnTypeDefaults
diagnosticHints = \case
TcRnUnknownMessage m
-> diagnosticHints m
- TcRnTypeDoesNotHaveFixedRuntimeRep{}
- -> noHints
TcRnMessageWithInfo _ msg_with_info
-> case msg_with_info of
TcRnMessageDetailed _ m -> diagnosticHints m
+ TcRnSolverReport _ _ hints
+ -> hints
+ TcRnRedundantConstraints{}
+ -> noHints
+ TcRnInaccessibleCode{}
+ -> noHints
+ TcRnTypeDoesNotHaveFixedRuntimeRep{}
+ -> noHints
TcRnImplicitLift{}
-> noHints
TcRnUnusedPatternBinds{}
@@ -987,6 +1076,14 @@ instance Diagnostic TcRnMessage where
-> [SuggestAppropriateTHTick $ nameNameSpace nm]
| otherwise
-> noHints
+ TcRnNotInScope err _ _ hints
+ -> scopeErrorHints err ++ hints
+ TcRnUntickedPromotedConstructor name
+ -> [SuggestAddTick name]
+ TcRnIllegalBuiltinSyntax {}
+ -> noHints
+ TcRnWarnDefaulting {}
+ -> noHints
deriveInstanceErrReasonHints :: Class
-> UsingGeneralizedNewtypeDeriving
@@ -1334,3 +1431,1283 @@ derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving pprHerald = \cas
ppr2 = derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving False that
in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
(ppr1 $$ text " or" $$ ppr2)
+
+{- *********************************************************************
+* *
+ Outputable ReportErrCtxt (for debugging)
+* *
+**********************************************************************-}
+
+instance Outputable ReportErrCtxt where
+ ppr (CEC { cec_binds = bvar
+ , cec_defer_type_errors = dte
+ , cec_expr_holes = eh
+ , cec_type_holes = th
+ , cec_out_of_scope_holes = osh
+ , cec_warn_redundant = wr
+ , cec_expand_syns = es
+ , cec_suppress = sup })
+ = text "CEC" <+> braces (vcat
+ [ text "cec_binds" <+> equals <+> ppr bvar
+ , text "cec_defer_type_errors" <+> equals <+> ppr dte
+ , text "cec_expr_holes" <+> equals <+> ppr eh
+ , text "cec_type_holes" <+> equals <+> ppr th
+ , text "cec_out_of_scope_holes" <+> equals <+> ppr osh
+ , text "cec_warn_redundant" <+> equals <+> ppr wr
+ , text "cec_expand_syns" <+> equals <+> ppr es
+ , text "cec_suppress" <+> equals <+> ppr sup ])
+
+{- *********************************************************************
+* *
+ Outputting TcReportMsg 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 'TcReportMsg', with its enclosing 'ReportErrCtxt'.
+pprTcReportMsg :: ReportErrCtxt -> TcReportMsg -> SDoc
+pprTcReportMsg ctxt (TcReportWithInfo msg (info :| infos)) =
+ vcat
+ ( pprTcReportMsg ctxt msg
+ : pprTcReportInfo ctxt info
+ : map (pprTcReportInfo ctxt) infos )
+pprTcReportMsg _ (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) =
+ pprUserTypeErrorTy ty
+pprTcReportMsg ctxt (ReportHoleError hole err) =
+ pprHoleError ctxt hole err
+pprTcReportMsg _ (CannotUnifyWithPolytype ct tv1 ty2) =
+ vcat [ (if isSkolemTyVar tv1
+ then text "Cannot equate type variable"
+ else text "Cannot instantiate unification variable")
+ <+> quotes (ppr tv1)
+ , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) ]
+ where
+ what = text $ levelString $
+ ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel
+pprTcReportMsg _
+ (Mismatch { mismatch_ea = add_ea
+ , mismatch_ct = ct
+ , mismatch_ty1 = ty1
+ , mismatch_ty2 = ty2 })
+ = addArising (ctOrigin ct) msg
+ where
+ msg
+ | (isLiftedRuntimeRep ty1 && isUnliftedRuntimeRep ty2) ||
+ (isLiftedRuntimeRep ty2 && isUnliftedRuntimeRep ty1) ||
+ (isLiftedLevity ty1 && isUnliftedLevity ty2) ||
+ (isLiftedLevity ty2 && isUnliftedLevity ty1)
+ = text "Couldn't match a lifted type with an unlifted type"
+
+ | isAtomicTy ty1 || isAtomicTy ty2
+ = -- Print with quotes
+ sep [ text herald1 <+> quotes (ppr ty1)
+ , nest padding $
+ text herald2 <+> quotes (ppr ty2) ]
+
+ | otherwise
+ = -- Print with vertical layout
+ vcat [ text herald1 <> colon <+> ppr ty1
+ , nest padding $
+ text herald2 <> colon <+> ppr ty2 ]
+
+ herald1 = conc [ "Couldn't match"
+ , if is_repr then "representation of" else ""
+ , if add_ea then "expected" else ""
+ , what ]
+ herald2 = conc [ "with"
+ , if is_repr then "that of" else ""
+ , if add_ea then ("actual " ++ what) else "" ]
+
+ padding = length herald1 - length herald2
+
+ is_repr = case ctEqRel ct of { ReprEq -> True; NomEq -> False }
+
+ what = levelString (ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel)
+
+ conc :: [String] -> String
+ conc = foldr1 add_space
+
+ add_space :: String -> String -> String
+ add_space s1 s2 | null s1 = s2
+ | null s2 = s1
+ | otherwise = s1 ++ (' ' : s2)
+pprTcReportMsg _
+ (KindMismatch { kmismatch_what = thing
+ , kmismatch_expected = exp
+ , kmismatch_actual = act })
+ = hang (text "Expected" <+> kind_desc <> comma)
+ 2 (text "but" <+> quotes (ppr thing) <+> text "has kind" <+>
+ quotes (ppr act))
+ where
+ kind_desc | tcIsConstraintKind exp = text "a constraint"
+ | Just arg <- kindRep_maybe exp -- TYPE t0
+ , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case
+ True -> text "kind" <+> quotes (ppr exp)
+ False -> text "a type"
+ | otherwise = text "kind" <+> quotes (ppr exp)
+
+
+pprTcReportMsg ctxt
+ (TypeEqMismatch { teq_mismatch_ppr_explicit_kinds = ppr_explicit_kinds
+ , teq_mismatch_ct = ct
+ , teq_mismatch_ty1 = ty1
+ , teq_mismatch_ty2 = ty2
+ , teq_mismatch_expected = exp
+ , teq_mismatch_actual = act
+ , teq_mismatch_what = mb_thing })
+ = addArising orig $ pprWithExplicitKindsWhen ppr_explicit_kinds msg
+ where
+ msg
+ | isUnliftedTypeKind act, isLiftedTypeKind exp
+ = sep [ text "Expecting a lifted type, but"
+ , thing_msg mb_thing (text "an") (text "unlifted") ]
+ | isLiftedTypeKind act, isUnliftedTypeKind exp
+ = sep [ text "Expecting an unlifted type, but"
+ , thing_msg mb_thing (text "a") (text "lifted") ]
+ | tcIsLiftedTypeKind exp
+ = maybe_num_args_msg $$
+ sep [ text "Expected a type, but"
+ , case mb_thing of
+ Nothing -> text "found something with kind"
+ Just thing -> quotes (ppr thing) <+> text "has kind"
+ , 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
+ | -- 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
+ -- 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
+
+ ct_loc = ctLoc ct
+ orig = ctOrigin ct
+ level = ctLocTypeOrKind_maybe ct_loc `orElse` TypeLevel
+
+ thing_msg (Just thing) _ levity = quotes (ppr thing) <+> text "is" <+> levity
+ thing_msg Nothing an levity = text "got" <+> an <+> levity <+> text "type"
+
+ num_args_msg = case level of
+ KindLevel
+ | not (isMetaTyVarTy exp) && not (isMetaTyVarTy act)
+ -- if one is a meta-tyvar, then it's possible that the user
+ -- has asked for something impredicative, and we couldn't unify.
+ -- Don't bother with counting arguments.
+ -> let n_act = count_args act
+ n_exp = count_args exp in
+ case n_act - n_exp of
+ 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)
+ _ -> Nothing
+
+ _ -> Nothing
+
+ maybe_num_args_msg = num_args_msg `orElse` empty
+
+ count_args ty = count isVisibleBinder $ fst $ splitPiTys ty
+pprTcReportMsg _ (FixedRuntimeRepError origs_and_tys) =
+ let
+ -- Assemble the error message: pair up each origin with the corresponding type, e.g.
+ -- • FixedRuntimeRep origin msg 1 ...
+ -- a :: TYPE r1
+ -- • FixedRuntimeRep origin msg 2 ...
+ -- b :: TYPE r2
+ combine_origin_ty :: FRROrigin -> Type -> SDoc
+ combine_origin_ty frr_orig ty =
+ -- Add bullet points if there is more than one error.
+ (if length origs_and_tys > 1 then (bullet <+>) else id) $
+ vcat [pprFRROrigin frr_orig <> colon
+ ,nest 2 $ ppr ty <+> dcolon <+> pprWithTYPE (typeKind ty)]
+ in
+ vcat $ map (uncurry combine_origin_ty) origs_and_tys
+pprTcReportMsg _ (SkolemEscape ct implic esc_skols) =
+ let
+ esc_doc = sep [ text "because" <+> what <+> text "variable" <> plural esc_skols
+ <+> pprQuotedList esc_skols
+ , text "would escape" <+>
+ if isSingleton esc_skols then text "its scope"
+ else text "their scope" ]
+ in
+ vcat [ nest 2 $ esc_doc
+ , sep [ (if isSingleton esc_skols
+ then text "This (rigid, skolem)" <+>
+ what <+> text "variable is"
+ else text "These (rigid, skolem)" <+>
+ what <+> text "variables are")
+ <+> text "bound by"
+ , nest 2 $ ppr (ic_info implic)
+ , nest 2 $ text "at" <+>
+ ppr (getLclEnvLoc (ic_env implic)) ] ]
+ where
+ what = text $ levelString $
+ ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel
+pprTcReportMsg _ (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) =
+ vcat [ hang (text "Cannot use equality for substitution:")
+ 2 (ppr (ctPred ct))
+ , text "Doing so would be ill-kinded." ]
+pprTcReportMsg _ (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)) =
+ 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)
+ where
+ preds = map ctPred (ct : cts)
+pprTcReportMsg ctxt (CouldNotDeduce useful_givens (ct :| others) mb_extra)
+ = main_msg $$
+ case supplementary of
+ Left infos
+ -> vcat (map (pprTcReportInfo ctxt) infos)
+ Right other_msg
+ -> pprTcReportMsg ctxt other_msg
+ where
+ main_msg
+ | null useful_givens
+ = addArising (ctOrigin ct) no_instance_msg
+ | otherwise
+ = vcat [ addArising (ctOrigin ct) no_deduce_msg
+ , vcat (pp_givens useful_givens) ]
+ supplementary = case mb_extra of
+ Nothing
+ -> Left []
+ Just (CND_Extra level ty1 ty2)
+ -> mk_supplementary_ea_msg ctxt level ty1 ty2 orig
+ (wanted, wanteds) = (ctPred ct, map ctPred others)
+ orig = ctOrigin ct
+ no_instance_msg
+ | null others
+ , Just (tc, _) <- splitTyConApp_maybe wanted
+ , isClassTyCon tc
+ -- Don't say "no instance" for a constraint such as "c" for a type variable c.
+ = text "No instance for" <+> pprParendType wanted
+ | otherwise
+ = text "Could not solve:" <+> pprTheta wanteds
+ no_deduce_msg
+ | null others
+ = text "Could not deduce" <+> pprParendType wanted
+ | otherwise
+ = text "Could not deduce:" <+> pprTheta wanteds
+pprTcReportMsg ctxt (AmbiguityPreventsSolvingCt ct ambigs) =
+ pprTcReportInfo 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})
+ (CannotResolveInstance ct unifiers candidates imp_errs suggs binds)
+ =
+ vcat
+ [ pprTcReportMsg 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))
+ , pprRelevantBindings binds
+ , potential_msg ])
+ , ppWhen (isNothing mb_patsyn_prov) $
+ -- Don't suggest fixes for the provided context of a pattern
+ -- synonym; the right fix is to bind more in the pattern
+ show_fixes (ctxtFixes has_ambigs pred implics
+ ++ drv_fixes)
+ , ppWhen (not (null candidates))
+ (hang (text "There are instances for similar types:")
+ 2 (vcat (map ppr candidates)))
+ -- See Note [Report candidate instances]
+ , vcat $ map ppr imp_errs
+ , vcat $ map ppr suggs ]
+ where
+ orig = ctOrigin ct
+ pred = ctPred ct
+ (clas, tys) = getClassPredTys pred
+ -- See Note [Highlighting ambiguous type variables]
+ (ambig_kvs, ambig_tvs) = ambigTkvsOfCt ct
+ ambigs = ambig_kvs ++ ambig_tvs
+ has_ambigs = not (null ambigs)
+ useful_givens = discardProvCtxtGivens orig (getUserGivensFromImplics implics)
+ -- useful_givens are the enclosing implications with non-empty givens,
+ -- modulo the horrid discardProvCtxtGivens
+ lead_with_ambig = not (null ambigs)
+ && not (any isRuntimeUnkSkol ambigs)
+ && not (null unifiers)
+ && null useful_givens
+
+ no_inst_msg :: TcReportMsg
+ no_inst_msg
+ | lead_with_ambig
+ = AmbiguityPreventsSolvingCt ct (ambig_kvs, ambig_tvs)
+ | otherwise
+ = CouldNotDeduce useful_givens (ct :| []) Nothing
+
+ -- Report "potential instances" only when the constraint arises
+ -- directly from the user's use of an overloaded function
+ want_potential (TypeEqOrigin {}) = False
+ want_potential _ = True
+
+ potential_msg
+ = ppWhen (not (null unifiers) && want_potential orig) $
+ potential_hdr $$
+ potentialInstancesErrMsg (PotentialInstances { matches = [], unifiers })
+
+ potential_hdr
+ = ppWhen lead_with_ambig $
+ text "Probable fix: use a type annotation to specify what"
+ <+> pprQuotedList ambig_tvs <+> text "should be."
+
+ mb_patsyn_prov :: Maybe SDoc
+ mb_patsyn_prov
+ | not lead_with_ambig
+ , ProvCtxtOrigin PSB{ psb_def = L _ pat } <- orig
+ = Just (vcat [ text "In other words, a successful match on the pattern"
+ , nest 2 $ ppr pat
+ , text "does not provide the constraint" <+> pprParendType pred ])
+ | otherwise = Nothing
+
+ extra_note | any isFunTy (filterOutInvisibleTypes (classTyCon clas) tys)
+ = text "(maybe you haven't applied a function to enough arguments?)"
+ | className clas == typeableClassName -- Avoid mysterious "No instance for (Typeable T)
+ , [_,ty] <- tys -- Look for (Typeable (k->*) (T k))
+ , Just (tc,_) <- tcSplitTyConApp_maybe ty
+ , not (isTypeFamilyTyCon tc)
+ = hang (text "GHC can't yet do polykinded")
+ 2 (text "Typeable" <+>
+ parens (ppr ty <+> dcolon <+> ppr (tcTypeKind ty)))
+ | otherwise
+ = empty
+
+ drv_fixes = case orig of
+ DerivClauseOrigin -> [drv_fix False]
+ StandAloneDerivOrigin -> [drv_fix True]
+ DerivOriginDC _ _ standalone -> [drv_fix standalone]
+ DerivOriginCoerce _ _ _ standalone -> [drv_fix standalone]
+ _ -> []
+
+ drv_fix standalone_wildcard
+ | standalone_wildcard
+ = text "fill in the wildcard constraint yourself"
+ | otherwise
+ = 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) =
+ vcat
+ [ addArising orig $
+ (text "Overlapping instances for"
+ <+> pprType (mkClassPred clas tys))
+ , ppUnless (null matching_givens) $
+ sep [text "Matching givens (or their superclasses):"
+ , nest 2 (vcat matching_givens)]
+ , potentialInstancesErrMsg
+ (PotentialInstances { matches, unifiers })
+ , ppWhen (null matching_givens && isSingleton matches && null unifiers) $
+ -- Intuitively, some given matched the wanted in their
+ -- flattened or rewritten (from given equalities) form
+ -- but the matcher can't figure that out because the
+ -- constraints are non-flat and non-rewritten so we
+ -- simply report back the whole given
+ -- context. Accelerate Smart.hs showed this problem.
+ sep [ text "There exists a (perhaps superclass) match:"
+ , nest 2 (vcat (pp_givens useful_givens))]
+
+ , ppWhen (isSingleton matches) $
+ parens (vcat [ ppUnless (null tyCoVars) $
+ text "The choice depends on the instantiation of" <+>
+ quotes (pprWithCommas ppr tyCoVars)
+ , ppUnless (null famTyCons) $
+ if (null tyCoVars)
+ then
+ text "The choice depends on the result of evaluating" <+>
+ quotes (pprWithCommas ppr famTyCons)
+ else
+ text "and the result of evaluating" <+>
+ quotes (pprWithCommas ppr famTyCons)
+ , ppWhen (null (matching_givens)) $
+ vcat [ text "To pick the first instance above, use IncoherentInstances"
+ , text "when compiling the other instance declarations"]
+ ])]
+ where
+ orig = ctOrigin ct
+ pred = ctPred ct
+ (clas, tys) = getClassPredTys pred
+ tyCoVars = tyCoVarsOfTypesList tys
+ famTyCons = filter isFamilyTyCon $ concatMap (nonDetEltsUniqSet . tyConsOfType) tys
+ useful_givens = discardProvCtxtGivens orig (getUserGivensFromImplics implics)
+ matching_givens = mapMaybe matchable useful_givens
+ matchable implic@(Implic { ic_given = evvars, ic_info = skol_info })
+ = case ev_vars_matching of
+ [] -> Nothing
+ _ -> Just $ hang (pprTheta ev_vars_matching)
+ 2 (sep [ text "bound by" <+> ppr skol_info
+ , text "at" <+>
+ ppr (getLclEnvLoc (ic_env implic)) ])
+ where ev_vars_matching = [ pred
+ | ev_var <- evvars
+ , let pred = evVarPred ev_var
+ , any can_match (pred : transSuperClasses pred) ]
+ can_match pred
+ = case getClassPredTys_maybe pred of
+ Just (clas', tys') -> clas' == clas
+ && isJust (tcMatchTys tys tys')
+ Nothing -> False
+pprTcReportMsg _ (UnsafeOverlap ct matches unsafe_overlapped) =
+ vcat [ addArising orig (text "Unsafe overlapping instances for"
+ <+> pprType (mkClassPred clas tys))
+ , sep [text "The matching instance is:",
+ nest 2 (pprInstance $ head matches)]
+ , vcat [ text "It is compiled in a Safe module and as such can only"
+ , text "overlap instances from the same module, however it"
+ , text "overlaps the following instances from different" <+>
+ text "modules:"
+ , nest 2 (vcat [pprInstances $ unsafe_overlapped])
+ ]
+ ]
+ where
+ orig = ctOrigin ct
+ pred = ctPred ct
+ (clas, tys) = getClassPredTys pred
+
+{- *********************************************************************
+* *
+ Displaying potential instances
+* *
+**********************************************************************-}
+
+-- | Directly display the given matching and unifying instances,
+-- with a header for each: `Matching instances`/`Potentially matching instances`.
+pprPotentialInstances :: (ClsInst -> SDoc) -> PotentialInstances -> SDoc
+pprPotentialInstances ppr_inst (PotentialInstances { matches, unifiers }) =
+ vcat
+ [ ppWhen (not $ null matches) $
+ text "Matching instance" <> plural matches <> colon $$
+ nest 2 (vcat (map ppr_inst matches))
+ , ppWhen (not $ null unifiers) $
+ (text "Potentially matching instance" <> plural unifiers <> colon) $$
+ nest 2 (vcat (map ppr_inst unifiers))
+ ]
+
+-- | Display a summary of available instances, omitting those involving
+-- out-of-scope types, in order to explain why we couldn't solve a particular
+-- constraint, e.g. due to instance overlap or out-of-scope types.
+--
+-- To directly display a collection of matching/unifying instances,
+-- use 'pprPotentialInstances'.
+potentialInstancesErrMsg :: PotentialInstances -> SDoc
+-- See Note [Displaying potential instances]
+potentialInstancesErrMsg potentials =
+ sdocOption sdocPrintPotentialInstances $ \print_insts ->
+ getPprStyle $ \sty ->
+ potentials_msg_with_options potentials print_insts sty
+
+-- | Display a summary of available instances, omitting out-of-scope ones.
+--
+-- Use 'potentialInstancesErrMsg' to automatically set the pretty-printing
+-- options.
+potentials_msg_with_options :: PotentialInstances
+ -> Bool -- ^ Whether to print /all/ potential instances
+ -> PprStyle
+ -> SDoc
+potentials_msg_with_options
+ (PotentialInstances { matches, unifiers })
+ show_all_potentials sty
+ | null matches && null unifiers
+ = empty
+
+ | null show_these_matches && null show_these_unifiers
+ = vcat [ not_in_scope_msg empty
+ , flag_hint ]
+
+ | otherwise
+ = vcat [ pprPotentialInstances
+ pprInstance -- print instance + location info
+ (PotentialInstances
+ { matches = show_these_matches
+ , unifiers = show_these_unifiers })
+ , overlapping_but_not_more_specific_msg sorted_matches
+ , nest 2 $ vcat
+ [ ppWhen (n_in_scope_hidden > 0) $
+ text "...plus"
+ <+> speakNOf n_in_scope_hidden (text "other")
+ , ppWhen (not_in_scopes > 0) $
+ not_in_scope_msg (text "...plus")
+ , flag_hint ] ]
+ where
+ n_show_matches, n_show_unifiers :: Int
+ n_show_matches = 3
+ n_show_unifiers = 2
+
+ (in_scope_matches, not_in_scope_matches) = partition inst_in_scope matches
+ (in_scope_unifiers, not_in_scope_unifiers) = partition inst_in_scope unifiers
+ sorted_matches = sortBy fuzzyClsInstCmp in_scope_matches
+ sorted_unifiers = sortBy fuzzyClsInstCmp in_scope_unifiers
+ (show_these_matches, show_these_unifiers)
+ | show_all_potentials = (sorted_matches, sorted_unifiers)
+ | otherwise = (take n_show_matches sorted_matches
+ ,take n_show_unifiers sorted_unifiers)
+ n_in_scope_hidden
+ = length sorted_matches + length sorted_unifiers
+ - length show_these_matches - length show_these_unifiers
+
+ -- "in scope" means that all the type constructors
+ -- are lexically in scope; these instances are likely
+ -- to be more useful
+ inst_in_scope :: ClsInst -> Bool
+ inst_in_scope cls_inst = nameSetAll name_in_scope $
+ orphNamesOfTypes (is_tys cls_inst)
+
+ name_in_scope name
+ | pretendNameIsInScope name
+ = True -- E.g. (->); see Note [pretendNameIsInScope] in GHC.Builtin.Names
+ | Just mod <- nameModule_maybe name
+ = qual_in_scope (qualName sty mod (nameOccName name))
+ | otherwise
+ = True
+
+ qual_in_scope :: QualifyName -> Bool
+ qual_in_scope NameUnqual = True
+ qual_in_scope (NameQual {}) = True
+ qual_in_scope _ = False
+
+ not_in_scopes :: Int
+ not_in_scopes = length not_in_scope_matches + length not_in_scope_unifiers
+
+ not_in_scope_msg herald =
+ hang (herald <+> speakNOf not_in_scopes (text "instance")
+ <+> text "involving out-of-scope types")
+ 2 (ppWhen show_all_potentials $
+ pprPotentialInstances
+ pprInstanceHdr -- only print the header, not the instance location info
+ (PotentialInstances
+ { matches = not_in_scope_matches
+ , unifiers = not_in_scope_unifiers
+ }))
+
+ flag_hint = ppUnless (show_all_potentials
+ || (equalLength show_these_matches matches
+ && equalLength show_these_unifiers unifiers)) $
+ text "(use -fprint-potential-instances to see them all)"
+
+-- | Compute a message informing the user of any instances that are overlapped
+-- but were not discarded because the instance overlapping them wasn't
+-- strictly more specific.
+overlapping_but_not_more_specific_msg :: [ClsInst] -> SDoc
+overlapping_but_not_more_specific_msg insts
+ -- Only print one example of "overlapping but not strictly more specific",
+ -- to avoid information overload.
+ | overlap : _ <- overlapping_but_not_more_specific
+ = overlap_header $$ ppr_overlapping overlap
+ | otherwise
+ = empty
+ where
+ overlap_header :: SDoc
+ overlap_header
+ | [_] <- overlapping_but_not_more_specific
+ = text "An overlapping instance can only be chosen when it is strictly more specific."
+ | otherwise
+ = text "Overlapping instances can only be chosen when they are strictly more specific."
+ overlapping_but_not_more_specific :: [(ClsInst, ClsInst)]
+ overlapping_but_not_more_specific
+ = nubOrdBy (comparing (is_dfun . fst))
+ [ (overlapper, overlappee)
+ | these <- groupBy ((==) `on` is_cls_nm) insts
+ -- Take all pairs of distinct instances...
+ , one:others <- tails these -- if `these = [inst_1, inst_2, ...]`
+ , other <- others -- then we get pairs `(one, other) = (inst_i, inst_j)` with `i < j`
+ -- ... such that one instance in the pair overlaps the other...
+ , let mb_overlapping
+ | hasOverlappingFlag (overlapMode $ is_flag one)
+ || hasOverlappableFlag (overlapMode $ is_flag other)
+ = [(one, other)]
+ | hasOverlappingFlag (overlapMode $ is_flag other)
+ || hasOverlappableFlag (overlapMode $ is_flag one)
+ = [(other, one)]
+ | otherwise
+ = []
+ , (overlapper, overlappee) <- mb_overlapping
+ -- ... but the overlapper is not more specific than the overlappee.
+ , not (overlapper `more_specific_than` overlappee)
+ ]
+ more_specific_than :: ClsInst -> ClsInst -> Bool
+ is1 `more_specific_than` is2
+ = isJust (tcMatchTys (is_tys is1) (is_tys is2))
+ ppr_overlapping :: (ClsInst, ClsInst) -> SDoc
+ ppr_overlapping (overlapper, overlappee)
+ = text "The first instance that follows overlaps the second, but is not more specific than it:"
+ $$ nest 2 (vcat $ map pprInstanceHdr [overlapper, overlappee])
+
+{- Note [Displaying potential instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When showing a list of instances for
+ - overlapping instances (show ones that match)
+ - no such instance (show ones that could match)
+we want to give it a bit of structure. Here's the plan
+
+* Say that an instance is "in scope" if all of the
+ type constructors it mentions are lexically in scope.
+ These are the ones most likely to be useful to the programmer.
+
+* Show at most n_show in-scope instances,
+ and summarise the rest ("plus N others")
+
+* Summarise the not-in-scope instances ("plus 4 not in scope")
+
+* Add the flag -fshow-potential-instances which replaces the
+ summary with the full list
+-}
+
+{- *********************************************************************
+* *
+ Outputting TcReportInfo
+* *
+**********************************************************************-}
+
+-- | Pretty-print an informational message, to accompany a 'TcReportMsg'.
+pprTcReportInfo :: ReportErrCtxt -> TcReportInfo -> SDoc
+pprTcReportInfo _ (Ambiguity prepend_msg (ambig_kvs, ambig_tvs)) = msg
+ where
+
+ msg | any isRuntimeUnkSkol ambig_kvs -- See Note [Runtime skolems]
+ || any isRuntimeUnkSkol ambig_tvs
+ = vcat [ text "Cannot resolve unknown runtime type"
+ <> plural ambig_tvs <+> pprQuotedList ambig_tvs
+ , text "Use :print or :force to determine these types"]
+
+ | not (null ambig_tvs)
+ = pp_ambig (text "type") ambig_tvs
+
+ | otherwise
+ = pp_ambig (text "kind") ambig_kvs
+
+ pp_ambig what tkvs
+ | prepend_msg -- "Ambiguous type variable 't0'"
+ = text "Ambiguous" <+> what <+> text "variable"
+ <> plural tkvs <+> pprQuotedList tkvs
+
+ | otherwise -- "The type variable 't0' is ambiguous"
+ = text "The" <+> what <+> text "variable" <> plural tkvs
+ <+> pprQuotedList tkvs <+> isOrAre tkvs <+> text "ambiguous"
+pprTcReportInfo ctxt (TyVarInfo tv) =
+ case tcTyVarDetails tv of
+ SkolemTv {} -> pprSkols ctxt [tv]
+ RuntimeUnk {} -> quotes (ppr tv) <+> text "is an interactive-debugger skolem"
+ MetaTv {} -> empty
+pprTcReportInfo _ (NonInjectiveTyFam tc) =
+ text "NB:" <+> quotes (ppr tc)
+ <+> text "is a non-injective type family"
+pprTcReportInfo _ (ReportCoercibleMsg msg) =
+ pprCoercibleMsg msg
+pprTcReportInfo _ (ExpectedActual { ea_expected = exp, ea_actual = act }) =
+ vcat
+ [ text "Expected:" <+> ppr exp
+ , text " Actual:" <+> ppr act ]
+pprTcReportInfo _
+ (ExpectedActualAfterTySynExpansion
+ { ea_expanded_expected = exp
+ , ea_expanded_actual = act } )
+ = vcat
+ [ 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) =
+ sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions ->
+ if printExplicitCoercions
+ || not (cty1 `pickyEqType` cty2)
+ then vcat [ hang (text "When matching" <+> sub_whats)
+ 2 (vcat [ ppr cty1 <+> dcolon <+>
+ ppr (tcTypeKind cty1)
+ , ppr cty2 <+> dcolon <+>
+ ppr (tcTypeKind cty2) ])
+ , supplementary ]
+ else text "When matching the kind of" <+> quotes (ppr cty1)
+ where
+ sub_t_or_k = mb_sub_t_or_k `orElse` TypeLevel
+ 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) =
+ text "NB:" <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2)
+ where
+ ppr_from same_pkg nm
+ | isGoodSrcSpan loc
+ = hang (quotes (ppr nm) <+> text "is defined at")
+ 2 (ppr loc)
+ | otherwise -- Imported things have an UnhelpfulSrcSpan
+ = hang (quotes (ppr nm))
+ 2 (sep [ text "is defined in" <+> quotes (ppr (moduleName mod))
+ , ppUnless (same_pkg || pkg == mainUnit) $
+ nest 4 $ text "in package" <+> quotes (ppr pkg) ])
+ where
+ pkg = moduleUnit mod
+ mod = nameModule nm
+ loc = nameSrcSpan nm
+pprTcReportInfo ctxt (OccursCheckInterestingTyVars (tv :| tvs)) =
+ hang (text "Type variable kinds:") 2 $
+ vcat (map (tyvar_binding . tidyTyCoVarOcc (cec_tidy ctxt))
+ (tv:tvs))
+ where
+ tyvar_binding tyvar = ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)
+
+pprCoercibleMsg :: CoercibleMsg -> SDoc
+pprCoercibleMsg (UnknownRoles ty) =
+ hang (text "NB: We cannot know what roles the parameters to" <+>
+ quotes (ppr ty) <+> text "have;")
+ 2 (text "we must assume that the role is nominal")
+pprCoercibleMsg (TyConIsAbstract tc) =
+ hsep [ text "NB: The type constructor"
+ , quotes (pprSourceTyCon tc)
+ , text "is abstract" ]
+pprCoercibleMsg (OutOfScopeNewtypeConstructor tc dc) =
+ hang (text "The data constructor" <+> quotes (ppr $ dataConName dc))
+ 2 (sep [ text "of newtype" <+> quotes (pprSourceTyCon tc)
+ , text "is not in scope" ])
+
+{- *********************************************************************
+* *
+ Outputting HoleError messages
+* *
+**********************************************************************-}
+
+pprHoleError :: ReportErrCtxt -> Hole -> HoleError -> SDoc
+pprHoleError _ (Hole { hole_ty, hole_occ = occ }) (OutOfScopeHole imp_errs)
+ = out_of_scope_msg $$ vcat (map ppr imp_errs)
+ where
+ herald | isDataOcc occ = text "Data constructor not in scope:"
+ | otherwise = text "Variable not in scope:"
+ out_of_scope_msg -- Print v :: ty only if the type has structure
+ | boring_type = hang herald 2 (ppr occ)
+ | otherwise = hang herald 2 (pp_occ_with_type occ hole_ty)
+ boring_type = isTyVarTy hole_ty
+pprHoleError ctxt (Hole { hole_ty, hole_occ }) (HoleError sort) =
+ vcat [ hole_msg
+ , tyvars_msg
+ , case sort of { ExprHole {} -> expr_hole_hint; _ -> type_hole_hint } ]
+
+ where
+
+ hole_msg = case sort of
+ ExprHole {} ->
+ hang (text "Found hole:")
+ 2 (pp_occ_with_type hole_occ hole_ty)
+ TypeHole ->
+ hang (text "Found type wildcard" <+> quotes (ppr hole_occ))
+ 2 (text "standing for" <+> quotes pp_hole_type_with_kind)
+ ConstraintHole ->
+ hang (text "Found extra-constraints wildcard standing for")
+ 2 (quotes $ pprType hole_ty) -- always kind constraint
+
+ hole_kind = tcTypeKind hole_ty
+
+ pp_hole_type_with_kind
+ | isLiftedTypeKind hole_kind
+ || isCoVarType hole_ty -- Don't print the kind of unlifted
+ -- equalities (#15039)
+ = pprType hole_ty
+ | otherwise
+ = pprType hole_ty <+> dcolon <+> pprKind hole_kind
+
+ tyvars = tyCoVarsOfTypeList hole_ty
+ tyvars_msg = ppUnless (null tyvars) $
+ text "Where:" <+> (vcat (map loc_msg other_tvs)
+ $$ pprSkols ctxt skol_tvs)
+ where
+ (skol_tvs, other_tvs) = partition is_skol tyvars
+ is_skol tv = isTcTyVar tv && isSkolemTyVar tv
+ -- Coercion variables can be free in the
+ -- hole, via kind casts
+ expr_hole_hint -- Give hint for, say, f x = _x
+ | lengthFS (occNameFS hole_occ) > 1 -- Don't give this hint for plain "_"
+ = text "Or perhaps" <+> quotes (ppr hole_occ)
+ <+> text "is mis-spelled, or not in scope"
+ | otherwise
+ = empty
+
+ type_hole_hint
+ | ErrorWithoutFlag <- cec_type_holes ctxt
+ = text "To use the inferred type, enable PartialTypeSignatures"
+ | otherwise
+ = empty
+
+ loc_msg tv
+ | isTyVar tv
+ = case tcTyVarDetails tv of
+ MetaTv {} -> quotes (ppr tv) <+> text "is an ambiguous type variable"
+ _ -> empty -- Skolems dealt with already
+ | otherwise -- A coercion variable can be free in the hole type
+ = ppWhenOption sdocPrintExplicitCoercions $
+ quotes (ppr tv) <+> text "is a coercion variable"
+
+pp_occ_with_type :: OccName -> Type -> SDoc
+pp_occ_with_type occ hole_ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hole_ty)
+
+{- *********************************************************************
+* *
+ Outputting ScopeError messages
+* *
+**********************************************************************-}
+
+pprScopeError :: RdrName -> NotInScopeError -> SDoc
+pprScopeError rdr_name scope_err =
+ case scope_err of
+ NotInScope {} ->
+ hang (text "Not in scope:")
+ 2 (what <+> quotes (ppr rdr_name))
+ NoExactName name ->
+ text "The Name" <+> quotes (ppr name) <+> text "is not in scope."
+ SameName gres ->
+ assertPpr (length gres >= 2) (text "pprScopeError SameName: fewer than 2 elements" $$ nest 2 (ppr gres))
+ $ hang (text "Same Name in multiple name-spaces:")
+ 2 (vcat (map pp_one sorted_names))
+ where
+ sorted_names = sortBy (leftmost_smallest `on` nameSrcSpan) (map greMangledName gres)
+ pp_one name
+ = hang (pprNameSpace (occNameSpace (getOccName name))
+ <+> quotes (ppr name) <> comma)
+ 2 (text "declared at:" <+> ppr (nameSrcLoc name))
+ MissingBinding thing _ ->
+ sep [ text "The" <+> thing
+ <+> text "for" <+> quotes (ppr rdr_name)
+ , nest 2 $ text "lacks an accompanying binding" ]
+ NoTopLevelBinding ->
+ hang (text "No top-level binding for")
+ 2 (what <+> quotes (ppr rdr_name) <+> text "in this module")
+ UnknownSubordinate doc ->
+ quotes (ppr rdr_name) <+> text "is not a (visible)" <+> doc
+ where
+ what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
+
+scopeErrorHints :: NotInScopeError -> [GhcHint]
+scopeErrorHints scope_err =
+ case scope_err of
+ NotInScope -> noHints
+ NoExactName {} -> [SuggestDumpSlices]
+ SameName {} -> [SuggestDumpSlices]
+ MissingBinding _ hints -> hints
+ NoTopLevelBinding -> noHints
+ UnknownSubordinate {} -> noHints
+
+{- *********************************************************************
+* *
+ Outputting ImportError messages
+* *
+**********************************************************************-}
+
+instance Outputable ImportError where
+ ppr (MissingModule mod_name) =
+ hsep
+ [ text "NB: no module named"
+ , quotes (ppr mod_name)
+ , text "is imported."
+ ]
+ ppr (ModulesDoNotExport mods occ_name)
+ | mod NE.:| [] <- mods
+ = hsep
+ [ text "NB: the module"
+ , quotes (ppr mod)
+ , text "does not export"
+ , quotes (ppr occ_name) <> dot ]
+ | otherwise
+ = hsep
+ [ text "NB: neither"
+ , quotedListWithNor (map ppr $ NE.toList mods)
+ , text "export"
+ , quotes (ppr occ_name) <> dot ]
+
+{- *********************************************************************
+* *
+ Suggested fixes for implication constraints
+* *
+**********************************************************************-}
+
+-- TODO: these functions should use GhcHint instead.
+
+show_fixes :: [SDoc] -> SDoc
+show_fixes [] = empty
+show_fixes (f:fs) = sep [ text "Possible fix:"
+ , nest 2 (vcat (f : map (text "or" <+>) fs))]
+
+ctxtFixes :: Bool -> PredType -> [Implication] -> [SDoc]
+ctxtFixes has_ambig_tvs pred implics
+ | not has_ambig_tvs
+ , isTyVarClassPred pred
+ , (skol:skols) <- usefulContext implics pred
+ , let what | null skols
+ , SigSkol (PatSynCtxt {}) _ _ <- skol
+ = text "\"required\""
+ | otherwise
+ = empty
+ = [sep [ text "add" <+> pprParendType pred
+ <+> text "to the" <+> what <+> text "context of"
+ , nest 2 $ ppr_skol skol $$
+ vcat [ text "or" <+> ppr_skol skol
+ | skol <- skols ] ] ]
+ | otherwise = []
+ where
+ ppr_skol (PatSkol (RealDataCon dc) _) = text "the data constructor" <+> quotes (ppr dc)
+ ppr_skol (PatSkol (PatSynCon ps) _) = text "the pattern synonym" <+> quotes (ppr ps)
+ ppr_skol skol_info = ppr skol_info
+
+usefulContext :: [Implication] -> PredType -> [SkolemInfo]
+-- usefulContext picks out the implications whose context
+-- the programmer might plausibly augment to solve 'pred'
+usefulContext implics pred
+ = go implics
+ where
+ pred_tvs = tyCoVarsOfType pred
+ go [] = []
+ go (ic : ics)
+ | implausible ic = rest
+ | otherwise = ic_info ic : rest
+ where
+ -- Stop when the context binds a variable free in the predicate
+ rest | any (`elemVarSet` pred_tvs) (ic_skols ic) = []
+ | otherwise = go ics
+
+ implausible ic
+ | null (ic_skols ic) = True
+ | implausible_info (ic_info ic) = True
+ | otherwise = False
+
+ implausible_info (SigSkol (InfSigCtxt {}) _ _) = True
+ implausible_info _ = False
+ -- Do not suggest adding constraints to an *inferred* type signature
+
+pp_givens :: [Implication] -> [SDoc]
+pp_givens givens
+ = case givens of
+ [] -> []
+ (g:gs) -> ppr_given (text "from the context:") g
+ : map (ppr_given (text "or from:")) gs
+ where
+ ppr_given herald implic@(Implic { ic_given = gs, ic_info = skol_info })
+ = hang (herald <+> pprEvVarTheta (mkMinimalBySCs evVarPred gs))
+ -- See Note [Suppress redundant givens during error reporting]
+ -- for why we use mkMinimalBySCs above.
+ 2 (sep [ text "bound by" <+> ppr skol_info
+ , text "at" <+> ppr (getLclEnvLoc (ic_env implic)) ])
+
+{- *********************************************************************
+* *
+ CtOrigin information
+* *
+**********************************************************************-}
+
+levelString :: TypeOrKind -> String
+levelString TypeLevel = "type"
+levelString KindLevel = "kind"
+
+pprArising :: CtOrigin -> SDoc
+-- Used for the main, top-level error message
+-- We've done special processing for TypeEq, KindEq, givens
+pprArising (TypeEqOrigin {}) = empty
+pprArising (KindEqOrigin {}) = empty
+pprArising orig | isGivenOrigin orig = empty
+ | otherwise = pprCtOrigin orig
+
+-- Add the "arising from..." part to a message
+addArising :: CtOrigin -> SDoc -> SDoc
+addArising orig msg = hang msg 2 (pprArising orig)
+
+pprWithArising :: [Ct] -> SDoc
+-- Print something like
+-- (Eq a) arising from a use of x at y
+-- (Show a) arising from a use of p at q
+-- Also return a location for the error message
+-- Works for Wanted/Derived only
+pprWithArising []
+ = panic "pprWithArising"
+pprWithArising (ct:cts)
+ | null cts
+ = addArising (ctLocOrigin loc) (pprTheta [ctPred ct])
+ | otherwise
+ = vcat (map ppr_one (ct:cts))
+ where
+ loc = ctLoc ct
+ ppr_one ct' = hang (parens (pprType (ctPred ct')))
+ 2 (pprCtLoc (ctLoc ct'))
+
+{- *********************************************************************
+* *
+ SkolemInfo
+* *
+**********************************************************************-}
+
+pprSkols :: ReportErrCtxt -> [TcTyVar] -> SDoc
+pprSkols ctxt tvs
+ = vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs))
+ where
+ pp_one (UnkSkol, tvs)
+ = vcat [ hang (pprQuotedList tvs)
+ 2 (is_or_are tvs "a" "(rigid, skolem)")
+ , nest 2 (text "of unknown origin")
+ , nest 2 (text "bound at" <+> ppr (foldr1 combineSrcSpans (map getSrcSpan tvs)))
+ ]
+ pp_one (RuntimeUnkSkol, tvs)
+ = hang (pprQuotedList tvs)
+ 2 (is_or_are tvs "an" "unknown runtime")
+ pp_one (skol_info, tvs)
+ = vcat [ hang (pprQuotedList tvs)
+ 2 (is_or_are tvs "a" "rigid" <+> text "bound by")
+ , nest 2 (pprSkolInfo skol_info)
+ , nest 2 (text "at" <+> ppr (foldr1 combineSrcSpans (map getSrcSpan tvs))) ]
+
+ is_or_are [_] article adjective = text "is" <+> text article <+> text adjective
+ <+> text "type variable"
+ is_or_are _ _ adjective = text "are" <+> text adjective
+ <+> text "type variables"
+
+{- *********************************************************************
+* *
+ Utilities for expected/actual messages
+* *
+**********************************************************************-}
+
+mk_supplementary_ea_msg :: ReportErrCtxt -> TypeOrKind
+ -> Type -> Type -> CtOrigin -> Either [TcReportInfo] TcReportMsg
+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)
+ = mk_ea_msg ctxt Nothing level orig
+ | otherwise
+ = Left []
+
+ea_looks_same :: Type -> Type -> Type -> Type -> Bool
+-- True if the faulting types (ty1, ty2) look the same as
+-- the expected/actual types (exp, act).
+-- If so, we don't want to redundantly report the latter
+ea_looks_same ty1 ty2 exp act
+ = (act `looks_same` ty1 && exp `looks_same` ty2) ||
+ (exp `looks_same` ty1 && act `looks_same` ty2)
+ where
+ looks_same t1 t2 = t1 `pickyEqType` t2
+ || t1 `eqType` liftedTypeKind && t2 `eqType` liftedTypeKind
+ -- pickyEqType is sensitive to synonyms, so only replies True
+ -- 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
+-- Constructs a "Couldn't match" message
+-- The (Maybe Ct) says whether this is the main top-level message (Just)
+-- or a supplementary message (Nothing)
+mk_ea_msg ctxt at_top level
+ (TypeEqOrigin { uo_actual = act, uo_expected = exp, uo_thing = mb_thing })
+ | Just thing <- mb_thing
+ , KindLevel <- level
+ = Right $ KindMismatch { kmismatch_what = thing
+ , kmismatch_expected = exp
+ , kmismatch_actual = act }
+ | Just ct <- at_top
+ , let mismatch =
+ Mismatch
+ { mismatch_ea = True
+ , mismatch_ct = ct
+ , mismatch_ty1 = exp
+ , mismatch_ty2 = act }
+ = Right $
+ if expanded_syns
+ then mkTcReportWithInfo mismatch [ea_expanded]
+ else mismatch
+ | otherwise
+ = Left $
+ if expanded_syns
+ then [ea,ea_expanded]
+ else [ea]
+
+ where
+ ea = ExpectedActual { ea_expected = exp, ea_actual = act }
+ ea_expanded =
+ ExpectedActualAfterTySynExpansion
+ { ea_expanded_expected = expTy1
+ , ea_expanded_actual = expTy2 }
+
+ expanded_syns = cec_expand_syns ctxt
+ && not (expTy1 `pickyEqType` exp && expTy2 `pickyEqType` act)
+ (expTy1, expTy2) = expandSynonymsToMatch exp act
+mk_ea_msg _ _ _ _ = Left []
+
+{- Note [Expanding type synonyms to make types similar]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+In type error messages, if -fprint-expanded-types is used, we want to expand
+type synonyms to make expected and found types as similar as possible, but we
+shouldn't expand types too much to make type messages even more verbose and
+harder to understand. The whole point here is to make the difference in expected
+and found types clearer.
+
+`expandSynonymsToMatch` does this, it takes two types, and expands type synonyms
+only as much as necessary. Given two types t1 and t2:
+
+ * If they're already same, it just returns the types.
+
+ * If they're in form `C1 t1_1 .. t1_n` and `C2 t2_1 .. t2_m` (C1 and C2 are
+ type constructors), it expands C1 and C2 if they're different type synonyms.
+ Then it recursively does the same thing on expanded types. If C1 and C2 are
+ same, then it applies the same procedure to arguments of C1 and arguments of
+ C2 to make them as similar as possible.
+
+ Most important thing here is to keep number of synonym expansions at
+ minimum. For example, if t1 is `T (T3, T5, Int)` and t2 is `T (T5, T3,
+ Bool)` where T5 = T4, T4 = T3, ..., T1 = X, it returns `T (T3, T3, Int)` and
+ `T (T3, T3, Bool)`.
+
+ * Otherwise types don't have same shapes and so the difference is clearly
+ visible. It doesn't do any expansions and show these types.
+
+Note that we only expand top-layer type synonyms. Only when top-layer
+constructors are the same we start expanding inner type synonyms.
+
+Suppose top-layer type synonyms of t1 and t2 can expand N and M times,
+respectively. If their type-synonym-expanded forms will meet at some point (i.e.
+will have same shapes according to `sameShapes` function), it's possible to find
+where they meet in O(N+M) top-layer type synonym expansions and O(min(N,M))
+comparisons. We first collect all the top-layer expansions of t1 and t2 in two
+lists, then drop the prefix of the longer list so that they have same lengths.
+Then we search through both lists in parallel, and return the first pair of
+types that have same shapes. Inner types of these two types with same shapes
+are then expanded using the same algorithm.
+
+In case they don't meet, we return the last pair of types in the lists, which
+has top-layer type synonyms completely expanded. (in this case the inner types
+are not expanded at all, as the current form already shows the type error)
+-}
+
+-- | Expand type synonyms in given types only enough to make them as similar as
+-- possible. Returned types are the same in terms of used type synonyms.
+--
+-- To expand all synonyms, see 'Type.expandTypeSynonyms'.
+--
+-- See `ExpandSynsFail` tests in tests testsuite/tests/typecheck/should_fail for
+-- some examples of how this should work.
+expandSynonymsToMatch :: Type -> Type -> (Type, Type)
+expandSynonymsToMatch ty1 ty2 = (ty1_ret, ty2_ret)
+ where
+ (ty1_ret, ty2_ret) = go ty1 ty2
+
+ -- | Returns (type synonym expanded version of first type,
+ -- type synonym expanded version of second type)
+ go :: Type -> Type -> (Type, Type)
+ go t1 t2
+ | t1 `pickyEqType` t2 =
+ -- Types are same, nothing to do
+ (t1, t2)
+
+ go (TyConApp tc1 tys1) (TyConApp tc2 tys2)
+ | tc1 == tc2
+ , tys1 `equalLength` tys2 =
+ -- Type constructors are same. They may be synonyms, but we don't
+ -- expand further. The lengths of tys1 and tys2 must be equal;
+ -- for example, with type S a = a, we don't want
+ -- to zip (S Monad Int) and (S Bool).
+ let (tys1', tys2') =
+ unzip (zipWithEqual "expandSynonymsToMatch" go tys1 tys2)
+ in (TyConApp tc1 tys1', TyConApp tc2 tys2')
+
+ go (AppTy t1_1 t1_2) (AppTy t2_1 t2_2) =
+ let (t1_1', t2_1') = go t1_1 t2_1
+ (t1_2', t2_2') = go t1_2 t2_2
+ in (mkAppTy t1_1' t1_2', mkAppTy t2_1' t2_2')
+
+ go ty1@(FunTy _ w1 t1_1 t1_2) ty2@(FunTy _ w2 t2_1 t2_2) | w1 `eqType` w2 =
+ let (t1_1', t2_1') = go t1_1 t2_1
+ (t1_2', t2_2') = go t1_2 t2_2
+ in ( ty1 { ft_arg = t1_1', ft_res = t1_2' }
+ , ty2 { ft_arg = t2_1', ft_res = t2_2' })
+
+ go (ForAllTy b1 t1) (ForAllTy b2 t2) =
+ -- NOTE: We may have a bug here, but we just can't reproduce it easily.
+ -- See D1016 comments for details and our attempts at producing a test
+ -- case. Short version: We probably need RnEnv2 to really get this right.
+ let (t1', t2') = go t1 t2
+ in (ForAllTy b1 t1', ForAllTy b2 t2')
+
+ go (CastTy ty1 _) ty2 = go ty1 ty2
+ go ty1 (CastTy ty2 _) = go ty1 ty2
+
+ go t1 t2 =
+ -- See Note [Expanding type synonyms to make types similar] for how this
+ -- works
+ let
+ t1_exp_tys = t1 : tyExpansions t1
+ t2_exp_tys = t2 : tyExpansions t2
+ t1_exps = length t1_exp_tys
+ t2_exps = length t2_exp_tys
+ dif = abs (t1_exps - t2_exps)
+ in
+ followExpansions $
+ zipEqual "expandSynonymsToMatch.go"
+ (if t1_exps > t2_exps then drop dif t1_exp_tys else t1_exp_tys)
+ (if t2_exps > t1_exps then drop dif t2_exp_tys else t2_exp_tys)
+
+ -- | Expand the top layer type synonyms repeatedly, collect expansions in a
+ -- list. The list does not include the original type.
+ --
+ -- Example, if you have:
+ --
+ -- type T10 = T9
+ -- type T9 = T8
+ -- ...
+ -- type T0 = Int
+ --
+ -- `tyExpansions T10` returns [T9, T8, T7, ... Int]
+ --
+ -- This only expands the top layer, so if you have:
+ --
+ -- type M a = Maybe a
+ --
+ -- `tyExpansions (M T10)` returns [Maybe T10] (T10 is not expanded)
+ tyExpansions :: Type -> [Type]
+ tyExpansions = unfoldr (\t -> (\x -> (x, x)) `fmap` tcView t)
+
+ -- | Drop the type pairs until types in a pair look alike (i.e. the outer
+ -- constructors are the same).
+ followExpansions :: [(Type, Type)] -> (Type, Type)
+ followExpansions [] = pprPanic "followExpansions" empty
+ followExpansions [(t1, t2)]
+ | sameShapes t1 t2 = go t1 t2 -- expand subtrees
+ | otherwise = (t1, t2) -- the difference is already visible
+ followExpansions ((t1, t2) : tss)
+ -- Traverse subtrees when the outer shapes are the same
+ | sameShapes t1 t2 = go t1 t2
+ -- Otherwise follow the expansions until they look alike
+ | otherwise = followExpansions tss
+
+ sameShapes :: Type -> Type -> Bool
+ sameShapes AppTy{} AppTy{} = True
+ sameShapes (TyConApp tc1 _) (TyConApp tc2 _) = tc1 == tc2
+ sameShapes (FunTy {}) (FunTy {}) = True
+ sameShapes (ForAllTy {}) (ForAllTy {}) = True
+ sameShapes (CastTy ty1 _) ty2 = sameShapes ty1 ty2
+ sameShapes ty1 (CastTy ty2 _) = sameShapes ty1 ty2
+ sameShapes _ _ = False
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index f9de50f37a05..8fa8e02b5eca 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -31,22 +31,43 @@ module GHC.Tc.Errors.Types (
, associatedTyLastVarInKind
, AssociatedTyNotParamOverLastTyVar(..)
, associatedTyNotParamOverLastTyVar
+
+ , SolverReport(..), SolverReportSupplementary(..)
+ , ReportWithCtxt(..)
+ , ReportErrCtxt(..)
+ , getUserGivens, discardProvCtxtGivens, getSkolemInfo
+ , TcReportMsg(..), TcReportInfo(..)
+ , CND_Extra(..)
+ , mkTcReportWithInfo
+ , FitsMbSuppressed(..)
+ , ValidHoleFits(..), noValidHoleFits
+ , HoleFitDispConfig(..)
+ , RelevantBindings(..), pprRelevantBindings
+ , NotInScopeError(..), mkTcRnNotInScope
+ , ImportError(..)
+ , HoleError(..)
+ , CoercibleMsg(..)
+ , PotentialInstances(..)
) where
import GHC.Prelude
import GHC.Hs
import {-# SOURCE #-} GHC.Tc.Types (TcIdSigInfo)
+import {-# SOURCE #-} GHC.Tc.Errors.Hole.FitTypes (HoleFit)
import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.Evidence (EvBindsVar)
+import GHC.Tc.Types.Origin (CtOrigin (ProvCtxtOrigin), TypedThing, TyVarBndrs, SkolemInfo (SigSkol, UnkSkol, RuntimeUnkSkol), FRROrigin, UserTypeCtxt (PatSynCtxt))
import GHC.Tc.Types.Rank (Rank)
-import GHC.Tc.Utils.TcType (TcType)
+import GHC.Tc.Utils.TcType (TcType, isRuntimeUnkSkol)
import GHC.Types.Error
import GHC.Types.FieldLabel (FieldLabelString)
-import GHC.Types.Name (Name, OccName)
+import GHC.Types.Name (Name, OccName, getSrcLoc)
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import GHC.Types.TyThing (TyThing)
-import GHC.Types.Var (Id)
+import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar)
+import GHC.Types.Var.Env (TidyEnv)
import GHC.Types.Var.Set (TyVarSet, VarSet)
import GHC.Unit.Types (Module)
import GHC.Utils.Outputable
@@ -61,10 +82,14 @@ import GHC.Core.Type (Kind, Type, ThetaType, PredType)
import GHC.Unit.State (UnitState)
import GHC.Unit.Module.Name (ModuleName)
import GHC.Types.Basic
+import GHC.Utils.Misc (filterOut)
+import GHC.Utils.Trace (pprTraceUserWarning)
import qualified GHC.LanguageExtensions as LangExt
import qualified Data.List.NonEmpty as NE
import Data.Typeable hiding (TyCon)
+import qualified Data.Semigroup as Semigroup
+import Data.List (partition)
{-
Note [Migrating TcM Messages]
@@ -138,6 +163,50 @@ data TcRnMessage where
-> !TcRnMessageDetailed
-> TcRnMessage
+ {-| 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
+ of the different errors.
+ -}
+ TcRnSolverReport :: [ReportWithCtxt]
+ -> DiagnosticReason
+ -> [GhcHint]
+ -> TcRnMessage
+ -- TODO: split up TcRnSolverReport into several components,
+ -- so that we can compute the reason and hints, as opposed
+ -- to having to pass them here.
+
+ {-| TcRnRedundantConstraints is a warning that is emitted when a binding
+ has a user-written type signature which contains superfluous constraints.
+
+ Example:
+
+ f :: (Eq a, Ord a) => a -> a -> a
+ f x y = (x < y) || x == y
+ -- `Eq a` is superfluous: the `Ord a` constraint suffices.
+
+ Test cases: T9939, T10632, T18036a, T20602, PluralS, T19296.
+ -}
+ TcRnRedundantConstraints :: [Id] -> (SkolemInfo, Bool) -> TcRnMessage
+
+ {-| TcRnInaccessibleCode is a warning that is emitted when the RHS of a pattern
+ match is inaccessible, because the constraint solver has detected a contradiction.
+
+ Example:
+
+ data B a where { MkTrue :: B True; MkFalse :: B False }
+
+ foo :: B False -> Bool
+ foo MkFalse = False
+ foo MkTrue = True -- Inaccessible: requires True ~ False
+
+ Test cases: T7293, T7294, T15558, T17646, T18572, T18610, tcfail167.
+ -}
+ TcRnInaccessibleCode :: Implication -- ^ The implication containing a contradiction.
+ -> NE.NonEmpty ReportWithCtxt -- ^ The contradiction(s).
+ -> TcRnMessage
+
{-| A type which was expected to have a fixed runtime representation
does not have a fixed runtime representation.
@@ -1416,7 +1485,7 @@ data TcRnMessage where
-}
TcRnArrowProcGADTPattern :: TcRnMessage
- {- TcRnForallIdentifier is a warning (controlled with -Wforall-identifier) that occurs
+ {-| TcRnForallIdentifier is a warning (controlled with -Wforall-identifier) that occurs
when a definition uses 'forall' as an identifier.
Example:
@@ -1435,6 +1504,60 @@ data TcRnMessage where
Test cases: T20485, T20485a
-}
TcRnGADTMonoLocalBinds :: TcRnMessage
+ {-| The TcRnNotInScope constructor is used for various not-in-scope errors.
+ See 'NotInScopeError' for more details. -}
+ TcRnNotInScope :: NotInScopeError -- ^ what the problem is
+ -> RdrName -- ^ the name that is not in scope
+ -> [ImportError] -- ^ import errors that are relevant
+ -> [GhcHint] -- ^ hints, e.g. enable DataKinds to refer to a promoted data constructor
+ -> TcRnMessage
+
+ {-| TcRnUntickedPromotedConstructor is a warning (controlled with -Wunticked-promoted-constructors
+ that is triggered by an unticked occurrence of a promoted data constructor.
+
+ Example:
+
+ data A = MkA
+ type family F (a :: A) where { F MkA = Bool }
+
+ Test case: T9778.
+ -}
+ TcRnUntickedPromotedConstructor :: Name
+ -> TcRnMessage
+
+ {-| TcRnIllegalBuiltinSyntax is an error that occurs when built-in syntax appears
+ in an unexpected location, e.g. as a data constructor or in a fixity declaration.
+
+ Examples:
+
+ infixl 5 :
+
+ data P = (,)
+
+ Test cases: rnfail042, T14907b, T15124, T15233.
+ -}
+ TcRnIllegalBuiltinSyntax :: SDoc -- ^ what kind of thing this is (a binding, fixity declaration, ...)
+ -> RdrName
+ -> TcRnMessage
+ -- TODO: remove the SDoc argument.
+
+ {-| TcRnWarnDefaulting is a warning (controlled by -Wtype-defaults)
+ that is triggered whenever a Wanted typeclass constraint
+ is solving through the defaulting of a type variable.
+
+ Example:
+
+ one = show 1
+ -- We get Wanteds Show a0, Num a0, and default a0 to Integer.
+
+ Test cases:
+ none (which are really specific to defaulting),
+ but see e.g. tcfail204.
+ -}
+ TcRnWarnDefaulting :: [Ct] -- ^ Wanted constraints in which defaulting occurred
+ -> Maybe TyVar -- ^ The type variable being defaulted
+ -> Type -- ^ The default type
+ -> TcRnMessage
{-| TcRnIncorrectNameSpace is an error that occurs when a 'Name'
is used in the incorrect 'NameSpace', e.g. a type constructor
@@ -1703,3 +1826,590 @@ data AssociatedTyNotParamOverLastTyVar
associatedTyNotParamOverLastTyVar :: Maybe TyCon -> AssociatedTyNotParamOverLastTyVar
associatedTyNotParamOverLastTyVar (Just tc) = YesAssociatedTyNotParamOverLastTyVar tc
associatedTyNotParamOverLastTyVar Nothing = NoAssociatedTyNotParamOverLastTyVar
+
+--------------------------------------------------------------------------------
+-- Errors used in GHC.Tc.Errors
+
+{- Note [Error report]
+~~~~~~~~~~~~~~~~~~~~~~
+The idea is that error msgs are divided into three parts: the main msg, the
+context block ("In the second argument of ..."), and the relevant bindings
+block, which are displayed in that order, with a mark to divide them. The
+the main msg ('report_important') varies depending on the error
+in question, but context and relevant bindings are always the same, which
+should simplify visual parsing.
+
+See 'GHC.Tc.Errors.Types.SolverReport' and 'GHC.Tc.Errors.mkErrorReport'.
+-}
+
+-- | A collection of main error messages and supplementary information.
+--
+-- In practice, we will:
+-- - display the important messages first,
+-- - then the error context (e.g. by way of a call to 'GHC.Tc.Errors.mkErrorReport'),
+-- - then the supplementary information (e.g. relevant bindings, valid hole fits),
+-- - then the hints ("Possible fix: ...").
+--
+-- So this is mostly just a way of making sure that the error context appears
+-- early on rather than at the end of the message.
+--
+-- See Note [Error report] for details.
+data SolverReport
+ = SolverReport
+ { sr_important_msgs :: [ReportWithCtxt]
+ , sr_supplementary :: [SolverReportSupplementary]
+ , sr_hints :: [GhcHint]
+ }
+
+-- | Additional information to print in a 'SolverReport', after the
+-- important messages and after the error context.
+--
+-- See Note [Error report].
+data SolverReportSupplementary
+ = SupplementaryBindings RelevantBindings
+ | SupplementaryHoleFits ValidHoleFits
+ | SupplementaryCts [(PredType, RealSrcSpan)]
+
+-- | A 'TcReportMsg', together with context (e.g. enclosing implication constraints)
+-- that are needed in order to report it.
+data ReportWithCtxt =
+ ReportWithCtxt
+ { reportContext :: ReportErrCtxt
+ -- ^ Context for what we wish to report.
+ -- This can change as we enter implications, so is
+ -- stored alongside the content.
+ , reportContent :: TcReportMsg
+ -- ^ The content of the message to report.
+ }
+
+instance Semigroup SolverReport where
+ SolverReport main1 supp1 hints1 <> SolverReport main2 supp2 hints2
+ = SolverReport (main1 ++ main2) (supp1 ++ supp2) (hints1 ++ hints2)
+
+instance Monoid SolverReport where
+ mempty = SolverReport [] [] []
+ mappend = (Semigroup.<>)
+
+-- | Context needed when reporting a 'TcReportMsg', such as
+-- the enclosing implication constraints or whether we are deferring type errors.
+data ReportErrCtxt
+ = CEC { cec_encl :: [Implication] -- | Enclosing implications
+ -- (innermost first)
+ -- ic_skols and givens are tidied, rest are not
+ , cec_tidy :: TidyEnv
+
+ , cec_binds :: EvBindsVar -- Make some errors (depending on cec_defer)
+ -- into warnings, and emit evidence bindings
+ -- into 'cec_binds' for unsolved constraints
+
+ , cec_defer_type_errors :: DiagnosticReason -- Defer type errors until runtime
+
+ -- cec_expr_holes is a union of:
+ -- cec_type_holes - a set of typed holes: '_', '_a', '_foo'
+ -- cec_out_of_scope_holes - a set of variables which are
+ -- out of scope: 'x', 'y', 'bar'
+ , cec_expr_holes :: DiagnosticReason -- Holes in expressions.
+ , cec_type_holes :: DiagnosticReason -- Holes in types.
+ , cec_out_of_scope_holes :: DiagnosticReason -- Out of scope holes.
+
+ , cec_warn_redundant :: Bool -- | True <=> -Wredundant-constraints
+ , cec_expand_syns :: Bool -- | True <=> -fprint-expanded-synonyms
+
+ , cec_suppress :: Bool -- | True <=> More important errors have occurred,
+ -- so create bindings if need be, but
+ -- don't issue any more errors/warnings
+ -- See Note [Suppressing error messages]
+ }
+
+getUserGivens :: ReportErrCtxt -> [UserGiven]
+-- One item for each enclosing implication
+getUserGivens (CEC {cec_encl = implics}) = getUserGivensFromImplics implics
+
+
+{- Note [discardProvCtxtGivens]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In most situations we call all enclosing implications "useful". There is one
+exception, and that is when the constraint that causes the error is from the
+"provided" context of a pattern synonym declaration:
+
+ pattern Pat :: (Num a, Eq a) => Show a => a -> Maybe a
+ -- required => provided => type
+ pattern Pat x <- (Just x, 4)
+
+When checking the pattern RHS we must check that it does actually bind all
+the claimed "provided" constraints; in this case, does the pattern (Just x, 4)
+bind the (Show a) constraint. Answer: no!
+
+But the implication we generate for this will look like
+ forall a. (Num a, Eq a) => [W] Show a
+because when checking the pattern we must make the required
+constraints available, since they are needed to match the pattern (in
+this case the literal '4' needs (Num a, Eq a)).
+
+BUT we don't want to suggest adding (Show a) to the "required" constraints
+of the pattern synonym, thus:
+ pattern Pat :: (Num a, Eq a, Show a) => Show a => a -> Maybe a
+It would then typecheck but it's silly. We want the /pattern/ to bind
+the alleged "provided" constraints, Show a.
+
+So we suppress that Implication in discardProvCtxtGivens. It's
+painfully ad-hoc but the truth is that adding it to the "required"
+constraints would work. Suppressing it solves two problems. First,
+we never tell the user that we could not deduce a "provided"
+constraint from the "required" context. Second, we never give a
+possible fix that suggests to add a "provided" constraint to the
+"required" context.
+
+For example, without this distinction the above code gives a bad error
+message (showing both problems):
+
+ error: Could not deduce (Show a) ... from the context: (Eq a)
+ ... Possible fix: add (Show a) to the context of
+ the signature for pattern synonym `Pat' ...
+-}
+
+
+discardProvCtxtGivens :: CtOrigin -> [UserGiven] -> [UserGiven]
+discardProvCtxtGivens orig givens -- See Note [discardProvCtxtGivens]
+ | ProvCtxtOrigin (PSB {psb_id = L _ name}) <- orig
+ = filterOut (discard name) givens
+ | otherwise
+ = givens
+ where
+ discard n (Implic { ic_info = SigSkol (PatSynCtxt n') _ _ }) = n == n'
+ discard _ _ = False
+
+
+getSkolemInfo :: [Implication] -> [TcTyVar]
+ -> [(SkolemInfo, [TcTyVar])] -- #14628
+-- Get the skolem info for some type variables
+-- from the implication constraints that bind them.
+--
+-- In the returned (skolem, tvs) pairs, the 'tvs' part is non-empty
+getSkolemInfo _ []
+ = []
+
+getSkolemInfo [] tvs
+ | all isRuntimeUnkSkol tvs = [(RuntimeUnkSkol, tvs)] -- #14628
+ | otherwise = -- See https://gitlab.haskell.org/ghc/ghc/-/issues?label_name[]=No%20skolem%20info
+ pprTraceUserWarning msg [(UnkSkol,tvs)]
+ where
+ msg = text "No skolem info - we could not find the origin of the following variables" <+> ppr tvs
+ $$ text "This should not happen, please report it as a bug following the instructions at:"
+ $$ text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug"
+
+
+getSkolemInfo (implic:implics) tvs
+ | null tvs_here = getSkolemInfo implics tvs
+ | otherwise = (ic_info implic, tvs_here) : getSkolemInfo implics tvs_other
+ where
+ (tvs_here, tvs_other) = partition (`elem` ic_skols implic) tvs
+
+-- | 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
+ -- 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!
+
+ -- | Wrap a message with additional information.
+ --
+ -- Prefer using the 'mkTcReportWithInfo' smart constructor
+ = TcReportWithInfo TcReportMsg (NE.NonEmpty TcReportInfo)
+
+ -- | Quantified variables appear out of dependency order.
+ --
+ -- Example:
+ --
+ -- forall (a :: k) k. ...
+ --
+ -- Test cases: BadTelescope2, T16418, T16247, T16726, T18451.
+ | BadTelescope TyVarBndrs [TyCoVar]
+
+ -- | We came across a custom type error and we have decided to report it.
+ --
+ -- Example:
+ --
+ -- type family F a where
+ -- F a = TypeError (Text "error")
+ --
+ -- err :: F ()
+ -- err = ()
+ --
+ -- Test cases: CustomTypeErrors0{1,2,3,4,5}, T12104.
+ | UserTypeError Type
+
+ -- | We want to report an out of scope variable or a typed hole.
+ -- See 'HoleError'.
+ | ReportHoleError Hole HoleError
+
+ -- | A type equality between a type variable and a polytype.
+ --
+ -- Test cases: T12427a, T2846b, T10194, ...
+ | CannotUnifyWithPolytype Ct TyVar Type
+
+ -- | Couldn't unify two types or kinds.
+ --
+ -- Example:
+ --
+ -- 3 + 3# -- can't match a lifted type with an unlifted type
+ --
+ -- Test cases: T1396, T8263, ...
+ | Mismatch
+ { mismatch_ea :: Bool -- ^ Should this be phrased in terms of expected vs actual?
+ , mismatch_ct :: Ct -- ^ The constraint in which the mismatch originated.
+ , mismatch_ty1 :: Type -- ^ First type (the expected type if if mismatch_ea is True)
+ , mismatch_ty2 :: Type -- ^ Second type (the actual type if mismatch_ea is True)
+ }
+
+ -- | A type has an unexpected kind.
+ --
+ -- Test cases: T2994, T7609, ...
+ | KindMismatch
+ { kmismatch_what :: TypedThing -- ^ What thing is 'kmismatch_actual' the kind of?
+ , kmismatch_expected :: Type
+ , kmismatch_actual :: Type
+ }
+ -- TODO: combine 'Mismatch' and 'KindMismatch' messages.
+
+ -- | A mismatch between two types, which arose from a type equality.
+ --
+ -- Test cases: T1470, tcfail212.
+ | TypeEqMismatch
+ { teq_mismatch_ppr_explicit_kinds :: Bool
+ , teq_mismatch_ct :: Ct
+ , teq_mismatch_ty1 :: Type
+ , teq_mismatch_ty2 :: Type
+ , teq_mismatch_expected :: Type -- ^ The overall expected type
+ , teq_mismatch_actual :: Type -- ^ The overall actual type
+ , teq_mismatch_what :: Maybe TypedThing -- ^ What thing is 'teq_mismatch_actual' the kind of?
+ }
+ -- TODO: combine 'Mismatch' and 'TypeEqMismatch' messages.
+
+ -- | A violation of the representation-polymorphism invariants,
+ -- i.e. an unsolved `Concrete# ty` constraint.
+ --
+ -- See 'FRROrigin' for more information.
+ | FixedRuntimeRepError [(FRROrigin, Type)]
+
+ -- | A skolem type variable escapes its scope.
+ --
+ -- Example:
+ --
+ -- data Ex where { MkEx :: a -> MkEx }
+ -- foo (MkEx x) = x
+ --
+ -- Test cases: TypeSkolEscape, T11142.
+ | SkolemEscape Ct Implication [TyVar]
+
+ -- | Trying to unify an untouchable variable, e.g. a variable from an outer scope.
+ --
+ -- Test case: Simple14
+ | UntouchableVariable TyVar Implication
+
+ -- | An equality between two types is blocked on a kind equality
+ -- beteen their kinds.
+ --
+ -- Test cases: none.
+ | BlockedEquality Ct
+
+ -- | Something was not applied to sufficiently many arguments.
+ --
+ -- Example:
+ --
+ -- instance Eq Maybe where {..}
+ --
+ -- Test case: T11563.
+ | ExpectingMoreArguments Int TypedThing
+
+ -- | Trying to use an unbound implicit parameter.
+ --
+ -- Example:
+ --
+ -- foo :: Int
+ -- foo = ?param
+ --
+ -- Test case: tcfail130.
+ | UnboundImplicitParams
+ (NE.NonEmpty Ct)
+
+ -- | Couldn't solve some Wanted constraints using the Givens.
+ -- This is the most commonly used constructor, used for generic
+ -- @"No instance for ..."@ and @"Could not deduce ... from"@ messages.
+ | CouldNotDeduce
+ { cnd_user_givens :: [Implication]
+ -- | The Wanted constraints we couldn't solve.
+ --
+ -- N.B.: the 'Ct' at the head of the list has been tidied,
+ -- perhaps not the others.
+ , cnd_wanted :: NE.NonEmpty Ct
+
+ -- | Some additional info consumed by 'mk_supplementary_ea_msg'.
+ , cnd_extra :: Maybe CND_Extra
+ }
+
+ -- | A constraint couldn't be solved because it contains
+ -- ambiguous type variables.
+ --
+ -- Example:
+ --
+ -- class C a b where
+ -- f :: (a,b)
+ --
+ -- x = fst f
+ --
+ --
+ -- Test case: T4921.
+ | AmbiguityPreventsSolvingCt
+ Ct -- ^ always a class constraint
+ ([TyVar], [TyVar]) -- ^ ambiguous kind and type variables, respectively
+
+ -- | Could not solve a constraint; there were several unifying candidate instances
+ -- but no matching instances. This is used to report as much useful information
+ -- as possible about why we couldn't choose any instance, e.g. because of
+ -- ambiguous type variables.
+ | CannotResolveInstance
+ { cannotResolve_ct :: Ct
+ , cannotResolve_unifiers :: [ClsInst]
+ , cannotResolve_candidates :: [ClsInst]
+ , cannotResolve_importErrors :: [ImportError]
+ , cannotResolve_suggestions :: [GhcHint]
+ , cannotResolve_relevant_bindings :: RelevantBindings }
+ -- TODO: remove the fields of type [GhcHint] and RelevantBindings,
+ -- in order to handle them uniformly with other diagnostic messages.
+
+ -- | Could not solve a constraint using available instances
+ -- because the instances overlap.
+ --
+ -- Test cases: tcfail118, tcfail121, tcfail218.
+ | OverlappingInstances
+ { overlappingInstances_ct :: Ct
+ , overlappingInstances_matches :: [ClsInst]
+ , overlappingInstances_unifiers :: [ClsInst] }
+
+ -- | Could not solve a constraint from instances because
+ -- instances declared in a Safe module cannot overlap instances
+ -- from other modules (with -XSafeHaskell).
+ --
+ -- Test cases: SH_Overlap{1,2,5,6,7,11}.
+ | UnsafeOverlap
+ { unsafeOverlap_ct :: Ct
+ , unsafeOverlap_matches :: [ClsInst]
+ , unsafeOverlapped :: [ClsInst] }
+
+-- | Additional information to be given in a 'CouldNotDeduce' message,
+-- 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
+ -- 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'.
+ -- If you see possible improvements, please go right ahead!
+
+ -- | Some type variables remained ambiguous: print them to the user.
+ = Ambiguity
+ { lead_with_ambig_msg :: Bool -- ^ True <=> start the message with "Ambiguous type variable ..."
+ -- False <=> create a message of the form "The type variable is ambiguous."
+ , ambig_tyvars :: ([TyVar], [TyVar]) -- ^ Ambiguous kind and type variables, respectively.
+ -- Guaranteed to not both be empty.
+ }
+
+ -- | Specify some information about a type variable,
+ -- e.g. its 'SkolemInfo'.
+ | TyVarInfo TyVar
+
+ -- | Remind the user that a particular type family is not injective.
+ | NonInjectiveTyFam TyCon
+
+ -- | Explain why we couldn't coerce between two types. See 'CoercibleMsg'.
+ | ReportCoercibleMsg CoercibleMsg
+
+ -- | Display the expected and actual types.
+ | ExpectedActual
+ { ea_expected, ea_actual :: Type }
+
+ -- | Display the expected and actual types, after expanding type synonyms.
+ | ExpectedActualAfterTySynExpansion
+ { ea_expanded_expected, ea_expanded_actual :: Type }
+
+ -- | Explain how a kind equality originated.
+ | WhenMatching TcType TcType CtOrigin (Maybe TypeOrKind)
+
+ -- | Add some information to disambiguate errors in which
+ -- two 'Names' would otherwise appear to be identical.
+ --
+ -- See Note [Disambiguating (X ~ X) errors].
+ | SameOcc
+ { sameOcc_same_pkg :: Bool -- ^ Whether the two 'Name's also came from the same package.
+ , sameOcc_lhs :: Name
+ , sameOcc_rhs :: Name }
+
+ -- | Report some type variables that might be participating in an occurs-check failure.
+ | OccursCheckInterestingTyVars (NE.NonEmpty TyVar)
+
+-- | Some form of @"not in scope"@ error. See also the 'OutOfScopeHole'
+-- constructor of 'HoleError'.
+data NotInScopeError
+
+ -- | A run-of-the-mill @"not in scope"@ error.
+ = NotInScope
+
+ -- | An exact 'Name' was not in scope.
+ --
+ -- This usually indicates a problem with a Template Haskell splice.
+ --
+ -- Test cases: T5971, T18263.
+ | NoExactName Name
+
+ -- The same exact 'Name' occurs in multiple name-spaces.
+ --
+ -- This usually indicates a problem with a Template Haskell splice.
+ --
+ -- Test case: T7241.
+ | SameName [GlobalRdrElt] -- ^ always at least 2 elements
+
+ -- A type signature, fixity declaration, pragma, standalone kind signature...
+ -- is missing an associated binding.
+ | MissingBinding SDoc [GhcHint]
+ -- TODO: remove the SDoc argument.
+
+ -- | Couldn't find a top-level binding.
+ --
+ -- Happens when specifying an annotation for something that
+ -- is not in scope.
+ --
+ -- Test cases: annfail01, annfail02, annfail11.
+ | NoTopLevelBinding
+
+ -- | A class doesnt have a method with this name,
+ -- or, a class doesn't have an associated type with this name,
+ -- or, a record doesn't have a record field with this name.
+ | UnknownSubordinate SDoc
+
+-- | Create a @"not in scope"@ error message for the given 'RdrName'.
+mkTcRnNotInScope :: RdrName -> NotInScopeError -> TcRnMessage
+mkTcRnNotInScope rdr err = TcRnNotInScope err rdr [] noHints
+
+-- | Configuration for pretty-printing valid hole fits.
+data HoleFitDispConfig =
+ HFDC { showWrap, showWrapVars, showType, showProv, showMatches
+ :: Bool }
+
+-- | Report an error involving a 'Hole'.
+--
+-- This could be an out of scope data constructor or variable,
+-- a typed hole, or a wildcard in a type.
+data HoleError
+ -- | Report an out-of-scope data constructor or variable
+ -- masquerading as an expression hole.
+ --
+ -- See Note [Insoluble holes] in GHC.Tc.Types.Constraint.
+ -- See 'NotInScopeError' for other not-in-scope errors.
+ --
+ -- Test cases: T9177a.
+ = OutOfScopeHole [ImportError]
+ -- | Report a typed hole, or wildcard, with additional information.
+ | HoleError HoleSort
+
+-- | A message that aims to explain why two types couldn't be seen
+-- to be representationally equal.
+data CoercibleMsg
+ -- | Not knowing the role of a type constructor prevents us from
+ -- concluding that two types are representationally equal.
+ --
+ -- Example:
+ --
+ -- foo :: Applicative m => m (Sum Int)
+ -- foo = coerce (pure $ 1 :: Int)
+ --
+ -- We don't know what role `m` has, so we can't coerce `m Int` to `m (Sum Int)`.
+ --
+ -- Test cases: T8984, TcCoercibleFail.
+ = UnknownRoles Type
+
+ -- | The fact that a 'TyCon' is abstract prevents us from decomposing
+ -- a 'TyConApp' and deducing that two types are representationally equal.
+ --
+ -- Test cases: none.
+ | TyConIsAbstract TyCon
+
+ -- | We can't unwrap a newtype whose constructor is not in scope.
+ --
+ -- Example:
+ --
+ -- import Data.Ord (Down) -- NB: not importing the constructor
+ -- foo :: Int -> Down Int
+ -- foo = coerce
+ --
+ -- Test cases: TcCoercibleFail.
+ | OutOfScopeNewtypeConstructor TyCon DataCon
+
+-- | Explain a problem with an import.
+data ImportError
+ -- | Couldn't find a module with the requested name.
+ = MissingModule ModuleName
+ -- | The imported modules don't export what we're looking for.
+ | ModulesDoNotExport (NE.NonEmpty Module) OccName
+
+-- | This datatype collates instances that match or unifier,
+-- in order to report an error message for an unsolved typeclass constraint.
+data PotentialInstances
+ = PotentialInstances
+ { matches :: [ClsInst]
+ , unifiers :: [ClsInst]
+ }
+
+-- | Append additional information to a `TcReportMsg`.
+mkTcReportWithInfo :: TcReportMsg -> [TcReportInfo] -> TcReportMsg
+mkTcReportWithInfo msg []
+ = msg
+mkTcReportWithInfo (TcReportWithInfo msg (prev NE.:| prevs)) infos
+ = TcReportWithInfo msg (prev NE.:| prevs ++ infos)
+mkTcReportWithInfo msg (info : infos)
+ = TcReportWithInfo msg (info NE.:| infos)
+
+-- | A collection of valid hole fits or refinement fits,
+-- in which some fits might have been suppressed.
+data FitsMbSuppressed
+ = Fits
+ { fits :: [HoleFit]
+ , fitsSuppressed :: Bool -- ^ Whether we have suppressed any fits because there were too many.
+ }
+
+-- | A collection of hole fits and refinement fits.
+data ValidHoleFits
+ = ValidHoleFits
+ { holeFits :: FitsMbSuppressed
+ , refinementFits :: FitsMbSuppressed
+ }
+
+noValidHoleFits :: ValidHoleFits
+noValidHoleFits = ValidHoleFits (Fits [] False) (Fits [] False)
+
+data RelevantBindings
+ = RelevantBindings
+ { relevantBindingNamesAndTys :: [(Name, Type)]
+ , ranOutOfFuel :: Bool -- ^ Whether we ran out of fuel generating the bindings.
+ }
+
+-- | Display some relevant bindings.
+pprRelevantBindings :: RelevantBindings -> SDoc
+-- This function should be in "GHC.Tc.Errors.Ppr",
+-- but's it's here for the moment as it's needed in "GHC.Tc.Errors".
+pprRelevantBindings (RelevantBindings bds ran_out_of_fuel) =
+ ppUnless (null bds) $
+ hang (text "Relevant bindings include")
+ 2 (vcat (map ppr_binding bds) $$ ppWhen ran_out_of_fuel discardMsg)
+ where
+ ppr_binding (nm, tidy_ty) =
+ sep [ pprPrefixOcc nm <+> dcolon <+> ppr tidy_ty
+ , nest 2 (parens (text "bound at"
+ <+> ppr (getSrcLoc nm)))]
+
+discardMsg :: SDoc
+discardMsg = text "(Some bindings suppressed;" <+>
+ text "use -fmax-relevant-binds=N or -fno-max-relevant-binds)"
diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs
index 1ee4e957532f..0db2d804a8ed 100644
--- a/compiler/GHC/Tc/Gen/App.hs
+++ b/compiler/GHC/Tc/Gen/App.hs
@@ -862,7 +862,7 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args
go1 delta acc so_far fun_ty
(eva@(EValArg { eva_arg = ValArg arg, eva_ctxt = ctxt }) : rest_args)
= do { (wrap, arg_ty, res_ty) <- matchActualFunTySigma herald
- (Just (ppr rn_fun))
+ (Just $ HsExprRnThing rn_fun)
(n_val_args, so_far) fun_ty
; (delta', arg') <- if do_ql
then addArgCtxt ctxt arg $
@@ -1238,7 +1238,7 @@ qlUnify delta ty1 ty2
-- Passes the occurs check
= do { let ty2_kind = typeKind ty2
kappa_kind = tyVarKind kappa
- ; co <- unifyKind (Just (ppr ty2)) ty2_kind kappa_kind
+ ; co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind
-- unifyKind: see Note [Actual unification in qlUnify]
; traceTc "qlUnify:update" $
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index b6573897e22d..0c1d4faf249c 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -781,7 +781,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left rbnds }) res_
scrut_ty = TcType.substTy scrut_subst con1_res_ty
con1_arg_tys' = map (TcType.substTy result_subst) con1_arg_tys
- ; co_scrut <- unifyType (Just (ppr record_expr)) record_rho scrut_ty
+ ; co_scrut <- unifyType (Just . HsExprRnThing $ unLoc record_expr) record_rho scrut_ty
-- NB: normal unification is OK here (as opposed to subsumption),
-- because for this to work out, both record_rho and scrut_ty have
-- to be normal datatypes -- no contravariant stuff can go on
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index b878a5b45b4c..286eec6e5ca6 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -47,7 +47,6 @@ import GHC.Tc.Utils.Instantiate
import GHC.Tc.Instance.Family ( tcLookupDataFamInst )
import GHC.Core.FamInstEnv ( FamInstEnvs )
import GHC.Core.UsageEnv ( unitUE )
-import GHC.Rename.Utils ( unknownSubordinateErr )
import GHC.Rename.Unbound ( unknownNameSuggestions, WhatLooking(..) )
import GHC.Unit.Module ( getModule )
import GHC.Tc.Errors.Types
@@ -548,8 +547,8 @@ lookupParents is_selector rdr
fieldNotInType :: RecSelParent -> RdrName -> TcRnMessage
fieldNotInType p rdr
- = TcRnUnknownMessage $ mkPlainError noHints $
- unknownSubordinateErr (text "field of type" <+> quotes (ppr p)) rdr
+ = mkTcRnNotInScope rdr $
+ UnknownSubordinate (text "field of type" <+> quotes (ppr p))
notSelector :: Name -> TcRnMessage
notSelector field
@@ -676,10 +675,10 @@ tcInferOverLit lit@(OverLit { ol_val = val
do { from_id <- tcLookupId from_name
; (wrap1, from_ty) <- topInstantiate orig (idType from_id)
- ; (wrap2, sarg_ty, res_ty) <- matchActualFunTySigma herald mb_doc
+ ; (wrap2, sarg_ty, res_ty) <- matchActualFunTySigma herald mb_thing
(1, []) from_ty
; hs_lit <- mkOverLit val
- ; co <- unifyType mb_doc (hsLitType hs_lit) (scaledThing sarg_ty)
+ ; co <- unifyType mb_thing (hsLitType hs_lit) (scaledThing sarg_ty)
; let lit_expr = L (l2l loc) $ mkHsWrapCo co $
HsLit noAnn hs_lit
@@ -691,9 +690,9 @@ tcInferOverLit lit@(OverLit { ol_val = val
, ol_type = res_ty } }
; return (HsOverLit noAnn lit', res_ty) }
where
- orig = LiteralOrigin lit
- mb_doc = Just (ppr from_name)
- herald = sep [ text "The function" <+> quotes (ppr from_name)
+ orig = LiteralOrigin lit
+ mb_thing = Just (NameThing from_name)
+ herald = sep [ text "The function" <+> quotes (ppr from_name)
, text "is applied to"]
@@ -760,25 +759,29 @@ tc_infer_id id_name
ppr thing <+> text "used where a value identifier was expected" }
where
fail_tycon tc = do
- gre <- getGlobalRdrEnv
- suggestions <- get_suggestions dataName
- unit_state <- hsc_units <$> getTopEnv
- let pprov = case lookupGRE_Name gre (tyConName tc) of
+ gre <- getGlobalRdrEnv
+ let nm = tyConName tc
+ pprov = case lookupGRE_Name gre nm of
Just gre -> nest 2 (pprNameProvenance gre)
Nothing -> empty
- info = ErrInfo { errInfoContext = pprov, errInfoSupplementary = suggestions }
- msg = TcRnMessageWithInfo unit_state
- $ TcRnMessageDetailed info (TcRnIncorrectNameSpace (tyConName tc) False)
- failWithTc msg
-
- fail_tyvar name = do
- suggestions <- get_suggestions varName
- unit_state <- hsc_units <$> getTopEnv
- let pprov = nest 2 (text "bound at" <+> ppr (getSrcLoc name))
- info = ErrInfo { errInfoContext = pprov, errInfoSupplementary = suggestions }
- msg = TcRnMessageWithInfo unit_state
- $ TcRnMessageDetailed info (TcRnIncorrectNameSpace name False)
- failWithTc msg
+ fail_with_msg dataName nm pprov
+
+ fail_tyvar nm =
+ let pprov = nest 2 (text "bound at" <+> ppr (getSrcLoc nm))
+ in fail_with_msg varName nm pprov
+
+ fail_with_msg whatName nm pprov = do
+ (import_errs, hints) <- get_suggestions whatName
+ unit_state <- hsc_units <$> getTopEnv
+ let
+ -- TODO: unfortunate to have to convert to SDoc here.
+ -- This should go away once we refactor ErrInfo.
+ hint_msg = vcat $ map ppr hints
+ import_err_msg = vcat $ map ppr import_errs
+ info = ErrInfo { errInfoContext = pprov, errInfoSupplementary = import_err_msg $$ hint_msg }
+ msg = TcRnMessageWithInfo unit_state
+ $ TcRnMessageDetailed info (TcRnIncorrectNameSpace nm False)
+ failWithTc msg
get_suggestions ns = do
let occ = mkOccNameFS ns (occNameFS (occName id_name))
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index b5386aa6a793..c9024a5cf5a2 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -1668,7 +1668,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args
(HsValArg _ : _, Nothing)
-> try_again_after_substing_or $
do { let arrows_needed = n_initial_val_args all_args
- ; co <- matchExpectedFunKind hs_ty arrows_needed substed_fun_ki
+ ; co <- matchExpectedFunKind (HsTypeRnThing $ unLoc hs_ty) arrows_needed substed_fun_ki
; fun' <- zonkTcType (fun `mkTcCastTy` co)
-- This zonk is essential, to expose the fruits
@@ -1925,7 +1925,7 @@ checkExpectedKind hs_ty ty act_kind exp_kind
; let origin = TypeEqOrigin { uo_actual = act_kind'
, uo_expected = exp_kind
- , uo_thing = Just (ppr hs_ty)
+ , uo_thing = Just (HsTypeRnThing hs_ty)
, uo_visible = True } -- the hs_ty is visible
; traceTc "checkExpectedKindX" $
@@ -2683,7 +2683,7 @@ kcCheckDeclHeader_sig kisig name flav
KindedTyVar _ _ v v_hs_ki -> do
v_ki <- tcLHsKindSig (TyVarBndrKindCtxt (unLoc v)) v_hs_ki
discardResult $ -- See Note [discardResult in kcCheckDeclHeader_sig]
- unifyKind (Just (ppr v))
+ unifyKind (Just . NameThing $ unLoc v)
(tyBinderType tb)
v_ki
@@ -3163,7 +3163,7 @@ tcExplicitTKBndrsX skol_mode bndrs thing_inside
bindExplicitTKBndrsX skol_mode bndrs $
thing_inside
- ; let skol_info = ForAllSkol (fsep (map ppr bndrs))
+ ; let skol_info = ForAllSkol (HsTyVarBndrsRn $ map unLoc bndrs)
-- Notice that we use ForAllSkol here, ignoring the enclosing
-- skol_info unlike tc_implicit_tk_bndrs, because the bad-telescope
-- test applies only to ForAllSkol
@@ -3247,7 +3247,7 @@ bindExplicitTKBndrsX skol_mode@(SM { sm_parent = check_parent, sm_kind = ctxt_ki
, Just (ATyVar _ tv) <- lookupNameEnv lcl_env name
= do { kind <- tc_lhs_kind_sig tc_ki_mode (TyVarBndrKindCtxt name) lhs_kind
; discardResult $
- unifyKind (Just (ppr name)) kind (tyVarKind tv)
+ unifyKind (Just . NameThing $ name) kind (tyVarKind tv)
-- This unify rejects:
-- class C (m :: * -> *) where
-- type F (m :: *) = ...
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 00b2e053f8ff..2fbd7dcf8c1f 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -433,7 +433,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
-- Expression must be a function
; let herald = text "A view pattern expression expects"
; (expr_wrap1, Scaled _mult inf_arg_ty, inf_res_sigma)
- <- matchActualFunTySigma herald (Just (ppr expr)) (1,[]) expr_ty
+ <- matchActualFunTySigma herald (Just . HsExprRnThing $ unLoc expr) (1,[]) expr_ty
-- See Note [View patterns and polymorphism]
-- expr_wrap1 :: expr_ty "->" (inf_arg_ty -> inf_res_sigma)
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 9e7dca9bd4b9..da6054a74fac 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -3191,7 +3191,7 @@ checkFamTelescope tclvl hs_outer_bndrs outer_tvs
| HsOuterExplicit { hso_bndrs = bndrs } <- hs_outer_bndrs
, (b_first : _) <- bndrs
, let b_last = last bndrs
- skol_info = ForAllSkol (fsep (map ppr bndrs))
+ skol_info = ForAllSkol $ HsTyVarBndrsRn (map unLoc bndrs)
= setSrcSpan (combineSrcSpans (getLocA b_first) (getLocA b_last)) $
emitResidualTvConstraint skol_info outer_tvs tclvl emptyWC
| otherwise
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 98fb149c270c..ff44f1864e0f 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -898,7 +898,7 @@ tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity
-- is compatible with the explicit signature (or Type, if there
-- is none)
; let hs_lhs = nlHsTyConApp fixity (getName fam_tc) hs_pats
- ; _ <- unifyKind (Just (ppr hs_lhs)) lhs_applied_kind res_kind
+ ; _ <- unifyKind (Just . HsTypeRnThing $ unLoc hs_lhs) lhs_applied_kind res_kind
; traceTc "tcDataFamInstHeader" $
vcat [ ppr fam_tc, ppr m_ksig, ppr lhs_applied_kind, ppr res_kind ]
diff --git a/compiler/GHC/Tc/Types/Constraint.hs b/compiler/GHC/Tc/Types/Constraint.hs
index 103f0744b61a..955874b13f12 100644
--- a/compiler/GHC/Tc/Types/Constraint.hs
+++ b/compiler/GHC/Tc/Types/Constraint.hs
@@ -25,6 +25,7 @@ module GHC.Tc.Types.Constraint (
ctEvExpr, ctEvTerm, ctEvCoercion, ctEvEvId,
tyCoVarsOfCt, tyCoVarsOfCts,
tyCoVarsOfCtList, tyCoVarsOfCtsList,
+ ambigTkvsOfCt,
CtIrredReason(..), HoleSet, isInsolubleReason,
@@ -49,6 +50,7 @@ module GHC.Tc.Types.Constraint (
Implication(..), implicationPrototype, checkTelescopeSkol,
ImplicStatus(..), isInsolubleStatus, isSolvedStatus,
+ UserGiven, getUserGivensFromImplics,
HasGivenEqs(..),
SubGoalDepth, initialSubGoalDepth, maxSubGoalDepth,
bumpSubGoalDepth, subGoalDepthExceeded,
@@ -114,7 +116,7 @@ import qualified Data.Semigroup ( (<>) )
-- these are for CheckTyEqResult
import Data.Word ( Word8 )
-import Data.List ( intersperse )
+import Data.List ( intersperse, partition )
@@ -741,6 +743,14 @@ tyCoFVsOfHole (Hole { hole_ty = ty }) = tyCoFVsOfType ty
tyCoFVsOfBag :: (a -> FV) -> Bag a -> FV
tyCoFVsOfBag tvs_of = foldr (unionFV . tvs_of) emptyFV
+ambigTkvsOfCt :: Ct -> ([Var],[Var])
+ambigTkvsOfCt ct
+ = partition (`elemVarSet` dep_tkv_set) ambig_tkvs
+ where
+ tkvs = tyCoVarsOfCtList ct
+ ambig_tkvs = filter isAmbiguousTyVar tkvs
+ dep_tkv_set = tyCoVarsOfTypes (map tyVarKind tkvs)
+
---------------------------
dropDerivedWC :: WantedConstraints -> WantedConstraints
-- See Note [Dropping derived constraints]
@@ -1386,6 +1396,12 @@ data HasGivenEqs -- See Note [HasGivenEqs]
-- is possible.
deriving Eq
+type UserGiven = Implication
+
+getUserGivensFromImplics :: [Implication] -> [UserGiven]
+getUserGivensFromImplics implics
+ = reverse (filterOut (null . ic_given) implics)
+
{- Note [HasGivenEqs]
~~~~~~~~~~~~~~~~~~~~~
The GivenEqs data type describes the Given constraints of an implication constraint:
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index d7c68ccd1773..00f1ca10a0a5 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -1,4 +1,6 @@
-
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
@@ -20,6 +22,8 @@ module GHC.Tc.Types.Origin (
isVisibleOrigin, toInvisibleOrigin,
pprCtOrigin, isGivenOrigin,
+ TypedThing(..), TyVarBndrs(..),
+
-- CtOrigin and CallStack
isPushCallStackOrigin, callStackOriginFS,
-- FixedRuntimeRep origin
@@ -212,8 +216,8 @@ data SkolemInfo
-- hence, we have less info
| ForAllSkol -- Bound by a user-written "forall".
- SDoc -- Shows just the binders, used when reporting a bad telescope
- -- See Note [Checking telescopes] in GHC.Tc.Types.Constraint
+ TyVarBndrs -- Shows just the binders, used when reporting a bad telescope
+ -- See Note [Checking telescopes] in GHC.Tc.Types.Constraint
| DerivSkol Type -- Bound by a 'deriving' clause;
-- the type is the instance we are trying to derive
@@ -264,7 +268,7 @@ pprSkolInfo :: SkolemInfo -> SDoc
-- Complete the sentence "is a rigid type variable bound by..."
pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty
pprSkolInfo (SigTypeSkol cx) = pprUserTypeCtxt cx
-pprSkolInfo (ForAllSkol tvs) = text "an explicit forall" <+> tvs
+pprSkolInfo (ForAllSkol tvs) = text "an explicit forall" <+> ppr tvs
pprSkolInfo (IPSkol ips) = text "the implicit-parameter binding" <> plural ips <+> text "for"
<+> pprWithCommas ppr ips
pprSkolInfo (DerivSkol pred) = text "the deriving clause for" <+> quotes (ppr pred)
@@ -358,6 +362,32 @@ in the right place. So we proceed as follows:
************************************************************************
-}
+-- | Some thing which has a type.
+--
+-- This datatype is used when we want to report to the user
+-- that something has an unexpected type.
+data TypedThing
+ = HsTypeRnThing (HsType GhcRn)
+ | TypeThing Type
+ | HsExprRnThing (HsExpr GhcRn)
+ | NameThing Name
+
+-- | Some kind of type variable binder.
+--
+-- Used for reporting errors, in 'SkolemInfo' and 'TcReportMsg'.
+data TyVarBndrs
+ = forall flag. OutputableBndrFlag flag 'Renamed =>
+ HsTyVarBndrsRn [HsTyVarBndr flag GhcRn]
+
+instance Outputable TypedThing where
+ ppr (HsTypeRnThing ty) = ppr ty
+ ppr (TypeThing ty) = ppr ty
+ ppr (HsExprRnThing expr) = ppr expr
+ ppr (NameThing name) = ppr name
+
+instance Outputable TyVarBndrs where
+ ppr (HsTyVarBndrsRn bndrs) = fsep (map ppr bndrs)
+
data CtOrigin
= -- | A given constraint from a user-written type signature. The
-- 'SkolemInfo' inside gives more information.
@@ -404,9 +434,10 @@ data CtOrigin
| SpecPragOrigin UserTypeCtxt -- Specialisation pragma for
-- function or instance
+
| TypeEqOrigin { uo_actual :: TcType
, uo_expected :: TcType
- , uo_thing :: Maybe SDoc
+ , uo_thing :: Maybe TypedThing
-- ^ The thing that has type "actual"
, uo_visible :: Bool
-- ^ Is at least one of the three elements above visible?
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index a0b8106a8db5..aa1a75336922 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -89,7 +89,7 @@ import qualified Data.Semigroup as S ( (<>) )
-- returning an uninstantiated sigma-type
matchActualFunTySigma
:: SDoc -- See Note [Herald for matchExpectedFunTys]
- -> Maybe SDoc -- The thing with type TcSigmaType
+ -> Maybe TypedThing -- The thing with type TcSigmaType
-> (Arity, [Scaled TcSigmaType]) -- Total number of value args in the call, and
-- types of values args to which function has
-- been applied already (reversed)
@@ -190,7 +190,7 @@ Ugh!
-- for example in function application
matchActualFunTysRho :: SDoc -- See Note [Herald for matchExpectedFunTys]
-> CtOrigin
- -> Maybe SDoc -- the thing with type TcSigmaType
+ -> Maybe TypedThing -- the thing with type TcSigmaType
-> Arity
-> TcSigmaType
-> TcM (HsWrapper, [Scaled TcSigmaType], TcRhoType)
@@ -523,7 +523,7 @@ tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpR
tcWrapResultO orig rn_expr expr actual_ty res_ty
= do { traceTc "tcWrapResult" (vcat [ text "Actual: " <+> ppr actual_ty
, text "Expected:" <+> ppr res_ty ])
- ; wrap <- tcSubTypeNC orig GenSigCtxt (Just (ppr rn_expr)) actual_ty res_ty
+ ; wrap <- tcSubTypeNC orig GenSigCtxt (Just $ HsExprRnThing rn_expr) actual_ty res_ty
; return (mkHsWrap wrap expr) }
tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTc
@@ -545,7 +545,7 @@ unifyExpectedType :: HsExpr GhcRn
unifyExpectedType rn_expr act_ty exp_ty
= case exp_ty of
Infer inf_res -> fillInferResult act_ty inf_res
- Check exp_ty -> unifyType (Just (ppr rn_expr)) act_ty exp_ty
+ Check exp_ty -> unifyType (Just $ HsExprRnThing rn_expr) act_ty exp_ty
------------------------
tcSubTypePat :: CtOrigin -> UserTypeCtxt
@@ -566,8 +566,8 @@ tcSubTypePat _ _ (Infer inf_res) ty_expected
---------------
tcSubType :: CtOrigin -> UserTypeCtxt
- -> TcSigmaType -- Actual
- -> ExpRhoType -- Expected
+ -> TcSigmaType -- ^ Actual
+ -> ExpRhoType -- ^ Expected
-> TcM HsWrapper
-- Checks that 'actual' is more polymorphic than 'expected'
tcSubType orig ctxt ty_actual ty_expected
@@ -575,11 +575,11 @@ tcSubType orig ctxt ty_actual ty_expected
do { traceTc "tcSubType" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected])
; tcSubTypeNC orig ctxt Nothing ty_actual ty_expected }
-tcSubTypeNC :: CtOrigin -- Used when instantiating
- -> UserTypeCtxt -- Used when skolemising
- -> Maybe SDoc -- The expression that has type 'actual' (if known)
- -> TcSigmaType -- Actual type
- -> ExpRhoType -- Expected type
+tcSubTypeNC :: CtOrigin -- ^ Used when instantiating
+ -> UserTypeCtxt -- ^ Used when skolemising
+ -> Maybe TypedThing -- ^ The expression that has type 'actual' (if known)
+ -> TcSigmaType -- ^ Actual type
+ -> ExpRhoType -- ^ Expected type
-> TcM HsWrapper
tcSubTypeNC inst_orig ctxt m_thing ty_actual res_ty
= case res_ty of
@@ -1071,7 +1071,7 @@ The exported functions are all defined as versions of some
non-exported generic functions.
-}
-unifyType :: Maybe SDoc -- ^ If present, the thing that has type ty1
+unifyType :: Maybe TypedThing -- ^ If present, the thing that has type ty1
-> TcTauType -> TcTauType -- ty1, ty2
-> TcM TcCoercionN -- :: ty1 ~# ty2
-- Actual and expected types
@@ -1081,7 +1081,7 @@ unifyType thing ty1 ty2
where
origin = TypeEqOrigin { uo_actual = ty1
, uo_expected = ty2
- , uo_thing = ppr <$> thing
+ , uo_thing = thing
, uo_visible = True }
unifyTypeET :: TcTauType -> TcTauType -> TcM CoercionN
@@ -1096,7 +1096,7 @@ unifyTypeET ty1 ty2
, uo_visible = True }
-unifyKind :: Maybe SDoc -> TcKind -> TcKind -> TcM CoercionN
+unifyKind :: Maybe TypedThing -> TcKind -> TcKind -> TcM CoercionN
unifyKind mb_thing ty1 ty2
= uType KindLevel origin ty1 ty2
where
@@ -1820,8 +1820,7 @@ causing this wibble in behavior seen here.
-- | Breaks apart a function kind into its pieces.
matchExpectedFunKind
- :: Outputable fun
- => fun -- ^ type, only for errors
+ :: TypedThing -- ^ type, only for errors
-> Arity -- ^ n: number of desired arrows
-> TcKind -- ^ fun_ kind
-> TcM Coercion -- ^ co :: fun_kind ~ (arg1 -> ... -> argn -> res)
@@ -1852,7 +1851,7 @@ matchExpectedFunKind hs_ty n k = go n k
; let new_fun = mkVisFunTysMany arg_kinds res_kind
origin = TypeEqOrigin { uo_actual = k
, uo_expected = new_fun
- , uo_thing = Just (ppr hs_ty)
+ , uo_thing = Just hs_ty
, uo_visible = True
}
; uType KindLevel origin k new_fun }
diff --git a/compiler/GHC/Tc/Utils/Unify.hs-boot b/compiler/GHC/Tc/Utils/Unify.hs-boot
index 7b4561420cfc..dc8bcce6e8e6 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs-boot
+++ b/compiler/GHC/Tc/Utils/Unify.hs-boot
@@ -4,15 +4,14 @@ import GHC.Prelude
import GHC.Tc.Utils.TcType ( TcTauType )
import GHC.Tc.Types ( TcM )
import GHC.Tc.Types.Evidence ( TcCoercion, HsWrapper )
-import GHC.Tc.Types.Origin ( CtOrigin )
-import GHC.Utils.Outputable( SDoc )
+import GHC.Tc.Types.Origin ( CtOrigin, TypedThing )
import GHC.Hs.Type ( Mult )
-- This boot file exists only to tie the knot between
-- GHC.Tc.Utils.Unify and Inst
-unifyType :: Maybe SDoc -> TcTauType -> TcTauType -> TcM TcCoercion
-unifyKind :: Maybe SDoc -> TcTauType -> TcTauType -> TcM TcCoercion
+unifyType :: Maybe TypedThing -> TcTauType -> TcTauType -> TcM TcCoercion
+unifyKind :: Maybe TypedThing -> TcTauType -> TcTauType -> TcM TcCoercion
tcSubMult :: CtOrigin -> Mult -> Mult -> TcM HsWrapper
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index 519e55edb1cf..4182e40b3f14 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -5,6 +5,10 @@ module GHC.Types.Hint (
, AvailableBindings(..)
, InstantiationSuggestion(..)
, LanguageExtensionHint(..)
+ , ImportSuggestion(..)
+ , HowInScope(..)
+ , SimilarName(..)
+ , StarIsType(..)
, suggestExtension
, suggestExtensionWithInfo
, suggestExtensions
@@ -12,6 +16,7 @@ module GHC.Types.Hint (
, suggestAnyExtension
, suggestAnyExtensionWithInfo
, useExtensionInOrderTo
+ , noStarIsTypeHints
) where
import GHC.Prelude
@@ -24,10 +29,14 @@ import Data.Typeable
import GHC.Unit.Module (ModuleName, Module)
import GHC.Hs.Extension (GhcTc)
import GHC.Core.Coercion
-import GHC.Types.Name (Name, NameSpace)
+import GHC.Types.Name (Name, NameSpace, OccName (occNameFS))
+import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec)
+import GHC.Types.SrcLoc (SrcSpan)
import GHC.Types.Basic (Activation, RuleName)
import GHC.Parser.Errors.Basic
import {-# SOURCE #-} Language.Haskell.Syntax.Expr
+import GHC.Unit.Module.Imported (ImportedModsVal)
+import GHC.Data.FastString (fsLit)
-- This {-# SOURCE #-} import should be removable once
-- 'Language.Haskell.Syntax.Bind' no longer depends on 'GHC.Tc.Types.Evidence'.
@@ -237,7 +246,7 @@ data GhcHint
Test case(s): wcompat-warnings/WCompatWarningsOn.hs
-}
- | SuggestUseTypeFromDataKind
+ | SuggestUseTypeFromDataKind (Maybe RdrName)
{-| Suggests placing the 'qualified' keyword /after/ the module name.
@@ -309,9 +318,9 @@ data GhcHint
-}
| SuggestFillInWildcardConstraint
- {-| Suggests to use an identifier other than 'forall'
- Triggered by: 'GHC.Tc.Errors.Types.TcRnForallIdentifier'
- -}
+ {-| Suggests to use an identifier other than 'forall'
+ Triggered by: 'GHC.Tc.Errors.Types.TcRnForallIdentifier'
+ -}
| SuggestRenameForall
{-| Suggests to use the appropriate Template Haskell tick:
@@ -321,6 +330,59 @@ data GhcHint
Triggered by: 'GHC.Tc.Errors.Types.TcRnIncorrectNameSpace'.
-}
| SuggestAppropriateTHTick NameSpace
+ {-| Suggests enabling -ddump-splices to help debug an issue
+ when a 'Name' is not in scope or is used in multiple
+ different namespaces (e.g. both as a data constructor
+ and a type constructor).
+
+ Concomitant with 'NoExactName' or 'SameName' errors,
+ see e.g. "GHC.Rename.Env.lookupExactOcc_either".
+ Test cases: T5971, T7241, T13937.
+ -}
+ | SuggestDumpSlices
+
+ {-| Suggests adding a tick to refer to a data constructor
+ at the type level.
+
+ Test case: T9778.
+ -}
+ | SuggestAddTick Name
+
+ {-| Something is split off from its corresponding declaration.
+ For example, a datatype is given a role declaration
+ in a different module.
+
+ Test cases: T495, T8485, T2713, T5533.
+ -}
+ | SuggestMoveToDeclarationSite
+ -- TODO: remove the SDoc argument.
+ SDoc -- ^ fixity declaration, role annotation, type signature, ...
+ RdrName -- ^ the 'RdrName' for the declaration site
+
+ {-| Suggest a similar name that the user might have meant,
+ e.g. suggest 'traverse' when the user has written @travrese@.
+
+ Test case: mod73.
+ -}
+ | SuggestSimilarNames RdrName (NE.NonEmpty SimilarName)
+
+ {-| Remind the user that the field selector has been suppressed
+ because of -XNoFieldSelectors.
+
+ Test cases: NFSSuppressed, records-nofieldselectors.
+ -}
+ | RemindFieldSelectorSuppressed
+ { suppressed_selector :: RdrName
+ , suppressed_parents :: [Name] }
+
+ {-| Suggest importing from a module, removing a @hiding@ clause,
+ or explain to the user that we couldn't find a module
+ with the given 'ModuleName'.
+
+ Test cases: mod28, mod36, mod87, mod114, ...
+ -}
+ | ImportSuggestion ImportSuggestion
+
-- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
-- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
@@ -334,3 +396,101 @@ data GhcHint
-- (Try passing -instantiated-with="MyStr=<MyStr>"
-- replacing <MyStr> as necessary.)
data InstantiationSuggestion = InstantiationSuggestion !ModuleName !Module
+
+-- | Suggest how to fix an import.
+data ImportSuggestion
+ -- | Some module exports what we want, but we aren't explicitly importing it.
+ = CouldImportFrom (NE.NonEmpty (Module, ImportedModsVal)) OccName
+ -- | Some module exports what we want, but we are explicitly hiding it.
+ | CouldUnhideFrom (NE.NonEmpty (Module, ImportedModsVal)) OccName
+
+-- | Explain how something is in scope.
+data HowInScope
+ -- | It was locally bound at this particular source location.
+ = LocallyBoundAt SrcSpan
+ -- | It was imported by this particular import declaration.
+ | ImportedBy ImpDeclSpec
+
+data SimilarName
+ = SimilarName Name
+ | SimilarRdrName RdrName HowInScope
+
+--------------------------------------------------------------------------------
+
+-- | Whether '*' is a synonym for 'Data.Kind.Type'.
+data StarIsType
+ = StarIsNotType
+ | StarIsType
+
+-- | Display info about the treatment of '*' under NoStarIsType.
+--
+-- With StarIsType, three properties of '*' hold:
+--
+-- (a) it is not an infix operator
+-- (b) it is always in scope
+-- (c) it is a synonym for Data.Kind.Type
+--
+-- However, the user might not know that they are working on a module with
+-- NoStarIsType and write code that still assumes (a), (b), and (c), which
+-- actually do not hold in that module.
+--
+-- Violation of (a) shows up in the parser. For instance, in the following
+-- examples, we have '*' not applied to enough arguments:
+--
+-- data A :: *
+-- data F :: * -> *
+--
+-- Violation of (b) or (c) show up in the renamer and the typechecker
+-- respectively. For instance:
+--
+-- type K = Either * Bool
+--
+-- This will parse differently depending on whether StarIsType is enabled,
+-- but it will parse nonetheless. With NoStarIsType it is parsed as a type
+-- operator, thus we have ((*) Either Bool). Now there are two cases to
+-- consider:
+--
+-- 1. There is no definition of (*) in scope. In this case the renamer will
+-- fail to look it up. This is a violation of assumption (b).
+--
+-- 2. There is a definition of the (*) type operator in scope (for example
+-- coming from GHC.TypeNats). In this case the user will get a kind
+-- mismatch error. This is a violation of assumption (c).
+--
+-- The user might unknowingly be working on a module with NoStarIsType
+-- or use '*' as 'Data.Kind.Type' out of habit. So it is important to give a
+-- hint whenever an assumption about '*' is violated. Unfortunately, it is
+-- somewhat difficult to deal with (c), so we limit ourselves to (a) and (b).
+--
+-- 'noStarIsTypeHints' returns appropriate hints to the user depending on the
+-- extensions enabled in the module and the name that triggered the error.
+-- That is, if we have NoStarIsType and the error is related to '*' or its
+-- Unicode variant, we will suggest using 'Data.Kind.Type'; otherwise we won't
+-- suggest anything.
+noStarIsTypeHints :: StarIsType -> RdrName -> [GhcHint]
+noStarIsTypeHints is_star_type rdr_name
+ -- One might ask: if can use `sdocOption sdocStarIsType` here, why bother to
+ -- take star_is_type as input? Why not refactor?
+ --
+ -- The reason is that `sdocOption sdocStarIsType` would indicate that
+ -- StarIsType is enabled in the module that tries to load the problematic
+ -- definition, not in the module that is being loaded.
+ --
+ -- So if we have 'data T :: *' in a module with NoStarIsType, then the hint
+ -- must be displayed even if we load this definition from a module (or GHCi)
+ -- with StarIsType enabled!
+ --
+ | isUnqualStar
+ , StarIsNotType <- is_star_type
+ = [SuggestUseTypeFromDataKind (Just rdr_name)]
+ | otherwise
+ = []
+ where
+ -- Does rdr_name look like the user might have meant the '*' kind by it?
+ -- We focus on unqualified stars specifically, because qualified stars are
+ -- treated as type operators even under StarIsType.
+ isUnqualStar
+ | Unqual occName <- rdr_name
+ = let fs = occNameFS occName
+ in fs == fsLit "*" || fs == fsLit "★"
+ | otherwise = False
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index a11be602090a..9fd39e2a5310 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -14,7 +14,10 @@ import GHC.Types.Hint
import GHC.Hs.Expr () -- instance Outputable
import GHC.Types.Id
-import GHC.Types.Name (isValNameSpace)
+import GHC.Types.Name (NameSpace, pprDefinedAt, occNameSpace, pprNameSpace, isValNameSpace)
+import GHC.Types.Name.Reader (RdrName,ImpDeclSpec (..), rdrNameOcc, rdrNameSpace)
+import GHC.Types.SrcLoc (SrcSpan(..), srcSpanStartLine)
+import GHC.Unit.Module.Imported (ImportedModsVal(..))
import GHC.Unit.Types
import GHC.Utils.Outputable
@@ -91,9 +94,16 @@ instance Outputable GhcHint where
, whenPprDebug (ppr bad_rule) ]
SuggestIncreaseSimplifierIterations
-> text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit"
- SuggestUseTypeFromDataKind
+ SuggestUseTypeFromDataKind mb_rdr_name
-> text "Use" <+> quotes (text "Type")
- <+> text "from" <+> quotes (text "Data.Kind") <+> text "instead."
+ <+> text "from" <+> quotes (text "Data.Kind") <+> text "instead."
+ $$
+ maybe empty
+ (\rdr_name ->
+ text "NB: with NoStarIsType, " <> quotes (ppr rdr_name)
+ <+> text "is treated as a regular type operator.")
+ mb_rdr_name
+
SuggestQualifiedAfterModuleName
-> text "Place" <+> quotes (text "qualified")
<+> text "after the module name."
@@ -138,6 +148,105 @@ instance Outputable GhcHint where
how_many
| isValNameSpace ns = text "single"
| otherwise = text "double"
+ SuggestDumpSlices
+ -> vcat [ text "If you bound a unique Template Haskell name (NameU)"
+ , text "perhaps via newName,"
+ , text "then -ddump-splices might be useful." ]
+ SuggestAddTick name
+ -> hsep [ text "Use"
+ , quotes (char '\'' <> ppr name)
+ , text "instead of"
+ , quotes (ppr name) <> dot ]
+ SuggestMoveToDeclarationSite what rdr_name
+ -> text "Move the" <+> what <+> text "to the declaration site of"
+ <+> quotes (ppr rdr_name) <> dot
+ SuggestSimilarNames tried_rdr_name similar_names
+ -> case similar_names of
+ n NE.:| [] -> text "Perhaps use" <+> pp_item n
+ _ -> sep [ text "Perhaps use one of these:"
+ , nest 2 (pprWithCommas pp_item $ NE.toList similar_names) ]
+ where
+ tried_ns = occNameSpace $ rdrNameOcc tried_rdr_name
+ pp_item = pprSimilarName tried_ns
+ RemindFieldSelectorSuppressed rdr_name parents
+ -> text "Notice that" <+> quotes (ppr rdr_name)
+ <+> text "is a field selector" <+> whose
+ $$ text "that has been suppressed by NoFieldSelectors."
+ where
+ -- parents may be empty if this is a pattern synonym field without a selector
+ whose | null parents = empty
+ | otherwise = text "belonging to the type" <> plural parents
+ <+> pprQuotedList parents
+ ImportSuggestion import_suggestion
+ -> pprImportSuggestion import_suggestion
perhapsAsPat :: SDoc
perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
+
+-- | Pretty-print an 'ImportSuggestion'.
+pprImportSuggestion :: ImportSuggestion -> SDoc
+pprImportSuggestion (CouldImportFrom mods occ_name)
+ | (mod, imv) NE.:| [] <- mods
+ = fsep
+ [ text "Perhaps you want to add"
+ , quotes (ppr occ_name)
+ , text "to the import list"
+ , text "in the import of"
+ , quotes (ppr mod)
+ , parens (ppr (imv_span imv)) <> dot
+ ]
+ | otherwise
+ = fsep
+ [ text "Perhaps you want to add"
+ , quotes (ppr occ_name)
+ , text "to one of these import lists:"
+ ]
+ $$
+ nest 2 (vcat
+ [ quotes (ppr mod) <+> parens (ppr (imv_span imv))
+ | (mod,imv) <- NE.toList mods
+ ])
+pprImportSuggestion (CouldUnhideFrom mods occ_name)
+ | (mod, imv) NE.:| [] <- mods
+ = fsep
+ [ text "Perhaps you want to remove"
+ , quotes (ppr occ_name)
+ , text "from the explicit hiding list"
+ , text "in the import of"
+ , quotes (ppr mod)
+ , parens (ppr (imv_span imv)) <> dot
+ ]
+ | otherwise
+ = fsep
+ [ text "Perhaps you want to remove"
+ , quotes (ppr occ_name)
+ , text "from the hiding clauses"
+ , text "in one of these imports:"
+ ]
+ $$
+ nest 2 (vcat
+ [ quotes (ppr mod) <+> parens (ppr (imv_span imv))
+ | (mod,imv) <- NE.toList mods
+ ])
+
+-- | Pretty-print a 'SimilarName'.
+pprSimilarName :: NameSpace -> SimilarName -> SDoc
+pprSimilarName _ (SimilarName name)
+ = quotes (ppr name) <+> parens (pprDefinedAt name)
+pprSimilarName tried_ns (SimilarRdrName rdr_name how_in_scope)
+ = case how_in_scope of
+ LocallyBoundAt loc ->
+ pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc'
+ where
+ loc' = case loc of
+ UnhelpfulSpan l -> parens (ppr l)
+ RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
+ ImportedBy is ->
+ pp_ns rdr_name <+> quotes (ppr rdr_name) <+>
+ parens (text "imported from" <+> ppr (is_mod is))
+
+ where
+ pp_ns :: RdrName -> SDoc
+ pp_ns rdr | ns /= tried_ns = pprNameSpace ns
+ | otherwise = empty
+ where ns = rdrNameSpace rdr
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index 864101e8a9d6..05ea5a696b6a 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -71,11 +71,8 @@ module GHC.Types.Name.Reader (
ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
importSpecLoc, importSpecModule, isExplicitItem, bestImport,
- -- * Utils for StarIsType
- starInfo,
-
-- * Utils
- opIsAt,
+ opIsAt
) where
import GHC.Prelude
@@ -1374,83 +1371,6 @@ pprLoc :: SrcSpan -> SDoc
pprLoc (RealSrcSpan s _) = text "at" <+> ppr s
pprLoc (UnhelpfulSpan {}) = empty
--- | Display info about the treatment of '*' under NoStarIsType.
---
--- With StarIsType, three properties of '*' hold:
---
--- (a) it is not an infix operator
--- (b) it is always in scope
--- (c) it is a synonym for Data.Kind.Type
---
--- However, the user might not know that they are working on a module with
--- NoStarIsType and write code that still assumes (a), (b), and (c), which
--- actually do not hold in that module.
---
--- Violation of (a) shows up in the parser. For instance, in the following
--- examples, we have '*' not applied to enough arguments:
---
--- data A :: *
--- data F :: * -> *
---
--- Violation of (b) or (c) show up in the renamer and the typechecker
--- respectively. For instance:
---
--- type K = Either * Bool
---
--- This will parse differently depending on whether StarIsType is enabled,
--- but it will parse nonetheless. With NoStarIsType it is parsed as a type
--- operator, thus we have ((*) Either Bool). Now there are two cases to
--- consider:
---
--- 1. There is no definition of (*) in scope. In this case the renamer will
--- fail to look it up. This is a violation of assumption (b).
---
--- 2. There is a definition of the (*) type operator in scope (for example
--- coming from GHC.TypeNats). In this case the user will get a kind
--- mismatch error. This is a violation of assumption (c).
---
--- The user might unknowingly be working on a module with NoStarIsType
--- or use '*' as 'Data.Kind.Type' out of habit. So it is important to give a
--- hint whenever an assumption about '*' is violated. Unfortunately, it is
--- somewhat difficult to deal with (c), so we limit ourselves to (a) and (b).
---
--- 'starInfo' generates an appropriate hint to the user depending on the
--- extensions enabled in the module and the name that triggered the error.
--- That is, if we have NoStarIsType and the error is related to '*' or its
--- Unicode variant, the resulting SDoc will contain a helpful suggestion.
--- Otherwise it is empty.
---
-starInfo :: Bool -> RdrName -> SDoc
-starInfo star_is_type rdr_name =
- -- One might ask: if can use `sdocOption sdocStarIsType` here, why bother to
- -- take star_is_type as input? Why not refactor?
- --
- -- The reason is that `sdocOption sdocStarIsType` would indicate that
- -- StarIsType is enabled in the module that tries to load the problematic
- -- definition, not in the module that is being loaded.
- --
- -- So if we have 'data T :: *' in a module with NoStarIsType, then the hint
- -- must be displayed even if we load this definition from a module (or GHCi)
- -- with StarIsType enabled!
- --
- if isUnqualStar && not star_is_type
- then text "With NoStarIsType, " <>
- quotes (ppr rdr_name) <>
- text " is treated as a regular type operator. "
- $$
- text "Did you mean to use " <> quotes (text "Type") <>
- text " from Data.Kind instead?"
- else empty
- where
- -- Does rdr_name look like the user might have meant the '*' kind by it?
- -- We focus on unqualified stars specifically, because qualified stars are
- -- treated as type operators even under StarIsType.
- isUnqualStar
- | Unqual occName <- rdr_name
- = let fs = occNameFS occName
- in fs == fsLit "*" || fs == fsLit "★"
- | otherwise = False
-
-- | Indicate if the given name is the "@" operator
opIsAt :: RdrName -> Bool
opIsAt e = e == mkUnqual varName (fsLit "@")
diff --git a/testsuite/tests/backpack/should_fail/bkpfail24.stderr b/testsuite/tests/backpack/should_fail/bkpfail24.stderr
index 65a79bf119c5..ee4238451f0a 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail24.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail24.stderr
@@ -1,10 +1,10 @@
[1 of 1] Processing p
- [1 of 3] Compiling H1[sig] ( p/H1.hsig, nothing )
- [2 of 3] Compiling H2[sig] ( p/H2.hsig, nothing )
- [3 of 3] Compiling M ( p/M.hs, nothing )
+ [1 of 3] Compiling H1[sig] ( p\H1.hsig, nothing )
+ [2 of 3] Compiling H2[sig] ( p\H2.hsig, nothing )
+ [3 of 3] Compiling M ( p\M.hs, nothing )
bkpfail24.bkp:14:15: error:
- • Could not deduce: a ~ b
+ • Could not deduce (a ~ b)
from the context: {H1.T} ~ {H2.T}
bound by the type signature for:
f :: forall a b. ({H1.T} ~ {H2.T}) => a -> b
diff --git a/testsuite/tests/backpack/should_fail/bkpfail44.stderr b/testsuite/tests/backpack/should_fail/bkpfail44.stderr
index c16b2f2527f8..d51742c9878d 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail44.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail44.stderr
@@ -1,9 +1,9 @@
[1 of 1] Processing p
- [1 of 2] Compiling A[sig] ( p/A.hsig, nothing )
- [2 of 2] Compiling B ( p/B.hs, nothing )
+ [1 of 2] Compiling A[sig] ( p\A.hsig, nothing )
+ [2 of 2] Compiling B ( p\B.hs, nothing )
bkpfail44.bkp:10:15: error:
- • Could not deduce: a ~ b
+ • Could not deduce (a ~ b)
from the context: Coercible (T a) (T b)
bound by the type signature for:
f :: forall a b. Coercible (T a) (T b) => a -> b
diff --git a/testsuite/tests/backpack/should_fail/bkpfail49.stderr b/testsuite/tests/backpack/should_fail/bkpfail49.stderr
index b6b60e2b869a..f61be26f1ac2 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail49.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail49.stderr
@@ -1,10 +1,10 @@
[1 of 2] Processing p
- [1 of 1] Compiling A[sig] ( p/A.hsig, nothing )
+ [1 of 1] Compiling A[sig] ( p\A.hsig, nothing )
[2 of 2] Processing q
- [1 of 3] Compiling A[sig] ( q/A.hsig, nothing )
- [2 of 3] Compiling M ( q/M.hs, nothing )
+ [1 of 3] Compiling A[sig] ( q\A.hsig, nothing )
+ [2 of 3] Compiling M ( q\M.hs, nothing )
bkpfail49.bkp:11:13: error:
Not in scope: data constructor ‘A.True’
- Module ‘A’ does not export ‘True’.
+ NB: the module ‘A’ does not export ‘True’.
[3 of 3] Instantiating p
diff --git a/testsuite/tests/dependent/should_fail/RenamingStar.stderr b/testsuite/tests/dependent/should_fail/RenamingStar.stderr
index 4001811f1f40..a0f0bbbab06c 100644
--- a/testsuite/tests/dependent/should_fail/RenamingStar.stderr
+++ b/testsuite/tests/dependent/should_fail/RenamingStar.stderr
@@ -1,5 +1,6 @@
RenamingStar.hs:5:13: error:
Operator applied to too few arguments: *
- With NoStarIsType, ‘*’ is treated as a regular type operator.
- Did you mean to use ‘Type’ from Data.Kind instead?
+ Suggested fix:
+ Use ‘Type’ from ‘Data.Kind’ instead.
+ NB: with NoStarIsType, ‘*’ is treated as a regular type operator.
diff --git a/testsuite/tests/gadt/T15558.stderr b/testsuite/tests/gadt/T15558.stderr
index ee70f0373b77..e3223fb7a33d 100644
--- a/testsuite/tests/gadt/T15558.stderr
+++ b/testsuite/tests/gadt/T15558.stderr
@@ -1,9 +1,9 @@
T15558.hs:11:15: warning: [-Winaccessible-code (in -Wdefault)]
- • Couldn't match type ‘Int’ with ‘Bool’
- Inaccessible code in
+ • Inaccessible code in
a type expected by the context:
(a ~ Bool) => ()
+ Couldn't match type ‘Int’ with ‘Bool’
• In the first argument of ‘MkFoo’, namely ‘()’
In the expression: MkFoo ()
In an equation for ‘f’: f MkT = MkFoo ()
diff --git a/testsuite/tests/gadt/T7293.stderr b/testsuite/tests/gadt/T7293.stderr
index 5625ff01c572..4546789ec2cb 100644
--- a/testsuite/tests/gadt/T7293.stderr
+++ b/testsuite/tests/gadt/T7293.stderr
@@ -4,9 +4,9 @@ T7293.hs:26:1: error: [-Woverlapping-patterns (in -Wdefault), -Werror=overlappin
In an equation for ‘nth’: nth Nil _ = ...
T7293.hs:26:5: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessible-code]
- • Couldn't match type ‘'False’ with ‘'True’
- Inaccessible code in
+ • Inaccessible code in
a pattern with constructor: Nil :: forall a. Vec a 'Zero,
in an equation for ‘nth’
+ Couldn't match type ‘'False’ with ‘'True’
• In the pattern: Nil
In an equation for ‘nth’: nth Nil _ = undefined
diff --git a/testsuite/tests/gadt/T7294.stderr b/testsuite/tests/gadt/T7294.stderr
index f694af8d0c28..718a463e31ae 100644
--- a/testsuite/tests/gadt/T7294.stderr
+++ b/testsuite/tests/gadt/T7294.stderr
@@ -4,9 +4,9 @@ T7294.hs:27:1: warning: [-Woverlapping-patterns (in -Wdefault)]
In an equation for ‘nth’: nth Nil _ = ...
T7294.hs:27:5: warning: [-Winaccessible-code (in -Wdefault)]
- • Couldn't match type ‘'False’ with ‘'True’
- Inaccessible code in
+ • Inaccessible code in
a pattern with constructor: Nil :: forall a. Vec a 'Zero,
in an equation for ‘nth’
+ Couldn't match type ‘'False’ with ‘'True’
• In the pattern: Nil
In an equation for ‘nth’: nth Nil _ = undefined
diff --git a/testsuite/tests/gadt/gadt-escape1.stderr b/testsuite/tests/gadt/gadt-escape1.stderr
index f2b7ac569ede..b23736169966 100644
--- a/testsuite/tests/gadt/gadt-escape1.stderr
+++ b/testsuite/tests/gadt/gadt-escape1.stderr
@@ -1,6 +1,6 @@
gadt-escape1.hs:19:58: error:
- • Could not deduce: p ~ ExpGADT Int
+ • Could not deduce (p ~ ExpGADT Int)
from the context: t ~ Int
bound by a pattern with constructor: ExpInt :: Int -> ExpGADT Int,
in a case alternative
@@ -10,10 +10,10 @@ gadt-escape1.hs:19:58: error:
‘p’ is a rigid type variable bound by
the inferred type of weird1 :: p
at gadt-escape1.hs:19:1-58
- Possible fix: add a type signature for ‘weird1’
• In the expression: a
In a case alternative: Hidden (ExpInt _) a -> a
In the expression:
case (hval :: Hidden) of Hidden (ExpInt _) a -> a
• Relevant bindings include
weird1 :: p (bound at gadt-escape1.hs:19:1)
+ Suggested fix: Consider giving ‘weird1’ a type signature
diff --git a/testsuite/tests/gadt/gadt13.stderr b/testsuite/tests/gadt/gadt13.stderr
index 49eb2bc96f2d..83b0e73e5310 100644
--- a/testsuite/tests/gadt/gadt13.stderr
+++ b/testsuite/tests/gadt/gadt13.stderr
@@ -1,6 +1,6 @@
gadt13.hs:15:13: error:
- • Could not deduce: p ~ (String -> [Char])
+ • Could not deduce (p ~ (String -> [Char]))
from the context: a ~ Int
bound by a pattern with constructor: I :: Int -> Term Int,
in an equation for ‘shw’
@@ -8,8 +8,8 @@ gadt13.hs:15:13: error:
‘p’ is a rigid type variable bound by
the inferred type of shw :: Term a -> p
at gadt13.hs:15:1-30
- Possible fix: add a type signature for ‘shw’
• In the expression: ("I " ++) . shows t
In an equation for ‘shw’: shw (I t) = ("I " ++) . shows t
• Relevant bindings include
shw :: Term a -> p (bound at gadt13.hs:15:1)
+ Suggested fix: Consider giving ‘shw’ a type signature
diff --git a/testsuite/tests/gadt/gadt7.stderr b/testsuite/tests/gadt/gadt7.stderr
index 314404c246bc..478c41046870 100644
--- a/testsuite/tests/gadt/gadt7.stderr
+++ b/testsuite/tests/gadt/gadt7.stderr
@@ -1,6 +1,6 @@
gadt7.hs:16:38: error:
- • Could not deduce: p ~ p1
+ • Could not deduce (p ~ p1)
from the context: a ~ Int
bound by a pattern with constructor: K :: T Int,
in a case alternative
@@ -11,7 +11,6 @@ gadt7.hs:16:38: error:
‘p1’ is a rigid type variable bound by
the inferred type of i1b :: T a -> p -> p1
at gadt7.hs:16:1-44
- Possible fix: add a type signature for ‘i1b’
• In the expression: y1
In a case alternative: K -> y1
In the expression: case t1 of K -> y1
@@ -19,3 +18,4 @@ gadt7.hs:16:38: error:
y1 :: p (bound at gadt7.hs:16:16)
y :: p (bound at gadt7.hs:16:7)
i1b :: T a -> p -> p1 (bound at gadt7.hs:16:1)
+ Suggested fix: Consider giving ‘i1b’ a type signature
diff --git a/testsuite/tests/ghci/prog009/ghci.prog009.stderr b/testsuite/tests/ghci/prog009/ghci.prog009.stderr
index 4f9cf12a3e22..e8e5d4ab3e11 100644
--- a/testsuite/tests/ghci/prog009/ghci.prog009.stderr
+++ b/testsuite/tests/ghci/prog009/ghci.prog009.stderr
@@ -2,7 +2,7 @@
A.hs:1:16: error: parse error on input ‘where’
<interactive>:25:1: error:
- • Variable not in scope: yan
- • Perhaps you meant ‘tan’ (imported from Prelude)
+ Variable not in scope: yan
+ Suggested fix: Perhaps use ‘tan’ (imported from Prelude)
A.hs:1:16: error: parse error on input ‘where’
diff --git a/testsuite/tests/ghci/scripts/Defer02.stderr b/testsuite/tests/ghci/scripts/Defer02.stderr
index c25cc4b81f08..3477f47b17a1 100644
--- a/testsuite/tests/ghci/scripts/Defer02.stderr
+++ b/testsuite/tests/ghci/scripts/Defer02.stderr
@@ -17,10 +17,10 @@ Defer01.hs:25:1: warning: [-Woverlapping-patterns (in -Wdefault)]
In an equation for ‘c’: c (C2 x) = ...
Defer01.hs:25:4: warning: [-Winaccessible-code (in -Wdefault)]
- • Couldn't match type ‘Int’ with ‘Bool’
- Inaccessible code in
+ • Inaccessible code in
a pattern with constructor: C2 :: Bool -> C Bool,
in an equation for ‘c’
+ Couldn't match type ‘Int’ with ‘Bool’
• In the pattern: C2 x
In an equation for ‘c’: c (C2 x) = True
diff --git a/testsuite/tests/ghci/scripts/T20455.stderr b/testsuite/tests/ghci/scripts/T20455.stderr
index cb94e6ee3d4b..61870da12afe 100644
--- a/testsuite/tests/ghci/scripts/T20455.stderr
+++ b/testsuite/tests/ghci/scripts/T20455.stderr
@@ -1,7 +1,8 @@
<interactive>:3:1: error:
- • Variable not in scope: ll
- • Perhaps you meant one of these:
+ Variable not in scope: ll
+ Suggested fix:
+ Perhaps use one of these:
‘Ghci1.l’ (imported from Ghci1), ‘l’ (line 2),
‘all’ (imported from Prelude)
diff --git a/testsuite/tests/ghci/scripts/T2452.stderr b/testsuite/tests/ghci/scripts/T2452.stderr
index 99b0acbd219d..c6f37c66803e 100644
--- a/testsuite/tests/ghci/scripts/T2452.stderr
+++ b/testsuite/tests/ghci/scripts/T2452.stderr
@@ -1,8 +1,8 @@
<interactive>:1:1: error:
Not in scope: ‘System.IO.hPutStrLn’
- No module named ‘System.IO’ is imported.
+ NB: no module named ‘System.IO’ is imported.
<interactive>:1:1: error:
Not in scope: ‘System.IO.hPutStrLn’
- No module named ‘System.IO’ is imported.
+ NB: no module named ‘System.IO’ is imported.
diff --git a/testsuite/tests/ghci/scripts/T5564.stderr b/testsuite/tests/ghci/scripts/T5564.stderr
index 89de0f18e375..2338e22e03cd 100644
--- a/testsuite/tests/ghci/scripts/T5564.stderr
+++ b/testsuite/tests/ghci/scripts/T5564.stderr
@@ -1,10 +1,11 @@
<interactive>:2:1: error:
- • Variable not in scope: git
- • Perhaps you meant ‘it’ (line 1)
+ Variable not in scope: git
+ Suggested fix: Perhaps use ‘it’ (line 1)
<interactive>:4:1: error:
- • Variable not in scope: fit
- • Perhaps you meant one of these:
+ Variable not in scope: fit
+ Suggested fix:
+ Perhaps use one of these:
‘Ghci1.it’ (imported from Ghci1), ‘it’ (line 3),
‘fst’ (imported from Prelude)
diff --git a/testsuite/tests/ghci/scripts/T8485.stderr b/testsuite/tests/ghci/scripts/T8485.stderr
index d1c005b9f6e9..8d77f82eaa4c 100644
--- a/testsuite/tests/ghci/scripts/T8485.stderr
+++ b/testsuite/tests/ghci/scripts/T8485.stderr
@@ -1,4 +1,5 @@
<interactive>:2:11: error:
The role annotation for ‘X’ lacks an accompanying binding
- (The role annotation must be given where ‘X’ is declared)
+ Suggested fix:
+ Move the role annotation to the declaration site of ‘X’.
diff --git a/testsuite/tests/ghci/scripts/T8639.stderr b/testsuite/tests/ghci/scripts/T8639.stderr
index ee06e6e70c51..9764bcdf67ae 100644
--- a/testsuite/tests/ghci/scripts/T8639.stderr
+++ b/testsuite/tests/ghci/scripts/T8639.stderr
@@ -1,5 +1,5 @@
<interactive>:1:1: error:
Not in scope: ‘H.bit’
- Perhaps you meant ‘Q.bit’ (imported from T8639)
- No module named ‘H’ is imported.
+ NB: no module named ‘H’ is imported.
+ Suggested fix: Perhaps use ‘Q.bit’ (imported from T8639)
diff --git a/testsuite/tests/ghci/scripts/ghci036.stderr b/testsuite/tests/ghci/scripts/ghci036.stderr
index 5b44b562a7e7..482fac7e6238 100644
--- a/testsuite/tests/ghci/scripts/ghci036.stderr
+++ b/testsuite/tests/ghci/scripts/ghci036.stderr
@@ -9,10 +9,10 @@
<interactive>:1:1: error:
Variable not in scope: nub
- Perhaps you meant ‘L.nub’ (imported from Data.List)
+ Suggested fix: Perhaps use ‘L.nub’ (imported from Data.List)
<interactive>:1:1: error:
Not in scope: ‘L.nub’
- No module named ‘L’ is imported.
+ NB: no module named ‘L’ is imported.
<interactive>:1:1: error: Variable not in scope: nub
diff --git a/testsuite/tests/impredicative/T17332.stderr b/testsuite/tests/impredicative/T17332.stderr
index 24bb0e2aee1e..7d0615ad4ed6 100644
--- a/testsuite/tests/impredicative/T17332.stderr
+++ b/testsuite/tests/impredicative/T17332.stderr
@@ -1,5 +1,5 @@
T17332.hs:13:7: error:
- • Could not deduce: a arising from a use of ‘MkDict’
+ • Could not solve: () arising from a use of ‘MkDict’
• In the expression: MkDict
In an equation for ‘aux’: aux = MkDict
diff --git a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr
index 5ba9df0d1ad2..16078fd7fc17 100644
--- a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr
+++ b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr
@@ -1,6 +1,6 @@
PushedInAsGivens.hs:10:31: error:
- • Could not deduce: a1 ~ a
+ • Could not deduce (a1 ~ a)
from the context: F Int ~ [a1]
bound by the type signature for:
foo :: forall a1. (F Int ~ [a1]) => a1 -> Int
diff --git a/testsuite/tests/indexed-types/should_compile/T12538.stderr b/testsuite/tests/indexed-types/should_compile/T12538.stderr
index 7de8f787af0a..d5c8f97f9cb1 100644
--- a/testsuite/tests/indexed-types/should_compile/T12538.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T12538.stderr
@@ -1,6 +1,6 @@
T12538.hs:37:8: error:
- • Could not deduce: a' ~ Tagged Int a
+ • Could not deduce (a' ~ Tagged Int a)
from the context: (TagImpl a a', b ~ DF a')
bound by the instance declaration at T12538.hs:36:10-46
Expected: Tagged Int a -> b
diff --git a/testsuite/tests/indexed-types/should_compile/T3208b.stderr b/testsuite/tests/indexed-types/should_compile/T3208b.stderr
index 063870465b3d..c1a09ebfcb94 100644
--- a/testsuite/tests/indexed-types/should_compile/T3208b.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T3208b.stderr
@@ -1,6 +1,6 @@
T3208b.hs:15:15: error:
- • Could not deduce: OTerm o0 ~ STerm a
+ • Could not deduce (OTerm o0 ~ STerm a)
arising from a use of ‘apply’
from the context: (OTerm a ~ STerm a, OBJECT a, SUBST a)
bound by the type signature for:
diff --git a/testsuite/tests/indexed-types/should_fail/T2627b.stderr b/testsuite/tests/indexed-types/should_fail/T2627b.stderr
index 2db3dd639782..a2086a813482 100644
--- a/testsuite/tests/indexed-types/should_fail/T2627b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2627b.stderr
@@ -1,6 +1,6 @@
T2627b.hs:20:24: error:
- • Could not deduce: Dual (Dual a0) ~ a0
+ • Could not deduce (Dual (Dual a0) ~ a0)
arising from a use of ‘conn’
from the context: (Dual a ~ b, Dual b ~ a)
bound by the type signature for:
diff --git a/testsuite/tests/indexed-types/should_fail/T2664.stderr b/testsuite/tests/indexed-types/should_fail/T2664.stderr
index 155fe0e03b5f..e4aa61426424 100644
--- a/testsuite/tests/indexed-types/should_fail/T2664.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2664.stderr
@@ -1,6 +1,6 @@
T2664.hs:32:52: error:
- • Could not deduce: b ~ a arising from a use of ‘newPChan’
+ • Could not deduce (b ~ a) arising from a use of ‘newPChan’
from the context: ((a :*: b) ~ Dual c, c ~ Dual (a :*: b))
bound by the type signature for:
newPChan :: forall c.
diff --git a/testsuite/tests/indexed-types/should_fail/T3440.stderr b/testsuite/tests/indexed-types/should_fail/T3440.stderr
index af8f27b76180..bf36f954f7d0 100644
--- a/testsuite/tests/indexed-types/should_fail/T3440.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T3440.stderr
@@ -1,6 +1,6 @@
T3440.hs:11:22: error:
- • Could not deduce: a1 ~ a
+ • Could not deduce (a1 ~ a)
from the context: Fam a ~ Fam a1
bound by a pattern with constructor:
GADT :: forall a. a -> Fam a -> GADT (Fam a),
diff --git a/testsuite/tests/indexed-types/should_fail/T4093a.stderr b/testsuite/tests/indexed-types/should_fail/T4093a.stderr
index 81d9c404ed6c..10b62841051d 100644
--- a/testsuite/tests/indexed-types/should_fail/T4093a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4093a.stderr
@@ -1,6 +1,6 @@
T4093a.hs:8:8: error:
- • Could not deduce: e ~ ()
+ • Could not deduce (e ~ ())
from the context: Foo e ~ Maybe e
bound by the type signature for:
hang :: forall e. (Foo e ~ Maybe e) => Foo e
diff --git a/testsuite/tests/indexed-types/should_fail/T4093b.stderr b/testsuite/tests/indexed-types/should_fail/T4093b.stderr
index 367c904e4fe0..575aed2a7b41 100644
--- a/testsuite/tests/indexed-types/should_fail/T4093b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4093b.stderr
@@ -1,6 +1,6 @@
T4093b.hs:31:13: error:
- • Could not deduce: e ~ C
+ • Could not deduce (e ~ C)
from the context: (EitherCO e (A C O n) (A O O n) ~ A e O n,
EitherCO x (A C C n) (A C O n) ~ A C x n)
bound by the type signature for:
diff --git a/testsuite/tests/module/mod101.stderr b/testsuite/tests/module/mod101.stderr
index 1c4818688561..ecaae0a7d26e 100644
--- a/testsuite/tests/module/mod101.stderr
+++ b/testsuite/tests/module/mod101.stderr
@@ -1,4 +1,4 @@
mod101.hs:8:5: error:
- • Data constructor not in scope: ConB :: Bool -> DataA
- • Perhaps you meant ‘ConA’ (imported from Mod101_AuxB)
+ Data constructor not in scope: ConB :: Bool -> DataA
+ Suggested fix: Perhaps use ‘ConA’ (imported from Mod101_AuxB)
diff --git a/testsuite/tests/module/mod102.stderr b/testsuite/tests/module/mod102.stderr
index 17ade933a604..afb4f9db7dcd 100644
--- a/testsuite/tests/module/mod102.stderr
+++ b/testsuite/tests/module/mod102.stderr
@@ -1,4 +1,4 @@
mod102.hs:8:5: error:
- • Variable not in scope: methB :: Bool -> Bool -> ()
- • Perhaps you meant ‘methA’ (imported from Mod102_AuxB)
+ Variable not in scope: methB :: Bool -> Bool -> ()
+ Suggested fix: Perhaps use ‘methA’ (imported from Mod102_AuxB)
diff --git a/testsuite/tests/module/mod114.stderr b/testsuite/tests/module/mod114.stderr
index 739ac82452d3..e473360f1586 100644
--- a/testsuite/tests/module/mod114.stderr
+++ b/testsuite/tests/module/mod114.stderr
@@ -1,5 +1,6 @@
mod114.hs:3:16: error:
Not in scope: type constructor or class ‘Stuff’
- Perhaps you want to remove ‘Stuff’ from the explicit hiding list
- in the import of ‘Mod114_Help’ (mod114.hs:4:1-36).
+ Suggested fix:
+ Perhaps you want to remove ‘Stuff’ from the explicit hiding list
+ in the import of ‘Mod114_Help’ (mod114.hs:4:1-36).
diff --git a/testsuite/tests/module/mod121.stderr b/testsuite/tests/module/mod121.stderr
index fda1dec212a5..f51fec45e5d8 100644
--- a/testsuite/tests/module/mod121.stderr
+++ b/testsuite/tests/module/mod121.stderr
@@ -1,4 +1,4 @@
mod121.hs:5:5: error:
- • Variable not in scope: m2 :: Int -> t
- • Perhaps you meant ‘m1’ (imported from Mod121_A)
+ Variable not in scope: m2 :: Int -> t
+ Suggested fix: Perhaps use ‘m1’ (imported from Mod121_A)
diff --git a/testsuite/tests/module/mod124.stderr b/testsuite/tests/module/mod124.stderr
index a052a506ad2b..8c1109314b5d 100644
--- a/testsuite/tests/module/mod124.stderr
+++ b/testsuite/tests/module/mod124.stderr
@@ -1,5 +1,6 @@
mod124.hs:6:6: error:
Not in scope: type constructor or class ‘T’
- Perhaps you want to remove ‘T’ from the explicit hiding list
- in the import of ‘Mod124_A’ (mod124.hs:4:1-26).
+ Suggested fix:
+ Perhaps you want to remove ‘T’ from the explicit hiding list
+ in the import of ‘Mod124_A’ (mod124.hs:4:1-26).
diff --git a/testsuite/tests/module/mod125.stderr b/testsuite/tests/module/mod125.stderr
index e2b29849c479..d21066e2792a 100644
--- a/testsuite/tests/module/mod125.stderr
+++ b/testsuite/tests/module/mod125.stderr
@@ -1,5 +1,6 @@
mod125.hs:7:5: error:
Data constructor not in scope: T
- Perhaps you want to remove ‘T’ from the explicit hiding list
- in the import of ‘Mod125_A’ (mod125.hs:4:1-26).
+ Suggested fix:
+ Perhaps you want to remove ‘T’ from the explicit hiding list
+ in the import of ‘Mod125_A’ (mod125.hs:4:1-26).
diff --git a/testsuite/tests/module/mod126.stderr b/testsuite/tests/module/mod126.stderr
index 385ce4b3414c..871ac149457c 100644
--- a/testsuite/tests/module/mod126.stderr
+++ b/testsuite/tests/module/mod126.stderr
@@ -1,5 +1,6 @@
mod126.hs:7:5: error:
Data constructor not in scope: T
- Perhaps you want to remove ‘T’ from the explicit hiding list
- in the import of ‘Mod126_A’ (mod126.hs:4:1-26).
+ Suggested fix:
+ Perhaps you want to remove ‘T’ from the explicit hiding list
+ in the import of ‘Mod126_A’ (mod126.hs:4:1-26).
diff --git a/testsuite/tests/module/mod127.stderr b/testsuite/tests/module/mod127.stderr
index 861d492d1a35..66b1c1a530cf 100644
--- a/testsuite/tests/module/mod127.stderr
+++ b/testsuite/tests/module/mod127.stderr
@@ -1,5 +1,6 @@
mod127.hs:6:6: error:
Not in scope: type constructor or class ‘T’
- Perhaps you want to remove ‘T’ from the explicit hiding list
- in the import of ‘Mod127_A’ (mod127.hs:4:1-26).
+ Suggested fix:
+ Perhaps you want to remove ‘T’ from the explicit hiding list
+ in the import of ‘Mod127_A’ (mod127.hs:4:1-26).
diff --git a/testsuite/tests/module/mod130.stderr b/testsuite/tests/module/mod130.stderr
index 9e41bcdc4228..e19a3e258bcd 100644
--- a/testsuite/tests/module/mod130.stderr
+++ b/testsuite/tests/module/mod130.stderr
@@ -1,5 +1,6 @@
mod130.hs:7:5: error:
Variable not in scope: (<) :: t0 -> Int -> Int
- Perhaps you want to remove ‘<’ from the explicit hiding list
- in the import of ‘Prelude’ (mod130.hs:4:1-33).
+ Suggested fix:
+ Perhaps you want to remove ‘<’ from the explicit hiding list
+ in the import of ‘Prelude’ (mod130.hs:4:1-33).
diff --git a/testsuite/tests/module/mod132.stderr b/testsuite/tests/module/mod132.stderr
index 0c901d090cc5..4913c59b0680 100644
--- a/testsuite/tests/module/mod132.stderr
+++ b/testsuite/tests/module/mod132.stderr
@@ -3,6 +3,6 @@ mod132.hs:6:7: error:
• Illegal term-level use of the type constructor or class ‘Foo’
• imported from ‘Mod132_B’ at mod132.hs:4:1-15
(and originally defined in ‘Mod132_A’ at Mod132_A.hs:3:1-14)
- • Perhaps you meant variable ‘foo’ (line 6)
+ • Perhaps use variable ‘foo’ (line 6)
• In the expression: Foo
In an equation for ‘foo’: foo = Foo
diff --git a/testsuite/tests/module/mod134.stderr b/testsuite/tests/module/mod134.stderr
index 75c556cd4f6a..a911e32c84ad 100644
--- a/testsuite/tests/module/mod134.stderr
+++ b/testsuite/tests/module/mod134.stderr
@@ -1,9 +1,10 @@
mod134.hs:6:19: error:
Not in scope: ‘Prelude.head’
- Perhaps you meant one of these:
- ‘Prelude.read’ (imported from Prelude),
- ‘Prelude.reads’ (imported from Prelude),
- ‘Prelude.id’ (imported from Prelude)
- Perhaps you want to remove ‘head’ from the explicit hiding list
- in the import of ‘Prelude’ (mod134.hs:4:1-28).
+ Suggested fixes:
+ • Perhaps use one of these:
+ ‘Prelude.read’ (imported from Prelude),
+ ‘Prelude.reads’ (imported from Prelude),
+ ‘Prelude.id’ (imported from Prelude)
+ • Perhaps you want to remove ‘head’ from the explicit hiding list
+ in the import of ‘Prelude’ (mod134.hs:4:1-28).
diff --git a/testsuite/tests/module/mod136.stderr b/testsuite/tests/module/mod136.stderr
index fc5e0d682c31..3a54d8f2e307 100644
--- a/testsuite/tests/module/mod136.stderr
+++ b/testsuite/tests/module/mod136.stderr
@@ -1,6 +1,7 @@
mod136.hs:7:5: error:
Variable not in scope: zipWith5
- Perhaps you meant one of these:
- ‘zipWith’ (imported from Mod136_A),
- ‘zipWith3’ (imported from Mod136_A)
+ Suggested fix:
+ Perhaps use one of these:
+ ‘zipWith’ (imported from Mod136_A),
+ ‘zipWith3’ (imported from Mod136_A)
diff --git a/testsuite/tests/module/mod160.stderr b/testsuite/tests/module/mod160.stderr
index d853c67e6b8a..d7cba8d1e827 100644
--- a/testsuite/tests/module/mod160.stderr
+++ b/testsuite/tests/module/mod160.stderr
@@ -1,6 +1,7 @@
mod160.hs:12:5: error:
- • Variable not in scope: m3 :: Char -> t
- • Perhaps you meant one of these:
+ Variable not in scope: m3 :: Char -> t
+ Suggested fix:
+ Perhaps use one of these:
‘m1’ (imported from Mod159_D), ‘m2’ (imported from Mod159_D)
exit(1)
diff --git a/testsuite/tests/module/mod29.stderr b/testsuite/tests/module/mod29.stderr
index e70c5df83d49..0392497c2ed2 100644
--- a/testsuite/tests/module/mod29.stderr
+++ b/testsuite/tests/module/mod29.stderr
@@ -1,5 +1,6 @@
mod29.hs:6:12: error:
Not in scope: type constructor or class ‘Char’
- Perhaps you want to add ‘Char’ to the import list in the import of
- ‘Prelude’ (mod29.hs:5:1-19).
+ Suggested fix:
+ Perhaps you want to add ‘Char’ to the import list in the import of
+ ‘Prelude’ (mod29.hs:5:1-19).
diff --git a/testsuite/tests/module/mod36.stderr b/testsuite/tests/module/mod36.stderr
index f70285acea92..438b97b6aa61 100644
--- a/testsuite/tests/module/mod36.stderr
+++ b/testsuite/tests/module/mod36.stderr
@@ -1,5 +1,6 @@
mod36.hs:5:5: error:
Variable not in scope: const
- Perhaps you want to remove ‘const’ from the explicit hiding list
- in the import of ‘Prelude’ (mod36.hs:3:1-32).
+ Suggested fix:
+ Perhaps you want to remove ‘const’ from the explicit hiding list
+ in the import of ‘Prelude’ (mod36.hs:3:1-32).
diff --git a/testsuite/tests/module/mod4.stderr b/testsuite/tests/module/mod4.stderr
index d9e833974033..2b4d400b28d7 100644
--- a/testsuite/tests/module/mod4.stderr
+++ b/testsuite/tests/module/mod4.stderr
@@ -1,5 +1,5 @@
mod4.hs:2:10: error:
• Not in scope: data constructor ‘K2’
- Perhaps you meant ‘K1’ (line 3)
• In the export: T(K1, K2)
+ Suggested fix: Perhaps use ‘K1’ (line 3)
diff --git a/testsuite/tests/module/mod62.stderr b/testsuite/tests/module/mod62.stderr
index 0a2ceff6d901..539a905f2690 100644
--- a/testsuite/tests/module/mod62.stderr
+++ b/testsuite/tests/module/mod62.stderr
@@ -3,4 +3,4 @@ mod62.hs:3:9: error: Qualified name in binding position: M.y
mod62.hs:3:22: error:
Not in scope: ‘M.y’
- Perhaps you meant ‘M.x’ (line 3)
+ Suggested fix: Perhaps use ‘M.x’ (line 3)
diff --git a/testsuite/tests/module/mod73.stderr b/testsuite/tests/module/mod73.stderr
index 12dc6b2b3965..2fe9582a4ad2 100644
--- a/testsuite/tests/module/mod73.stderr
+++ b/testsuite/tests/module/mod73.stderr
@@ -1,8 +1,9 @@
mod73.hs:3:7: error:
Not in scope: ‘Prelude.g’
- Perhaps you meant one of these:
- data constructor ‘Prelude.GT’ (imported from Prelude),
- data constructor ‘Prelude.EQ’ (imported from Prelude),
- data constructor ‘Prelude.LT’ (imported from Prelude)
- Module ‘Prelude’ does not export ‘g’.
+ NB: the module ‘Prelude’ does not export ‘g’.
+ Suggested fix:
+ Perhaps use one of these:
+ data constructor ‘Prelude.EQ’ (imported from Prelude),
+ data constructor ‘Prelude.GT’ (imported from Prelude),
+ data constructor ‘Prelude.LT’ (imported from Prelude)
diff --git a/testsuite/tests/module/mod74.stderr b/testsuite/tests/module/mod74.stderr
index 55a8ca65f2c9..e9711586067c 100644
--- a/testsuite/tests/module/mod74.stderr
+++ b/testsuite/tests/module/mod74.stderr
@@ -1,4 +1,4 @@
mod74.hs:3:7: error:
Not in scope: ‘N.g’
- No module named ‘N’ is imported.
+ NB: no module named ‘N’ is imported.
diff --git a/testsuite/tests/module/mod87.stderr b/testsuite/tests/module/mod87.stderr
index 504075b47c7f..c5b92a85da10 100644
--- a/testsuite/tests/module/mod87.stderr
+++ b/testsuite/tests/module/mod87.stderr
@@ -1,5 +1,6 @@
mod87.hs:4:5: error:
- • Data constructor not in scope: Left :: GHC.Types.Char -> t
- • Perhaps you want to add ‘Left’ to the import list
- in the import of ‘Prelude’ (mod87.hs:3:1-22).
+ Data constructor not in scope: Left :: GHC.Types.Char -> t
+ Suggested fix:
+ Perhaps you want to add ‘Left’ to the import list in the import of
+ ‘Prelude’ (mod87.hs:3:1-22).
diff --git a/testsuite/tests/module/mod88.stderr b/testsuite/tests/module/mod88.stderr
index f145350c4e2f..aa2627c861b7 100644
--- a/testsuite/tests/module/mod88.stderr
+++ b/testsuite/tests/module/mod88.stderr
@@ -1,5 +1,6 @@
mod88.hs:5:5: error:
Not in scope: data constructor ‘Prelude.Left’
- Perhaps you want to add ‘Left’ to the import list in the import of
- ‘Prelude’ (mod88.hs:4:1-30).
+ Suggested fix:
+ Perhaps you want to add ‘Left’ to the import list in the import of
+ ‘Prelude’ (mod88.hs:4:1-30).
diff --git a/testsuite/tests/module/mod97.stderr b/testsuite/tests/module/mod97.stderr
index f5cec79104b9..db9b30e83d71 100644
--- a/testsuite/tests/module/mod97.stderr
+++ b/testsuite/tests/module/mod97.stderr
@@ -1,6 +1,7 @@
mod97.hs:4:9: error:
- • Variable not in scope:
- (==) :: GHC.Types.Char -> GHC.Types.Char -> t
- • Perhaps you want to add ‘==’ to the import list in the import of
+ Variable not in scope:
+ (==) :: GHC.Types.Char -> GHC.Types.Char -> t
+ Suggested fix:
+ Perhaps you want to add ‘==’ to the import list in the import of
‘Prelude’ (mod97.hs:3:1-18).
diff --git a/testsuite/tests/overloadedrecflds/ghci/T19314.stdout b/testsuite/tests/overloadedrecflds/ghci/T19314.stdout
index 4e09a8a476ec..ed29a3d212fe 100644
--- a/testsuite/tests/overloadedrecflds/ghci/T19314.stdout
+++ b/testsuite/tests/overloadedrecflds/ghci/T19314.stdout
@@ -1,12 +1,14 @@
w :: [a] -> a
x :: [a] -> a
-<interactive>:1:1:
- • Variable not in scope: y
- • NB: ‘y’ is a field selector
- that has been suppressed by NoFieldSelectors
+<interactive>:1:1: error:
+ Variable not in scope: y
+ Suggested fix:
+ Notice that ‘y’ is a field selector
+ that has been suppressed by NoFieldSelectors.
-<interactive>:1:1:
- • Variable not in scope: z
- • NB: ‘z’ is a field selector
- that has been suppressed by NoFieldSelectors
+<interactive>:1:1: error:
+ Variable not in scope: z
+ Suggested fix:
+ Notice that ‘z’ is a field selector
+ that has been suppressed by NoFieldSelectors.
diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSExport.stderr b/testsuite/tests/overloadedrecflds/should_fail/NFSExport.stderr
index c704facfc9d9..86631573a5d7 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/NFSExport.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/NFSExport.stderr
@@ -1,5 +1,6 @@
NFSExport.hs:2:27: error:
Not in scope: ‘foo’
- NB: ‘foo’ is a field selector belonging to the type ‘T’
- that has been suppressed by NoFieldSelectors
+ Suggested fix:
+ Notice that ‘foo’ is a field selector belonging to the type ‘T’
+ that has been suppressed by NoFieldSelectors.
diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSSuppressed.stderr b/testsuite/tests/overloadedrecflds/should_fail/NFSSuppressed.stderr
index 51415300e06b..204aee2b2b98 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/NFSSuppressed.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/NFSSuppressed.stderr
@@ -1,6 +1,7 @@
NFSSuppressed.hs:9:5: error:
- • Variable not in scope: foo
- • Perhaps you meant data constructor ‘Foo’ (line 7)
- NB: ‘foo’ is a field selector belonging to the type ‘Foo’
- that has been suppressed by NoFieldSelectors
+ Variable not in scope: foo
+ Suggested fixes:
+ • Perhaps use data constructor ‘Foo’ (line 7)
+ • Notice that ‘foo’ is a field selector belonging to the type ‘Foo’
+ that has been suppressed by NoFieldSelectors.
diff --git a/testsuite/tests/parser/should_fail/T17045.stderr b/testsuite/tests/parser/should_fail/T17045.stderr
index fdcf4422ea25..e67ac82f5e1a 100644
--- a/testsuite/tests/parser/should_fail/T17045.stderr
+++ b/testsuite/tests/parser/should_fail/T17045.stderr
@@ -1,5 +1,6 @@
T17045.hs:7:11: error:
Not in scope: type constructor or class ‘String’
- Perhaps you want to add ‘String’ to the import list
- in the import of ‘Prelude’ (T17045.hs:5:1-27).
+ Suggested fix:
+ Perhaps you want to add ‘String’ to the import list
+ in the import of ‘Prelude’ (T17045.hs:5:1-27).
diff --git a/testsuite/tests/parser/should_fail/T8501c.stderr b/testsuite/tests/parser/should_fail/T8501c.stderr
index 3b0243282234..20975c3c19d3 100644
--- a/testsuite/tests/parser/should_fail/T8501c.stderr
+++ b/testsuite/tests/parser/should_fail/T8501c.stderr
@@ -1,6 +1,6 @@
T8501c.hs:4:7: error:
- • Variable not in scope:
- mdo :: (String -> IO ()) -> String -> IO ()
- • Perhaps you meant ‘mod’ (imported from Prelude)
- Perhaps you meant to use RecursiveDo
+ Variable not in scope: mdo :: (String -> IO ()) -> String -> IO ()
+ Suggested fixes:
+ • Perhaps use ‘mod’ (imported from Prelude)
+ • Perhaps you intended to use RecursiveDo
diff --git a/testsuite/tests/parser/should_fail/readFail001.stderr b/testsuite/tests/parser/should_fail/readFail001.stderr
index 6425d16c49d9..f8b3b7e81af6 100644
--- a/testsuite/tests/parser/should_fail/readFail001.stderr
+++ b/testsuite/tests/parser/should_fail/readFail001.stderr
@@ -4,11 +4,15 @@ readFail001.hs:25:11: error:
readFail001.hs:38:32: error:
Not in scope: type constructor or class ‘Leaf’
- A data constructor of that name is in scope; did you mean DataKinds?
+ Suggested fix:
+ Perhaps you intended to use DataKinds
+ to refer to the data constructor of that name?
readFail001.hs:38:41: error:
Not in scope: type constructor or class ‘Leaf’
- A data constructor of that name is in scope; did you mean DataKinds?
+ Suggested fix:
+ Perhaps you intended to use DataKinds
+ to refer to the data constructor of that name?
readFail001.hs:107:30: error: Not in scope: data constructor ‘Foo’
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr b/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr
index 146b0146eb65..7bb143e1655e 100644
--- a/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr
@@ -1,6 +1,6 @@
NamedExtraConstraintsWildcard.hs:5:1: error:
- • Could not deduce: w0
+ • Could not deduce w0
from the context: (Eq a, w)
bound by the inferred type for ‘foo’:
forall a {w :: Constraint}. (Eq a, w) => a -> a
diff --git a/testsuite/tests/partial-sigs/should_fail/T14584.stderr b/testsuite/tests/partial-sigs/should_fail/T14584.stderr
index 0e7967a2764a..9d0247f22b29 100644
--- a/testsuite/tests/partial-sigs/should_fail/T14584.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/T14584.stderr
@@ -11,7 +11,7 @@ T14584.hs:56:41: warning: [-Wdeferred-type-errors (in -Wdefault)]
act @_ @_ @act (fromSing @m (sing @m @a :: Sing _))
T14584.hs:56:50: warning: [-Wdeferred-type-errors (in -Wdefault)]
- • Could not deduce: m ~ *
+ • Could not deduce (m ~ *)
from the context: (Action act, Monoid a, Good m)
bound by the instance declaration at T14584.hs:54:10-89
‘m’ is a rigid type variable bound by
diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInADTContext2.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInADTContext2.stderr
index 441f46466bc5..32fc28b6fafc 100644
--- a/testsuite/tests/partial-sigs/should_fail/WildcardInADTContext2.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/WildcardInADTContext2.stderr
@@ -4,4 +4,4 @@ WildcardInADTContext2.hs:1:53: warning: [-Wdeprecated-flags (in -Wdefault)]
WildcardInADTContext2.hs:4:10: error:
Not in scope: type variable ‘_a’
- Perhaps you meant ‘a’ (line 4)
+ Suggested fix: Perhaps use ‘a’ (line 4)
diff --git a/testsuite/tests/patsyn/should_fail/T13470.stderr b/testsuite/tests/patsyn/should_fail/T13470.stderr
index 748b5d1da282..87bd4884dc64 100644
--- a/testsuite/tests/patsyn/should_fail/T13470.stderr
+++ b/testsuite/tests/patsyn/should_fail/T13470.stderr
@@ -5,4 +5,4 @@ T13470.hs:11:11: error: Not in scope: ‘nan’
T13470.hs:16:12: error:
Not in scope: ‘x12345’
- Perhaps you meant ‘x123456’ (line 16)
+ Suggested fix: Perhaps use ‘x123456’ (line 16)
diff --git a/testsuite/tests/patsyn/should_fail/T15685.stderr b/testsuite/tests/patsyn/should_fail/T15685.stderr
index 723d0fcff3c4..afc6d45de44b 100644
--- a/testsuite/tests/patsyn/should_fail/T15685.stderr
+++ b/testsuite/tests/patsyn/should_fail/T15685.stderr
@@ -1,6 +1,6 @@
T15685.hs:13:24: error:
- • Could not deduce: k ~ [k0]
+ • Could not deduce (k ~ [k0])
from the context: as ~ (a : as1)
bound by a pattern with constructor:
Here :: forall {k} (f :: k -> *) (a :: k) (as :: [k]).
@@ -10,7 +10,7 @@ T15685.hs:13:24: error:
‘k’ is a rigid type variable bound by
the inferred type of HereNil :: NS f as
at T15685.hs:13:9-15
- Possible fix: add a type signature for ‘HereNil’
• In the pattern: Nil
In the pattern: Here Nil
In the declaration for pattern synonym ‘HereNil’
+ Suggested fix: Consider giving ‘HereNil’ a type signature
diff --git a/testsuite/tests/patsyn/should_fail/T15695.stderr b/testsuite/tests/patsyn/should_fail/T15695.stderr
index 555c00436021..62b082fd41c2 100644
--- a/testsuite/tests/patsyn/should_fail/T15695.stderr
+++ b/testsuite/tests/patsyn/should_fail/T15695.stderr
@@ -1,6 +1,6 @@
T15695.hs:40:14: warning: [-Wdeferred-type-errors (in -Wdefault)]
- • Could not deduce: a2 ~ NA 'VO
+ • Could not deduce (a2 ~ NA 'VO)
from the context: ((* -> * -> *) ~ (k -> k1 -> *), Either ~~ f,
ctx ~~ (a2 ':&: (a3 ':&: 'E)), f a2 ~~ f1, f1 a3 ~~ a4)
bound by a pattern with pattern synonym:
diff --git a/testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr b/testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr
index 26124310fc5f..5b24406cbfc1 100644
--- a/testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr
+++ b/testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr
@@ -1,5 +1,6 @@
records-nofieldselectors.hs:9:12: error:
- • Variable not in scope: x :: [a0] -> Int
- • NB: ‘x’ is a field selector
- that has been suppressed by NoFieldSelectors
+ Variable not in scope: x :: [a0] -> Int
+ Suggested fix:
+ Notice that ‘x’ is a field selector
+ that has been suppressed by NoFieldSelectors.
diff --git a/testsuite/tests/pmcheck/should_compile/T17646.stderr b/testsuite/tests/pmcheck/should_compile/T17646.stderr
index 93a60bc4665d..e5a3964a0a28 100644
--- a/testsuite/tests/pmcheck/should_compile/T17646.stderr
+++ b/testsuite/tests/pmcheck/should_compile/T17646.stderr
@@ -4,12 +4,12 @@ T17646.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)]
In an equation for ‘g’: Guards do not cover entire pattern space
T17646.hs:11:5: warning: [-Winaccessible-code (in -Wdefault)]
- • Couldn't match type ‘'True’ with ‘'False’
- Inaccessible code in
+ • Inaccessible code in
a pattern with constructor: B :: T 'False,
in a pattern binding in
a pattern guard for
an equation for ‘g’
+ Couldn't match type ‘'True’ with ‘'False’
• In the pattern: B
In a stmt of a pattern guard for
an equation for ‘g’:
diff --git a/testsuite/tests/pmcheck/should_compile/T18572.stderr b/testsuite/tests/pmcheck/should_compile/T18572.stderr
index a6ed65e6774b..b56ef9f18613 100644
--- a/testsuite/tests/pmcheck/should_compile/T18572.stderr
+++ b/testsuite/tests/pmcheck/should_compile/T18572.stderr
@@ -1,18 +1,17 @@
T18572.hs:12:1: warning: [-Winaccessible-code (in -Wdefault)]
- • Couldn't match type ‘'False’ with ‘'True’
- Inaccessible code in
+ • Inaccessible code in
a pattern with constructor: STrue :: SBool 'True,
in a pattern binding
+ Couldn't match type ‘'False’ with ‘'True’
• In the pattern: STrue
In a pattern binding: STrue = SFalse
T18572.hs:12:1: warning: [-Wincomplete-uni-patterns (in -Wall)]
Pattern match(es) are non-exhaustive
In a pattern binding:
- Patterns of type ‘SBool 'False’ not matched: SFalse
+ Patterns of type ‘SBool 'False’ not matched: SFalse
T18572.hs:12:1: warning: [-Woverlapping-patterns (in -Wdefault)]
Pattern match is redundant
In a pattern binding: STrue = ...
-
diff --git a/testsuite/tests/pmcheck/should_compile/T18610.stderr b/testsuite/tests/pmcheck/should_compile/T18610.stderr
index cc2ddf299678..c4576625628e 100644
--- a/testsuite/tests/pmcheck/should_compile/T18610.stderr
+++ b/testsuite/tests/pmcheck/should_compile/T18610.stderr
@@ -9,9 +9,9 @@ T18610.hs:24:7: warning: [-Wincomplete-patterns (in -Wextra)]
Patterns of type ‘(Bool, Bool)’ not matched: _
T18610.hs:53:3: warning: [-Winaccessible-code (in -Wdefault)]
- • Couldn't match type ‘Bool’ with ‘Int’
- Inaccessible code in
+ • Inaccessible code in
a pattern with constructor: Refl :: forall {k} (a :: k). a :~: a,
in an equation for ‘k’
+ Couldn't match type ‘Bool’ with ‘Int’
• In the pattern: Refl
In an equation for ‘k’: k Refl _ | considerAccessible = 2
diff --git a/testsuite/tests/polykinds/T18451.stderr b/testsuite/tests/polykinds/T18451.stderr
index 5f61afcbbea9..0bd3f9893b6a 100644
--- a/testsuite/tests/polykinds/T18451.stderr
+++ b/testsuite/tests/polykinds/T18451.stderr
@@ -1,9 +1,9 @@
T18451.hs:10:58: error:
• Expected kind ‘k0’, but ‘b’ has kind ‘k’
+ Type variable kinds:
+ a :: k0
+ k :: Const (*) a
• In the second argument of ‘SameKind’, namely ‘b’
In the type ‘forall (b :: k). SameKind a b’
In the type declaration for ‘T’
- • Type variable kinds:
- a :: k0
- k :: Const (*) a
diff --git a/testsuite/tests/polykinds/T7230.stderr b/testsuite/tests/polykinds/T7230.stderr
index f59e44d5cd8d..aea0ea4a9d51 100644
--- a/testsuite/tests/polykinds/T7230.stderr
+++ b/testsuite/tests/polykinds/T7230.stderr
@@ -1,6 +1,6 @@
T7230.hs:48:32: error:
- • Could not deduce: (x :<<= x1) ~ 'True
+ • Could not deduce ((x :<<= x1) ~ 'True)
from the context: Increasing xs ~ 'True
bound by the type signature for:
crash :: forall (xs :: [Nat]).
diff --git a/testsuite/tests/polykinds/T7438.stderr b/testsuite/tests/polykinds/T7438.stderr
index dd953fa69a58..ff1e74cc27fe 100644
--- a/testsuite/tests/polykinds/T7438.stderr
+++ b/testsuite/tests/polykinds/T7438.stderr
@@ -1,6 +1,6 @@
T7438.hs:6:14: error:
- • Could not deduce: p ~ p1
+ • Could not deduce (p ~ p1)
from the context: b ~ a
bound by a pattern with constructor:
Nil :: forall {k} (a :: k). Thrist a a,
@@ -12,9 +12,9 @@ T7438.hs:6:14: error:
‘p1’ is a rigid type variable bound by
the inferred type of go :: Thrist a b -> p -> p1
at T7438.hs:6:1-16
- Possible fix: add a type signature for ‘go’
• In the expression: acc
In an equation for ‘go’: go Nil acc = acc
• Relevant bindings include
acc :: p (bound at T7438.hs:6:8)
go :: Thrist a b -> p -> p1 (bound at T7438.hs:6:1)
+ Suggested fix: Consider giving ‘go’ a type signature
diff --git a/testsuite/tests/polykinds/T7594.stderr b/testsuite/tests/polykinds/T7594.stderr
index fc0aa1fcc34b..9a75c80ec357 100644
--- a/testsuite/tests/polykinds/T7594.stderr
+++ b/testsuite/tests/polykinds/T7594.stderr
@@ -1,6 +1,6 @@
T7594.hs:37:12: error:
- • Could not deduce: b ~ IO ()
+ • Could not deduce (b ~ IO ())
from the context: (:&:) c0 Real a
bound by a type expected by the context:
forall a. (:&:) c0 Real a => a -> b
@@ -10,8 +10,8 @@ T7594.hs:37:12: error:
‘b’ is a rigid type variable bound by
the inferred type of bar2 :: b
at T7594.hs:37:1-19
- Possible fix: add a type signature for ‘bar2’
• In the first argument of ‘app’, namely ‘print’
In the expression: app print q2
In an equation for ‘bar2’: bar2 = app print q2
• Relevant bindings include bar2 :: b (bound at T7594.hs:37:1)
+ Suggested fix: Consider giving ‘bar2’ a type signature
diff --git a/testsuite/tests/qualifieddo/should_fail/qdofail003.stderr b/testsuite/tests/qualifieddo/should_fail/qdofail003.stderr
index 8cf5f670ac90..ed59cd2bf42c 100644
--- a/testsuite/tests/qualifieddo/should_fail/qdofail003.stderr
+++ b/testsuite/tests/qualifieddo/should_fail/qdofail003.stderr
@@ -1,5 +1,6 @@
-qdofail003.hs:11:5:
+qdofail003.hs:11:5: error:
Not in scope: ‘P.>>’
- Perhaps you want to remove ‘>>’ from the explicit hiding list
- in the import of ‘Prelude’ (qdofail003.hs:3:1-33).
+ Suggested fix:
+ Perhaps you want to remove ‘>>’ from the explicit hiding list
+ in the import of ‘Prelude’ (qdofail003.hs:3:1-33).
diff --git a/testsuite/tests/qualifieddo/should_fail/qdofail004.stderr b/testsuite/tests/qualifieddo/should_fail/qdofail004.stderr
index 39752a29952c..cfe60a90105f 100644
--- a/testsuite/tests/qualifieddo/should_fail/qdofail004.stderr
+++ b/testsuite/tests/qualifieddo/should_fail/qdofail004.stderr
@@ -1,5 +1,6 @@
-qdofail004.hs:10:5:
+qdofail004.hs:10:5: error:
Not in scope: ‘P.fail’
- Perhaps you want to remove ‘fail’ from the explicit hiding list
- in the import of ‘Prelude’ (qdofail004.hs:3:1-33).
+ Suggested fix:
+ Perhaps you want to remove ‘fail’ from the explicit hiding list
+ in the import of ‘Prelude’ (qdofail004.hs:3:1-33).
diff --git a/testsuite/tests/quantified-constraints/T19921.stderr b/testsuite/tests/quantified-constraints/T19921.stderr
index 0465b10be991..9c2b06420485 100644
--- a/testsuite/tests/quantified-constraints/T19921.stderr
+++ b/testsuite/tests/quantified-constraints/T19921.stderr
@@ -1,6 +1,6 @@
T19921.hs:29:8: error:
- • Could not deduce: r arising from a use of ‘Dict’
+ • Could not deduce r arising from a use of ‘Dict’
from the context: (x \/ y) \/ z
bound by a quantified context at T19921.hs:1:1
or from: (x ⇒ r, (y \/ z) ⇒ r)
diff --git a/testsuite/tests/rename/prog002/rename.prog002.stderr b/testsuite/tests/rename/prog002/rename.prog002.stderr
index 01ab86946e7d..9fe478288fe5 100644
--- a/testsuite/tests/rename/prog002/rename.prog002.stderr
+++ b/testsuite/tests/rename/prog002/rename.prog002.stderr
@@ -1,5 +1,6 @@
rnfail037.hs:8:7: error:
Not in scope: data constructor ‘Rn037Help.C’
- Perhaps you want to remove ‘C’ from the explicit hiding list
- in the import of ‘Rn037Help’ (rnfail037.hs:4:1-28).
+ Suggested fix:
+ Perhaps you want to remove ‘C’ from the explicit hiding list
+ in the import of ‘Rn037Help’ (rnfail037.hs:4:1-28).
diff --git a/testsuite/tests/rename/should_compile/T9778.stderr b/testsuite/tests/rename/should_compile/T9778.stderr
index 81c69fdb8e78..9fcc9ece347f 100644
--- a/testsuite/tests/rename/should_compile/T9778.stderr
+++ b/testsuite/tests/rename/should_compile/T9778.stderr
@@ -1,4 +1,4 @@
T9778.hs:8:10: warning: [-Wunticked-promoted-constructors (in -Wall)]
Unticked promoted constructor: ‘A’.
- Use ‘'A’ instead of ‘A’.
+ Suggested fix: Use ‘'A’ instead of ‘A’.
diff --git a/testsuite/tests/rename/should_fail/T10618.stderr b/testsuite/tests/rename/should_fail/T10618.stderr
index cba5e47aff3e..629e93727b8c 100644
--- a/testsuite/tests/rename/should_fail/T10618.stderr
+++ b/testsuite/tests/rename/should_fail/T10618.stderr
@@ -1,6 +1,7 @@
T10618.hs:3:22: error:
- • Variable not in scope: (<|>) :: Maybe (Maybe a0) -> Maybe a1 -> t
- • Perhaps you meant one of these:
+ Variable not in scope: (<|>) :: Maybe (Maybe a0) -> Maybe a1 -> t
+ Suggested fix:
+ Perhaps use one of these:
‘<>’ (imported from Prelude), ‘<$>’ (imported from Prelude),
‘<*>’ (imported from Prelude)
diff --git a/testsuite/tests/rename/should_fail/T10781.stderr b/testsuite/tests/rename/should_fail/T10781.stderr
index d86f0d1beb52..3a5ccde99fcb 100644
--- a/testsuite/tests/rename/should_fail/T10781.stderr
+++ b/testsuite/tests/rename/should_fail/T10781.stderr
@@ -1,4 +1,4 @@
T10781.hs:12:5: error:
Not in scope: ‘Foo._name’
- No module named ‘Foo’ is imported.
+ NB: no module named ‘Foo’ is imported.
diff --git a/testsuite/tests/rename/should_fail/T11071.stderr b/testsuite/tests/rename/should_fail/T11071.stderr
index 0e77fae7dee1..4faad680ec17 100644
--- a/testsuite/tests/rename/should_fail/T11071.stderr
+++ b/testsuite/tests/rename/should_fail/T11071.stderr
@@ -1,53 +1,60 @@
T11071.hs:19:12: error:
Not in scope: ‘NoSuchModule.foo’
- No module named ‘NoSuchModule’ is imported.
+ NB: no module named ‘NoSuchModule’ is imported.
T11071.hs:20:12: error:
Not in scope: ‘Data.List.foobar’
- Module ‘Data.List’ does not export ‘foobar’.
+ NB: the module ‘Data.List’ does not export ‘foobar’.
T11071.hs:21:12: error:
Not in scope: ‘M.foobar’
- Neither ‘Data.IntMap’ nor ‘Data.Map’ exports ‘foobar’.
+ NB: neither ‘Data.IntMap’ nor ‘Data.Map’ export ‘foobar’.
T11071.hs:22:12: error:
Not in scope: ‘M'.foobar’
- Neither ‘System.IO’, ‘Data.IntMap’ nor ‘Data.Map’ exports ‘foobar’.
+ NB: neither ‘System.IO’,
+ ‘Data.IntMap’ nor ‘Data.Map’ export ‘foobar’.
T11071.hs:23:12: error:
Not in scope: ‘Data.List.sort’
- Perhaps you want to add ‘sort’ to the import list in the import of
- ‘Data.List’ (T11071.hs:3:1-24).
+ Suggested fix:
+ Perhaps you want to add ‘sort’ to the import list in the import of
+ ‘Data.List’ (T11071.hs:3:1-24).
T11071.hs:24:12: error:
Not in scope: ‘Data.List.unlines’
- Perhaps you meant ‘Data.List.lines’ (imported from Data.List)
- Perhaps you want to add ‘unlines’ to the import list
- in the import of ‘Data.List’ (T11071.hs:3:1-24).
+ Suggested fixes:
+ • Perhaps use ‘Data.List.lines’ (imported from Data.List)
+ • Perhaps you want to add ‘unlines’ to the import list
+ in the import of ‘Data.List’ (T11071.hs:3:1-24).
T11071.hs:25:12: error:
Not in scope: ‘M.size’
- Perhaps you want to add ‘size’ to one of these import lists:
- ‘Data.IntMap’ (T11071.hs:5:1-36)
- ‘Data.Map’ (T11071.hs:4:1-33)
+ Suggested fix:
+ Perhaps you want to add ‘size’ to one of these import lists:
+ ‘Data.IntMap’ (T11071.hs:5:1-36)
+ ‘Data.Map’ (T11071.hs:4:1-33)
T11071.hs:26:12: error:
Not in scope: ‘M.valid’
- Perhaps you meant one of these:
- ‘M'.valid’ (imported from Data.Map),
- ‘M'.valid’ (imported from Data.Map)
- Perhaps you want to add ‘valid’ to the import list in the import of
- ‘Data.Map’ (T11071.hs:4:1-33).
+ Suggested fixes:
+ • Perhaps use one of these:
+ ‘M'.valid’ (imported from Data.Map),
+ ‘M'.valid’ (imported from Data.Map)
+ • Perhaps you want to add ‘valid’ to the import list
+ in the import of ‘Data.Map’ (T11071.hs:4:1-33).
T11071.hs:27:12: error:
Not in scope: data constructor ‘Ord.Down’
- Perhaps you want to remove ‘Down’ from the explicit hiding list
- in the import of ‘Data.Ord’ (T11071.hs:8:1-46).
+ Suggested fix:
+ Perhaps you want to remove ‘Down’ from the explicit hiding list
+ in the import of ‘Data.Ord’ (T11071.hs:8:1-46).
T11071.hs:28:12: error:
Not in scope: ‘M'.size’
- Perhaps you want to remove ‘size’ from the hiding clauses
- in one of these imports:
- ‘Data.IntMap’ (T11071.hs:12:1-48)
- ‘Data.Map’ (T11071.hs:10:1-53)
+ Suggested fix:
+ Perhaps you want to remove ‘size’ from the hiding clauses
+ in one of these imports:
+ ‘Data.IntMap’ (T11071.hs:12:1-48)
+ ‘Data.Map’ (T11071.hs:10:1-53)
diff --git a/testsuite/tests/rename/should_fail/T11071a.stderr b/testsuite/tests/rename/should_fail/T11071a.stderr
index 853a79d3d703..5a2a9e92fa28 100644
--- a/testsuite/tests/rename/should_fail/T11071a.stderr
+++ b/testsuite/tests/rename/should_fail/T11071a.stderr
@@ -1,26 +1,30 @@
T11071a.hs:12:12: error:
- • Variable not in scope: intersperse
- • Perhaps you want to add ‘intersperse’ to the import list
+ Variable not in scope: intersperse
+ Suggested fix:
+ Perhaps you want to add ‘intersperse’ to the import list
in the import of ‘Data.List’ (T11071a.hs:3:1-24).
T11071a.hs:13:12: error:
- • Variable not in scope: foldl'
- • Perhaps you meant one of these:
- ‘foldl’ (imported from Prelude), ‘foldl1’ (imported from Prelude),
- ‘foldr’ (imported from Prelude)
- Perhaps you want to add ‘foldl'’ to one of these import lists:
- ‘Data.List’ (T11071a.hs:3:1-24)
- ‘Data.IntMap’ (T11071a.hs:4:1-21)
+ Variable not in scope: foldl'
+ Suggested fixes:
+ • Perhaps use one of these:
+ ‘foldl’ (imported from Prelude), ‘foldl1’ (imported from Prelude),
+ ‘foldr’ (imported from Prelude)
+ • Perhaps you want to add ‘foldl'’ to one of these import lists:
+ ‘Data.List’ (T11071a.hs:3:1-24)
+ ‘Data.IntMap’ (T11071a.hs:4:1-21)
T11071a.hs:14:12: error:
- • Data constructor not in scope: Down
- • Perhaps you want to remove ‘Down’ from the explicit hiding list
+ Data constructor not in scope: Down
+ Suggested fix:
+ Perhaps you want to remove ‘Down’ from the explicit hiding list
in the import of ‘Data.Ord’ (T11071a.hs:5:1-29).
T11071a.hs:15:12: error:
- • Data constructor not in scope: True
- • Perhaps you want to remove ‘True’ from the explicit hiding list
+ Data constructor not in scope: True
+ Suggested fix:
+ Perhaps you want to remove ‘True’ from the explicit hiding list
in the import of ‘Prelude’ (T11071a.hs:6:1-28).
T11071a.hs:16:12: error: Variable not in scope: foobar
diff --git a/testsuite/tests/rename/should_fail/T12681.stderr b/testsuite/tests/rename/should_fail/T12681.stderr
index 547cf4c01ca4..9f57265bcdd2 100644
--- a/testsuite/tests/rename/should_fail/T12681.stderr
+++ b/testsuite/tests/rename/should_fail/T12681.stderr
@@ -1,4 +1,4 @@
T12681.hs:4:17: error:
Not in scope: ‘a’
- Perhaps you meant ‘T12681a.a’ (imported from T12681a)
+ Suggested fix: Perhaps use ‘T12681a.a’ (imported from T12681a)
diff --git a/testsuite/tests/rename/should_fail/T13568.stderr b/testsuite/tests/rename/should_fail/T13568.stderr
index 63ee18409ac2..b0fce190e001 100644
--- a/testsuite/tests/rename/should_fail/T13568.stderr
+++ b/testsuite/tests/rename/should_fail/T13568.stderr
@@ -1,4 +1,6 @@
T13568.hs:7:8: error:
Not in scope: type constructor or class ‘A’
- A data constructor of that name is in scope; did you mean DataKinds?
+ Suggested fix:
+ Perhaps you intended to use DataKinds
+ to refer to the data constructor of that name?
diff --git a/testsuite/tests/rename/should_fail/T14225.stderr b/testsuite/tests/rename/should_fail/T14225.stderr
index f54e463e531d..c3ea46a7892f 100644
--- a/testsuite/tests/rename/should_fail/T14225.stderr
+++ b/testsuite/tests/rename/should_fail/T14225.stderr
@@ -1,3 +1,4 @@
+
<interactive>:2:1: error:
Not in scope: ‘M.fromJusr’
- Perhaps you meant ‘M.fromJust’ (imported from Data.Maybe)
+ Suggested fix: Perhaps use ‘M.fromJust’ (imported from Data.Maybe)
diff --git a/testsuite/tests/rename/should_fail/T15539.stderr b/testsuite/tests/rename/should_fail/T15539.stderr
index 9ac202f42039..c3c1653b5176 100644
--- a/testsuite/tests/rename/should_fail/T15539.stderr
+++ b/testsuite/tests/rename/should_fail/T15539.stderr
@@ -1,4 +1,5 @@
T15539.hs:6:13: error:
- • Variable not in scope: baz
- • Perhaps you meant one of these: ‘bam’ (line 17), ‘bar’ (line 15)
+ Variable not in scope: baz
+ Suggested fix:
+ Perhaps use one of these: ‘bam’ (line 17), ‘bar’ (line 15)
diff --git a/testsuite/tests/rename/should_fail/T15607.stderr b/testsuite/tests/rename/should_fail/T15607.stderr
index 4c1111eef9fe..2a534d2a5ad3 100644
--- a/testsuite/tests/rename/should_fail/T15607.stderr
+++ b/testsuite/tests/rename/should_fail/T15607.stderr
@@ -1,5 +1,6 @@
T15607.hs:6:10: error:
- • Variable not in scope: pure :: t0 -> t
- • Perhaps you want to remove ‘pure’ from the explicit hiding list
+ Variable not in scope: pure :: t0 -> t
+ Suggested fix:
+ Perhaps you want to remove ‘pure’ from the explicit hiding list
in the import of ‘Prelude’ (T15607.hs:4:1-36).
diff --git a/testsuite/tests/rename/should_fail/T16504.stderr b/testsuite/tests/rename/should_fail/T16504.stderr
index 2fc822d3a252..798404afc337 100644
--- a/testsuite/tests/rename/should_fail/T16504.stderr
+++ b/testsuite/tests/rename/should_fail/T16504.stderr
@@ -2,14 +2,16 @@
T16504.hs:5:1: error:
The type signature for ‘simpleFuntcion’
lacks an accompanying binding
- Perhaps you meant one of these:
+ Suggested fix:
+ Perhaps use one of these:
‘simpleFunction’ (Defined at T16504.hs:6:1),
‘simpleFunction2’ (Defined at T16504.hs:7:1)
T16504.hs:11:9: error:
The type signature for ‘anotherFunction’
lacks an accompanying binding
- Perhaps you meant ‘anotherFuntcion’ (Defined at T16504.hs:12:9)
+ Suggested fix:
+ Perhaps use ‘anotherFuntcion’ (Defined at T16504.hs:12:9)
T16504.hs:15:1: error:
The type signature for ‘nonexistentFuntcion’
diff --git a/testsuite/tests/rename/should_fail/T19843b.stderr b/testsuite/tests/rename/should_fail/T19843b.stderr
index 5b457440eb0f..6a92e26a4d53 100644
--- a/testsuite/tests/rename/should_fail/T19843b.stderr
+++ b/testsuite/tests/rename/should_fail/T19843b.stderr
@@ -1,4 +1,4 @@
-T19843b.hs:7:6:
- • Data constructor not in scope: Map :: (a0 -> Bool) -> t -> t0
- • Perhaps you meant variable ‘map’ (imported from Prelude)
+T19843b.hs:7:6: error:
+ Data constructor not in scope: Map :: (a0 -> Bool) -> t -> t0
+ Suggested fix: Perhaps use variable ‘map’ (imported from Prelude)
diff --git a/testsuite/tests/rename/should_fail/T19843c.stderr b/testsuite/tests/rename/should_fail/T19843c.stderr
index 94cdadf528f7..d15ac772b43e 100644
--- a/testsuite/tests/rename/should_fail/T19843c.stderr
+++ b/testsuite/tests/rename/should_fail/T19843c.stderr
@@ -1,4 +1,4 @@
T19843c.hs:6:6: error:
Not in scope: data constructor ‘Map.Map’
- Module ‘Data.Map’ does not export ‘Map’.
+ NB: the module ‘Data.Map’ does not export ‘Map’.
diff --git a/testsuite/tests/rename/should_fail/T19843d.stderr b/testsuite/tests/rename/should_fail/T19843d.stderr
index a27a6270052c..34a5de28f03c 100644
--- a/testsuite/tests/rename/should_fail/T19843d.stderr
+++ b/testsuite/tests/rename/should_fail/T19843d.stderr
@@ -1,4 +1,4 @@
T19843d.hs:7:6: error:
Not in scope: data constructor ‘Map’
- Perhaps you meant ‘Mup’ (line 5)
+ Suggested fix: Perhaps use ‘Mup’ (line 5)
diff --git a/testsuite/tests/rename/should_fail/T19843e.stderr b/testsuite/tests/rename/should_fail/T19843e.stderr
index 890c719bd872..f5870a356e9c 100644
--- a/testsuite/tests/rename/should_fail/T19843e.stderr
+++ b/testsuite/tests/rename/should_fail/T19843e.stderr
@@ -1,4 +1,4 @@
T19843e.hs:9:6: error:
Not in scope: data constructor ‘Map’
- Perhaps you meant ‘Mup’ (line 7)
+ Suggested fix: Perhaps use ‘Mup’ (line 7)
diff --git a/testsuite/tests/rename/should_fail/T19843f.stderr b/testsuite/tests/rename/should_fail/T19843f.stderr
index 903fee78496b..3b73444439db 100644
--- a/testsuite/tests/rename/should_fail/T19843f.stderr
+++ b/testsuite/tests/rename/should_fail/T19843f.stderr
@@ -1,8 +1,8 @@
T19843f.hs:8:12: error:
Not in scope: ‘mup’
- Perhaps you meant ‘mop’ (line 5)
+ Suggested fix: Perhaps use ‘mop’ (line 5)
T19843f.hs:10:10: error:
Not in scope: ‘mup’
- Perhaps you meant ‘mop’ (line 5)
+ Suggested fix: Perhaps use ‘mop’ (line 5)
diff --git a/testsuite/tests/rename/should_fail/T19843g.stderr b/testsuite/tests/rename/should_fail/T19843g.stderr
index 6d0d398bfd9c..f635b6c2d26b 100644
--- a/testsuite/tests/rename/should_fail/T19843g.stderr
+++ b/testsuite/tests/rename/should_fail/T19843g.stderr
@@ -1,4 +1,4 @@
T19843g.hs:10:12: error:
Not in scope: ‘mup’
- Perhaps you meant ‘mop’ (line 7)
+ Suggested fix: Perhaps use ‘mop’ (line 7)
diff --git a/testsuite/tests/rename/should_fail/T19843h.stderr b/testsuite/tests/rename/should_fail/T19843h.stderr
index 56bca0feebdb..f7eeb9d5e93d 100644
--- a/testsuite/tests/rename/should_fail/T19843h.stderr
+++ b/testsuite/tests/rename/should_fail/T19843h.stderr
@@ -1,34 +1,34 @@
-T19843h.hs:14:7:
- No instance for (GHC.Records.HasField "mup" r4 a4)
+T19843h.hs:14:7: error:
+ • No instance for (GHC.Records.HasField "mup" r4 a4)
arising from selecting the field ‘mup’
- Perhaps you meant ‘mop’ (line 11)
- In the expression: undefined.mup
+ Perhaps use ‘mop’ (line 11)
+ • In the expression: undefined.mup
In an equation for ‘foo’: foo = undefined.mup
-T19843h.hs:16:7:
- No instance for (GHC.Records.HasField "traverse" r3 a3)
+T19843h.hs:16:7: error:
+ • No instance for (GHC.Records.HasField "traverse" r3 a3)
arising from selecting the field ‘traverse’
- In the expression: undefined.traverse
+ • In the expression: undefined.traverse
In an equation for ‘bar’: bar = undefined.traverse
-T19843h.hs:18:7:
- No instance for (GHC.Records.HasField "getSum" r2 a2)
+T19843h.hs:18:7: error:
+ • No instance for (GHC.Records.HasField "getSum" r2 a2)
arising from selecting the field ‘getSum’
- In the expression: undefined.getSum
+ • In the expression: undefined.getSum
In an equation for ‘baz’: baz = undefined.getSum
-T19843h.hs:20:8:
- No instance for (GHC.Records.HasField "getAlt" r1 a1)
+T19843h.hs:20:8: error:
+ • No instance for (GHC.Records.HasField "getAlt" r1 a1)
arising from selecting the field ‘getAlt’
- In the expression: undefined.getAlt
+ • In the expression: undefined.getAlt
In an equation for ‘quux’: quux = undefined.getAlt
-T19843h.hs:24:8:
- No instance for (GHC.Records.HasField "getAll" r0 a0)
+T19843h.hs:24:8: error:
+ • No instance for (GHC.Records.HasField "getAll" r0 a0)
arising from selecting the field ‘getAll’
- Perhaps you meant ‘getAlt’ (imported from Data.Monoid)
+ Perhaps use ‘getAlt’ (imported from Data.Monoid)
Perhaps you want to add ‘getAll’ to the import list
in the import of ‘Data.Monoid’ (T19843h.hs:9:1-28).
- In the expression: undefined.getAll
+ • In the expression: undefined.getAll
In an equation for ‘quur’: quur = undefined.getAll
diff --git a/testsuite/tests/rename/should_fail/T19843i.stderr b/testsuite/tests/rename/should_fail/T19843i.stderr
index 60f671c67903..f5de15281be4 100644
--- a/testsuite/tests/rename/should_fail/T19843i.stderr
+++ b/testsuite/tests/rename/should_fail/T19843i.stderr
@@ -1,5 +1,6 @@
-T19843i.hs:5:5:
+T19843i.hs:5:5: error:
Not in scope: ‘M.getSum’
- Perhaps you want to add ‘getSum’ to the import list
- in the import of ‘Data.Monoid’ (T19843i.hs:3:1-32).
+ Suggested fix:
+ Perhaps you want to add ‘getSum’ to the import list
+ in the import of ‘Data.Monoid’ (T19843i.hs:3:1-32).
diff --git a/testsuite/tests/rename/should_fail/T19843j.stderr b/testsuite/tests/rename/should_fail/T19843j.stderr
index e99a9f0a6275..a0423eeb7613 100644
--- a/testsuite/tests/rename/should_fail/T19843j.stderr
+++ b/testsuite/tests/rename/should_fail/T19843j.stderr
@@ -1,5 +1,6 @@
-T19843j.hs:5:5:
- Variable not in scope: guard
- Perhaps you want to add ‘guard’ to the import list
- in the import of ‘Control.Monad’ (T19843j.hs:3:1-31).
+T19843j.hs:5:5: error:
+ Variable not in scope: guard
+ Suggested fix:
+ Perhaps you want to add ‘guard’ to the import list in the import of
+ ‘Control.Monad’ (T19843j.hs:3:1-31).
diff --git a/testsuite/tests/rename/should_fail/T19843k.stderr b/testsuite/tests/rename/should_fail/T19843k.stderr
index 08ed7d8c089c..7872fdb784b4 100644
--- a/testsuite/tests/rename/should_fail/T19843k.stderr
+++ b/testsuite/tests/rename/should_fail/T19843k.stderr
@@ -1,4 +1,4 @@
-T19843k.hs:5:8:
+T19843k.hs:5:8: error:
Not in scope: ‘M.doesn'tExist’
- Module ‘Data.Monoid’ does not export ‘doesn'tExist’.
+ NB: the module ‘Data.Monoid’ does not export ‘doesn'tExist’.
diff --git a/testsuite/tests/rename/should_fail/T19843l.stderr b/testsuite/tests/rename/should_fail/T19843l.stderr
index d5168b2b908e..094a0b43a29d 100644
--- a/testsuite/tests/rename/should_fail/T19843l.stderr
+++ b/testsuite/tests/rename/should_fail/T19843l.stderr
@@ -1,4 +1,4 @@
-T19843l.hs:7:12:
+T19843l.hs:7:12: error:
Not in scope: type constructor or class ‘WrongName’
- Perhaps you meant ‘FongName’ (line 4)
+ Suggested fix: Perhaps use ‘FongName’ (line 4)
diff --git a/testsuite/tests/rename/should_fail/T19843m.stderr b/testsuite/tests/rename/should_fail/T19843m.stderr
index dd7583842a1c..1ec2b3192536 100644
--- a/testsuite/tests/rename/should_fail/T19843m.stderr
+++ b/testsuite/tests/rename/should_fail/T19843m.stderr
@@ -1,5 +1,6 @@
-T19843m.hs:9:12:
+T19843m.hs:9:12: error:
Not in scope: type constructor or class ‘WrongName’
- Perhaps you meant one of these:
- ‘FongName’ (line 6), data constructor ‘LongName’ (line 5)
+ Suggested fix:
+ Perhaps use one of these:
+ ‘FongName’ (line 6), data constructor ‘LongName’ (line 5)
diff --git a/testsuite/tests/rename/should_fail/T2901.stderr b/testsuite/tests/rename/should_fail/T2901.stderr
index d5a5bbda9a48..eab94f2acf46 100644
--- a/testsuite/tests/rename/should_fail/T2901.stderr
+++ b/testsuite/tests/rename/should_fail/T2901.stderr
@@ -1,4 +1,4 @@
T2901.hs:6:5: error:
Not in scope: data constructor ‘F.Foo’
- No module named ‘F’ is imported.
+ NB: no module named ‘F’ is imported.
diff --git a/testsuite/tests/rename/should_fail/T2993.stderr b/testsuite/tests/rename/should_fail/T2993.stderr
index 4542ffeaf064..67dadf14bc9d 100644
--- a/testsuite/tests/rename/should_fail/T2993.stderr
+++ b/testsuite/tests/rename/should_fail/T2993.stderr
@@ -1,4 +1,4 @@
T2993.hs:7:13: error:
- • Variable not in scope: (<**>) :: t -> (a -> a) -> t1
- • Perhaps you meant ‘<*>’ (imported from Prelude)
+ Variable not in scope: (<**>) :: t -> (a -> a) -> t1
+ Suggested fix: Perhaps use ‘<*>’ (imported from Prelude)
diff --git a/testsuite/tests/rename/should_fail/T495.stderr b/testsuite/tests/rename/should_fail/T495.stderr
index 0581807d7028..cc637c468177 100644
--- a/testsuite/tests/rename/should_fail/T495.stderr
+++ b/testsuite/tests/rename/should_fail/T495.stderr
@@ -4,4 +4,5 @@ T495.hs:4:12: error:
T495.hs:7:12: error:
The INLINE pragma for ‘lookup’ lacks an accompanying binding
- (The INLINE pragma must be given where ‘lookup’ is declared)
+ Suggested fix:
+ Move the INLINE pragma to the declaration site of ‘lookup’.
diff --git a/testsuite/tests/rename/should_fail/T5001b.stderr b/testsuite/tests/rename/should_fail/T5001b.stderr
index e5f7aa1d145f..2544aa4dc281 100644
--- a/testsuite/tests/rename/should_fail/T5001b.stderr
+++ b/testsuite/tests/rename/should_fail/T5001b.stderr
@@ -1,4 +1,5 @@
T5001b.hs:10:17: error:
The INLINE pragma for ‘genum’ lacks an accompanying binding
- (The INLINE pragma must be given where ‘genum’ is declared)
+ Suggested fix:
+ Move the INLINE pragma to the declaration site of ‘genum’.
diff --git a/testsuite/tests/rename/should_fail/T5372.stderr b/testsuite/tests/rename/should_fail/T5372.stderr
index d8b8e8fa5654..3642362660f6 100644
--- a/testsuite/tests/rename/should_fail/T5372.stderr
+++ b/testsuite/tests/rename/should_fail/T5372.stderr
@@ -1,4 +1,4 @@
T5372.hs:4:11: error:
Not in scope: data constructor ‘MkS’
- Perhaps you meant ‘T5372a.MkS’ (imported from T5372a)
+ Suggested fix: Perhaps use ‘T5372a.MkS’ (imported from T5372a)
diff --git a/testsuite/tests/rename/should_fail/T5533.stderr b/testsuite/tests/rename/should_fail/T5533.stderr
index bd5516cceb7b..67dbf3a93e68 100644
--- a/testsuite/tests/rename/should_fail/T5533.stderr
+++ b/testsuite/tests/rename/should_fail/T5533.stderr
@@ -1,4 +1,5 @@
T5533.hs:4:1: error:
The type signature for ‘f2’ lacks an accompanying binding
- (The type signature must be given where ‘f2’ is declared)
+ Suggested fix:
+ Move the type signature to the declaration site of ‘f2’.
diff --git a/testsuite/tests/rename/should_fail/T5657.stderr b/testsuite/tests/rename/should_fail/T5657.stderr
index 5663b900d996..28c3ba7d6c15 100644
--- a/testsuite/tests/rename/should_fail/T5657.stderr
+++ b/testsuite/tests/rename/should_fail/T5657.stderr
@@ -1,7 +1,7 @@
T5657.hs:3:8: error:
Not in scope: ‘LT..’
- No module named ‘LT’ is imported.
+ NB: no module named ‘LT’ is imported.
T5657.hs:3:8: error:
A section must be enclosed in parentheses thus: (LT.. GT)
diff --git a/testsuite/tests/rename/should_fail/T7906.stderr b/testsuite/tests/rename/should_fail/T7906.stderr
index ddcd4ff484e4..5a8c7cb77d8f 100644
--- a/testsuite/tests/rename/should_fail/T7906.stderr
+++ b/testsuite/tests/rename/should_fail/T7906.stderr
@@ -1,4 +1,5 @@
T7906.hs:5:15: error:
The INLINABLE pragma for ‘foo’ lacks an accompanying binding
- (The INLINABLE pragma must be given where ‘foo’ is declared)
+ Suggested fix:
+ Move the INLINABLE pragma to the declaration site of ‘foo’.
diff --git a/testsuite/tests/rename/should_fail/T7937.stderr b/testsuite/tests/rename/should_fail/T7937.stderr
index 7a65b0c06e71..11a2bed876de 100644
--- a/testsuite/tests/rename/should_fail/T7937.stderr
+++ b/testsuite/tests/rename/should_fail/T7937.stderr
@@ -1,4 +1,4 @@
T7937.hs:8:13: error:
- • Variable not in scope: (***) :: Bool -> Bool -> t
- • Perhaps you meant ‘**’ (imported from Prelude)
+ Variable not in scope: (***) :: Bool -> Bool -> t
+ Suggested fix: Perhaps use ‘**’ (imported from Prelude)
diff --git a/testsuite/tests/rename/should_fail/T9177.stderr b/testsuite/tests/rename/should_fail/T9177.stderr
index a1153b4fcb66..215a144f06c6 100644
--- a/testsuite/tests/rename/should_fail/T9177.stderr
+++ b/testsuite/tests/rename/should_fail/T9177.stderr
@@ -1,11 +1,12 @@
T9177.hs:4:13: error:
Not in scope: type variable ‘int’
- Perhaps you meant type constructor or class ‘Int’ (imported from Prelude)
+ Suggested fix:
+ Perhaps use type constructor or class ‘Int’ (imported from Prelude)
T9177.hs:7:14: error:
Not in scope: type variable ‘integerr’
- Perhaps you meant type constructor or class ‘Integer’ (imported from Prelude)
+ Suggested fix:
+ Perhaps use type constructor or class ‘Integer’ (imported from Prelude)
-T9177.hs:17:6: error:
- Not in scope: data constructor ‘Fun’
+T9177.hs:17:6: error: Not in scope: data constructor ‘Fun’
diff --git a/testsuite/tests/rename/should_fail/T9436.stderr b/testsuite/tests/rename/should_fail/T9436.stderr
index 2b9b10fb14a9..30a7c5f6b4fa 100644
--- a/testsuite/tests/rename/should_fail/T9436.stderr
+++ b/testsuite/tests/rename/should_fail/T9436.stderr
@@ -1,4 +1,4 @@
-T9436.hs:8:4:
+T9436.hs:8:4: error:
Not in scope: data constructor ‘T'’
- Perhaps you meant ‘T’ (line 5)
+ Suggested fix: Perhaps use ‘T’ (line 5)
diff --git a/testsuite/tests/rename/should_fail/rnfail022.stderr b/testsuite/tests/rename/should_fail/rnfail022.stderr
index c27e6130f9ae..87a1adef3f0c 100644
--- a/testsuite/tests/rename/should_fail/rnfail022.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail022.stderr
@@ -1,4 +1,5 @@
rnfail022.hs:8:5: error:
- • Variable not in scope: intersperse
- • Perhaps you meant ‘L.intersperse’ (imported from Data.List)
+ Variable not in scope: intersperse
+ Suggested fix:
+ Perhaps use ‘L.intersperse’ (imported from Data.List)
diff --git a/testsuite/tests/rename/should_fail/rnfail030.stderr b/testsuite/tests/rename/should_fail/rnfail030.stderr
index 462dc5fa2c06..6343062325c0 100644
--- a/testsuite/tests/rename/should_fail/rnfail030.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail030.stderr
@@ -1,5 +1,6 @@
rnfail030.hs:2:21: error:
Not in scope: ‘Data.List.map’
- Perhaps you want to add ‘map’ to the import list in the import of
- ‘Data.List’ (rnfail030.hs:3:1-19).
+ Suggested fix:
+ Perhaps you want to add ‘map’ to the import list in the import of
+ ‘Data.List’ (rnfail030.hs:3:1-19).
diff --git a/testsuite/tests/rename/should_fail/rnfail031.stderr b/testsuite/tests/rename/should_fail/rnfail031.stderr
index 95d8ea1561f4..1036d52bcbf8 100644
--- a/testsuite/tests/rename/should_fail/rnfail031.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail031.stderr
@@ -1,5 +1,6 @@
rnfail031.hs:2:21: error:
Not in scope: ‘Data.List.map’
- Perhaps you want to add ‘map’ to the import list in the import of
- ‘Data.List’ (rnfail031.hs:3:1-36).
+ Suggested fix:
+ Perhaps you want to add ‘map’ to the import list in the import of
+ ‘Data.List’ (rnfail031.hs:3:1-36).
diff --git a/testsuite/tests/rename/should_fail/rnfail032.stderr b/testsuite/tests/rename/should_fail/rnfail032.stderr
index 874b1746e6d2..febd38044275 100644
--- a/testsuite/tests/rename/should_fail/rnfail032.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail032.stderr
@@ -1,9 +1,10 @@
rnfail032.hs:2:21: error:
Not in scope: ‘Data.List.map’
- Perhaps you meant one of these:
- ‘Data.List.zip’ (imported from Data.List),
- ‘Data.List.or’ (imported from Data.List),
- ‘Data.List.all’ (imported from Data.List)
- Perhaps you want to remove ‘map’ from the explicit hiding list
- in the import of ‘Data.List’ (rnfail032.hs:3:1-41).
+ Suggested fixes:
+ • Perhaps use one of these:
+ ‘Data.List.zip’ (imported from Data.List),
+ ‘Data.List.or’ (imported from Data.List),
+ ‘Data.List.all’ (imported from Data.List)
+ • Perhaps you want to remove ‘map’ from the explicit hiding list
+ in the import of ‘Data.List’ (rnfail032.hs:3:1-41).
diff --git a/testsuite/tests/rename/should_fail/rnfail033.stderr b/testsuite/tests/rename/should_fail/rnfail033.stderr
index a445fd729331..d9fbc22a1c31 100644
--- a/testsuite/tests/rename/should_fail/rnfail033.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail033.stderr
@@ -1,9 +1,10 @@
rnfail033.hs:2:21: error:
Not in scope: ‘Data.List.map’
- Perhaps you meant one of these:
- ‘Data.List.zip’ (imported from Data.List),
- ‘Data.List.or’ (imported from Data.List),
- ‘Data.List.all’ (imported from Data.List)
- Perhaps you want to remove ‘map’ from the explicit hiding list
- in the import of ‘Data.List’ (rnfail033.hs:3:1-31).
+ Suggested fixes:
+ • Perhaps use one of these:
+ ‘Data.List.zip’ (imported from Data.List),
+ ‘Data.List.or’ (imported from Data.List),
+ ‘Data.List.all’ (imported from Data.List)
+ • Perhaps you want to remove ‘map’ from the explicit hiding list
+ in the import of ‘Data.List’ (rnfail033.hs:3:1-31).
diff --git a/testsuite/tests/rename/should_fail/rnfail034.stderr b/testsuite/tests/rename/should_fail/rnfail034.stderr
index a5219c138bda..be73da47a44c 100644
--- a/testsuite/tests/rename/should_fail/rnfail034.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail034.stderr
@@ -3,4 +3,4 @@ rnfail034.hs:4:11: error: Qualified name in binding position: M.y
rnfail034.hs:4:26: error:
Not in scope: ‘M.y’
- Perhaps you meant ‘M.g’ (line 4)
+ Suggested fix: Perhaps use ‘M.g’ (line 4)
diff --git a/testsuite/tests/safeHaskell/ghci/p16.stderr b/testsuite/tests/safeHaskell/ghci/p16.stderr
index 69a10da8dbd5..357bc5bc9fd0 100644
--- a/testsuite/tests/safeHaskell/ghci/p16.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p16.stderr
@@ -11,7 +11,7 @@
for GHC's newtype-deriving extension
<interactive>:19:9: error:
- • Data constructor not in scope: T2 :: T -> t
- • Perhaps you meant ‘T1’ (line 13)
+ Data constructor not in scope: T2 :: T -> t
+ Suggested fix: Perhaps use ‘T1’ (line 13)
<interactive>:22:4: error: Variable not in scope: y
diff --git a/testsuite/tests/safeHaskell/ghci/p4.stderr b/testsuite/tests/safeHaskell/ghci/p4.stderr
index 621960f9e25d..47ea0ca18e18 100644
--- a/testsuite/tests/safeHaskell/ghci/p4.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p4.stderr
@@ -1,7 +1,7 @@
<interactive>:6:9: error:
Not in scope: ‘System.IO.Unsafe.unsafePerformIO’
- No module named ‘System.IO.Unsafe’ is imported.
+ NB: no module named ‘System.IO.Unsafe’ is imported.
<interactive>:7:9: error: Variable not in scope: x :: IO b0 -> t
diff --git a/testsuite/tests/safeHaskell/ghci/p6.stderr b/testsuite/tests/safeHaskell/ghci/p6.stderr
index d8dc09a996e5..cba63662ce16 100644
--- a/testsuite/tests/safeHaskell/ghci/p6.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p6.stderr
@@ -6,5 +6,5 @@
foreign import ccall safe "sin" c_sin :: Double -> Double
<interactive>:13:1: error:
- • Variable not in scope: c_sin :: t0 -> t
- • Perhaps you meant ‘c_sin'’ (line 8)
+ Variable not in scope: c_sin :: t0 -> t
+ Suggested fix: Perhaps use ‘c_sin'’ (line 8)
diff --git a/testsuite/tests/th/T11680.stderr b/testsuite/tests/th/T11680.stderr
index 07d88403f184..05e976837a80 100644
--- a/testsuite/tests/th/T11680.stderr
+++ b/testsuite/tests/th/T11680.stderr
@@ -2,27 +2,29 @@
T11680.hs:15:7: error: Variable not in scope: noMatches :: Bool
T11680.hs:20:7: error:
- • Variable not in scope: abce :: [a]
- • Perhaps you meant ‘abcd’ (line 23)
+ Variable not in scope: abce :: [a]
+ Suggested fix: Perhaps use ‘abcd’ (line 23)
T11680.hs:31:7: error: Variable not in scope: foo :: Int
T11680.hs:39:7: error:
- • Variable not in scope: bar :: ()
- • Perhaps you meant one of these: ‘bat’ (line 42), ‘baz’ (line 45)
+ Variable not in scope: bar :: ()
+ Suggested fix:
+ Perhaps use one of these: ‘bat’ (line 42), ‘baz’ (line 45)
T11680.hs:50:7: error: Variable not in scope: ns :: [Double]
T11680.hs:55:7: error:
- • Variable not in scope: intercalate
- • Perhaps you meant ‘List.intercalate’ (imported from Data.List)
+ Variable not in scope: intercalate
+ Suggested fix:
+ Perhaps use ‘List.intercalate’ (imported from Data.List)
T11680.hs:59:7: error:
- • Variable not in scope: nub
- • Perhaps you meant ‘List.nub’ (imported from Data.List)
+ Variable not in scope: nub
+ Suggested fix: Perhaps use ‘List.nub’ (imported from Data.List)
T11680.hs:64:7: error: Variable not in scope: x :: t0 -> Int
T11680.hs:69:7: error:
- • Variable not in scope: cat :: ()
- • Perhaps you meant ‘bat’ (line 42)
+ Variable not in scope: cat :: ()
+ Suggested fix: Perhaps use ‘bat’ (line 42)
diff --git a/testsuite/tests/th/T11941.stderr b/testsuite/tests/th/T11941.stderr
index 4508ed3557fb..ca21f919fed5 100644
--- a/testsuite/tests/th/T11941.stderr
+++ b/testsuite/tests/th/T11941.stderr
@@ -1,6 +1,7 @@
T11941.hs:7:30: error:
Not in scope: ‘getFrst’
- Perhaps you meant one of these:
- ‘getFirst’ (imported from Data.Monoid),
- ‘getLast’ (imported from Data.Monoid)
+ Suggested fix:
+ Perhaps use one of these:
+ ‘getFirst’ (imported from Data.Monoid),
+ ‘getLast’ (imported from Data.Monoid)
diff --git a/testsuite/tests/th/T13837.stderr b/testsuite/tests/th/T13837.stderr
index 7bb6587dedb6..a5f1005ca849 100644
--- a/testsuite/tests/th/T13837.stderr
+++ b/testsuite/tests/th/T13837.stderr
@@ -1,10 +1,11 @@
T13837.hs:9:4: error:
- • The exact Name ‘Fam’ is not in scope
- Probable cause: you used a unique Template Haskell name (NameU),
- perhaps via newName, but did not bind it
- If that's it, then -ddump-splices might be useful
+ • The Name ‘Fam’ is not in scope.
• In the argument of reifyInstances: Fam_0
In the untyped splice:
$(do fam_name <- newName "Fam"
stringE . show =<< qReifyInstances fam_name [])
+ Suggested fix:
+ If you bound a unique Template Haskell name (NameU)
+ perhaps via newName,
+ then -ddump-splices might be useful.
diff --git a/testsuite/tests/th/T18102.stderr b/testsuite/tests/th/T18102.stderr
index 9c1f1e248402..d757c9735fd3 100644
--- a/testsuite/tests/th/T18102.stderr
+++ b/testsuite/tests/th/T18102.stderr
@@ -8,18 +8,20 @@ T18102.hs:11:22: error:
T18102.hs:11:35: error:
• Not in scope: ‘fromInteger’
- Perhaps you want to add ‘fromInteger’ to the import list
- in the import of ‘Prelude’ (T18102.hs:5:1-50).
• In the Template Haskell quotation [|| if True then 10 else 15 ||]
In the typed splice:
$$(do _stuff <- [|| if True then 10 else 15 ||]
return [])
+ Suggested fix:
+ Perhaps you want to add ‘fromInteger’ to the import list
+ in the import of ‘Prelude’ (T18102.hs:5:1-50).
T18102.hs:11:43: error:
• Not in scope: ‘fromInteger’
- Perhaps you want to add ‘fromInteger’ to the import list
- in the import of ‘Prelude’ (T18102.hs:5:1-50).
• In the Template Haskell quotation [|| if True then 10 else 15 ||]
In the typed splice:
$$(do _stuff <- [|| if True then 10 else 15 ||]
return [])
+ Suggested fix:
+ Perhaps you want to add ‘fromInteger’ to the import list
+ in the import of ‘Prelude’ (T18102.hs:5:1-50).
diff --git a/testsuite/tests/th/T2713.stderr b/testsuite/tests/th/T2713.stderr
index 89a15ca83a5f..ce9091c79cf8 100644
--- a/testsuite/tests/th/T2713.stderr
+++ b/testsuite/tests/th/T2713.stderr
@@ -1,8 +1,10 @@
-T2713.hs:11:10:
+T2713.hs:11:10: error:
The fixity signature for ‘.*.’ lacks an accompanying binding
- (The fixity signature must be given where ‘.*.’ is declared)
+ Suggested fix:
+ Move the fixity signature to the declaration site of ‘.*.’.
-T2713.hs:12:1:
+T2713.hs:12:1: error:
The type signature for ‘f’ lacks an accompanying binding
- (The type signature must be given where ‘f’ is declared)
+ Suggested fix:
+ Move the type signature to the declaration site of ‘f’.
diff --git a/testsuite/tests/th/T5971.stderr b/testsuite/tests/th/T5971.stderr
index c8164cd1dfdc..c06561b8532e 100644
--- a/testsuite/tests/th/T5971.stderr
+++ b/testsuite/tests/th/T5971.stderr
@@ -1,7 +1,8 @@
T5971.hs:6:6: error:
- • The exact Name ‘x’ is not in scope
- Probable cause: you used a unique Template Haskell name (NameU),
- perhaps via newName, but did not bind it
- If that's it, then -ddump-splices might be useful
+ • The Name ‘x’ is not in scope.
• In the untyped splice: $(newName "x" >>= varE)
+ Suggested fix:
+ If you bound a unique Template Haskell name (NameU)
+ perhaps via newName,
+ then -ddump-splices might be useful.
diff --git a/testsuite/tests/th/T7241.stderr b/testsuite/tests/th/T7241.stderr
index 1681b45f51db..a46daa2c2510 100644
--- a/testsuite/tests/th/T7241.stderr
+++ b/testsuite/tests/th/T7241.stderr
@@ -1,8 +1,9 @@
T7241.hs:7:2: error:
- Same exact name in multiple name-spaces:
+ Same Name in multiple name-spaces:
type constructor or class ‘Foo’, declared at: T7241.hs:7:2
data constructor ‘Foo’, declared at: T7241.hs:7:2
- Probable cause: you bound a unique Template Haskell name (NameU),
- perhaps via newName, in different name-spaces.
- If that's it, then -ddump-splices might be useful
+ Suggested fix:
+ If you bound a unique Template Haskell name (NameU)
+ perhaps via newName,
+ then -ddump-splices might be useful.
diff --git a/testsuite/tests/typecheck/should_compile/T13651.stderr b/testsuite/tests/typecheck/should_compile/T13651.stderr
index 99d57d1c96ff..72ed83da20fb 100644
--- a/testsuite/tests/typecheck/should_compile/T13651.stderr
+++ b/testsuite/tests/typecheck/should_compile/T13651.stderr
@@ -1,6 +1,6 @@
T13651.hs:12:8: error:
- • Could not deduce: F cr (Bar h (Foo u)) ~ Bar h (Bar r u)
+ • Could not deduce (F cr (Bar h (Foo u)) ~ Bar h (Bar r u))
from the context: (F cr cu ~ Bar h (Bar r u),
F cu cs ~ Bar (Foo h) (Bar u s))
bound by the type signature for:
diff --git a/testsuite/tests/typecheck/should_compile/T9939.stderr b/testsuite/tests/typecheck/should_compile/T9939.stderr
index 3067cddbf692..4d1af91a6cb7 100644
--- a/testsuite/tests/typecheck/should_compile/T9939.stderr
+++ b/testsuite/tests/typecheck/should_compile/T9939.stderr
@@ -1,20 +1,20 @@
T9939.hs:6:7: warning: [-Wredundant-constraints]
- • Redundant constraint: Eq a
- • In the type signature for:
- f1 :: forall a. (Eq a, Ord a) => a -> a -> Bool
+ Redundant constraint: Eq a
+ In the type signature for:
+ f1 :: forall a. (Eq a, Ord a) => a -> a -> Bool
T9939.hs:10:7: warning: [-Wredundant-constraints]
- • Redundant constraint: Ord a
- • In the type signature for:
- f2 :: forall a. (Eq a, Ord a) => a -> a -> Bool
+ Redundant constraint: Ord a
+ In the type signature for:
+ f2 :: forall a. (Eq a, Ord a) => a -> a -> Bool
T9939.hs:14:7: warning: [-Wredundant-constraints]
- • Redundant constraint: Eq b
- • In the type signature for:
- f3 :: forall a b. (Eq a, a ~ b, Eq b) => a -> b -> Bool
+ Redundant constraint: Eq b
+ In the type signature for:
+ f3 :: forall a b. (Eq a, a ~ b, Eq b) => a -> b -> Bool
T9939.hs:21:7: warning: [-Wredundant-constraints]
- • Redundant constraint: Eq b
- • In the type signature for:
- f4 :: forall a b. (Eq a, Eq b) => a -> b -> Equal a b -> Bool
+ Redundant constraint: Eq b
+ In the type signature for:
+ f4 :: forall a b. (Eq a, Eq b) => a -> b -> Equal a b -> Bool
diff --git a/testsuite/tests/typecheck/should_compile/tc214.stderr b/testsuite/tests/typecheck/should_compile/tc214.stderr
index ea5cc8d93ca5..de6b340e4b42 100644
--- a/testsuite/tests/typecheck/should_compile/tc214.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc214.stderr
@@ -4,15 +4,15 @@ tc214.hs:19:1: warning: [-Woverlapping-patterns (in -Wdefault)]
In an equation for ‘bar2’: bar2 (F2 _) = ...
tc214.hs:19:7: warning: [-Winaccessible-code (in -Wdefault)]
- • Couldn't match type ‘a’ with ‘forall a1. a1’
+ • Inaccessible code in
+ a pattern with constructor: F2 :: forall a. a -> Foo2 [a],
+ in an equation for ‘bar2’
+ Couldn't match type ‘a’ with ‘forall a1. a1’
Cannot equate type variable ‘a’
with a type involving polytypes: forall a1. a1
‘a’ is a rigid type variable bound by
a pattern with constructor: F2 :: forall a. a -> Foo2 [a],
in an equation for ‘bar2’
at tc214.hs:19:7-10
- Inaccessible code in
- a pattern with constructor: F2 :: forall a. a -> Foo2 [a],
- in an equation for ‘bar2’
• In the pattern: F2 _
In an equation for ‘bar2’: bar2 (F2 _) = ()
diff --git a/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
index bc12dfa2baa3..1c105ae30c55 100644
--- a/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
@@ -2,12 +2,14 @@
[2 of 2] Compiling Foo ( valid_hole_fits.hs, valid_hole_fits.o )
valid_hole_fits.hs:9:6: warning: [-Wdeferred-out-of-scope-variables (in -Wdefault)]
- • Variable not in scope: putStrLn :: String -> IO ()
- • Perhaps you meant one of these:
- ‘System.IO.putStrLn’ (imported from System.IO),
- ‘System.IO.putStr’ (imported from System.IO)
- Perhaps you want to remove ‘putStrLn’ from the explicit hiding list
- in the import of ‘Prelude’ (valid_hole_fits.hs:3:1-40).
+ Variable not in scope: putStrLn :: String -> IO ()
+ Suggested fixes:
+ • Perhaps use one of these:
+ ‘System.IO.putStrLn’ (imported from System.IO),
+ ‘System.IO.putStr’ (imported from System.IO)
+ • Perhaps you want to remove ‘putStrLn’
+ from the explicit hiding list in the import of ‘Prelude’
+ (valid_hole_fits.hs:3:1-40).
valid_hole_fits.hs:17:17: warning: [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Int -> IO Int
diff --git a/testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr b/testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr
index e4260e62edba..4d759155ccac 100644
--- a/testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr
+++ b/testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr
@@ -1,6 +1,6 @@
GivenForallLoop.hs:8:11: error:
- • Could not deduce: a ~ b
+ • Could not deduce (a ~ b)
from the context: a ~ (forall b1. F a b1)
bound by the type signature for:
loopy :: forall a b. (a ~ (forall b1. F a b1)) => a -> b
diff --git a/testsuite/tests/typecheck/should_fail/T10285.stderr b/testsuite/tests/typecheck/should_fail/T10285.stderr
index 02215e2f70ec..c259a8e3e2da 100644
--- a/testsuite/tests/typecheck/should_fail/T10285.stderr
+++ b/testsuite/tests/typecheck/should_fail/T10285.stderr
@@ -1,6 +1,6 @@
T10285.hs:8:17: error:
- • Could not deduce: Coercible a b arising from a use of ‘coerce’
+ • Could not deduce (Coercible a b) arising from a use of ‘coerce’
from the context: Coercible (N a) (N b)
bound by a pattern with constructor:
Coercion :: forall {k} (a :: k) (b :: k).
diff --git a/testsuite/tests/typecheck/should_fail/T10534.stderr b/testsuite/tests/typecheck/should_fail/T10534.stderr
index 86020af877ab..a8888ba5beb7 100644
--- a/testsuite/tests/typecheck/should_fail/T10534.stderr
+++ b/testsuite/tests/typecheck/should_fail/T10534.stderr
@@ -1,6 +1,6 @@
T10534a.hs:10:9: error:
- • Could not deduce: Coercible a b arising from a use of ‘coerce’
+ • Could not deduce (Coercible a b) arising from a use of ‘coerce’
from the context: Coercible (DF a) (DF b)
bound by the type signature for:
silly :: forall a b. Coercible (DF a) (DF b) => a -> b
diff --git a/testsuite/tests/typecheck/should_fail/T12178a.stderr b/testsuite/tests/typecheck/should_fail/T12178a.stderr
index ef9f66a52672..46fb5a661495 100644
--- a/testsuite/tests/typecheck/should_fail/T12178a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12178a.stderr
@@ -1,4 +1,5 @@
T12178a.hs:7:12: error:
The INLINE pragma for ‘C’ lacks an accompanying binding
- (The INLINE pragma must be given where ‘C’ is declared)
+ Suggested fix:
+ Move the INLINE pragma to the declaration site of ‘C’.
diff --git a/testsuite/tests/typecheck/should_fail/T12785b.stderr b/testsuite/tests/typecheck/should_fail/T12785b.stderr
index 14ce110c0d74..cd2c75b2c185 100644
--- a/testsuite/tests/typecheck/should_fail/T12785b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12785b.stderr
@@ -1,6 +1,6 @@
T12785b.hs:30:65: error:
- • Could not deduce: Payload ('S n) (Payload n s1) ~ s
+ • Could not deduce (Payload ('S n) (Payload n s1) ~ s)
arising from a use of ‘SBranchX’
from the context: m ~ 'S n
bound by a pattern with constructor:
diff --git a/testsuite/tests/typecheck/should_fail/T13640.stderr b/testsuite/tests/typecheck/should_fail/T13640.stderr
index d926dd924143..28afc7d55e02 100644
--- a/testsuite/tests/typecheck/should_fail/T13640.stderr
+++ b/testsuite/tests/typecheck/should_fail/T13640.stderr
@@ -1,8 +1,9 @@
T13640.hs:13:22: error:
- • Variable not in scope:
- (.)
- :: (f0 a c0 -> f0 b c0)
- -> ((a0 -> b0) -> f1 a0 -> f1 b0) -> f a c -> f b d
- • Perhaps you want to remove ‘.’ from the explicit hiding list
+ Variable not in scope:
+ (.)
+ :: (f0 a c0 -> f0 b c0)
+ -> ((a0 -> b0) -> f1 a0 -> f1 b0) -> f a c -> f b d
+ Suggested fix:
+ Perhaps you want to remove ‘.’ from the explicit hiding list
in the import of ‘Prelude’ (T13640.hs:4:1-27).
diff --git a/testsuite/tests/typecheck/should_fail/T15361.stderr b/testsuite/tests/typecheck/should_fail/T15361.stderr
index 1520bc398231..b4692064f33d 100644
--- a/testsuite/tests/typecheck/should_fail/T15361.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15361.stderr
@@ -1,6 +1,6 @@
T15361.hs:13:13: error:
- • Could not deduce: a ~ c
+ • Could not deduce (a ~ c)
from the context: b ~ a
bound by a pattern with constructor:
HRefl :: forall {k1} (a :: k1). a :~~: a,
diff --git a/testsuite/tests/typecheck/should_fail/T19978.stderr b/testsuite/tests/typecheck/should_fail/T19978.stderr
index 4ea25fcf04e1..68796e058a97 100644
--- a/testsuite/tests/typecheck/should_fail/T19978.stderr
+++ b/testsuite/tests/typecheck/should_fail/T19978.stderr
@@ -3,19 +3,19 @@ T19978.hs:8:7: error:
• Illegal term-level use of the type constructor or class ‘Bool’
• imported from ‘Prelude’ at T19978.hs:3:8-13
(and originally defined in ‘GHC.Types’)
- • Perhaps you meant one of these:
+ • Perhaps use one of these:
‘Bowl’ (line 11), variable ‘bool’ (line 12)
• In the expression: Bool
In an equation for ‘ex1’: ex1 = Bool
T19978.hs:14:7: error:
- • Data constructor not in scope: Let
- • Perhaps you meant ‘Left’ (imported from Prelude)
+ Data constructor not in scope: Let
+ Suggested fix: Perhaps use ‘Left’ (imported from Prelude)
T19978.hs:21:7: error:
• Illegal term-level use of the type variable ‘mytv’
• bound at T19978.hs:20:15
- • Perhaps you meant one of these:
+ • Perhaps use one of these:
data constructor ‘Mytv’ (line 24), ‘myvv’ (line 25)
• In the expression: mytv
In an equation for ‘ex3’: ex3 = mytv
diff --git a/testsuite/tests/typecheck/should_fail/T5853.stderr b/testsuite/tests/typecheck/should_fail/T5853.stderr
index b25e1fca91d6..1cb76d317fa2 100644
--- a/testsuite/tests/typecheck/should_fail/T5853.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5853.stderr
@@ -1,6 +1,6 @@
T5853.hs:15:52: error:
- • Could not deduce: Subst fa1 (Elem fb) ~ fb
+ • Could not deduce (Subst fa1 (Elem fb) ~ fb)
arising from a use of ‘<$>’
from the context: (F fa, Elem fb ~ Elem fb,
Subst fa (Elem fb) ~ fb, Subst fb (Elem fa) ~ fa, F fa1,
diff --git a/testsuite/tests/typecheck/should_fail/T7525.stderr b/testsuite/tests/typecheck/should_fail/T7525.stderr
index 11028ef3bd67..86fc55e1982b 100644
--- a/testsuite/tests/typecheck/should_fail/T7525.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7525.stderr
@@ -1,6 +1,6 @@
T7525.hs:5:30: error:
- • Could not deduce: ?b::Bool
+ • Could not deduce (?b::Bool)
arising from a use of implicit parameter ‘?b’
from the context: ?a::Bool
bound by the implicit-parameter binding for ?a at T7525.hs:5:7-31
diff --git a/testsuite/tests/typecheck/should_fail/T9109.stderr b/testsuite/tests/typecheck/should_fail/T9109.stderr
index 6a4d4988deb5..223be12e8bd6 100644
--- a/testsuite/tests/typecheck/should_fail/T9109.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9109.stderr
@@ -1,6 +1,6 @@
T9109.hs:8:13: error:
- • Could not deduce: p ~ Bool
+ • Could not deduce (p ~ Bool)
from the context: a ~ Bool
bound by a pattern with constructor: GBool :: G Bool,
in an equation for ‘foo’
@@ -8,7 +8,7 @@ T9109.hs:8:13: error:
‘p’ is a rigid type variable bound by
the inferred type of foo :: G a -> p
at T9109.hs:8:1-16
- Possible fix: add a type signature for ‘foo’
• In the expression: True
In an equation for ‘foo’: foo GBool = True
• Relevant bindings include foo :: G a -> p (bound at T9109.hs:8:1)
+ Suggested fix: Consider giving ‘foo’ a type signature
diff --git a/testsuite/tests/typecheck/should_fail/tcfail046.stderr b/testsuite/tests/typecheck/should_fail/tcfail046.stderr
index 967b5a0fe632..6ee553f689db 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail046.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail046.stderr
@@ -11,10 +11,10 @@ tcfail046.hs:10:50: error:
tcfail046.hs:22:25: error:
• Could not deduce (Eq (Process a))
arising from the first field of ‘Create’ (type ‘Process a’)
- (maybe you haven't applied a function to enough arguments?)
from the context: Eq a
bound by the deriving clause for ‘Eq (Message a)’
at tcfail046.hs:22:25-26
+ (maybe you haven't applied a function to enough arguments?)
Possible fix:
use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
diff --git a/testsuite/tests/typecheck/should_fail/tcfail062.stderr b/testsuite/tests/typecheck/should_fail/tcfail062.stderr
index ff4915dfd23e..197bdb30f0e7 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail062.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail062.stderr
@@ -1,8 +1,10 @@
-tcfail062.hs:34:6:
+tcfail062.hs:34:6: error:
Not in scope: type variable ‘behaviouralExpression’
- Perhaps you meant type constructor or class ‘BehaviouralExpression’ (line 25)
+ Suggested fix:
+ Perhaps use type constructor or class ‘BehaviouralExpression’ (line 25)
-tcfail062.hs:34:29:
+tcfail062.hs:34:29: error:
Not in scope: type variable ‘behaviouralExpression’
- Perhaps you meant type constructor or class ‘BehaviouralExpression’ (line 25)
+ Suggested fix:
+ Perhaps use type constructor or class ‘BehaviouralExpression’ (line 25)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail167.stderr b/testsuite/tests/typecheck/should_fail/tcfail167.stderr
index 8ca5dc9b8047..6346257e0955 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail167.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail167.stderr
@@ -4,9 +4,9 @@ tcfail167.hs:14:1: error: [-Woverlapping-patterns (in -Wdefault), -Werror=overla
In an equation for ‘inaccessible’: inaccessible C2 = ...
tcfail167.hs:14:14: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessible-code]
- • Couldn't match type ‘Char’ with ‘Float’
- Inaccessible code in
+ • Inaccessible code in
a pattern with constructor: C2 :: T Float,
in an equation for ‘inaccessible’
+ Couldn't match type ‘Char’ with ‘Float’
• In the pattern: C2
In an equation for ‘inaccessible’: inaccessible C2 = ' '
diff --git a/testsuite/tests/typecheck/should_run/Typeable1.stderr b/testsuite/tests/typecheck/should_run/Typeable1.stderr
index 3ded9c03ed30..d2488bb57529 100644
--- a/testsuite/tests/typecheck/should_run/Typeable1.stderr
+++ b/testsuite/tests/typecheck/should_run/Typeable1.stderr
@@ -1,8 +1,6 @@
Typeable1.hs:22:5: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessible-code]
- • Couldn't match type: ComposeK
- with: a3 b3
- Inaccessible code in
+ • Inaccessible code in
a pattern with pattern synonym:
App :: forall k2 (t :: k2).
() =>
@@ -11,6 +9,8 @@ Typeable1.hs:22:5: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessi
TypeRep a -> TypeRep b -> TypeRep t,
in a pattern binding in
a 'do' block
+ Couldn't match type: ComposeK
+ with: a3 b3
• In the pattern: App x y
In a stmt of a 'do' block: App x y <- pure x
In the expression:
--
GitLab