diff options
author | Jakob Brünker <jakob.bruenker@gmail.com> | 2021-05-16 07:09:58 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-05-21 06:22:47 -0400 |
commit | d9eb8bbf38cda5b6c885fad8ae8addea3325ce42 (patch) | |
tree | a7eaa0e7ce587e6d8037667fb28367f3e830e9db | |
parent | 703c0c3c13cad700ae998de062134119bd33071f (diff) | |
download | haskell-d9eb8bbf38cda5b6c885fad8ae8addea3325ce42.tar.gz |
Only suggest names that make sense (#19843)
* Don't show suggestions for similar variables when a data constructor
in a pattern is not in scope.
* Only suggest record fields when a record field for record creation or
updating is not in scope.
* Suggest similar record fields when a record field is not in scope with
-XOverloadedRecordDot.
* Show suggestions for data constructors if a type constructor or type
is not in scope, but only if -XDataKinds is enabled.
Fixes #19843.
39 files changed, 497 insertions, 112 deletions
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs index 352ede60dd..1bd7a583b4 100644 --- a/compiler/GHC/Rename/Bind.hs +++ b/compiler/GHC/Rename/Bind.hs @@ -443,7 +443,8 @@ rnBindLHS name_maker _ bind@(FunBind { fun_id = rdr_name }) rnBindLHS name_maker _ (PatSynBind x psb@PSB{ psb_id = rdrname }) | isTopRecNameMaker name_maker = do { addLocMA checkConName rdrname - ; name <- lookupLocatedTopBndrRnN rdrname -- Should be in scope already + ; name <- + lookupLocatedTopConstructorRnN rdrname -- Should be in scope already ; return (PatSynBind x psb{ psb_ext = noAnn, psb_id = name }) } | otherwise -- Pattern synonym, not at top level diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs index 090810512f..957b118b88 100644 --- a/compiler/GHC/Rename/Env.hs +++ b/compiler/GHC/Rename/Env.hs @@ -13,8 +13,11 @@ module GHC.Rename.Env ( newTopSrcBinder, lookupLocatedTopBndrRn, lookupLocatedTopBndrRnN, lookupTopBndrRn, + lookupLocatedTopConstructorRn, lookupLocatedTopConstructorRnN, - lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe, + lookupLocatedOccRn, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField, + lookupLocatedOccRnNone, + lookupOccRn, lookupOccRn_maybe, lookupLocalOccRn_maybe, lookupInfoOccRn, lookupLocalOccThLvl_maybe, lookupLocalOccRn, lookupTypeOccRn, @@ -250,7 +253,7 @@ terribly efficient, but there seems to be no better way. -- Can be made to not be exposed -- Only used unwrapped in rnAnnProvenance -lookupTopBndrRn :: RdrName -> RnM Name +lookupTopBndrRn :: WhatLooking -> RdrName -> RnM Name -- Look up a top-level source-code binder. We may be looking up an unqualified 'f', -- and there may be several imported 'f's too, which must not confuse us. -- For example, this is OK: @@ -261,7 +264,7 @@ lookupTopBndrRn :: RdrName -> RnM Name -- -- A separate function (importsFromLocalDecls) reports duplicate top level -- decls, so here it's safe just to choose an arbitrary one. -lookupTopBndrRn rdr_name = +lookupTopBndrRn which_suggest rdr_name = lookupExactOrOrig rdr_name id $ do { -- Check for operators in type or class declarations -- See Note [Type and class operator definitions] @@ -275,14 +278,20 @@ lookupTopBndrRn rdr_name = [gre] -> return (greMangledName gre) _ -> do -- Ambiguous (can't happen) or unbound traceRn "lookupTopBndrRN fail" (ppr rdr_name) - unboundName WL_LocalTop rdr_name + unboundName (LF which_suggest WL_LocalTop) rdr_name } +lookupLocatedTopConstructorRn :: Located RdrName -> RnM (Located Name) +lookupLocatedTopConstructorRn = wrapLocM (lookupTopBndrRn WL_Constructor) + +lookupLocatedTopConstructorRnN :: LocatedN RdrName -> RnM (LocatedN Name) +lookupLocatedTopConstructorRnN = wrapLocMA (lookupTopBndrRn WL_Constructor) + lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name) -lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn +lookupLocatedTopBndrRn = wrapLocM (lookupTopBndrRn WL_Anything) lookupLocatedTopBndrRnN :: LocatedN RdrName -> RnM (LocatedN Name) -lookupLocatedTopBndrRnN = wrapLocMA lookupTopBndrRn +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 @@ -393,7 +402,7 @@ lookupFamInstName :: Maybe Name -> LocatedN RdrName lookupFamInstName (Just cls) tc_rdr -- Associated type; c.f GHC.Rename.Bind.rnMethodBind = wrapLocMA (lookupInstDeclBndr cls (text "associated type")) tc_rdr lookupFamInstName Nothing tc_rdr -- Family instance; tc_rdr is an *occurrence* - = lookupLocatedOccRn tc_rdr + = lookupLocatedOccRnConstr tc_rdr ----------------------------------------------- lookupConstructorFields :: Name -> RnM [FieldLabel] @@ -550,7 +559,8 @@ lookupRecFieldOcc_update dup_fields_ok rdr_name = do Nothing -> unbound | otherwise -> unbound where - unbound = UnambiguousGre . NormalGreName <$> unboundName WL_Global rdr_name + unbound = UnambiguousGre . NormalGreName + <$> unboundName (LF WL_RecField WL_Global) rdr_name {- Note [DisambiguateRecordFields] @@ -991,6 +1001,18 @@ lookupLocatedOccRn :: GenLocated (SrcSpanAnn' ann) RdrName -> TcRn (GenLocated (SrcSpanAnn' ann) Name) lookupLocatedOccRn = wrapLocMA lookupOccRn +lookupLocatedOccRnConstr :: GenLocated (SrcSpanAnn' ann) RdrName + -> TcRn (GenLocated (SrcSpanAnn' ann) Name) +lookupLocatedOccRnConstr = wrapLocMA lookupOccRnConstr + +lookupLocatedOccRnRecField :: GenLocated (SrcSpanAnn' ann) RdrName + -> TcRn (GenLocated (SrcSpanAnn' ann) Name) +lookupLocatedOccRnRecField = wrapLocMA lookupOccRnRecField + +lookupLocatedOccRnNone :: GenLocated (SrcSpanAnn' ann) RdrName + -> TcRn (GenLocated (SrcSpanAnn' ann) Name) +lookupLocatedOccRnNone = wrapLocMA lookupOccRnNone + lookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name) -- Just look in the local environment lookupLocalOccRn_maybe rdr_name @@ -1003,13 +1025,34 @@ lookupLocalOccThLvl_maybe name = do { lcl_env <- getLclEnv ; return (lookupNameEnv (tcl_th_bndrs lcl_env) name) } --- lookupOccRn looks up an occurrence of a RdrName -lookupOccRn :: RdrName -> RnM Name -lookupOccRn rdr_name +-- lookupOccRn' looks up an occurrence of a RdrName, and uses its argument to +-- determine what kind of suggestions should be displayed if it is not in scope +lookupOccRn' :: WhatLooking -> RdrName -> RnM Name +lookupOccRn' which_suggest rdr_name = do { mb_name <- lookupOccRn_maybe rdr_name ; case mb_name of Just name -> return name - Nothing -> reportUnboundName rdr_name } + Nothing -> reportUnboundName' which_suggest rdr_name } + +-- lookupOccRn looks up an occurrence of a RdrName and displays suggestions if +-- it is not in scope +lookupOccRn :: RdrName -> RnM Name +lookupOccRn = lookupOccRn' WL_Anything + +-- lookupOccRnConstr looks up an occurrence of a RdrName and displays +-- constructors and pattern synonyms as suggestions if it is not in scope +lookupOccRnConstr :: RdrName -> RnM Name +lookupOccRnConstr = lookupOccRn' WL_Constructor + +-- lookupOccRnRecField looks up an occurrence of a RdrName and displays +-- record fields as suggestions if it is not in scope +lookupOccRnRecField :: RdrName -> RnM Name +lookupOccRnRecField = lookupOccRn' WL_RecField + +-- lookupOccRnRecField looks up an occurrence of a RdrName and displays +-- no suggestions if it is not in scope +lookupOccRnNone :: RdrName -> RnM Name +lookupOccRnNone = lookupOccRn' WL_None -- Only used in one place, to rename pattern synonym binders. -- See Note [Renaming pattern synonym variables] in GHC.Rename.Bind @@ -1018,7 +1061,7 @@ lookupLocalOccRn rdr_name = do { mb_name <- lookupLocalOccRn_maybe rdr_name ; case mb_name of Just name -> return name - Nothing -> unboundName WL_LocalOnly rdr_name } + Nothing -> unboundName (LF WL_Anything WL_LocalOnly) rdr_name } -- lookupTypeOccRn looks up an optionally promoted RdrName. -- Used for looking up type variables. @@ -1043,7 +1086,7 @@ lookup_demoted rdr_name ; if data_kinds then do { mb_demoted_name <- lookupOccRn_maybe demoted_rdr ; case mb_demoted_name of - Nothing -> unboundNameX WL_Any rdr_name star_info + Nothing -> unboundNameX looking_for rdr_name star_info Just demoted_name -> do { addDiagnostic (WarningWithFlag Opt_WarnUntickedPromotedConstructors) @@ -1057,12 +1100,13 @@ lookup_demoted rdr_name lookupOccRn_maybe demoted_rdr ; let suggestion | isJust mb_demoted_name = suggest_dk | otherwise = star_info - ; unboundNameX WL_Any rdr_name suggestion } } + ; unboundNameX looking_for rdr_name suggestion } } | otherwise - = reportUnboundName rdr_name + = reportUnboundName' (lf_which looking_for) 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 @@ -1208,7 +1252,11 @@ lookupGlobalOccRn' fos rdr_name = case mn of Just n -> return n Nothing -> do { traceRn "lookupGlobalOccRn" (ppr rdr_name) - ; unboundName WL_Global rdr_name } + ; unboundName (LF which_suggest WL_Global) rdr_name } + where which_suggest = case fos of + WantNormal -> WL_Anything + WantBoth -> WL_RecField + WantField -> WL_RecField -- Looks up a RdrName occurrence in the GlobalRdrEnv and with -- lookupQualifiedNameGHCi. Does not try to find an Exact or Orig name first. @@ -1444,7 +1492,7 @@ lookupGreAvailRn rdr_name GreNotFound -> do traceRn "lookupGreAvailRn" (ppr rdr_name) - name <- unboundName WL_Global rdr_name + name <- unboundName (LF WL_Anything WL_Global) rdr_name return (name, avail name) MultipleNames gres -> do @@ -1811,11 +1859,12 @@ lookupBindGroupOcc ctxt what rdr_name lookup_top keep_me = do { env <- getGlobalRdrEnv + ; dflags <- getDynFlags ; let all_gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name) names_in_scope = -- If rdr_name lacks a binding, only -- recommend alternatives from related -- namespaces. See #17593. - filter (\n -> nameSpacesRelated + filter (\n -> nameSpacesRelated dflags WL_Anything (rdrNameSpace rdr_name) (nameNameSpace n)) $ map greMangledName @@ -1974,7 +2023,7 @@ lookupIfThenElse = do { rebindable_on <- xoptM LangExt.RebindableSyntax ; if not rebindable_on then return Nothing - else do { ite <- lookupOccRn (mkVarUnqual (fsLit "ifThenElse")) + else do { ite <- lookupOccRnNone (mkVarUnqual (fsLit "ifThenElse")) ; return (Just ite) } } lookupSyntaxName :: Name -- ^ The standard name @@ -1989,7 +2038,7 @@ lookupSyntaxName std_name = do { rebind <- xoptM LangExt.RebindableSyntax ; if not rebind then return (std_name, emptyFVs) - else do { nm <- lookupOccRn (mkRdrUnqual (nameOccName std_name)) + else do { nm <- lookupOccRnNone (mkRdrUnqual (nameOccName std_name)) ; return (nm, unitFV nm) } } lookupSyntaxExpr :: Name -- ^ The standard name @@ -2013,7 +2062,8 @@ lookupSyntaxNames std_names ; if not rebindable_on then return (map (HsVar noExtField . noLocA) std_names, emptyFVs) else - do { usr_names <- mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names + do { usr_names <- + mapM (lookupOccRnNone . mkRdrUnqual . nameOccName) std_names ; return (map (HsVar noExtField . noLocA) usr_names, mkFVs usr_names) } } @@ -2047,7 +2097,7 @@ lookupQualifiedDo ctxt std_name lookupNameWithQualifier :: Name -> ModuleName -> RnM (Name, FreeVars) lookupNameWithQualifier std_name modName - = do { qname <- lookupOccRn (mkRdrQual modName (nameOccName std_name)) + = do { qname <- lookupOccRnNone (mkRdrQual modName (nameOccName std_name)) ; return (qname, unitFV qname) } -- See Note [QualifiedDo]. diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs index d97266d7f2..bdcd7a4151 100644 --- a/compiler/GHC/Rename/Expr.hs +++ b/compiler/GHC/Rename/Expr.hs @@ -415,7 +415,7 @@ rnExpr (ExplicitSum _ alt arity expr) rnExpr (RecordCon { rcon_con = con_id , rcon_flds = rec_binds@(HsRecFields { rec_dotdot = dd }) }) - = do { con_lname@(L _ con_name) <- lookupLocatedOccRn con_id + = do { con_lname@(L _ con_name) <- lookupLocatedOccRnConstr con_id ; (flds, fvs) <- rnHsRecFields (HsRecFieldCon con_name) mk_hs_var rec_binds ; (flds', fvss) <- mapAndUnzipM rn_field flds ; let rec_binds' = HsRecFields { rec_flds = flds', rec_dotdot = dd } diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index e91901ae50..817b2fe246 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -322,8 +322,10 @@ rnAnnProvenance :: AnnProvenance GhcPs -> RnM (AnnProvenance GhcRn, FreeVars) rnAnnProvenance provenance = do provenance' <- case provenance of - ValueAnnProvenance n -> ValueAnnProvenance <$> lookupLocatedTopBndrRnN n - TypeAnnProvenance n -> TypeAnnProvenance <$> lookupLocatedTopBndrRnN n + ValueAnnProvenance n -> ValueAnnProvenance + <$> lookupLocatedTopBndrRnN n + TypeAnnProvenance n -> TypeAnnProvenance + <$> lookupLocatedTopConstructorRnN n ModuleAnnProvenance -> return ModuleAnnProvenance return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance')) @@ -1781,7 +1783,7 @@ rnTyClDecl (FamDecl { tcdFam = fam }) rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs }) - = do { tycon' <- lookupLocatedTopBndrRnN tycon + = do { tycon' <- lookupLocatedTopConstructorRnN tycon ; let kvs = extractHsTyRdrTyVarsKindVars rhs doc = TySynCtx tycon ; traceRn "rntycl-ty" (ppr tycon <+> ppr kvs) @@ -1797,7 +1799,7 @@ rnTyClDecl (DataDecl tcdFixity = fixity, tcdDataDefn = defn@HsDataDefn{ dd_ND = new_or_data , dd_kindSig = kind_sig} }) - = do { tycon' <- lookupLocatedTopBndrRnN tycon + = do { tycon' <- lookupLocatedTopConstructorRnN tycon ; let kvs = extractDataDefnKindVars defn doc = TyDataCtx tycon ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs) @@ -1818,7 +1820,7 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls, tcdFDs = fds, tcdSigs = sigs, tcdMeths = mbinds, tcdATs = ats, tcdATDefs = at_defs, tcdDocs = docs}) - = do { lcls' <- lookupLocatedTopBndrRnN lcls + = do { lcls' <- lookupLocatedTopConstructorRnN lcls ; let cls' = unLoc lcls' kvs = [] -- No scoped kind vars except those in -- kind signatures on the tyvars @@ -2103,7 +2105,7 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars , fdFixity = fixity , fdInfo = info, fdResultSig = res_sig , fdInjectivityAnn = injectivity }) - = do { tycon' <- lookupLocatedTopBndrRnN tycon + = do { tycon' <- lookupLocatedTopConstructorRnN tycon ; ((tyvars', res_sig', injectivity'), fv1) <- bindHsQTyVars doc mb_cls kvs tyvars $ \ tyvars' _ -> do { let rn_sig = rnFamResultSig doc @@ -2286,7 +2288,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs , con_mb_cxt = mcxt, con_args = args , con_doc = mb_doc, con_forall = forall }) = do { _ <- addLocMA checkConName name - ; new_name <- lookupLocatedTopBndrRnN name + ; new_name <- lookupLocatedTopConstructorRnN name -- We bind no implicit binders here; this is just like -- a nested HsForAllTy. E.g. consider @@ -2321,7 +2323,7 @@ rnConDecl (ConDeclGADT { con_names = names , con_res_ty = res_ty , con_doc = mb_doc }) = do { mapM_ (addLocMA checkConName) names - ; new_names <- mapM lookupLocatedTopBndrRnN names + ; new_names <- mapM (lookupLocatedTopConstructorRnN) names ; let -- We must ensure that we extract the free tkvs in left-to-right -- order of their appearance in the constructor type. diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs index 8681903590..e9943c8be7 100644 --- a/compiler/GHC/Rename/Pat.hs +++ b/compiler/GHC/Rename/Pat.hs @@ -146,7 +146,7 @@ wrapSrcSpanCps fn (L loc a) lookupConCps :: LocatedN RdrName -> CpsRn (LocatedN Name) lookupConCps con_rdr - = CpsRn (\k -> do { con_name <- lookupLocatedOccRn con_rdr + = CpsRn (\k -> do { con_name <- lookupLocatedOccRnConstr con_rdr ; (r, fvs) <- k con_name ; return (r, addOneFV fvs (unLoc con_name)) }) -- We add the constructor name to the free vars diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs index f4c09dbe4c..0d666528c9 100644 --- a/compiler/GHC/Rename/Unbound.hs +++ b/compiler/GHC/Rename/Unbound.hs @@ -9,11 +9,15 @@ module GHC.Rename.Unbound , mkUnboundNameRdr , isUnboundName , reportUnboundName + , reportUnboundName' , unknownNameSuggestions + , WhatLooking(..) , WhereLooking(..) + , LookingFor(..) , unboundName , unboundNameX , notInScopeErr + , nameSpacesRelated , exactNameErr ) where @@ -31,6 +35,8 @@ import GHC.Utils.Misc import GHC.Data.Maybe import GHC.Data.FastString +import qualified GHC.LanguageExtensions as LangExt + import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Name import GHC.Types.Name.Reader @@ -51,28 +57,49 @@ import Data.Function ( on ) ************************************************************************ -} -data WhereLooking = WL_Any -- Any binding +-- What kind of suggestion are we looking for? #19843 +data WhatLooking = WL_Anything -- Any binding + | WL_Constructor -- Constructors and pattern synonyms + -- E.g. in K { f1 = True }, if K is not in scope, + -- suggest only constructors + | WL_RecField -- Record fields + -- E.g. in K { f1 = True, f2 = False }, if f2 is not in + -- scope, suggest only constructor fields + | WL_None -- No suggestions + -- WS_None is used for rebindable syntax, where there + -- is no point in suggesting alternative spellings + deriving Eq + +data WhereLooking = WL_Anywhere -- Any binding | WL_Global -- Any top-level binding (local or imported) | WL_LocalTop -- Any top-level binding in this module | WL_LocalOnly -- Only local bindings - -- (pattern synonyms declaractions, - -- see Note [Renaming pattern synonym variables]) + -- (pattern synonyms declarations, + -- see Note [Renaming pattern synonym variables] + -- in GHC.Rename.Bind) + +data LookingFor = LF { lf_which :: WhatLooking + , lf_where :: WhereLooking + } mkUnboundNameRdr :: RdrName -> Name mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr) +reportUnboundName' :: WhatLooking -> RdrName -> RnM Name +reportUnboundName' what_look rdr = unboundName (LF what_look WL_Anywhere) rdr + reportUnboundName :: RdrName -> RnM Name -reportUnboundName rdr = unboundName WL_Any rdr +reportUnboundName = reportUnboundName' WL_Anything -unboundName :: WhereLooking -> RdrName -> RnM Name -unboundName wl rdr = unboundNameX wl rdr Outputable.empty +unboundName :: LookingFor -> RdrName -> RnM Name +unboundName lf rdr = unboundNameX lf rdr Outputable.empty -unboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name -unboundNameX where_look rdr_name extra +unboundNameX :: LookingFor -> RdrName -> SDoc -> RnM Name +unboundNameX looking_for rdr_name extra = do { dflags <- getDynFlags ; let show_helpful_errors = gopt Opt_HelpfulErrors dflags - err = notInScopeErr where_look rdr_name $$ extra + err = notInScopeErr (lf_where looking_for) rdr_name $$ extra ; if not show_helpful_errors then addErr err else do { local_env <- getLocalRdrEnv @@ -80,7 +107,7 @@ unboundNameX where_look rdr_name extra ; impInfo <- getImports ; currmod <- getModule ; hpt <- getHpt - ; let suggestions = unknownNameSuggestions_ where_look + ; let suggestions = unknownNameSuggestions_ looking_for dflags hpt currmod global_env local_env impInfo rdr_name ; addErr (err $$ suggestions) } @@ -102,20 +129,20 @@ type HowInScope = Either SrcSpan ImpDeclSpec -- | Called from the typechecker ("GHC.Tc.Errors") when we find an unbound variable -unknownNameSuggestions :: DynFlags +unknownNameSuggestions :: WhatLooking -> DynFlags -> HomePackageTable -> Module -> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails -> RdrName -> SDoc -unknownNameSuggestions = unknownNameSuggestions_ WL_Any +unknownNameSuggestions what_look = unknownNameSuggestions_ (LF what_look WL_Anywhere) -unknownNameSuggestions_ :: WhereLooking -> DynFlags +unknownNameSuggestions_ :: LookingFor -> DynFlags -> HomePackageTable -> Module -> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails -> RdrName -> SDoc -unknownNameSuggestions_ where_look dflags hpt curr_mod global_env local_env +unknownNameSuggestions_ looking_for dflags hpt curr_mod global_env local_env imports tried_rdr_name = - similarNameSuggestions where_look dflags global_env local_env tried_rdr_name $$ - importSuggestions where_look global_env hpt + 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 @@ -139,11 +166,11 @@ fieldSelectorSuggestions global_env tried_rdr_name | otherwise = text "belonging to the type" <> plural parents <+> pprQuotedList parents -similarNameSuggestions :: WhereLooking -> DynFlags - -> GlobalRdrEnv -> LocalRdrEnv - -> RdrName -> SDoc -similarNameSuggestions where_look dflags global_env - local_env tried_rdr_name +similarNameSuggestions :: LookingFor -> DynFlags + -> GlobalRdrEnv -> LocalRdrEnv + -> RdrName -> SDoc +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 @@ -151,10 +178,11 @@ similarNameSuggestions where_look dflags global_env , nest 2 (pprWithCommas pp_item ps) ] where all_possibilities :: [(String, (RdrName, HowInScope))] - all_possibilities - = [ (showPpr dflags r, (r, Left loc)) - | (r,loc) <- local_possibilities local_env ] - ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ] + all_possibilities = case what_look of + WL_None -> [] + _ -> [ (showPpr dflags r, (r, Left 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" @@ -177,15 +205,17 @@ similarNameSuggestions where_look dflags global_env tried_ns = occNameSpace tried_occ tried_is_qual = isQual tried_rdr_name - correct_name_space occ = nameSpacesRelated (occNameSpace occ) tried_ns - && isSymOcc occ == tried_is_sym + correct_name_space occ = + (nameSpacesRelated dflags what_look tried_ns (occNameSpace occ)) + && isSymOcc occ == tried_is_sym -- Treat operator and non-operators as non-matching -- This heuristic avoids things like -- Not in scope 'f'; perhaps you meant '+' (from Prelude) - local_ok = case where_look of { WL_Any -> True + local_ok = case where_look of { WL_Anywhere -> True ; WL_LocalOnly -> True - ; _ -> False } + ; _ -> False } + local_possibilities :: LocalRdrEnv -> [(RdrName, SrcSpan)] local_possibilities env | tried_is_qual = [] @@ -199,8 +229,7 @@ similarNameSuggestions where_look dflags global_env global_possibilities global_env | tried_is_qual = [ (rdr_qual, (rdr_qual, how)) | gre <- globalRdrEnvElts global_env - , isGreOk where_look gre - , not (isNoFieldSelectorGRE gre) + , isGreOk looking_for gre , let occ = greOccName gre , correct_name_space occ , (mod, how) <- qualsInScope gre @@ -208,8 +237,7 @@ similarNameSuggestions where_look dflags global_env | otherwise = [ (rdr_unqual, pair) | gre <- globalRdrEnvElts global_env - , isGreOk where_look gre - , not (isNoFieldSelectorGRE gre) + , isGreOk looking_for gre , let occ = greOccName gre rdr_unqual = mkRdrUnqual occ , correct_name_space occ @@ -245,13 +273,13 @@ similarNameSuggestions where_look dflags global_env | i <- is, let ispec = is_decl i, is_qual ispec ] -- | Generate helpful suggestions if a qualified name Mod.foo is not in scope. -importSuggestions :: WhereLooking +importSuggestions :: LookingFor -> GlobalRdrEnv -> HomePackageTable -> Module -> ImportAvails -> RdrName -> SDoc -importSuggestions where_look global_env hpt currMod imports rdr_name - | WL_LocalOnly <- where_look = Outputable.empty - | WL_LocalTop <- where_look = Outputable.empty +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 | null interesting_imports , Just name <- mod_name @@ -354,7 +382,8 @@ importSuggestions where_look global_env hpt currMod imports rdr_name -- wouldn't have an out-of-scope error in the first place) helpful_imports = filter helpful interesting_imports where helpful (_,imv) - = not . null $ lookupGlobalRdrEnv (imv_all_exports imv) occ_name + = any (isGreOk looking_for) $ + lookupGlobalRdrEnv (imv_all_exports imv) occ_name -- Which of these do that because of an explicit hiding list resp. an -- explicit import list @@ -364,7 +393,7 @@ importSuggestions where_look global_env hpt currMod imports rdr_name -- See note [When to show/hide the module-not-imported line] show_not_imported_line :: ModuleName -> Bool -- #15611 show_not_imported_line modnam - | modnam `elem` globMods = False -- #14225 -- 1 + | modnam `elem` glob_mods = False -- #14225 -- 1 | moduleName currMod == modnam = False -- 2.1 | is_last_loaded_mod modnam hpt_uniques = False -- 2.2 | otherwise = True @@ -372,9 +401,8 @@ importSuggestions where_look global_env hpt currMod imports rdr_name hpt_uniques = map fst (udfmToList hpt) is_last_loaded_mod _ [] = False is_last_loaded_mod modnam uniqs = last uniqs == getUnique modnam - globMods = nub [ mod + glob_mods = nub [ mod | gre <- globalRdrEnvElts global_env - , isGreOk where_look gre , (mod, _) <- qualsInScope gre ] @@ -394,13 +422,76 @@ qualsInScope gre@GRE { gre_lcl = lcl, gre_imp = is } | otherwise = [ (is_as ispec, Right ispec) | i <- is, let ispec = is_decl i ] -isGreOk :: WhereLooking -> GlobalRdrElt -> Bool -isGreOk where_look = case where_look of - WL_LocalTop -> isLocalGRE - WL_LocalOnly -> const False - _ -> const True +isGreOk :: LookingFor -> GlobalRdrElt -> Bool +isGreOk (LF what_look where_look) gre = what_ok && where_ok + where + -- when looking for record fields, what_ok checks whether the GRE is a + -- record field. Otherwise, it checks whether the GRE is a record field + -- defined in a module with -XNoFieldSelectors - it wouldn't be a useful + -- suggestion in that case. + what_ok = case what_look of + WL_RecField -> isRecFldGRE gre + _ -> not (isNoFieldSelectorGRE gre) + + where_ok = case where_look of + WL_LocalTop -> isLocalGRE gre + WL_LocalOnly -> False + _ -> True + +-- see Note [Related name spaces] +nameSpacesRelated :: DynFlags -- ^ to find out whether -XDataKinds is enabled + -> WhatLooking -- ^ What kind of name are we looking for + -> NameSpace -- ^ Name space of the original name + -> NameSpace -- ^ Name space of a name that might have been meant + -> Bool +nameSpacesRelated dflags what_looking ns ns' + = ns' `elem` ns : [ other_ns + | (orig_ns, others) <- other_namespaces + , ns == orig_ns + , (other_ns, wls) <- others + , what_looking `elem` WL_Anything : wls + ] + where + -- explanation: + -- [(orig_ns, [(other_ns, what_looking_possibilities)])] + -- A particular other_ns is related if the original namespace is orig_ns + -- and what_looking is either WL_Anything or is one of + -- what_looking_possibilities + other_namespaces = + [ (varName , [(dataName, [WL_Constructor])]) + , (dataName , [(varName , [WL_RecField])]) + , (tvName , (tcClsName, [WL_Constructor]) : promoted_datacons) + , (tcClsName, (tvName , []) : promoted_datacons) + ] + -- If -XDataKinds is enabled, the data constructor name space is also + -- related to the type-level name spaces + data_kinds = xopt LangExt.DataKinds dflags + promoted_datacons = [(dataName, [WL_Constructor]) | data_kinds] + +{- +Note [Related name space] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Name spaces are related if there is a chance to mean the one when one writes +the other, i.e. variables <-> data constructors and type variables <-> type +constructors. + +In most contexts, this mistake can happen in both directions. Not so in +patterns: + +When a user writes + foo (just a) = ... +It is possible that they meant to use `Just` instead. However, when they write + foo (Map a) = ... +It is unlikely that they mean to use `map`, since variables cannot be used here. + +Similarly, when we look for record fields, data constructors are not in a +related namespace. + +Furthermore, with -XDataKinds, the data constructor name space is related to +the type variable and type constructor name spaces. -{- Note [When to show/hide the module-not-imported line] -- #15611 +Note [When to show/hide the module-not-imported line] -- #15611 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For the error message: Not in scope X.Y Module X does not export Y diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs index 767a7d22b2..dcd9745758 100644 --- a/compiler/GHC/Tc/Errors.hs +++ b/compiler/GHC/Tc/Errors.hs @@ -23,7 +23,7 @@ import GHC.Tc.Utils.Unify( occCheckForErrors, CheckTyEqResult(..) ) import GHC.Tc.Utils.Env( tcInitTidyEnv ) import GHC.Tc.Utils.TcType import GHC.Tc.Types.Origin -import GHC.Rename.Unbound ( unknownNameSuggestions ) +import GHC.Rename.Unbound ( unknownNameSuggestions, WhatLooking(..) ) import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.TyCo.Rep @@ -40,7 +40,8 @@ import GHC.Tc.Types.Evidence import GHC.Tc.Types.EvTerm import GHC.Hs.Binds ( PatSynBind(..) ) import GHC.Types.Name -import GHC.Types.Name.Reader ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual ) +import GHC.Types.Name.Reader ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual + , emptyLocalRdrEnv, lookupGlobalRdrEnv , lookupLocalRdrOcc ) import GHC.Builtin.Names ( typeableClassName ) import GHC.Types.Id import GHC.Types.Var @@ -1197,7 +1198,7 @@ mkHoleError _ _tidy_simples ctxt hole@(Hole { hole_occ = occ ; hpt <- getHpt ; let err = important out_of_scope_msg `mappend` (mk_relevant_bindings $ - unknownNameSuggestions dflags hpt curr_mod rdr_env + unknownNameSuggestions WL_Anything dflags hpt curr_mod rdr_env (tcl_rdr lcl_env) imp_info (mkRdrUnqual occ)) ; maybeAddDeferredBindings ctxt hole err @@ -2384,7 +2385,8 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over | null matches -- No matches but perhaps several unifiers = do { (_, binds_msg, ct) <- relevantBindings True ctxt ct ; candidate_insts <- get_candidate_instances - ; return (cannot_resolve_msg ct candidate_insts binds_msg) } + ; field_suggestions <- record_field_suggestions + ; return (cannot_resolve_msg ct candidate_insts binds_msg field_suggestions) } | null unsafe_overlapped -- Some matches => overlap errors = return overlap_msg @@ -2421,8 +2423,30 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over in different_names && same_occ_names | otherwise = False - cannot_resolve_msg :: Ct -> [ClsInst] -> SDoc -> SDoc - cannot_resolve_msg ct candidate_insts binds_msg + -- See Note [Out-of-scope fields with -XOverloadedRecordDot] + record_field_suggestions :: TcM SDoc + record_field_suggestions = flip (maybe $ return empty) 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)) } } + + occ_name_in_scope glb_env lcl_env occ_name = not $ + null (lookupGlobalRdrEnv glb_env occ_name) && + isNothing (lookupLocalRdrOcc lcl_env occ_name) + + record_field = case orig of + 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) @@ -2437,8 +2461,9 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over ++ drv_fixes) , ppWhen (not (null candidate_insts)) (hang (text "There are instances for similar types:") - 2 (vcat (map ppr candidate_insts))) ] + 2 (vcat (map ppr candidate_insts))) -- See Note [Report candidate instances] + , field_suggestions ] where orig = ctOrigin ct -- See Note [Highlighting ambiguous type variables] @@ -2709,6 +2734,33 @@ message (showing both problems): ... 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 +is produces here, and it says + No instance for (GHC.Record.HasField "<fieldname>" ...). + +Additionally, though, we want to suggest similar field names that are in scope +or could be in scope with different import lists. + +However, we can still get an error about a missing HasField instance when a +field is in scope (if the types are wrong), and so it's important that we don't +suggest similar names here if the record field is in scope, either qualified or +unqualified, since qualification doesn't matter for -XOverloadedRecordDot. + +Example: + + import Data.Monoid (Alt(..)) + + foo = undefined.getAll + +results in + + No instance for (GHC.Records.HasField "getAll" r0 a0) + arising from selecting the field ‘getAll’ + Perhaps you meant ‘getAlt’ (imported from Data.Monoid) + Perhaps you want to add ‘getAll’ to the import list + in the import of ‘Data.Monoid’ -} show_fixes :: [SDoc] -> SDoc diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs index d29d7ab7ec..4242f4c3dd 100644 --- a/compiler/GHC/Types/Name/Occurrence.hs +++ b/compiler/GHC/Types/Name/Occurrence.hs @@ -28,8 +28,6 @@ module GHC.Types.Name.Occurrence ( -- * The 'NameSpace' type NameSpace, -- Abstract - nameSpacesRelated, - -- ** Construction -- $real_vs_source_data_constructors tcName, clsName, tcClsName, dataName, varName, @@ -358,19 +356,6 @@ promoteOccName (OccName space name) = do space' <- promoteNameSpace space return $ OccName space' name --- Name spaces are related if there is a chance to mean the one when one writes --- the other, i.e. variables <-> data constructors and type variables <-> type constructors -nameSpacesRelated :: NameSpace -> NameSpace -> Bool -nameSpacesRelated ns1 ns2 = ns1 == ns2 || otherNameSpace ns1 == ns2 - -otherNameSpace :: NameSpace -> NameSpace -otherNameSpace VarName = DataName -otherNameSpace DataName = VarName -otherNameSpace TvName = TcClsName -otherNameSpace TcClsName = TvName - - - {- | Other names in the compiler add additional information to an OccName. This class provides a consistent way to access the underlying OccName. -} class HasOccName name where diff --git a/testsuite/tests/qualifieddo/should_fail/qdofail003.stderr b/testsuite/tests/qualifieddo/should_fail/qdofail003.stderr index 5137ae40c0..8cf5f670ac 100644 --- a/testsuite/tests/qualifieddo/should_fail/qdofail003.stderr +++ b/testsuite/tests/qualifieddo/should_fail/qdofail003.stderr @@ -1,8 +1,5 @@ qdofail003.hs:11:5: Not in scope: ‘P.>>’ - Perhaps you meant one of these: - ‘P.*>’ (imported from Prelude), ‘P.<>’ (imported from Prelude), - ‘P.>>=’ (imported from Prelude) 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 66a3fea529..39752a2995 100644 --- a/testsuite/tests/qualifieddo/should_fail/qdofail004.stderr +++ b/testsuite/tests/qualifieddo/should_fail/qdofail004.stderr @@ -1,8 +1,5 @@ qdofail004.hs:10:5: Not in scope: ‘P.fail’ - Perhaps you meant one of these: - ‘P.tail’ (imported from Prelude), ‘P.all’ (imported from Prelude), - ‘P.flip’ (imported from Prelude) 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/rename/should_fail/T19843a.hs b/testsuite/tests/rename/should_fail/T19843a.hs new file mode 100644 index 0000000000..746357d3e8 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843a.hs @@ -0,0 +1,5 @@ +module T19843a where + +import Prelude (map, undefined) + +foo (Map k v) = undefined diff --git a/testsuite/tests/rename/should_fail/T19843a.stderr b/testsuite/tests/rename/should_fail/T19843a.stderr new file mode 100644 index 0000000000..8f96612743 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843a.stderr @@ -0,0 +1,3 @@ + +T19843a.hs:5:6: + Not in scope: data constructor ‘Map’ diff --git a/testsuite/tests/rename/should_fail/T19843b.hs b/testsuite/tests/rename/should_fail/T19843b.hs new file mode 100644 index 0000000000..4bd6ef2d1b --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843b.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE ViewPatterns #-} + +module T19843b where + +import Prelude (map, even, undefined, Bool) + +foo (Map even -> xs) = undefined diff --git a/testsuite/tests/rename/should_fail/T19843b.stderr b/testsuite/tests/rename/should_fail/T19843b.stderr new file mode 100644 index 0000000000..5b457440eb --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843b.stderr @@ -0,0 +1,4 @@ + +T19843b.hs:7:6: + • Data constructor not in scope: Map :: (a0 -> Bool) -> t -> t0 + • Perhaps you meant variable ‘map’ (imported from Prelude) diff --git a/testsuite/tests/rename/should_fail/T19843c.hs b/testsuite/tests/rename/should_fail/T19843c.hs new file mode 100644 index 0000000000..1b55bce68b --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843c.hs @@ -0,0 +1,6 @@ +module T19843c where + +import Data.Map as Map +import Prelude (undefined, map) + +foo (Map.Map k v) = undefined diff --git a/testsuite/tests/rename/should_fail/T19843c.stderr b/testsuite/tests/rename/should_fail/T19843c.stderr new file mode 100644 index 0000000000..94cdadf528 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843c.stderr @@ -0,0 +1,4 @@ + +T19843c.hs:6:6: error: + Not in scope: data constructor ‘Map.Map’ + Module ‘Data.Map’ does not export ‘Map’. diff --git a/testsuite/tests/rename/should_fail/T19843d.hs b/testsuite/tests/rename/should_fail/T19843d.hs new file mode 100644 index 0000000000..72ddc65f3a --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843d.hs @@ -0,0 +1,7 @@ +module T19843d where + +import Prelude (undefined, map) + +data Mup k v = Mup k v + +foo (Map k v) = undefined diff --git a/testsuite/tests/rename/should_fail/T19843d.stderr b/testsuite/tests/rename/should_fail/T19843d.stderr new file mode 100644 index 0000000000..a27a627005 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843d.stderr @@ -0,0 +1,4 @@ + +T19843d.hs:7:6: error: + Not in scope: data constructor ‘Map’ + Perhaps you meant ‘Mup’ (line 5) diff --git a/testsuite/tests/rename/should_fail/T19843e.hs b/testsuite/tests/rename/should_fail/T19843e.hs new file mode 100644 index 0000000000..9223f6e169 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843e.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PatternSynonyms #-} + +module T19843e where + +import Prelude (undefined, map, Maybe(Just)) + +pattern Mup k = Just k + +foo (Map k) = undefined diff --git a/testsuite/tests/rename/should_fail/T19843e.stderr b/testsuite/tests/rename/should_fail/T19843e.stderr new file mode 100644 index 0000000000..890c719bd8 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843e.stderr @@ -0,0 +1,4 @@ + +T19843e.hs:9:6: error: + Not in scope: data constructor ‘Map’ + Perhaps you meant ‘Mup’ (line 7) diff --git a/testsuite/tests/rename/should_fail/T19843f.hs b/testsuite/tests/rename/should_fail/T19843f.hs new file mode 100644 index 0000000000..64beb233fa --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843f.hs @@ -0,0 +1,10 @@ +module T19843f where + +import Prelude (Int, map) + +data A = A {mop :: ()} +data Mup = Mup + +foo = foo {mup = 1} + +bar = A {mup = 1} diff --git a/testsuite/tests/rename/should_fail/T19843f.stderr b/testsuite/tests/rename/should_fail/T19843f.stderr new file mode 100644 index 0000000000..903fee7849 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843f.stderr @@ -0,0 +1,8 @@ + +T19843f.hs:8:12: error: + Not in scope: ‘mup’ + Perhaps you meant ‘mop’ (line 5) + +T19843f.hs:10:10: error: + Not in scope: ‘mup’ + Perhaps you meant ‘mop’ (line 5) diff --git a/testsuite/tests/rename/should_fail/T19843g.hs b/testsuite/tests/rename/should_fail/T19843g.hs new file mode 100644 index 0000000000..22db3381f3 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843g.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE NoFieldSelectors #-} + +module T19843g where + +import Prelude (Int, map) + +data A = A {mop :: ()} +data Mup = Mup + +foo = foo {mup = 1} diff --git a/testsuite/tests/rename/should_fail/T19843g.stderr b/testsuite/tests/rename/should_fail/T19843g.stderr new file mode 100644 index 0000000000..6d0d398bfd --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843g.stderr @@ -0,0 +1,4 @@ + +T19843g.hs:10:12: error: + Not in scope: ‘mup’ + Perhaps you meant ‘mop’ (line 7) diff --git a/testsuite/tests/rename/should_fail/T19843h.hs b/testsuite/tests/rename/should_fail/T19843h.hs new file mode 100644 index 0000000000..d78418555f --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843h.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE OverloadedRecordDot #-} + +module T19843h where + +import Prelude (Int, map, undefined) +import Data.Traversable hiding (traverse) +import qualified Data.Monoid (Sum(..), getSum) +import Data.Monoid (Alt(..)) + +data A = A {mop :: ()} +data Mup = Mup + +foo = undefined.mup + +bar = undefined.traverse + +baz = undefined.getSum + +quux = undefined.getAlt + +quuz = getAlt undefined + +quur = undefined.getAll diff --git a/testsuite/tests/rename/should_fail/T19843h.stderr b/testsuite/tests/rename/should_fail/T19843h.stderr new file mode 100644 index 0000000000..56bca0feeb --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843h.stderr @@ -0,0 +1,34 @@ + +T19843h.hs:14:7: + 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 + In an equation for ‘foo’: foo = undefined.mup + +T19843h.hs:16:7: + No instance for (GHC.Records.HasField "traverse" r3 a3) + arising from selecting the field ‘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) + arising from selecting the field ‘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) + arising from selecting the field ‘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) + arising from selecting the field ‘getAll’ + Perhaps you meant ‘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 an equation for ‘quur’: quur = undefined.getAll diff --git a/testsuite/tests/rename/should_fail/T19843i.hs b/testsuite/tests/rename/should_fail/T19843i.hs new file mode 100644 index 0000000000..5ed9668577 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843i.hs @@ -0,0 +1,5 @@ +module T19843i where + +import Data.Monoid as M (getAll) + +x = M.getSum diff --git a/testsuite/tests/rename/should_fail/T19843i.stderr b/testsuite/tests/rename/should_fail/T19843i.stderr new file mode 100644 index 0000000000..60f671c679 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843i.stderr @@ -0,0 +1,5 @@ + +T19843i.hs:5:5: + 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). diff --git a/testsuite/tests/rename/should_fail/T19843j.hs b/testsuite/tests/rename/should_fail/T19843j.hs new file mode 100644 index 0000000000..20cd1c84d8 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843j.hs @@ -0,0 +1,5 @@ +module T19843j where + +import Control.Monad (sequence) + +x = guard diff --git a/testsuite/tests/rename/should_fail/T19843j.stderr b/testsuite/tests/rename/should_fail/T19843j.stderr new file mode 100644 index 0000000000..e99a9f0a62 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843j.stderr @@ -0,0 +1,5 @@ + +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). diff --git a/testsuite/tests/rename/should_fail/T19843k.hs b/testsuite/tests/rename/should_fail/T19843k.hs new file mode 100644 index 0000000000..d97819b306 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843k.hs @@ -0,0 +1,5 @@ +module T19843k where + +import Data.Monoid as M + +main = M.doesn'tExist diff --git a/testsuite/tests/rename/should_fail/T19843k.stderr b/testsuite/tests/rename/should_fail/T19843k.stderr new file mode 100644 index 0000000000..08ed7d8c08 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843k.stderr @@ -0,0 +1,4 @@ + +T19843k.hs:5:8: + Not in scope: ‘M.doesn'tExist’ + Module ‘Data.Monoid’ does not export ‘doesn'tExist’. diff --git a/testsuite/tests/rename/should_fail/T19843l.hs b/testsuite/tests/rename/should_fail/T19843l.hs new file mode 100644 index 0000000000..340fe68539 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843l.hs @@ -0,0 +1,7 @@ +module T19843l where + +data Foo = LongName +data FongName +wrongName = wrongName + +type Bar = WrongName diff --git a/testsuite/tests/rename/should_fail/T19843l.stderr b/testsuite/tests/rename/should_fail/T19843l.stderr new file mode 100644 index 0000000000..d5168b2b90 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843l.stderr @@ -0,0 +1,4 @@ + +T19843l.hs:7:12: + Not in scope: type constructor or class ‘WrongName’ + Perhaps you meant ‘FongName’ (line 4) diff --git a/testsuite/tests/rename/should_fail/T19843m.hs b/testsuite/tests/rename/should_fail/T19843m.hs new file mode 100644 index 0000000000..72c08b2fdd --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843m.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} + +module T19843m where + +data Foo = LongName +data FongName +wrongName = wrongName + +type Bar = WrongName diff --git a/testsuite/tests/rename/should_fail/T19843m.stderr b/testsuite/tests/rename/should_fail/T19843m.stderr new file mode 100644 index 0000000000..dd7583842a --- /dev/null +++ b/testsuite/tests/rename/should_fail/T19843m.stderr @@ -0,0 +1,5 @@ + +T19843m.hs:9:12: + Not in scope: type constructor or class ‘WrongName’ + Perhaps you meant one of these: + ‘FongName’ (line 6), data constructor ‘LongName’ (line 5) diff --git a/testsuite/tests/rename/should_fail/T9177.hs b/testsuite/tests/rename/should_fail/T9177.hs index 553dbc7b53..2554e90a65 100644 --- a/testsuite/tests/rename/should_fail/T9177.hs +++ b/testsuite/tests/rename/should_fail/T9177.hs @@ -12,7 +12,8 @@ type Foo2 = (integerr) foo3 = bar foo4 = Fun --- this warning is suboptimal (fun would be illegal here) +-- this warning was suboptimal (fun would be illegal here) as of #9177 +-- fixed with #19843 foo5 Fun = () -- No errors here: diff --git a/testsuite/tests/rename/should_fail/T9177.stderr b/testsuite/tests/rename/should_fail/T9177.stderr index b336b32524..a1153b4fcb 100644 --- a/testsuite/tests/rename/should_fail/T9177.stderr +++ b/testsuite/tests/rename/should_fail/T9177.stderr @@ -7,6 +7,5 @@ T9177.hs:7:14: error: Not in scope: type variable ‘integerr’ Perhaps you meant type constructor or class ‘Integer’ (imported from Prelude) -T9177.hs:16:6: error: +T9177.hs:17:6: error: Not in scope: data constructor ‘Fun’ - Perhaps you meant variable ‘fun’ (line 20) diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index a5dd61e575..d709fd0ad0 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -165,3 +165,16 @@ test('T18240b', normal, compile_fail, ['']) test('T18740a', normal, compile_fail, ['']) test('T18740b', normal, compile_fail, ['']) test('T19781', [extra_files(['T19781_A.hs', 'T19781_A.hs-boot'])], multimod_compile_fail, ['T19781', '-v0']) +test('T19843a', normal, compile_fail, ['']) +test('T19843b', normal, compile_fail, ['']) +test('T19843c', normal, compile_fail, ['']) +test('T19843d', normal, compile_fail, ['']) +test('T19843e', normal, compile_fail, ['']) +test('T19843f', normal, compile_fail, ['']) +test('T19843g', normal, compile_fail, ['']) +test('T19843h', normal, compile_fail, ['']) +test('T19843i', normal, compile_fail, ['']) +test('T19843j', normal, compile_fail, ['']) +test('T19843k', normal, compile_fail, ['']) +test('T19843l', normal, compile_fail, ['']) +test('T19843m', normal, compile_fail, ['']) |