import TcEnv ( isBrackStage )
import RnEnv
import RnHsDoc ( rnHsDoc )
-import IfaceEnv ( ifaceExportNames )
+import IfaceEnv ( ifaceExportNames )
import LoadIface ( loadSrcInterface )
import TcRnMonad
import Util
import FastString
import ListSetOps
-import Data.List ( partition, (\\), delete )
+import Data.List ( partition, (\\), delete, find )
import qualified Data.Set as Set
import System.IO
import Control.Monad
-- (Opt_WarnMissingImportList also checks for T(..) items
-- but that is done in checkDodgyImport below)
case imp_details of
- Just (False, _) -> return ()
+ Just (False, _) -> return () -- Explicit import list
_ | implicit_prelude -> return ()
+ | qual_only -> return ()
| otherwise -> ifDOptM Opt_WarnMissingImportList $
addWarn (missingImportListWarn imp_mod_name)
hs_fords = foreign_decls })
= do { -- separate out the family instance declarations
let (tyinst_decls1, tycl_decls_noinsts)
- = partition (isFamInstDecl . unLoc) tycl_decls
+ = partition (isFamInstDecl . unLoc) (concat tycl_decls)
tyinst_decls = tyinst_decls1 ++ instDeclATs inst_decls
-- process all type/class decls except family instances
= ifDOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
-- NB. use the RdrName for reporting the warning
| IEThingAll {} <- ieRdr
+ , not (is_qual decl_spec)
= ifDOptM Opt_WarnMissingImportList $
addWarn (missingImportListItem ieRdr)
checkDodgyImport _
lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)]
lookup_ie opt_typeFamilies ie
= let bad_ie :: MaybeErr Message a
- bad_ie = Failed (badImportItemErr iface decl_spec ie)
+ bad_ie = Failed (badImportItemErr iface decl_spec ie all_avails)
lookup_name rdr
| isQual rdr = Failed (qualImportItemErr rdr)
type ExportAccum -- The type of the accumulating parameter of
-- the main worker function in rnExports
= ([LIE Name], -- Export items with Names
- ExportOccMap, -- Tracks exported occurrence names
+ ExportOccMap, -- Tracks exported occurrence names
[AvailInfo]) -- The accumulated exported stuff
-- Not nub'd!
exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
exports_from_item acc@(ie_names, occs, exports)
- (L loc ie@(IEModuleContents mod))
+ (L loc (IEModuleContents mod))
| let earlier_mods = [ mod | (L _ (IEModuleContents mod)) <- ie_names ]
, mod `elem` earlier_mods -- Duplicate export of M
= do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
-- The qualified and unqualified version of all of
-- these names are, in effect, used by this export
- ; occs' <- check_occs ie occs names
+ ; occs' <- check_occs (IEModuleContents mod) occs names
-- This check_occs not only finds conflicts
-- between this item and others, but also
-- internally within this item. That is, if
-------------------------------
check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap
-check_occs ie occs names
+check_occs ie occs names -- 'names' are the entities specifed by 'ie'
= foldlM check occs names
where
check occs name
| name == name' -- Duplicate export
-- But we don't want to warn if the same thing is exported
-- by two different module exports. See ticket #4478.
- -> do unless (diffModules ie ie') $ do
+ -> do unless (dupExport_ok name ie ie') $ do
warn_dup_exports <- doptM Opt_WarnDuplicateExports
warnIf warn_dup_exports (dupExportWarn name_occ ie ie')
return occs
return occs }
where
name_occ = nameOccName name
- -- True if the two IE RdrName are different module exports.
- diffModules (IEModuleContents n1) (IEModuleContents n2) = n1 /= n2
- diffModules _ _ = False
+
+
+dupExport_ok :: Name -> IE RdrName -> IE RdrName -> Bool
+-- The Name is exported by both IEs. Is that ok?
+-- "No" iff the name is mentioned explicitly in both IEs
+-- or one of the IEs mentions the name *alone*
+-- "Yes" otherwise
+--
+-- Examples of "no": module M( f, f )
+-- module M( fmap, Functor(..) )
+-- module M( module Data.List, head )
+--
+-- Example of "yes"
+-- module M( module A, module B ) where
+-- import A( f )
+-- import B( f )
+--
+-- Example of "yes" (Trac #2436)
+-- module M( C(..), T(..) ) where
+-- class C a where { data T a }
+-- instace C Int where { data T Int = TInt }
+--
+-- Example of "yes" (Trac #2436)
+-- module Foo ( T ) where
+-- data family T a
+-- module Bar ( T(..), module Foo ) where
+-- import Foo
+-- data instance T Int = TInt
+
+dupExport_ok n ie1 ie2
+ = not ( single ie1 || single ie2
+ || (explicit_in ie1 && explicit_in ie2) )
+ where
+ explicit_in (IEModuleContents _) = False -- module M
+ explicit_in (IEThingAll r) = nameOccName n == rdrNameOcc r -- T(..)
+ explicit_in _ = True
+
+ single (IEVar {}) = True
+ single (IEThingAbs {}) = True
+ single _ = False
\end{code}
%*********************************************************
; let usage :: [ImportDeclUsage]
usage = findImportUsage imports rdr_env (Set.elems uses)
+ ; traceRn (ptext (sLit "Import usage") <+> ppr usage)
; ifDOptM Opt_WarnUnusedImports $
mapM_ warnUnusedImport usage
; ifDOptM Opt_D_dump_minimal_imports $
printMinimalImports usage }
where
- explicit_import (L loc _) = isGoodSrcSpan loc
+ explicit_import (L loc _) = case loc of
+ UnhelpfulSpan _ -> False
+ RealSrcSpan _ -> True
-- Filter out the implicit Prelude import
-- which we do not want to bleat about
\end{code}
= hang (ptext (sLit "Illegal qualified name in import item:"))
2 (ppr rdr)
-badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
-badImportItemErr iface decl_spec ie
+badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
+badImportItemErrStd iface decl_spec ie
= sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import,
ptext (sLit "does not export"), quotes (ppr ie)]
where
source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
| otherwise = empty
+badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
+badImportItemErrDataCon dataType iface decl_spec ie
+ = vcat [ ptext (sLit "In module")
+ <+> quotes (ppr (is_mod decl_spec))
+ <+> source_import <> colon
+ , nest 2 $ quotes datacon
+ <+> ptext (sLit "is a data constructor of")
+ <+> quotes (ppr dataType)
+ , ptext (sLit "To import it use")
+ , nest 2 $ quotes (ptext (sLit "import")
+ <+> ppr (is_mod decl_spec)
+ <+> parens (ppr dataType <+> parens datacon))
+ , ptext (sLit "or")
+ , nest 2 $ quotes (ptext (sLit "import")
+ <+> ppr (is_mod decl_spec)
+ <+> parens (ppr dataType <+> parens (ptext $ sLit "..")))
+ ]
+ where
+ datacon = ppr . rdrNameOcc $ ieName ie
+ source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
+ | otherwise = empty
+
+badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> [AvailInfo] -> SDoc
+badImportItemErr iface decl_spec ie avails
+ = case find checkIfDataCon avails of
+ Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie
+ Nothing -> badImportItemErrStd iface decl_spec ie
+ where
+ checkIfDataCon (AvailTC _ ns) =
+ case find (\n -> importedFS == nameOccNameFS n) ns of
+ Just n -> isDataConName n
+ Nothing -> False
+ checkIfDataCon _ = False
+ availOccName = nameOccName . availName
+ nameOccNameFS = occNameFS . nameOccName
+ importedFS = occNameFS . rdrNameOcc $ ieName ie
+
illegalImportItemErr :: SDoc
illegalImportItemErr = ptext (sLit "Illegal import item")
projects / ghc-hetmet.git / blobdiff