Commit f7d3054a authored by Simon Peyton Jones's avatar Simon Peyton Jones

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.
parent 12c0f03a
......@@ -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]
......
mod81.hs:3:16:
Module ‘Prelude’ does not export ‘Either(Left, Right, Foo)’
mod81.hs:3:16: error:
Module ‘Prelude’ does not export ‘Either(Foo)’
mod91.hs:3:16:
Module ‘Prelude’ does not export ‘Eq((==), (/=), eq)’
mod91.hs:3:16: error: Module ‘Prelude’ does not export ‘Eq(eq)’
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment