lookupBindGroupOcc: recommend names in the same namespace (#17593)

Previously, `lookupBindGroupOcc`'s error message would recommend all
similar names in scope, regardless of whether they were type
constructors, data constructors, or functions, leading to the
confusion witnessed in #17593. This is easily fixed by only
recommending names in the same namespace, using the
`nameSpacesRelated` function.

Fixes #17593.

6 files changed, 35 insertions, 9 deletions

diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index b0dfa806e0..2cbd50ed6f 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -50,7 +50,7 @@ module Name (
 
         -- ** Manipulating and deconstructing 'Name's
         nameUnique, setNameUnique,
-        nameOccName, nameModule, nameModule_maybe,
+        nameOccName, nameNameSpace, nameModule, nameModule_maybe,
         setNameLoc,
         tidyNameOcc,
         localiseName,
@@ -196,14 +196,16 @@ instance HasOccName Name where
 
 nameUnique              :: Name -> Unique
 nameOccName             :: Name -> OccName
+nameNameSpace           :: Name -> NameSpace
 nameModule              :: HasDebugCallStack => Name -> Module
 nameSrcLoc              :: Name -> SrcLoc
 nameSrcSpan             :: Name -> SrcSpan
 
-nameUnique  name = n_uniq name
-nameOccName name = n_occ  name
-nameSrcLoc  name = srcSpanStart (n_loc name)
-nameSrcSpan name = n_loc  name
+nameUnique    name = n_uniq name
+nameOccName   name = n_occ  name
+nameNameSpace name = occNameSpace (n_occ name)
+nameSrcLoc    name = srcSpanStart (n_loc name)
+nameSrcSpan   name = n_loc  name
 
 {-
 ************************************************************************
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index 38f7524b8e..176b6cd0d0 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -156,7 +156,7 @@ importDecl name
   where
     nd_doc = text "Need decl for" <+> ppr name
     not_found_msg = hang (text "Can't find interface-file declaration for" <+>
-                                pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
+                                pprNameSpace (nameNameSpace name) <+> ppr name)
                        2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file",
                                 text "Use -ddump-if-trace to get an idea of which file caused the error"])
     found_things_msg eps =
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 00a76df77a..6f615a1721 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -1475,9 +1475,16 @@ lookupBindGroupOcc ctxt what rdr_name
     lookup_top keep_me
       = do { env <- getGlobalRdrEnv
            ; let all_gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
-           ; let candidates_msg = candidates $ map gre_name
-                                             $ filter isLocalGRE
-                                             $ globalRdrEnvElts env
+                 names_in_scope = -- If rdr_name lacks a binding, only
+                                  -- recommend alternatives from related
+                                  -- namespaces. See #17593.
+                                  filter (\n -> nameSpacesRelated
+                                                  (rdrNameSpace rdr_name)
+                                                  (nameNameSpace n))
+                                $ map gre_name
+                                $ filter isLocalGRE
+                                $ globalRdrEnvElts env
+                 candidates_msg = candidates names_in_scope
            ; case filter (keep_me . gre_name) all_gres of
                [] | null all_gres -> bale_out_with candidates_msg
                   | otherwise     -> bale_out_with local_msg
diff --git a/testsuite/tests/rename/should_fail/T17593.hs b/testsuite/tests/rename/should_fail/T17593.hs
new file mode 100644
index 0000000000..6e05343613
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T17593.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+module T17593 where
+
+(<+>) :: Int
+data (<+>)
+
+type MkT :: T
+data T = MkT
diff --git a/testsuite/tests/rename/should_fail/T17593.stderr b/testsuite/tests/rename/should_fail/T17593.stderr
new file mode 100644
index 0000000000..005f6c9fd4
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T17593.stderr
@@ -0,0 +1,7 @@
+
+T17593.hs:5:1: error:
+    The type signature for ‘<+>’ lacks an accompanying binding
+
+T17593.hs:8:6: error:
+    The standalone kind signature for ‘MkT’
+      lacks an accompanying binding
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index c36c4cfcf9..179ff13560 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -152,3 +152,4 @@ test('T16385', normal, compile_fail, [''])
 test('T16504', normal, compile_fail, [''])
 test('T14548', normal, compile_fail, [''])
 test('T16610', normal, compile_fail, [''])
+test('T17593', normal, compile_fail, [''])