Commit 68fd5dcd authored by pcapriotti's avatar pcapriotti
Browse files

Make badImportItem into a warning (#7167)

Also fix a bug where a dodgy import warning was emitted for data
families with a single constructor.

MERGED from commit 3d7c81a4
parent 29ec96c8
......@@ -643,24 +643,32 @@ filterImports iface decl_spec (Just (want_hiding, import_items))
lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
lookup_lie opt_typeFamilies (L loc ieRdr)
= do
stuff <- setSrcSpan loc $
case lookup_ie opt_typeFamilies ieRdr of
Failed err -> addErr err >> return []
Succeeded a -> return a
checkDodgyImport stuff
(stuff, warns) <- setSrcSpan loc .
liftM (fromMaybe ([],[])) $
run_lookup (lookup_ie opt_typeFamilies ieRdr)
mapM_ emit_warning warns
return [ (L loc ie, avail) | (ie,avail) <- stuff ]
where
-- Warn when importing T(..) if T was exported abstractly
checkDodgyImport stuff
| IEThingAll n <- ieRdr, (_, AvailTC _ [_]):_ <- stuff
= ifWOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
-- NB. use the RdrName for reporting the warning
| IEThingAll {} <- ieRdr
, not (is_qual decl_spec)
= ifWOptM Opt_WarnMissingImportList $
addWarn (missingImportListItem ieRdr)
checkDodgyImport _
= return ()
emit_warning (DodgyImport n) = ifWOptM Opt_WarnDodgyImports $
addWarn (dodgyImportWarn n)
emit_warning MissingImportList = ifWOptM Opt_WarnMissingImportList $
addWarn (missingImportListItem ieRdr)
emit_warning BadImportW = ifWOptM Opt_WarnDodgyImports $
addWarn (lookup_err_msg BadImport)
run_lookup :: IELookupM a -> TcRn (Maybe a)
run_lookup m = case m of
Failed err -> addErr (lookup_err_msg err) >> return Nothing
Succeeded a -> return (Just a)
lookup_err_msg err = case err of
BadImport -> badImportItemErr iface decl_spec ieRdr all_avails
IllegalImport -> illegalImportItemErr
QualImportError rdr -> qualImportItemErr rdr
TypeItemError children -> typeItemErr
(head . filter isTyConName $ children)
(text "in import list")
-- For each import item, we convert its RdrNames to Names,
-- and at the same time construct an AvailInfo corresponding
......@@ -672,78 +680,111 @@ filterImports iface decl_spec (Just (want_hiding, import_items))
-- data constructors of an associated family, we need separate
-- AvailInfos for the data constructors and the family (as they have
-- different parents). See the discussion at occ_env.
lookup_ie :: Bool -> IE RdrName -> MaybeErr MsgDoc [(IE Name,AvailInfo)]
lookup_ie opt_typeFamilies ie
= let bad_ie :: MaybeErr MsgDoc a
bad_ie = Failed (badImportItemErr iface decl_spec ie all_avails)
lookup_name rdr
| isQual rdr = Failed (qualImportItemErr rdr)
| Just nm <- lookupOccEnv occ_env (rdrNameOcc rdr) = return nm
| otherwise = bad_ie
in
case ie of
IEVar n -> do
(name, avail, _) <- lookup_name n
return [(IEVar name, trimAvail avail name)]
IEThingAll tc -> do
(name, avail@(AvailTC name2 subs), mb_parent) <- lookup_name tc
case mb_parent of
-- non-associated ty/cls
Nothing -> return [(IEThingAll name, avail)]
-- associated ty
Just parent -> return [(IEThingAll name,
AvailTC name2 (subs \\ [name])),
(IEThingAll name, AvailTC parent [name])]
IEThingAbs tc
| want_hiding -- hiding ( C )
-- Here the 'C' can be a data constructor
-- *or* a type/class, or even both
-> let tc_name = lookup_name tc
dc_name = lookup_name (setRdrNameSpace tc srcDataName)
in
case catMaybeErr [ tc_name, dc_name ] of
[] -> bad_ie
names -> return [mkIEThingAbs name | name <- names]
| otherwise
-> do nameAvail <- lookup_name tc
return [mkIEThingAbs nameAvail]
IEThingWith tc ns -> do
(name, AvailTC _ subnames, mb_parent) <- lookup_name tc
let
env = mkOccEnv [(nameOccName s, s) | s <- subnames]
mb_children = map (lookupOccEnv env . rdrNameOcc) ns
children <- if any isNothing mb_children
then bad_ie
else return (catMaybes mb_children)
-- check for proper import of type families
when (not opt_typeFamilies && any isTyConName children) $
Failed (typeItemErr (head . filter isTyConName $ children)
(text "in import list"))
lookup_ie :: Bool -> IE RdrName -> IELookupM ([(IE Name, AvailInfo)], [IELookupWarning])
lookup_ie opt_typeFamilies ie = handle_bad_import $ do
let lookup_name rdr
| isQual rdr
= failLookupWith (QualImportError rdr)
| Just nm <- lookupOccEnv occ_env (rdrNameOcc rdr)
= return nm
| otherwise
= failLookupWith BadImport
case ie of
IEVar n -> do
(name, avail, _) <- lookup_name n
return ([(IEVar name, trimAvail avail name)], [])
IEThingAll tc -> do
(name, avail@(AvailTC name2 subs), mb_parent) <- lookup_name tc
let warns
| null (drop 1 subs)
= [DodgyImport tc]
| not (is_qual decl_spec)
= [MissingImportList]
| otherwise
= []
case mb_parent of
-- non-associated ty/cls
Nothing -> return [(IEThingWith name children,
AvailTC name (name:children))]
Nothing -> return ([(IEThingAll name, avail)], warns)
-- associated ty
Just parent -> return [(IEThingWith name children,
Just parent -> return ([(IEThingAll name,
AvailTC name2 (subs \\ [name])),
(IEThingAll name, AvailTC parent [name])],
warns)
IEThingAbs tc
| want_hiding -- hiding ( C )
-- Here the 'C' can be a data constructor
-- *or* a type/class, or even both
-> let tc_name = lookup_name tc
dc_name = lookup_name (setRdrNameSpace tc srcDataName)
in
case catIELookupM [ tc_name, dc_name ] of
[] -> failLookupWith BadImport
names -> return ([mkIEThingAbs name | name <- names], [])
| otherwise
-> do nameAvail <- lookup_name tc
return ([mkIEThingAbs nameAvail], [])
IEThingWith tc ns -> do
(name, AvailTC _ subnames, mb_parent) <- lookup_name tc
let
env = mkOccEnv [(nameOccName s, s) | s <- subnames]
mb_children = map (lookupOccEnv env . rdrNameOcc) ns
children <- if any isNothing mb_children
then failLookupWith BadImport
else return (catMaybes mb_children)
-- check for proper import of type families
when (not opt_typeFamilies && any isTyConName children) $
failLookupWith (TypeItemError children)
case mb_parent of
-- non-associated ty/cls
Nothing -> return ([(IEThingWith name children,
AvailTC name (name:children))],
[])
-- associated ty
Just parent -> return ([(IEThingWith name children,
AvailTC name children),
(IEThingWith name children,
AvailTC parent [name])]
AvailTC parent [name])],
[])
_other -> Failed illegalImportItemErr
-- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
-- all errors.
_other -> failLookupWith IllegalImport
-- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
-- all errors.
where
mkIEThingAbs (n, av, Nothing ) = (IEThingAbs n, trimAvail av n)
mkIEThingAbs (n, _, Just parent) = (IEThingAbs n, AvailTC parent [n])
handle_bad_import m = catchIELookup m $ \err -> case err of
BadImport | want_hiding -> return ([], [BadImportW])
_ -> failLookupWith err
type IELookupM = MaybeErr IELookupError
data IELookupWarning
= BadImportW
| MissingImportList
| DodgyImport RdrName
-- NB. use the RdrName for reporting a "dodgy" import
data IELookupError
= QualImportError RdrName
| BadImport
| IllegalImport
| TypeItemError [Name]
failLookupWith :: IELookupError -> IELookupM a
failLookupWith err = Failed err
catchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup m h = case m of
Succeeded r -> return r
Failed err -> h err
catMaybeErr :: [MaybeErr err a] -> [a]
catMaybeErr ms = [ a | Succeeded a <- ms ]
catIELookupM :: [IELookupM a] -> [a]
catIELookupM ms = [ a | Succeeded a <- ms ]
\end{code}
%************************************************************************
......
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