Improve error message on un-satisfied import

Consider
  import M( C( a,b,c ) )
where class C is defined as
  module M where
     class C x where
        a :: blah
        c :: blah

Tnen (Trac #15413) we'd like to get an error message only about
failing to import C( b ), not C( a,b,c ).

This was fairly easy (and local) to do.

Turned out that the existing tests mod81 and mod91 are adequate
tests for the feature.

1 files changed, 48 insertions, 31 deletions

diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 33d44b9e3f..6b24d80e9c 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -898,10 +898,11 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
                            else (name1, a2, Just p1)
         combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
 
-    lookup_name :: RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
-    lookup_name rdr | isQual rdr              = failLookupWith (QualImportError rdr)
-                    | Just succ <- mb_success = return succ
-                    | otherwise               = failLookupWith BadImport
+    lookup_name :: IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
+    lookup_name ie rdr
+       | isQual rdr              = failLookupWith (QualImportError rdr)
+       | Just succ <- mb_success = return succ
+       | otherwise               = failLookupWith (BadImport ie)
       where
         mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr)
 
@@ -918,8 +919,8 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
               addWarn (Reason Opt_WarnDodgyImports) (dodgyImportWarn n)
             emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $
               addWarn (Reason Opt_WarnMissingImportList) (missingImportListItem ieRdr)
-            emit_warning BadImportW = whenWOptM Opt_WarnDodgyImports $
-              addWarn (Reason Opt_WarnDodgyImports) (lookup_err_msg BadImport)
+            emit_warning (BadImportW ie) = whenWOptM Opt_WarnDodgyImports $
+              addWarn (Reason Opt_WarnDodgyImports) (lookup_err_msg (BadImport ie))
 
             run_lookup :: IELookupM a -> TcRn (Maybe a)
             run_lookup m = case m of
@@ -927,7 +928,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
               Succeeded a -> return (Just a)
 
             lookup_err_msg err = case err of
-              BadImport -> badImportItemErr iface decl_spec ieRdr all_avails
+              BadImport ie  -> badImportItemErr iface decl_spec ie all_avails
               IllegalImport -> illegalImportItemErr
               QualImportError rdr -> qualImportItemErr rdr
 
@@ -946,12 +947,12 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
     lookup_ie ie = handle_bad_import $ do
       case ie of
         IEVar _ (L l n) -> do
-            (name, avail, _) <- lookup_name $ ieWrappedName n
+            (name, avail, _) <- lookup_name ie $ ieWrappedName n
             return ([(IEVar noExt (L l (replaceWrappedName n name)),
                                                   trimAvail avail name)], [])
 
         IEThingAll _ (L l tc) -> do
-            (name, avail, mb_parent) <- lookup_name $ ieWrappedName tc
+            (name, avail, mb_parent) <- lookup_name ie $ ieWrappedName tc
             let warns = case avail of
                           Avail {}                     -- e.g. f(..)
                             -> [DodgyImport $ ieWrappedName tc]
@@ -981,21 +982,21 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
                        -- Here the 'C' can be a data constructor
                        --  *or* a type/class, or even both
             -> let tc = ieWrappedName tc'
-                   tc_name = lookup_name tc
-                   dc_name = lookup_name (setRdrNameSpace tc srcDataName)
+                   tc_name = lookup_name ie tc
+                   dc_name = lookup_name ie (setRdrNameSpace tc srcDataName)
                in
                case catIELookupM [ tc_name, dc_name ] of
-                 []    -> failLookupWith BadImport
+                 []    -> failLookupWith (BadImport ie)
                  names -> return ([mkIEThingAbs tc' l name | name <- names], [])
             | otherwise
-            -> do nameAvail <- lookup_name (ieWrappedName tc')
+            -> do nameAvail <- lookup_name ie (ieWrappedName tc')
                   return ([mkIEThingAbs tc' l nameAvail]
                          , [])
 
-        IEThingWith _ (L l rdr_tc) wc rdr_ns' rdr_fs ->
+        IEThingWith xt ltc@(L l rdr_tc) wc rdr_ns rdr_fs ->
           ASSERT2(null rdr_fs, ppr rdr_fs) do
            (name, AvailTC _ ns subflds, mb_parent)
-                                         <- lookup_name (ieWrappedName rdr_tc)
+               <- lookup_name (IEThingAbs noExt ltc) (ieWrappedName rdr_tc)
 
            -- Look up the children in the sub-names of the parent
            let subnames = case ns of   -- The tc is first in ns,
@@ -1003,10 +1004,15 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
                                        -- See the AvailTC Invariant in Avail.hs
                             (n1:ns1) | n1 == name -> ns1
                                      | otherwise  -> ns
-               rdr_ns = map ieLWrappedName rdr_ns'
            case lookupChildren (map Left subnames ++ map Right subflds) rdr_ns of
-             Nothing                      -> failLookupWith BadImport
-             Just (childnames, childflds) ->
+
+             Failed rdrs -> failLookupWith (BadImport (IEThingWith xt ltc wc rdrs []))
+                                -- 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 ).
+                                -- c.f. Trac #15412
+
+             Succeeded (childnames, childflds) ->
                case mb_parent of
                  -- non-associated ty/cls
                  Nothing
@@ -1041,20 +1047,20 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
              , AvailTC parent [n] [])
 
         handle_bad_import m = catchIELookup m $ \err -> case err of
-          BadImport | want_hiding -> return ([], [BadImportW])
-          _                       -> failLookupWith err
+          BadImport ie | want_hiding -> return ([], [BadImportW ie])
+          _                          -> failLookupWith err
 
 type IELookupM = MaybeErr IELookupError
 
 data IELookupWarning
-  = BadImportW
+  = BadImportW (IE GhcPs)
   | MissingImportList
   | DodgyImport RdrName
   -- NB. use the RdrName for reporting a "dodgy" import
 
 data IELookupError
   = QualImportError RdrName
-  | BadImport
+  | BadImport (IE GhcPs)
   | IllegalImport
 
 failLookupWith :: IELookupError -> IELookupM a
@@ -1117,8 +1123,9 @@ mkChildEnv gres = foldr add emptyNameEnv gres
 findChildren :: NameEnv [a] -> Name -> [a]
 findChildren env n = lookupNameEnv env n `orElse` []
 
-lookupChildren :: [Either Name FieldLabel] -> [Located RdrName]
-               -> Maybe ([Located Name], [Located FieldLabel])
+lookupChildren :: [Either Name FieldLabel] -> [LIEWrappedName RdrName]
+               -> MaybeErr [LIEWrappedName RdrName]   -- The ones for which the lookup failed
+                           ([Located Name], [Located FieldLabel])
 -- (lookupChildren all_kids rdr_items) maps each rdr_item to its
 -- corresponding Name all_kids, if the former exists
 -- The matching is done by FastString, not OccName, so that
@@ -1127,17 +1134,27 @@ lookupChildren :: [Either Name FieldLabel] -> [Located RdrName]
 -- the RdrName for AssocTy may have a (bogus) DataName namespace
 -- (Really the rdr_items should be FastStrings in the first place.)
 lookupChildren all_kids rdr_items
-  = do xs <- mapM doOne rdr_items
-       return (fmap concat (partitionEithers xs))
+  | null fails
+  = Succeeded (fmap concat (partitionEithers oks))
+       -- This 'fmap concat' trickily applies concat to the /second/ component
+       -- of the pair, whose type is ([Located Name], [[Located FieldLabel]])
+  | otherwise
+  = Failed fails
   where
-    doOne (L l r) = case (lookupFsEnv kid_env . occNameFS . rdrNameOcc) r of
-      Just [Left n]            -> Just (Left (L l n))
-      Just rs | all isRight rs -> Just (Right (map (L l) (rights rs)))
-      _                        -> Nothing
+    mb_xs = map doOne rdr_items
+    fails = [ bad_rdr | Failed bad_rdr <- mb_xs ]
+    oks   = [ ok      | Succeeded ok   <- mb_xs ]
+    oks :: [Either (Located Name) [Located FieldLabel]]
+
+    doOne item@(L l r)
+       = case (lookupFsEnv kid_env . occNameFS . rdrNameOcc . ieWrappedName) r of
+           Just [Left n]            -> Succeeded (Left (L l n))
+           Just rs | all isRight rs -> Succeeded (Right (map (L l) (rights rs)))
+           _                        -> Failed    item
 
     -- See Note [Children for duplicate record fields]
     kid_env = extendFsEnvList_C (++) emptyFsEnv
-                      [(either (occNameFS . nameOccName) flLabel x, [x]) | x <- all_kids]
+              [(either (occNameFS . nameOccName) flLabel x, [x]) | x <- all_kids]