From 1af2e7735283251c686bdb1154afab6df5e45053 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Mon, 10 Jul 2023 16:38:10 +0200
Subject: [PATCH] Suggest similar names in imports
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This commit adds similar name suggestions when importing. For example
module A where { spelling = 'o' }
module B where { import B ( speling ) }
will give rise to the error message:
Module ‘A’ does not export ‘speling’.
Suggested fix: Perhaps use ‘spelling’
This also provides hints when users try to import record fields defined
with NoFieldSelectors.
---
compiler/GHC/Rename/Names.hs | 64 ++++++++++++++-----
compiler/GHC/Rename/Unbound.hs | 10 +--
compiler/GHC/Tc/Errors/Ppr.hs | 10 +--
compiler/GHC/Tc/Errors/Types.hs | 2 +-
compiler/GHC/Types/Hint.hs | 2 +-
compiler/GHC/Types/Hint/Ppr.hs | 21 +++---
.../should_compile/T22106_C.stderr | 4 +-
.../rename/should_fail/SimilarNamesImport.hs | 3 +
.../should_fail/SimilarNamesImport.stderr | 16 +++++
.../should_fail/SimilarNamesImport_aux.hs | 11 ++++
testsuite/tests/rename/should_fail/all.T | 1 +
11 files changed, 104 insertions(+), 40 deletions(-)
create mode 100644 testsuite/tests/rename/should_fail/SimilarNamesImport.hs
create mode 100644 testsuite/tests/rename/should_fail/SimilarNamesImport.stderr
create mode 100644 testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index af426dd1804a..be71785b5b00 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -38,6 +38,8 @@ import GHC.Driver.Ppr
import GHC.Rename.Env
import GHC.Rename.Fixity
import GHC.Rename.Utils ( warnUnusedTopBinds )
+import GHC.Rename.Unbound
+import qualified GHC.Rename.Unbound as Unbound
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Env
@@ -67,6 +69,7 @@ import GHC.Types.Name.Set
import GHC.Types.Name.Reader
import GHC.Types.Avail
import GHC.Types.FieldLabel
+import GHC.Types.Hint
import GHC.Types.SourceFile
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Basic ( TopLevelFlag(..) )
@@ -1228,7 +1231,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
= failLookupWith (QualImportError rdr)
| otherwise
= case lookups of
- [] -> failLookupWith (BadImport ie BadImportIsParent)
+ [] -> failLookupWith (BadImport ie IsNotSubordinate)
item:items -> return $ item :| items
where
lookups = concatMap nonDetNameEnvElts
@@ -1252,7 +1255,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
-- 'BadImportW' is only constructed below in 'handle_bad_import', in
-- the 'EverythingBut' case, so that's what we pass to
-- 'badImportItemErr'.
- reason <- badImportItemErr iface decl_spec ie BadImportIsParent all_avails
+ reason <- badImportItemErr iface decl_spec ie IsNotSubordinate all_avails
pure (TcRnDodgyImports (DodgyImportsHiding reason))
warning_msg (DeprecatedExport n w) =
pure (TcRnPragmaWarning {
@@ -1338,7 +1341,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
dc_name = lookup_parent ie (setRdrNameSpace tc srcDataName)
in
case catIELookupM [ tc_name, dc_name ] of
- [] -> failLookupWith (BadImport ie BadImportIsParent)
+ [] -> failLookupWith (BadImport ie IsNotSubordinate)
names -> return ( [mkIEThingAbs tc' l (imp_item name) | name <- names], [])
| otherwise
-> do ImpOccItem { imp_item = gre } <- lookup_parent ie (ieWrappedName tc')
@@ -1354,7 +1357,8 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
-- See Note [Importing DuplicateRecordFields]
case lookupChildren subnames rdr_ns of
- Failed rdrs -> failLookupWith (BadImport (IEThingWith (deprecation, ann) ltc wc rdrs ) BadImportIsSubordinate)
+ Failed rdrs -> failLookupWith $
+ BadImport (IEThingWith (deprecation, ann) ltc wc rdrs) IsSubordinate
-- We are trying to import T( a,b,c,d ), and failed
-- to find 'b' and 'd'. So we make up an import item
-- to report as failing, namely T( b, d ).
@@ -1382,7 +1386,9 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
where n = greName gre
handle_bad_import m = catchIELookup m $ \err -> case err of
- BadImport ie _ | want_hiding == EverythingBut -> return ([], [BadImportW ie])
+ BadImport ie _
+ | want_hiding == EverythingBut
+ -> return ([], [BadImportW ie])
_ -> failLookupWith err
mk_depr_export_warning gre
@@ -1398,11 +1404,13 @@ data IELookupWarning
| DodgyImport GlobalRdrElt
| DeprecatedExport Name (WarningTxt GhcRn)
-data BadImportIsSubordinate = BadImportIsParent | BadImportIsSubordinate
+-- | Is this import/export item a subordinate or not?
+data IsSubordinate
+ = IsSubordinate | IsNotSubordinate
data IELookupError
= QualImportError RdrName
- | BadImport (IE GhcPs) BadImportIsSubordinate
+ | BadImport (IE GhcPs) IsSubordinate
| IllegalImport
failLookupWith :: IELookupError -> IELookupM a
@@ -2151,21 +2159,42 @@ DRFPatSynExport for a test of this.
-}
badImportItemErr
- :: ModIface -> ImpDeclSpec -> IE GhcPs -> BadImportIsSubordinate
+ :: ModIface -> ImpDeclSpec -> IE GhcPs -> IsSubordinate
-> [AvailInfo]
-> TcRn ImportLookupReason
badImportItemErr iface decl_spec ie sub avails = do
patsyns_enabled <- xoptM LangExt.PatternSynonyms
expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces
- pure (ImportLookupBad (importErrorKind expl_ns_enabled) iface decl_spec ie patsyns_enabled)
+ dflags <- getDynFlags
+ hsc_env <- getTopEnv
+ let rdr_env = mkGlobalRdrEnv
+ $ gresFromAvails hsc_env (Just imp_spec) all_avails
+ pure (ImportLookupBad (importErrorKind dflags rdr_env expl_ns_enabled) iface decl_spec ie patsyns_enabled)
where
- importErrorKind expl_ns_enabled
+ importErrorKind dflags rdr_env expl_ns_enabled
| any checkIfTyCon avails = case sub of
- BadImportIsParent -> BadImportAvailTyCon expl_ns_enabled
- BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren
+ IsNotSubordinate -> BadImportAvailTyCon expl_ns_enabled
+ IsSubordinate -> BadImportNotExportedSubordinates unavailableChildren
| any checkIfVarName avails = BadImportAvailVar
| Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con)
- | otherwise = BadImportNotExported
+ | otherwise = BadImportNotExported suggs
+ where
+ suggs = similar_suggs ++ fieldSelectorSuggestions rdr_env rdr
+ similar_names =
+ similarNameSuggestions (Unbound.LF WL_Anything WL_Global)
+ dflags rdr_env emptyLocalRdrEnv rdr
+ similar_suggs =
+ case NE.nonEmpty $ mapMaybe imported_item $ similar_names of
+ Just similar -> [ SuggestSimilarNames rdr similar ]
+ Nothing -> [ ]
+
+ -- Only keep imported items, and set the "HowInScope" to
+ -- "Nothing" to avoid printing "imported from..." in the suggestion
+ -- error message.
+ imported_item (SimilarRdrName rdr_name (Just (ImportedBy {})))
+ = Just (SimilarRdrName rdr_name Nothing)
+ imported_item _ = Nothing
+
checkIfDataCon = checkIfAvailMatches isDataConName
checkIfTyCon = checkIfAvailMatches isTyConName
checkIfVarName =
@@ -2181,9 +2210,12 @@ badImportItemErr iface decl_spec ie sub avails = do
Nothing -> False
Avail{} -> False
availOccName = occName . availName
- importedFS = occNameFS . rdrNameOcc $ ieName ie
- unavailableChildren = map (rdrNameOcc) $ case ie of
- IEThingWith _ _ _ ns -> map (ieWrappedName . unLoc) ns
+ rdr = ieName ie
+ importedFS = occNameFS $ rdrNameOcc rdr
+ imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
+ all_avails = mi_exports iface
+ unavailableChildren = case ie of
+ IEThingWith _ _ _ ns -> map (rdrNameOcc . ieWrappedName . unLoc) ns
_ -> panic "importedChildren failed pattern match: no children"
addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn ()
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index 8c1b580ad150..744b42a0707b 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -15,6 +15,8 @@ module GHC.Rename.Unbound
, reportUnboundName
, reportUnboundName'
, unknownNameSuggestions
+ , similarNameSuggestions
+ , fieldSelectorSuggestions
, WhatLooking(..)
, WhereLooking(..)
, LookingFor(..)
@@ -225,7 +227,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
all_possibilities :: [(String, SimilarName)]
all_possibilities = case what_look of
WL_None -> []
- _ -> [ (showPpr dflags r, SimilarRdrName r (LocallyBoundAt loc))
+ _ -> [ (showPpr dflags r, SimilarRdrName r (Just $ LocallyBoundAt loc))
| (r,loc) <- local_possibilities local_env ]
++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ]
@@ -256,7 +258,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
global_possibilities :: GlobalRdrEnv -> [(RdrName, SimilarName)]
global_possibilities global_env
- | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual how)
+ | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual (Just how))
| gre <- globalRdrEnvElts global_env
, isGreOk looking_for gre
, let occ = greOccName gre
@@ -271,7 +273,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
rdr_unqual = mkRdrUnqual occ
, correct_name_space occ
, sim <- case (unquals_in_scope gre, quals_only gre) of
- (how:_, _) -> [ SimilarRdrName rdr_unqual how ]
+ (how:_, _) -> [ SimilarRdrName rdr_unqual (Just how) ]
([], pr:_) -> [ pr ] -- See Note [Only-quals]
([], []) -> [] ]
@@ -299,7 +301,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
quals_only :: GlobalRdrElt -> [SimilarName]
-- Ones for which *only* the qualified version is in scope
quals_only (gre@GRE { gre_imp = is })
- = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (ImportedBy ispec))
+ = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (Just $ ImportedBy ispec))
| i <- bagToList is, let ispec = is_decl i, is_qual ispec ]
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 002b1e7fc73e..65485293e513 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -3085,12 +3085,12 @@ instance Diagnostic TcRnMessage where
let mod_name = moduleName $ is_mod is
occ = rdrNameOcc $ ieName ie
in case k of
- BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name]
- BadImportNotExported -> noHints
- BadImportAvailTyCon ex_ns ->
+ BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name]
+ BadImportNotExported suggs -> suggs
+ BadImportAvailTyCon ex_ns ->
[useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not ex_ns]
++ [ImportSuggestion occ $ CouldAddTypeKeyword mod_name]
- BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par]
+ BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par]
BadImportNotExportedSubordinates{} -> noHints
TcRnImportLookup{}
-> noHints
@@ -5343,7 +5343,7 @@ pprImportLookup = \case
hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon)
2 (vcat msgs)
in case k of
- BadImportNotExported ->
+ BadImportNotExported _ ->
vcat
[ text "Module" <+> pprImpDeclSpec iface decl_spec <+>
text "does not export" <+> quotes (ppr ie) <> dot
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 43da4e8b8378..a65caa553dc8 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -5250,7 +5250,7 @@ data WhenMatching
data BadImportKind
-- | Module does not export...
- = BadImportNotExported
+ = BadImportNotExported [GhcHint] -- ^ suggestions for what might have been meant
-- | Missing @type@ keyword when importing a type.
-- e.g. `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+)
-- Then we want to suggest using `import TypeLits( type (+) )`
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index dc979918fdd3..0ef3968c9f08 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -515,7 +515,7 @@ data HowInScope
data SimilarName
= SimilarName Name
- | SimilarRdrName RdrName HowInScope
+ | SimilarRdrName RdrName (Maybe HowInScope)
-- | Something is promoted to the type-level without a promotion tick.
data UntickedPromotedThing
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index b7d4f1e08fc8..c725c3cb3912 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -353,18 +353,17 @@ 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 (moduleName $ is_mod is))
-
+ = pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc
where
+ loc = case how_in_scope of
+ Nothing -> empty
+ Just scope -> case scope of
+ LocallyBoundAt loc ->
+ case loc of
+ UnhelpfulSpan l -> parens (ppr l)
+ RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
+ ImportedBy is ->
+ parens (text "imported from" <+> ppr (moduleName $ is_mod is))
pp_ns :: RdrName -> SDoc
pp_ns rdr | ns /= tried_ns = pprNameSpace ns
| otherwise = empty
diff --git a/testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr b/testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr
index f8d67446af16..774a3e3da075 100644
--- a/testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr
+++ b/testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr
@@ -1,6 +1,6 @@
-T22106_C.hs:5:9: error: [GHC-88464]
- Variable not in scope: bar
+T22106_C.hs:3:21: error: [GHC-61689]
+ Module ‘T22106_aux’ does not export ‘bar’.
Suggested fix:
Notice that ‘bar’ is a field selector belonging to the type ‘T22106_aux.T’
that has been suppressed by NoFieldSelectors.
diff --git a/testsuite/tests/rename/should_fail/SimilarNamesImport.hs b/testsuite/tests/rename/should_fail/SimilarNamesImport.hs
new file mode 100644
index 000000000000..8b15b72128ea
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/SimilarNamesImport.hs
@@ -0,0 +1,3 @@
+module SimilarNamesImport where
+
+import SimilarNamesImport_aux ( dyzzy, Wabble, wabble, Trizzle(bizzy) )
diff --git a/testsuite/tests/rename/should_fail/SimilarNamesImport.stderr b/testsuite/tests/rename/should_fail/SimilarNamesImport.stderr
new file mode 100644
index 000000000000..528c1caad91c
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/SimilarNamesImport.stderr
@@ -0,0 +1,16 @@
+
+SimilarNamesImport.hs:3:33: error: [GHC-61689]
+ Module ‘SimilarNamesImport_aux’ does not export ‘dyzzy’.
+ Suggested fix:
+ Perhaps use one of these: record field of MkD ‘dizzy’, ‘xyzzy’
+
+SimilarNamesImport.hs:3:40: error: [GHC-61689]
+ Module ‘SimilarNamesImport_aux’ does not export ‘Wabble’.
+ Suggested fix: Perhaps use ‘Wibble’
+
+SimilarNamesImport.hs:3:48: error: [GHC-61689]
+ Module ‘SimilarNamesImport_aux’ does not export ‘wabble’.
+
+SimilarNamesImport.hs:3:56: error: [GHC-61689]
+ Module ‘SimilarNamesImport_aux’ does not export ‘Trizzle’.
+ Suggested fix: Perhaps use one of these: ‘Drizzle’, ‘Frizzle’
diff --git a/testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs b/testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs
new file mode 100644
index 000000000000..254433036a5b
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs
@@ -0,0 +1,11 @@
+module SimilarNamesImport_aux where
+
+xyzzy :: Double
+xyzzy = exp $ pi * sqrt 163
+
+
+data Drizzle = MkD { dizzy :: Int }
+data Frizzle = MkE { fizzy :: Bool }
+
+data Wibble
+
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index 0ae4848a2ea1..749002bc4570 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -199,6 +199,7 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, [''])
test('RnStupidThetaInGadt', normal, compile_fail, [''])
test('PackageImportsDisabled', normal, compile_fail, [''])
test('ImportLookupIllegal', normal, compile_fail, [''])
+test('SimilarNamesImport', [extra_files(['SimilarNamesImport_aux.hs'])], multimod_compile_fail, ['SimilarNamesImport', '-v0'])
test('T23510a', normal, compile_fail, [''])
test('T16635a', normal, compile_fail, [''])
test('T16635b', normal, compile_fail, [''])
--
GitLab