{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Rename.Names (
rnImports, getLocalNonValBinders, newRecordFieldLabel,
importsFromIface,
ImportUserSpec(..),
extendGlobalRdrEnvRn,
gresFromAvails,
calculateAvails,
reportUnusedNames,
checkConName,
mkChildEnv,
findChildren,
findImportUsage,
getMinimalImports,
printMinimalImports,
renamePkgQual, renameRawPkgQual,
classifyGREs,
ImportDeclUsage
) where
import GHC.Prelude hiding ( head, init, last, tail )
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Rename.Env
import GHC.Rename.Fixity
import GHC.Rename.Utils ( warnUnusedTopBinds )
import GHC.Rename.Unbound
import qualified GHC.Rename.Unbound as Unbound
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.Monad
import GHC.Tc.Types.LclEnv
import GHC.Tc.Zonk.TcType ( tcInitTidyEnv )
import GHC.Hs
import GHC.Iface.Load ( loadSrcInterface )
import GHC.Iface.Syntax ( IfaceDefault, fromIfaceWarnings )
import GHC.Builtin.Names
import GHC.Parser.PostProcess ( setRdrNameSpace )
import GHC.Core.Type
import GHC.Core.PatSyn
import GHC.Core.TyCon ( TyCon, tyConName )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Misc as Utils
import GHC.Utils.Panic
import GHC.Types.Fixity.Env
import GHC.Types.SafeHaskell
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.Name.Reader
import GHC.Types.Avail
import GHC.Types.FieldLabel
import GHC.Types.Hint
import GHC.Types.SourceFile
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Basic ( TopLevelFlag(..) )
import GHC.Types.SourceText
import GHC.Types.Id
import GHC.Types.HpcInfo
import GHC.Types.PkgQual
import GHC.Types.GREInfo (ConInfo(..), ConFieldInfo (..), ConLikeInfo (ConIsData))
import GHC.Unit
import GHC.Unit.Module.Warnings
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Imported
import GHC.Unit.Module.Deps
import GHC.Unit.Env
import GHC.Data.Bag
import GHC.Data.FastString
import GHC.Data.FastString.Env
import GHC.Data.Maybe
import GHC.Data.List.SetOps ( removeDups )
import Control.Monad
import Data.Foldable ( for_ )
import Data.IntMap ( IntMap )
import qualified Data.IntMap as IntMap
import Data.Map ( Map )
import qualified Data.Map as Map
import Data.Ord ( comparing )
import Data.List ( partition, find, sortBy )
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Function ( on )
import qualified Data.Set as S
import System.FilePath ((</>))
import System.IO
rnImports :: [(LImportDecl GhcPs, SDoc)]
-> RnM ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], AnyHpcUsage)
rnImports :: [(LImportDecl (GhcPass 'Parsed), SDoc)]
-> RnM
([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool)
rnImports [(LImportDecl (GhcPass 'Parsed), SDoc)]
imports = do
tcg_env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
let this_mod = TcGblEnv -> Module
tcg_mod TcGblEnv
tcg_env
let (source, ordinary) = partition (is_source_import . fst) imports
is_source_import (LImportDecl (GhcPass 'Parsed)
d::LImportDecl GhcPs) = ImportDecl (GhcPass 'Parsed) -> IsBootInterface
forall pass. ImportDecl pass -> IsBootInterface
ideclSource (GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))
-> ImportDecl (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc LImportDecl (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))
d) IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
stuff1 <- mapAndReportM (rnImportDecl this_mod) ordinary
stuff2 <- mapAndReportM (rnImportDecl this_mod) source
let (decls, imp_user_spec, rdr_env, imp_avails, defaults, hpc_usage) = combine (stuff1 ++ stuff2)
let merged_import_avail = ImportAvails -> ImportAvails
clobberSourceImports ImportAvails
imp_avails
return (decls, imp_user_spec, rdr_env, merged_import_avail, defaults, hpc_usage)
where
clobberSourceImports :: ImportAvails -> ImportAvails
clobberSourceImports ImportAvails
imp_avails =
ImportAvails
imp_avails { imp_boot_mods = imp_boot_mods' }
where
imp_boot_mods' :: InstalledModuleEnv (GenWithIsBoot ModuleName)
imp_boot_mods' = (GenWithIsBoot ModuleName
-> GenWithIsBoot ModuleName -> Maybe (GenWithIsBoot ModuleName))
-> (InstalledModuleEnv (GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName))
-> (InstalledModuleEnv (GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName))
-> InstalledModuleEnv (GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName)
forall elta eltb eltc.
(elta -> eltb -> Maybe eltc)
-> (InstalledModuleEnv elta -> InstalledModuleEnv eltc)
-> (InstalledModuleEnv eltb -> InstalledModuleEnv eltc)
-> InstalledModuleEnv elta
-> InstalledModuleEnv eltb
-> InstalledModuleEnv eltc
mergeInstalledModuleEnv GenWithIsBoot ModuleName
-> GenWithIsBoot ModuleName -> Maybe (GenWithIsBoot ModuleName)
forall {mod}.
GenWithIsBoot mod -> GenWithIsBoot mod -> Maybe (GenWithIsBoot mod)
combJ InstalledModuleEnv (GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName)
forall a. a -> a
id (InstalledModuleEnv (GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName)
forall a b. a -> b -> a
const InstalledModuleEnv (GenWithIsBoot ModuleName)
forall a. InstalledModuleEnv a
emptyInstalledModuleEnv)
(ImportAvails -> InstalledModuleEnv (GenWithIsBoot ModuleName)
imp_boot_mods ImportAvails
imp_avails)
(ImportAvails -> InstalledModuleEnv (GenWithIsBoot ModuleName)
imp_direct_dep_mods ImportAvails
imp_avails)
combJ :: GenWithIsBoot mod -> GenWithIsBoot mod -> Maybe (GenWithIsBoot mod)
combJ (GWIB mod
_ IsBootInterface
IsBoot) GenWithIsBoot mod
x = GenWithIsBoot mod -> Maybe (GenWithIsBoot mod)
forall a. a -> Maybe a
Just GenWithIsBoot mod
x
combJ GenWithIsBoot mod
r GenWithIsBoot mod
_ = GenWithIsBoot mod -> Maybe (GenWithIsBoot mod)
forall a. a -> Maybe a
Just GenWithIsBoot mod
r
combine :: [(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], AnyHpcUsage)]
-> ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], AnyHpcUsage)
combine :: [(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool)]
-> ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv,
ImportAvails, [(Module, IfaceDefault)], Bool)
combine [(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool)]
ss =
let ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
decls, [ImportUserSpec]
imp_user_spec, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails, [(Module, IfaceDefault)]
defaults, Bool
hpc_usage, ModuleSet
finsts) = ((GenLocated SrcSpanAnnA (ImportDecl GhcRn), ImportUserSpec,
GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], Bool)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], [ImportUserSpec],
GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], Bool,
ModuleSet)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], [ImportUserSpec],
GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], Bool,
ModuleSet))
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], [ImportUserSpec],
GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], Bool,
ModuleSet)
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), ImportUserSpec,
GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], Bool)]
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], [ImportUserSpec],
GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], Bool,
ModuleSet)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), ImportUserSpec,
GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], Bool)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], [ImportUserSpec],
GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], Bool,
ModuleSet)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], [ImportUserSpec],
GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], Bool,
ModuleSet)
forall {a} {a} {a}.
(a, a, GlobalRdrEnv, ImportAvails, [a], Bool)
-> ([a], [a], GlobalRdrEnv, ImportAvails, [a], Bool, ModuleSet)
-> ([a], [a], GlobalRdrEnv, ImportAvails, [a], Bool, ModuleSet)
plus
([], [], GlobalRdrEnv
forall info. GlobalRdrEnvX info
emptyGlobalRdrEnv, ImportAvails
emptyImportAvails, [], Bool
False, ModuleSet
emptyModuleSet)
[(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool)]
[(GenLocated SrcSpanAnnA (ImportDecl GhcRn), ImportUserSpec,
GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], Bool)]
ss
in ([LImportDecl GhcRn]
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
decls, [ImportUserSpec]
imp_user_spec, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails { imp_finsts = moduleSetElts finsts },
[(Module, IfaceDefault)]
defaults, Bool
hpc_usage)
plus :: (a, a, GlobalRdrEnv, ImportAvails, [a], Bool)
-> ([a], [a], GlobalRdrEnv, ImportAvails, [a], Bool, ModuleSet)
-> ([a], [a], GlobalRdrEnv, ImportAvails, [a], Bool, ModuleSet)
plus (a
decl, a
us, GlobalRdrEnv
gbl_env1, ImportAvails
imp_avails1, [a]
defaults1, Bool
hpc_usage1)
([a]
decls, [a]
uss, GlobalRdrEnv
gbl_env2, ImportAvails
imp_avails2, [a]
defaults2, Bool
hpc_usage2, ModuleSet
finsts_set)
= ( a
decla -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
decls,
a
usa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
uss,
GlobalRdrEnv
gbl_env1 GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
`plusGlobalRdrEnv` GlobalRdrEnv
gbl_env2,
ImportAvails
imp_avails1' ImportAvails -> ImportAvails -> ImportAvails
`plusImportAvails` ImportAvails
imp_avails2,
[a]
defaults1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
defaults2,
Bool
hpc_usage1 Bool -> Bool -> Bool
|| Bool
hpc_usage2,
ModuleSet -> [Module] -> ModuleSet
extendModuleSetList ModuleSet
finsts_set [Module]
new_finsts )
where
imp_avails1' :: ImportAvails
imp_avails1' = ImportAvails
imp_avails1 { imp_finsts = [] }
new_finsts :: [Module]
new_finsts = ImportAvails -> [Module]
imp_finsts ImportAvails
imp_avails1
rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc)
-> RnM (LImportDecl GhcRn, ImportUserSpec , GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], AnyHpcUsage)
rnImportDecl :: Module
-> (LImportDecl (GhcPass 'Parsed), SDoc)
-> RnM
(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool)
rnImportDecl Module
this_mod
(L SrcSpanAnnA
loc decl :: ImportDecl (GhcPass 'Parsed)
decl@(ImportDecl { ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = XRec (GhcPass 'Parsed) ModuleName
loc_imp_mod_name
, ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual = ImportDeclPkgQual (GhcPass 'Parsed)
raw_pkg_qual
, ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSource = IsBootInterface
want_boot, ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclSafe = Bool
mod_safe
, ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
qual_style
, ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclExt = XImportDeclPass { ideclImplicit :: XImportDeclPass -> Bool
ideclImplicit = Bool
implicit }
, ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs = Maybe (XRec (GhcPass 'Parsed) ModuleName)
as_mod, ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList = Maybe
(ImportListInterpretation,
XRec (GhcPass 'Parsed) [LIE (GhcPass 'Parsed)])
imp_details }), SDoc
import_reason)
= SrcSpanAnnA
-> RnM
(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool)
-> RnM
(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool)
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc (RnM
(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool)
-> RnM
(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool))
-> RnM
(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool)
-> RnM
(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails,
[(Module, IfaceDefault)], Bool)
forall a b. (a -> b) -> a -> b
$ do
case ImportDeclPkgQual (GhcPass 'Parsed)
raw_pkg_qual of
ImportDeclPkgQual (GhcPass 'Parsed)
RawPkgQual
NoRawPkgQual -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
RawPkgQual StringLiteral
_ -> do
pkg_imports <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.PackageImports
when (not pkg_imports) $ addErr TcRnPackageImportsDisabled
let qual_only :: Bool
qual_only = ImportDeclQualifiedStyle -> Bool
isImportDeclQualified ImportDeclQualifiedStyle
qual_style
let imp_mod_name :: ModuleName
imp_mod_name = GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc XRec (GhcPass 'Parsed) ModuleName
GenLocated SrcSpanAnnA ModuleName
loc_imp_mod_name
doc :: SDoc
doc = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
imp_mod_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
import_reason
hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
unit_env <- hsc_unit_env <$> getTopEnv
let pkg_qual = UnitEnv -> ModuleName -> RawPkgQual -> PkgQual
renameRawPkgQual UnitEnv
unit_env ModuleName
imp_mod_name ImportDeclPkgQual (GhcPass 'Parsed)
RawPkgQual
raw_pkg_qual
when (imp_mod_name == moduleName this_mod &&
(case pkg_qual of
PkgQual
NoPkgQual -> Bool
True
ThisPkg UnitId
uid -> UnitId
uid UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== DynFlags -> UnitId
homeUnitId_ (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
OtherPkg UnitId
_ -> Bool
False))
(addErr (TcRnSelfImport imp_mod_name))
case imp_details of
Just (ImportListInterpretation
Exactly, XRec (GhcPass 'Parsed) [LIE (GhcPass 'Parsed)]
_) -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe
(ImportListInterpretation,
XRec (GhcPass 'Parsed) [LIE (GhcPass 'Parsed)])
_ | Bool
implicit -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
qual_only -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic (ModuleName -> TcRnMessage
TcRnNoExplicitImportList ModuleName
imp_mod_name)
iface <- loadSrcInterface doc imp_mod_name want_boot pkg_qual
warnPprTrace ((want_boot == NotBoot) && (mi_boot iface == IsBoot)) "rnImportDecl" (ppr imp_mod_name) $ do
dflags <- getDynFlags
warnIf ((want_boot == IsBoot) && (mi_boot iface == NotBoot) && isOneShot (ghcMode dflags))
(TcRnRedundantSourceImport imp_mod_name)
when (mod_safe && not (safeImportsOn dflags)) $
addErr (TcRnSafeImportsDisabled imp_mod_name)
let imp_mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
qual_mod_name = (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> Maybe (GenLocated SrcSpanAnnA ModuleName) -> Maybe ModuleName
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Maybe (XRec (GhcPass 'Parsed) ModuleName)
Maybe (GenLocated SrcSpanAnnA ModuleName)
as_mod Maybe ModuleName -> ModuleName -> ModuleName
forall a. Maybe a -> a -> a
`orElse` ModuleName
imp_mod_name
imp_spec = ImpDeclSpec { is_mod :: Module
is_mod = Module
imp_mod, is_qual :: Bool
is_qual = Bool
qual_only,
is_dloc :: SrcSpan
is_dloc = SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc, is_as :: ModuleName
is_as = ModuleName
qual_mod_name,
is_pkg_qual :: PkgQual
is_pkg_qual = PkgQual
pkg_qual, is_isboot :: IsBootInterface
is_isboot = IsBootInterface
want_boot }
(new_imp_details, imp_user_list, gbl_env) <- filterImports hsc_env iface imp_spec imp_details
potential_gres <- (\(Maybe
(ImportListInterpretation,
LocatedLI [GenLocated SrcSpanAnnA (IE GhcRn)])
_,ImpUserList
_,GlobalRdrEnv
x) -> GlobalRdrEnv
x) <$> filterImports hsc_env iface imp_spec Nothing
let is_hiding | Just (ImportListInterpretation
EverythingBut,XRec (GhcPass 'Parsed) [LIE (GhcPass 'Parsed)]
_) <- Maybe
(ImportListInterpretation,
XRec (GhcPass 'Parsed) [LIE (GhcPass 'Parsed)])
imp_details = Bool
True
| Bool
otherwise = Bool
False
mod_safe' = Bool
mod_safe
Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
implicit Bool -> Bool -> Bool
&& DynFlags -> Bool
safeDirectImpsReq DynFlags
dflags)
Bool -> Bool -> Bool
|| (Bool
implicit Bool -> Bool -> Bool
&& DynFlags -> Bool
safeImplicitImpsReq DynFlags
dflags)
hsc_env <- getTopEnv
let home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
other_home_units = HscEnv -> Set UnitId
hsc_all_home_unit_ids HscEnv
hsc_env
imv = ImportedModsVal
{ imv_name :: ModuleName
imv_name = ImpDeclSpec -> ModuleName
is_as ImpDeclSpec
imp_spec
, imv_span :: SrcSpan
imv_span = SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc
, imv_is_safe :: Bool
imv_is_safe = Bool
mod_safe'
, imv_is_hiding :: Bool
imv_is_hiding = Bool
is_hiding
, imv_all_exports :: GlobalRdrEnv
imv_all_exports = GlobalRdrEnv
potential_gres
, imv_qualified :: Bool
imv_qualified = Bool
qual_only
}
imports = HomeUnit
-> Set UnitId
-> ModIface
-> Bool
-> IsBootInterface
-> ImportedBy
-> ImportAvails
calculateAvails HomeUnit
home_unit Set UnitId
other_home_units ModIface
iface Bool
mod_safe' IsBootInterface
want_boot (ImportedModsVal -> ImportedBy
ImportedByUser ImportedModsVal
imv)
case fromIfaceWarnings (mi_warns iface) of
WarnAll WarningTxt GhcRn
txt -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic (ModuleName -> WarningTxt GhcRn -> TcRnMessage
TcRnDeprecatedModule ModuleName
imp_mod_name WarningTxt GhcRn
txt)
Warnings GhcRn
_ -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let new_imp_decl = ImportDecl
{ ideclExt :: XCImportDecl GhcRn
ideclExt = ImportDecl (GhcPass 'Parsed) -> XCImportDecl (GhcPass 'Parsed)
forall pass. ImportDecl pass -> XCImportDecl pass
ideclExt ImportDecl (GhcPass 'Parsed)
decl
, ideclName :: XRec GhcRn ModuleName
ideclName = ImportDecl (GhcPass 'Parsed) -> XRec (GhcPass 'Parsed) ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl (GhcPass 'Parsed)
decl
, ideclPkgQual :: ImportDeclPkgQual GhcRn
ideclPkgQual = ImportDeclPkgQual GhcRn
PkgQual
pkg_qual
, ideclSource :: IsBootInterface
ideclSource = ImportDecl (GhcPass 'Parsed) -> IsBootInterface
forall pass. ImportDecl pass -> IsBootInterface
ideclSource ImportDecl (GhcPass 'Parsed)
decl
, ideclSafe :: Bool
ideclSafe = Bool
mod_safe'
, ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = ImportDecl (GhcPass 'Parsed) -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl (GhcPass 'Parsed)
decl
, ideclAs :: Maybe (XRec GhcRn ModuleName)
ideclAs = ImportDecl (GhcPass 'Parsed)
-> Maybe (XRec (GhcPass 'Parsed) ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl (GhcPass 'Parsed)
decl
, ideclImportList :: Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
ideclImportList = Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
Maybe
(ImportListInterpretation,
LocatedLI [GenLocated SrcSpanAnnA (IE GhcRn)])
new_imp_details
}
return (L loc new_imp_decl, ImpUserSpec imp_spec imp_user_list, gbl_env,
imports, (,) (mi_module iface) <$> mi_defaults iface, mi_hpc iface)
renameRawPkgQual :: UnitEnv -> ModuleName -> RawPkgQual -> PkgQual
renameRawPkgQual :: UnitEnv -> ModuleName -> RawPkgQual -> PkgQual
renameRawPkgQual UnitEnv
unit_env ModuleName
mn = \case
RawPkgQual
NoRawPkgQual -> PkgQual
NoPkgQual
RawPkgQual StringLiteral
p -> UnitEnv -> ModuleName -> Maybe FastString -> PkgQual
renamePkgQual UnitEnv
unit_env ModuleName
mn (FastString -> Maybe FastString
forall a. a -> Maybe a
Just (StringLiteral -> FastString
sl_fs StringLiteral
p))
renamePkgQual :: UnitEnv -> ModuleName -> Maybe FastString -> PkgQual
renamePkgQual :: UnitEnv -> ModuleName -> Maybe FastString -> PkgQual
renamePkgQual UnitEnv
unit_env ModuleName
mn Maybe FastString
mb_pkg = case Maybe FastString
mb_pkg of
Maybe FastString
Nothing -> PkgQual
NoPkgQual
Just FastString
pkg_fs
| Just UnitId
uid <- HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId (HomeUnit -> UnitId) -> Maybe HomeUnit -> Maybe UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnitEnv -> Maybe HomeUnit
ue_homeUnit UnitEnv
unit_env
, FastString
pkg_fs FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> FastString
fsLit String
"this"
-> UnitId -> PkgQual
ThisPkg UnitId
uid
| Just (UnitId
uid, Maybe FastString
_) <- ((UnitId, Maybe FastString) -> Bool)
-> [(UnitId, Maybe FastString)] -> Maybe (UnitId, Maybe FastString)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> ((UnitId, Maybe FastString) -> Maybe Bool)
-> (UnitId, Maybe FastString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FastString -> Bool) -> Maybe FastString -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
pkg_fs) (Maybe FastString -> Maybe Bool)
-> ((UnitId, Maybe FastString) -> Maybe FastString)
-> (UnitId, Maybe FastString)
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitId, Maybe FastString) -> Maybe FastString
forall a b. (a, b) -> b
snd) [(UnitId, Maybe FastString)]
home_names
-> UnitId -> PkgQual
ThisPkg UnitId
uid
| Just UnitId
uid <- UnitState -> ModuleName -> PackageName -> Maybe UnitId
resolvePackageImport (HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_units UnitEnv
unit_env) ModuleName
mn (FastString -> PackageName
PackageName FastString
pkg_fs)
-> UnitId -> PkgQual
OtherPkg UnitId
uid
| Bool
otherwise
-> UnitId -> PkgQual
OtherPkg (FastString -> UnitId
UnitId FastString
pkg_fs)
where
home_names :: [(UnitId, Maybe FastString)]
home_names = (UnitId -> (UnitId, Maybe FastString))
-> [UnitId] -> [(UnitId, Maybe FastString)]
forall a b. (a -> b) -> [a] -> [b]
map (\UnitId
uid -> (UnitId
uid, String -> FastString
mkFastString (String -> FastString) -> Maybe String -> Maybe FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> Maybe String
thisPackageName (HomeUnitEnv -> DynFlags
homeUnitEnv_dflags (HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
unit_env)))) [UnitId]
hpt_deps
units :: UnitState
units = HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_units UnitEnv
unit_env
hpt_deps :: [UnitId]
hpt_deps :: [UnitId]
hpt_deps = UnitState -> [UnitId]
homeUnitDepends UnitState
units
calculateAvails :: HomeUnit
-> S.Set UnitId
-> ModIface
-> IsSafeImport
-> IsBootInterface
-> ImportedBy
-> ImportAvails
calculateAvails :: HomeUnit
-> Set UnitId
-> ModIface
-> Bool
-> IsBootInterface
-> ImportedBy
-> ImportAvails
calculateAvails HomeUnit
home_unit Set UnitId
other_home_units ModIface
iface Bool
mod_safe' IsBootInterface
want_boot ImportedBy
imported_by =
let imp_mod :: Module
imp_mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
imp_sem_mod :: Module
imp_sem_mod= ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface
orph_iface :: Bool
orph_iface = ModIfaceBackend -> Bool
mi_orphan (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
has_finsts :: Bool
has_finsts = ModIfaceBackend -> Bool
mi_finsts (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
deps :: Dependencies
deps = ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface
trust :: SafeHaskellMode
trust = IfaceTrustInfo -> SafeHaskellMode
getSafeMode (IfaceTrustInfo -> SafeHaskellMode)
-> IfaceTrustInfo -> SafeHaskellMode
forall a b. (a -> b) -> a -> b
$ ModIface -> IfaceTrustInfo
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust ModIface
iface
trust_pkg :: Bool
trust_pkg = ModIface -> Bool
forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_trust_pkg ModIface
iface
is_sig :: Bool
is_sig = ModIface -> HscSource
forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src ModIface
iface HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsigFile
deporphs :: [Module]
deporphs = Dependencies -> [Module]
dep_orphs Dependencies
deps
depfinsts :: [Module]
depfinsts = Dependencies -> [Module]
dep_finsts Dependencies
deps
orphans :: [Module]
orphans | Bool
orph_iface = Bool -> SDoc -> [Module] -> [Module]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Bool -> Bool
not (Module
imp_sem_mod Module -> [Module] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Module]
deporphs)) (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
imp_sem_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Module] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Module]
deporphs) ([Module] -> [Module]) -> [Module] -> [Module]
forall a b. (a -> b) -> a -> b
$
Module
imp_sem_mod Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: [Module]
deporphs
| Bool
otherwise = [Module]
deporphs
finsts :: [Module]
finsts | Bool
has_finsts = Bool -> SDoc -> [Module] -> [Module]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Bool -> Bool
not (Module
imp_sem_mod Module -> [Module] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Module]
depfinsts)) (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
imp_sem_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Module] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Module]
depfinsts) ([Module] -> [Module]) -> [Module] -> [Module]
forall a b. (a -> b) -> a -> b
$
Module
imp_sem_mod Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: [Module]
depfinsts
| Bool
otherwise = [Module]
depfinsts
trusted_pkgs :: Set UnitId
trusted_pkgs | Bool
mod_safe' = Dependencies -> Set UnitId
dep_trusted_pkgs Dependencies
deps
| Bool
otherwise = Set UnitId
forall a. Set a
S.empty
pkg :: GenUnit UnitId
pkg = Module -> GenUnit UnitId
forall unit. GenModule unit -> unit
moduleUnit (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)
ipkg :: UnitId
ipkg = GenUnit UnitId -> UnitId
toUnitId GenUnit UnitId
pkg
ptrust :: Bool
ptrust = SafeHaskellMode
trust SafeHaskellMode -> SafeHaskellMode -> Bool
forall a. Eq a => a -> a -> Bool
== SafeHaskellMode
Sf_Trustworthy Bool -> Bool -> Bool
|| Bool
trust_pkg
pkg_trust_req :: Bool
pkg_trust_req
| HomeUnit -> GenUnit UnitId -> Bool
isHomeUnit HomeUnit
home_unit GenUnit UnitId
pkg = Bool
ptrust
| Bool
otherwise = Bool
False
dependent_pkgs :: Set UnitId
dependent_pkgs = if GenUnit UnitId -> UnitId
toUnitId GenUnit UnitId
pkg UnitId -> Set UnitId -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set UnitId
other_home_units
then Set UnitId
forall a. Set a
S.empty
else UnitId -> Set UnitId
forall a. a -> Set a
S.singleton UnitId
ipkg
direct_mods :: InstalledModuleEnv (GenWithIsBoot ModuleName)
direct_mods = Set (UnitId, GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName)
mkModDeps (Set (UnitId, GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName))
-> Set (UnitId, GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName)
forall a b. (a -> b) -> a -> b
$ if GenUnit UnitId -> UnitId
toUnitId GenUnit UnitId
pkg UnitId -> Set UnitId -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set UnitId
other_home_units
then (UnitId, GenWithIsBoot ModuleName)
-> Set (UnitId, GenWithIsBoot ModuleName)
forall a. a -> Set a
S.singleton (Module -> UnitId
moduleUnitId Module
imp_mod, (ModuleName -> IsBootInterface -> GenWithIsBoot ModuleName
forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
imp_mod) IsBootInterface
want_boot))
else Set (UnitId, GenWithIsBoot ModuleName)
forall a. Set a
S.empty
dep_boot_mods_map :: InstalledModuleEnv (GenWithIsBoot ModuleName)
dep_boot_mods_map = Set (UnitId, GenWithIsBoot ModuleName)
-> InstalledModuleEnv (GenWithIsBoot ModuleName)
mkModDeps (Dependencies -> Set (UnitId, GenWithIsBoot ModuleName)
dep_boot_mods Dependencies
deps)
boot_mods :: InstalledModuleEnv (GenWithIsBoot ModuleName)
boot_mods
| IsBootInterface
IsBoot <- IsBootInterface
want_boot = InstalledModuleEnv (GenWithIsBoot ModuleName)
-> InstalledModule
-> GenWithIsBoot ModuleName
-> InstalledModuleEnv (GenWithIsBoot ModuleName)
forall a.
InstalledModuleEnv a
-> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv InstalledModuleEnv (GenWithIsBoot ModuleName)
dep_boot_mods_map (GenUnit UnitId -> UnitId
toUnitId (GenUnit UnitId -> UnitId) -> Module -> InstalledModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module
imp_mod) (ModuleName -> IsBootInterface -> GenWithIsBoot ModuleName
forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
imp_mod) IsBootInterface
IsBoot)
| HomeUnit -> GenUnit UnitId -> Bool
isHomeUnit HomeUnit
home_unit GenUnit UnitId
pkg = InstalledModuleEnv (GenWithIsBoot ModuleName)
dep_boot_mods_map
| Bool
otherwise = InstalledModuleEnv (GenWithIsBoot ModuleName)
forall a. InstalledModuleEnv a
emptyInstalledModuleEnv
sig_mods :: [ModuleName]
sig_mods =
if Bool
is_sig
then Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
imp_mod ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
: Dependencies -> [ModuleName]
dep_sig_mods Dependencies
deps
else Dependencies -> [ModuleName]
dep_sig_mods Dependencies
deps
in ImportAvails {
imp_mods :: ImportedMods
imp_mods = Module -> [ImportedBy] -> ImportedMods
forall k a. k -> a -> Map k a
Map.singleton (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) [ImportedBy
imported_by],
imp_orphs :: [Module]
imp_orphs = [Module]
orphans,
imp_finsts :: [Module]
imp_finsts = [Module]
finsts,
imp_sig_mods :: [ModuleName]
imp_sig_mods = [ModuleName]
sig_mods,
imp_direct_dep_mods :: InstalledModuleEnv (GenWithIsBoot ModuleName)
imp_direct_dep_mods = InstalledModuleEnv (GenWithIsBoot ModuleName)
direct_mods,
imp_dep_direct_pkgs :: Set UnitId
imp_dep_direct_pkgs = Set UnitId
dependent_pkgs,
imp_boot_mods :: InstalledModuleEnv (GenWithIsBoot ModuleName)
imp_boot_mods = InstalledModuleEnv (GenWithIsBoot ModuleName)
boot_mods,
imp_trust_pkgs :: Set UnitId
imp_trust_pkgs = Set UnitId
trusted_pkgs,
imp_trust_own_pkg :: Bool
imp_trust_own_pkg = Bool
pkg_trust_req
}
extendGlobalRdrEnvRn :: [GlobalRdrElt]
-> MiniFixityEnv
-> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn :: [GlobalRdrElt] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [GlobalRdrElt]
new_gres MiniFixityEnv
new_fixities
= RnM (TcGblEnv, TcLclEnv) -> RnM (TcGblEnv, TcLclEnv)
forall r. TcM r -> TcM r
checkNoErrs (RnM (TcGblEnv, TcLclEnv) -> RnM (TcGblEnv, TcLclEnv))
-> RnM (TcGblEnv, TcLclEnv) -> RnM (TcGblEnv, TcLclEnv)
forall a b. (a -> b) -> a -> b
$
do { (gbl_env, lcl_env) <- RnM (TcGblEnv, TcLclEnv)
forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
getEnvs
; stage <- getStage
; isGHCi <- getIsGHCi
; let rdr_env = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env
fix_env = TcGblEnv -> FixityEnv
tcg_fix_env TcGblEnv
gbl_env
th_bndrs = TcLclEnv -> ThBindEnv
getLclEnvThBndrs TcLclEnv
lcl_env
th_lvl = ThStage -> Int
thLevel ThStage
stage
inBracket = ThStage -> Bool
isBrackStage ThStage
stage
lcl_env_TH = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
lcl_env -> TcLclCtxt
lcl_env { tcl_rdr = minusLocalRdrEnv (tcl_rdr lcl_env) new_gres_env }) TcLclEnv
lcl_env
lcl_env2 | Bool
inBracket = TcLclEnv
lcl_env_TH
| Bool
otherwise = TcLclEnv
lcl_env
want_shadowing = Bool
isGHCi Bool -> Bool -> Bool
|| Bool
inBracket
rdr_env1 | Bool
want_shadowing = Bool -> GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
shadowNames Bool
False GlobalRdrEnv
rdr_env GlobalRdrEnv
new_gres_env
| Bool
otherwise = GlobalRdrEnv
rdr_env
lcl_env3 = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
lcl_env -> TcLclCtxt
lcl_env { tcl_th_bndrs = extendNameEnvList th_bndrs
[ ( n, (TopLevel, th_lvl) )
| n <- new_names ] }) TcLclEnv
lcl_env2
; rdr_env2 <- foldlM add_gre rdr_env1 new_gres
; let fix_env' = (FixityEnv -> GlobalRdrElt -> FixityEnv)
-> FixityEnv -> [GlobalRdrElt] -> FixityEnv
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FixityEnv -> GlobalRdrElt -> FixityEnv
extend_fix_env FixityEnv
fix_env [GlobalRdrElt]
new_gres
gbl_env' = TcGblEnv
gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' }
; traceRn "extendGlobalRdrEnvRn 2" (pprGlobalRdrEnv True rdr_env2)
; return (gbl_env', lcl_env3) }
where
new_names :: [Name]
new_names = (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName [GlobalRdrElt]
new_gres
new_gres_env :: GlobalRdrEnv
new_gres_env = [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv [GlobalRdrElt]
new_gres
extend_fix_env :: FixityEnv -> GlobalRdrElt -> FixityEnv
extend_fix_env FixityEnv
fix_env GlobalRdrElt
gre
| Just (L SrcSpan
_ Fixity
fi) <- MiniFixityEnv -> Name -> Maybe (Located Fixity)
lookupMiniFixityEnv MiniFixityEnv
new_fixities Name
name
= FixityEnv -> Name -> FixItem -> FixityEnv
forall a. NameEnv a -> Name -> a -> NameEnv a
extendNameEnv FixityEnv
fix_env Name
name (OccName -> Fixity -> FixItem
FixItem OccName
occ Fixity
fi)
| Bool
otherwise
= FixityEnv
fix_env
where
name :: Name
name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
occ :: OccName
occ = GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre
add_gre :: GlobalRdrEnv -> GlobalRdrElt -> RnM GlobalRdrEnv
add_gre :: GlobalRdrEnv
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
add_gre GlobalRdrEnv
env GlobalRdrElt
gre
| Bool -> Bool
not ([GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
dups)
= do { NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDupDeclErr (GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
:| [GlobalRdrElt]
dups); GlobalRdrEnv -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return GlobalRdrEnv
env }
| Bool
otherwise
= GlobalRdrEnv -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
extendGlobalRdrEnv GlobalRdrEnv
env GlobalRdrElt
gre)
where
dups :: [GlobalRdrElt]
dups = (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
isBadDupGRE
([GlobalRdrElt] -> [GlobalRdrElt])
-> [GlobalRdrElt] -> [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
env (OccName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. OccName -> WhichGREs info -> LookupGRE info
LookupOccName (GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre) (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantBoth))
isBadDupGRE :: GlobalRdrElt -> Bool
isBadDupGRE GlobalRdrElt
old_gre = GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isLocalGRE GlobalRdrElt
old_gre Bool -> Bool -> Bool
&& GlobalRdrElt -> GlobalRdrElt -> Bool
greClashesWith GlobalRdrElt
gre GlobalRdrElt
old_gre
getLocalNonValBinders :: MiniFixityEnv -> HsGroup GhcPs
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
getLocalNonValBinders :: MiniFixityEnv
-> HsGroup (GhcPass 'Parsed) -> RnM ((TcGblEnv, TcLclEnv), Defs)
getLocalNonValBinders MiniFixityEnv
fixity_env
(HsGroup { hs_valds :: forall p. HsGroup p -> HsValBinds p
hs_valds = HsValBinds (GhcPass 'Parsed)
binds,
hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
hs_tyclds = [TyClGroup (GhcPass 'Parsed)]
tycl_decls,
hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
hs_fords = [LForeignDecl (GhcPass 'Parsed)]
foreign_decls })
= do {
; let inst_decls :: [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Parsed))]
inst_decls = [TyClGroup (GhcPass 'Parsed)]
tycl_decls [TyClGroup (GhcPass 'Parsed)]
-> (TyClGroup (GhcPass 'Parsed)
-> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Parsed))])
-> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Parsed))]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TyClGroup (GhcPass 'Parsed) -> [LInstDecl (GhcPass 'Parsed)]
TyClGroup (GhcPass 'Parsed)
-> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Parsed))]
forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds
; dup_fields_ok <- DynFlags -> DuplicateRecordFields
xopt_DuplicateRecordFields (DynFlags -> DuplicateRecordFields)
-> IOEnv (Env TcGblEnv TcLclEnv) DynFlags
-> IOEnv (Env TcGblEnv TcLclEnv) DuplicateRecordFields
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; has_sel <- xopt_FieldSelectors <$> getDynFlags
; tc_gres
<- concatMapM
(new_tc dup_fields_ok has_sel)
(tyClGroupTyClDecls tycl_decls)
; traceRn "getLocalNonValBinders 1" (ppr tc_gres)
; envs <- extendGlobalRdrEnvRn tc_gres fixity_env
; restoreEnvs envs $ do {
; nti_gress <- mapM (new_assoc dup_fields_ok has_sel) inst_decls
; is_boot <- tcIsHsBootOrSig
; let val_bndrs
| Bool
is_boot = case HsValBinds (GhcPass 'Parsed)
binds of
ValBinds XValBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
_ LHsBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
_val_binds [LSig (GhcPass 'Parsed)]
val_sigs ->
[ SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
decl_loc) (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
n)
| L SrcSpanAnnA
decl_loc (TypeSig XTypeSig (GhcPass 'Parsed)
_ [LIdP (GhcPass 'Parsed)]
ns LHsSigWcType (GhcPass 'Parsed)
_) <- [LSig (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))]
val_sigs, GenLocated SrcSpanAnnN RdrName
n <- [LIdP (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnN RdrName]
ns]
HsValBinds (GhcPass 'Parsed)
_ -> String -> [GenLocated SrcSpanAnnN RdrName]
forall a. HasCallStack => String -> a
panic String
"Non-ValBinds in hs-boot group"
| Bool
otherwise = [GenLocated SrcSpanAnnN RdrName]
for_hs_bndrs
; val_gres <- mapM new_simple val_bndrs
; let avails = [[GlobalRdrElt]] -> [GlobalRdrElt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GlobalRdrElt]]
nti_gress [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
val_gres
new_bndrs = [GlobalRdrElt] -> Defs
forall info. [GlobalRdrEltX info] -> Defs
gresToNameSet [GlobalRdrElt]
avails Defs -> Defs -> Defs
`unionNameSet`
[GlobalRdrElt] -> Defs
forall info. [GlobalRdrEltX info] -> Defs
gresToNameSet [GlobalRdrElt]
tc_gres
; traceRn "getLocalNonValBinders 2" (ppr avails)
; envs <- extendGlobalRdrEnvRn avails fixity_env
; return (envs, new_bndrs) } }
where
for_hs_bndrs :: [LocatedN RdrName]
for_hs_bndrs :: [GenLocated SrcSpanAnnN RdrName]
for_hs_bndrs = [LForeignDecl (GhcPass 'Parsed)] -> [LIdP (GhcPass 'Parsed)]
forall (p :: Pass) a.
(UnXRec (GhcPass p), IsSrcSpanAnn p a) =>
[LForeignDecl (GhcPass p)] -> [LIdP (GhcPass p)]
hsForeignDeclsBinders [LForeignDecl (GhcPass 'Parsed)]
foreign_decls
new_simple :: LocatedN RdrName -> RnM GlobalRdrElt
new_simple :: GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrElt
new_simple GenLocated SrcSpanAnnN RdrName
rdr_name = do { nm <- GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder GenLocated SrcSpanAnnN RdrName
rdr_name
; return (mkLocalVanillaGRE NoParent nm) }
new_tc :: DuplicateRecordFields -> FieldSelectors -> LTyClDecl GhcPs
-> RnM [GlobalRdrElt]
new_tc :: DuplicateRecordFields
-> FieldSelectors
-> LTyClDecl (GhcPass 'Parsed)
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
new_tc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel LTyClDecl (GhcPass 'Parsed)
tc_decl
= do { let TyDeclBinders (LocatedA (IdP (GhcPass 'Parsed))
main_bndr, TyConFlavour ()
tc_flav) [(LocatedA (IdP (GhcPass 'Parsed)), TyConFlavour ())]
at_bndrs [LocatedA (IdP (GhcPass 'Parsed))]
sig_bndrs
(LConsWithFields [(LocatedA (IdP (GhcPass 'Parsed)), Maybe [Located Int])]
cons_with_flds IntMap (LFieldOcc (GhcPass 'Parsed))
flds) = GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Parsed))
-> TyDeclBinders 'Parsed
forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
LocatedA (TyClDecl (GhcPass p)) -> TyDeclBinders p
hsLTyClDeclBinders LTyClDecl (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Parsed))
tc_decl
; tycon_name <- GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder (GenLocated SrcSpanAnnN RdrName -> RnM Name)
-> GenLocated SrcSpanAnnN RdrName -> RnM Name
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA RdrName -> GenLocated SrcSpanAnnN RdrName
forall l l2 a.
(HasLoc l, HasAnnotation l2) =>
GenLocated l a -> GenLocated l2 a
la2la LocatedA (IdP (GhcPass 'Parsed))
GenLocated SrcSpanAnnA RdrName
main_bndr
; at_names <- mapM (newTopSrcBinder . la2la . fst) at_bndrs
; sig_names <- mapM (newTopSrcBinder . la2la) sig_bndrs
; con_names_with_flds <- mapM (\(GenLocated SrcSpanAnnA RdrName
con,Maybe [Located Int]
flds) -> (,Maybe [Located Int]
flds) (Name -> (Name, Maybe [Located Int]))
-> RnM Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Name, Maybe [Located Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder (GenLocated SrcSpanAnnA RdrName -> GenLocated SrcSpanAnnN RdrName
forall l l2 a.
(HasLoc l, HasAnnotation l2) =>
GenLocated l a -> GenLocated l2 a
la2la GenLocated SrcSpanAnnA RdrName
con)) cons_with_flds
; flds' <- mapM (newRecordFieldLabel dup_fields_ok has_sel $ map fst con_names_with_flds) flds
; mapM_ (add_dup_fld_errs flds') con_names_with_flds
; let tc_gre = TyConFlavour Name -> Name -> GlobalRdrElt
mkLocalTyConGRE ((() -> Name) -> TyConFlavour () -> TyConFlavour Name
forall a b. (a -> b) -> TyConFlavour a -> TyConFlavour b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> () -> Name
forall a b. a -> b -> a
const Name
tycon_name) TyConFlavour ()
tc_flav) Name
tycon_name
fld_env = [(Name, Maybe [Located Int])]
-> IntMap FieldLabel -> [(ConLikeName, ConInfo)]
mk_fld_env [(Name, Maybe [Located Int])]
con_names_with_flds IntMap FieldLabel
flds'
at_gres = ((GenLocated SrcSpanAnnA RdrName, TyConFlavour ())
-> Name -> GlobalRdrElt)
-> [(GenLocated SrcSpanAnnA RdrName, TyConFlavour ())]
-> [Name]
-> [GlobalRdrElt]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ (GenLocated SrcSpanAnnA RdrName
_, TyConFlavour ()
at_flav) Name
at_nm -> TyConFlavour Name -> Name -> GlobalRdrElt
mkLocalTyConGRE ((() -> Name) -> TyConFlavour () -> TyConFlavour Name
forall a b. (a -> b) -> TyConFlavour a -> TyConFlavour b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> () -> Name
forall a b. a -> b -> a
const Name
tycon_name) TyConFlavour ()
at_flav) Name
at_nm)
[(LocatedA (IdP (GhcPass 'Parsed)), TyConFlavour ())]
[(GenLocated SrcSpanAnnA RdrName, TyConFlavour ())]
at_bndrs [Name]
at_names
sig_gres = (Name -> GlobalRdrElt) -> [Name] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map (Parent -> Name -> GlobalRdrElt
mkLocalVanillaGRE (Name -> Parent
ParentIs Name
tycon_name)) [Name]
sig_names
con_gres = ((ConLikeName, ConInfo) -> GlobalRdrElt)
-> [(ConLikeName, ConInfo)] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map (Parent -> (ConLikeName, ConInfo) -> GlobalRdrElt
mkLocalConLikeGRE (Name -> Parent
ParentIs Name
tycon_name)) [(ConLikeName, ConInfo)]
fld_env
fld_gres = Parent -> [(ConLikeName, ConInfo)] -> [GlobalRdrElt]
mkLocalFieldGREs (Name -> Parent
ParentIs Name
tycon_name) [(ConLikeName, ConInfo)]
fld_env
sub_gres = [GlobalRdrElt]
at_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
sig_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
con_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
fld_gres
; traceRn "getLocalNonValBinders new_tc" $
vcat [ text "tycon:" <+> ppr tycon_name
, text "tc_gre:" <+> ppr tc_gre
, text "sub_gres:" <+> ppr sub_gres ]
; return $ tc_gre : sub_gres }
mk_fld_env :: [(Name, Maybe [Located Int])] -> IntMap FieldLabel
-> [(ConLikeName, ConInfo)]
mk_fld_env :: [(Name, Maybe [Located Int])]
-> IntMap FieldLabel -> [(ConLikeName, ConInfo)]
mk_fld_env [(Name, Maybe [Located Int])]
names IntMap FieldLabel
flds =
[ (Name -> ConLikeName
DataConName Name
con, ConLikeInfo -> ConFieldInfo -> ConInfo
ConInfo ([Name] -> ConLikeInfo
ConIsData (((Name, Maybe [Located Int]) -> Name)
-> [(Name, Maybe [Located Int])] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Maybe [Located Int]) -> Name
forall a b. (a, b) -> a
fst [(Name, Maybe [Located Int])]
names)) ConFieldInfo
fld_info)
| (Name
con, Maybe [Located Int]
mb_fl_indxs) <- [(Name, Maybe [Located Int])]
names
, let fld_info :: ConFieldInfo
fld_info = case ([Located Int] -> [FieldLabel])
-> Maybe [Located Int] -> Maybe [FieldLabel]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Located Int -> FieldLabel) -> [Located Int] -> [FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map ((IntMap FieldLabel
flds IntMap FieldLabel -> Int -> FieldLabel
forall a. IntMap a -> Int -> a
IntMap.!) (Int -> FieldLabel)
-> (Located Int -> Int) -> Located Int -> FieldLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Int -> Int
forall l e. GenLocated l e -> e
unLoc)) Maybe [Located Int]
mb_fl_indxs of
Maybe [FieldLabel]
Nothing -> ConFieldInfo
ConHasPositionalArgs
Just [] -> ConFieldInfo
ConIsNullary
Just (FieldLabel
fld:[FieldLabel]
flds) -> NonEmpty FieldLabel -> ConFieldInfo
ConHasRecordFields (NonEmpty FieldLabel -> ConFieldInfo)
-> NonEmpty FieldLabel -> ConFieldInfo
forall a b. (a -> b) -> a -> b
$ FieldLabel
fld FieldLabel -> [FieldLabel] -> NonEmpty FieldLabel
forall a. a -> [a] -> NonEmpty a
NE.:| [FieldLabel]
flds ]
new_assoc :: DuplicateRecordFields -> FieldSelectors -> LInstDecl GhcPs
-> RnM [GlobalRdrElt]
new_assoc :: DuplicateRecordFields
-> FieldSelectors
-> LInstDecl (GhcPass 'Parsed)
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
new_assoc DuplicateRecordFields
_ FieldSelectors
_ (L SrcSpanAnnA
_ (TyFamInstD {})) = [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
new_assoc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel (L SrcSpanAnnA
_ (DataFamInstD XDataFamInstD (GhcPass 'Parsed)
_ DataFamInstDecl (GhcPass 'Parsed)
d))
= DuplicateRecordFields
-> FieldSelectors
-> Maybe Name
-> DataFamInstDecl (GhcPass 'Parsed)
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
new_di DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel Maybe Name
forall a. Maybe a
Nothing DataFamInstDecl (GhcPass 'Parsed)
d
new_assoc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel
(L SrcSpanAnnA
_ (ClsInstD XClsInstD (GhcPass 'Parsed)
_ (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = LHsSigType (GhcPass 'Parsed)
inst_ty
, cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts = [LDataFamInstDecl (GhcPass 'Parsed)]
adts })))
= do
mb_cls_gre <- MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt))
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ do
L loc cls_rdr <- IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpanAnnN RdrName))
-> MaybeT
(IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated SrcSpanAnnN RdrName)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpanAnnN RdrName))
-> MaybeT
(IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated SrcSpanAnnN RdrName))
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpanAnnN RdrName))
-> MaybeT
(IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ Maybe (GenLocated SrcSpanAnnN RdrName)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpanAnnN RdrName))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (GenLocated SrcSpanAnnN RdrName)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpanAnnN RdrName)))
-> Maybe (GenLocated SrcSpanAnnN RdrName)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpanAnnN RdrName))
forall a b. (a -> b) -> a -> b
$ LHsSigType (GhcPass 'Parsed)
-> Maybe (LocatedN (IdP (GhcPass 'Parsed)))
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsSigType (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
getLHsInstDeclClass_maybe LHsSigType (GhcPass 'Parsed)
inst_ty
MaybeT $ setSrcSpan (locA loc) $ lookupGlobalOccRn_maybe SameNameSpace cls_rdr
case mb_cls_gre of
Maybe GlobalRdrElt
Nothing
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just GlobalRdrElt
cls_gre
-> let cls_nm :: Name
cls_nm = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
cls_gre
in (GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt])
-> [GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Traversable f) =>
(a -> m [b]) -> f a -> m [b]
concatMapM (DuplicateRecordFields
-> FieldSelectors
-> Maybe Name
-> DataFamInstDecl (GhcPass 'Parsed)
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
new_di DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
cls_nm) (DataFamInstDecl (GhcPass 'Parsed)
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt])
-> (GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))
-> DataFamInstDecl (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))
-> DataFamInstDecl (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc) [LDataFamInstDecl (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
adts
new_di :: DuplicateRecordFields -> FieldSelectors
-> Maybe Name
-> DataFamInstDecl GhcPs
-> RnM [GlobalRdrElt]
new_di :: DuplicateRecordFields
-> FieldSelectors
-> Maybe Name
-> DataFamInstDecl (GhcPass 'Parsed)
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
new_di DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel Maybe Name
mb_cls dfid :: DataFamInstDecl (GhcPass 'Parsed)
dfid@(DataFamInstDecl { dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
dfid_eqn = FamEqn (GhcPass 'Parsed) (HsDataDefn (GhcPass 'Parsed))
ti_decl })
= do { main_name <- GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN Name -> Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnN Name)
-> RnM Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnN Name)
lookupFamInstName Maybe Name
mb_cls (FamEqn (GhcPass 'Parsed) (HsDataDefn (GhcPass 'Parsed))
-> LIdP (GhcPass 'Parsed)
forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon FamEqn (GhcPass 'Parsed) (HsDataDefn (GhcPass 'Parsed))
ti_decl)
; let LConsWithFields cons_with_flds flds = hsDataFamInstBinders dfid
; sub_names <- mapM (\(GenLocated SrcSpanAnnA RdrName
con,Maybe [Located Int]
flds) -> (,Maybe [Located Int]
flds) (Name -> (Name, Maybe [Located Int]))
-> RnM Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Name, Maybe [Located Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder (GenLocated SrcSpanAnnA RdrName -> GenLocated SrcSpanAnnN RdrName
forall l l2 a.
(HasLoc l, HasAnnotation l2) =>
GenLocated l a -> GenLocated l2 a
la2la GenLocated SrcSpanAnnA RdrName
con)) cons_with_flds
; flds' <- mapM (newRecordFieldLabel dup_fields_ok has_sel $ map fst sub_names) flds
; mapM_ (add_dup_fld_errs flds') sub_names
; let fld_env = [(Name, Maybe [Located Int])]
-> IntMap FieldLabel -> [(ConLikeName, ConInfo)]
mk_fld_env [(Name, Maybe [Located Int])]
sub_names IntMap FieldLabel
flds'
con_gres = ((ConLikeName, ConInfo) -> GlobalRdrElt)
-> [(ConLikeName, ConInfo)] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map (Parent -> (ConLikeName, ConInfo) -> GlobalRdrElt
mkLocalConLikeGRE (Name -> Parent
ParentIs Name
main_name)) [(ConLikeName, ConInfo)]
fld_env
field_gres = Parent -> [(ConLikeName, ConInfo)] -> [GlobalRdrElt]
mkLocalFieldGREs (Name -> Parent
ParentIs Name
main_name) [(ConLikeName, ConInfo)]
fld_env
; return $ con_gres ++ field_gres }
add_dup_fld_errs :: IntMap FieldLabel
-> (Name, Maybe [Located Int])
-> IOEnv (Env TcGblEnv TcLclEnv) ()
add_dup_fld_errs :: IntMap FieldLabel
-> (Name, Maybe [Located Int]) -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_dup_fld_errs IntMap FieldLabel
all_flds (Name
con, Maybe [Located Int]
mb_con_flds)
| Just [Located Int]
con_flds <- Maybe [Located Int]
mb_con_flds
, let ([Located Int]
_, [NonEmpty (Located Int)]
dups) = (Located Int -> Located Int -> Ordering)
-> [Located Int] -> ([Located Int], [NonEmpty (Located Int)])
forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
removeDups ((Located Int -> Int) -> Located Int -> Located Int -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Located Int -> Int
forall l e. GenLocated l e -> e
unLoc) [Located Int]
con_flds
= [NonEmpty (Located Int)]
-> (NonEmpty (Located Int) -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [NonEmpty (Located Int)]
dups ((NonEmpty (Located Int) -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> (NonEmpty (Located Int) -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ \ NonEmpty (Located Int)
dup_flds ->
let loc :: SrcSpan
loc =
case NonEmpty (Located Int)
dup_flds of
Located Int
_ :| ( L SrcSpan
loc Int
_ : [Located Int]
_) -> SrcSpan
loc
L SrcSpan
loc Int
_ :| [Located Int]
_ -> SrcSpan
loc
dup_rdrs :: NonEmpty RdrName
dup_rdrs = (Located Int -> RdrName)
-> NonEmpty (Located Int) -> NonEmpty RdrName
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> RdrName
nameRdrName (Name -> RdrName)
-> (Located Int -> Name) -> Located Int -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> Name
flSelector (FieldLabel -> Name)
-> (Located Int -> FieldLabel) -> Located Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap FieldLabel
all_flds IntMap FieldLabel -> Int -> FieldLabel
forall a. IntMap a -> Int -> a
IntMap.!) (Int -> FieldLabel)
-> (Located Int -> Int) -> Located Int -> FieldLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Int -> Int
forall l e. GenLocated l e -> e
unLoc) NonEmpty (Located Int)
dup_flds
in SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt SrcSpan
loc (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ RecordFieldPart -> NonEmpty RdrName -> TcRnMessage
TcRnDuplicateFieldName (Name -> RecordFieldPart
RecordFieldDecl Name
con) NonEmpty RdrName
dup_rdrs
| Bool
otherwise
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
newRecordFieldLabel :: DuplicateRecordFields -> FieldSelectors -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel
newRecordFieldLabel :: DuplicateRecordFields
-> FieldSelectors
-> [Name]
-> LFieldOcc (GhcPass 'Parsed)
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
newRecordFieldLabel DuplicateRecordFields
_ FieldSelectors
_ [] LFieldOcc (GhcPass 'Parsed)
_ = String -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall a. HasCallStack => String -> a
error String
"newRecordFieldLabel: datatype has no constructors!"
newRecordFieldLabel DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel (Name
dc:[Name]
_) (L SrcSpanAnnA
loc (FieldOcc XCFieldOcc (GhcPass 'Parsed)
_ (L SrcSpanAnnN
_ RdrName
fld)))
= do { selName <- GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder (GenLocated SrcSpanAnnN RdrName -> RnM Name)
-> GenLocated SrcSpanAnnN RdrName -> RnM Name
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
loc) (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. (a -> b) -> a -> b
$ RdrName
field
; return $ FieldLabel { flHasDuplicateRecordFields = dup_fields_ok
, flHasFieldSelector = has_sel
, flSelector = selName } }
where
fld_occ :: OccName
fld_occ = RdrName -> OccName
rdrNameOcc RdrName
fld
dc_fs :: FastString
dc_fs = OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
dc
field :: RdrName
field
| RdrName -> Bool
isExact RdrName
fld
= Bool -> SDoc -> RdrName -> RdrName
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (OccName -> Maybe FastString
fieldOcc_maybe OccName
fld_occ Maybe FastString -> Maybe FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString -> Maybe FastString
forall a. a -> Maybe a
Just FastString
dc_fs)
([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"newRecordFieldLabel: incorrect namespace for exact Name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
fld)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"expected namespace:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSpace -> SDoc
pprNameSpace (FastString -> NameSpace
fieldName FastString
dc_fs)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" actual namespace:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSpace -> SDoc
pprNameSpace (OccName -> NameSpace
occNameSpace OccName
fld_occ) ])
RdrName
fld
| Bool
otherwise
= OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => FastString -> OccName -> OccName
FastString -> OccName -> OccName
varToRecFieldOcc FastString
dc_fs OccName
fld_occ
gresFromAvail :: HasDebugCallStack
=> HscEnv -> Maybe ImportSpec -> AvailInfo -> [GlobalRdrElt]
gresFromAvail :: HasDebugCallStack =>
HscEnv -> Maybe ImportSpec -> AvailInfo -> [GlobalRdrElt]
gresFromAvail HscEnv
hsc_env Maybe ImportSpec
prov AvailInfo
avail =
[ Name -> GREInfo -> GlobalRdrElt
mk_gre Name
nm GREInfo
info
| Name
nm <- AvailInfo -> [Name]
availNames AvailInfo
avail
, let info :: GREInfo
info = HasDebugCallStack => HscEnv -> Name -> GREInfo
HscEnv -> Name -> GREInfo
lookupGREInfo HscEnv
hsc_env Name
nm ]
where
mk_gre :: Name -> GREInfo -> GlobalRdrElt
mk_gre Name
n GREInfo
info
= case Maybe ImportSpec
prov of
Maybe ImportSpec
Nothing -> GRE { gre_name :: Name
gre_name = Name
n, gre_par :: Parent
gre_par = Name -> AvailInfo -> Parent
mkParent Name
n AvailInfo
avail
, gre_lcl :: Bool
gre_lcl = Bool
True, gre_imp :: Bag ImportSpec
gre_imp = Bag ImportSpec
forall a. Bag a
emptyBag
, gre_info :: GREInfo
gre_info = GREInfo
info }
Just ImportSpec
is -> GRE { gre_name :: Name
gre_name = Name
n, gre_par :: Parent
gre_par = Name -> AvailInfo -> Parent
mkParent Name
n AvailInfo
avail
, gre_lcl :: Bool
gre_lcl = Bool
False, gre_imp :: Bag ImportSpec
gre_imp = ImportSpec -> Bag ImportSpec
forall a. a -> Bag a
unitBag ImportSpec
is
, gre_info :: GREInfo
gre_info = GREInfo
info }
gresFromAvails :: HscEnv -> Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails :: HscEnv -> Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails HscEnv
hsc_env Maybe ImportSpec
prov = (AvailInfo -> [GlobalRdrElt]) -> [AvailInfo] -> [GlobalRdrElt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HasDebugCallStack =>
HscEnv -> Maybe ImportSpec -> AvailInfo -> [GlobalRdrElt]
HscEnv -> Maybe ImportSpec -> AvailInfo -> [GlobalRdrElt]
gresFromAvail HscEnv
hsc_env Maybe ImportSpec
prov)
importsFromIface :: HscEnv -> ModIface -> ImpDeclSpec -> Maybe NameSet -> GlobalRdrEnv
importsFromIface :: HscEnv -> ModIface -> ImpDeclSpec -> Maybe Defs -> GlobalRdrEnv
importsFromIface HscEnv
hsc_env ModIface
iface ImpDeclSpec
decl_spec Maybe Defs
hidden = [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv ([GlobalRdrElt] -> GlobalRdrEnv) -> [GlobalRdrElt] -> GlobalRdrEnv
forall a b. (a -> b) -> a -> b
$ case Maybe Defs
hidden of
Maybe Defs
Nothing -> [GlobalRdrElt]
all_gres
Just Defs
hidden_names -> (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (GlobalRdrElt -> Bool) -> GlobalRdrElt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Defs -> Bool
`elemNameSet` Defs
hidden_names) (Name -> Bool) -> (GlobalRdrElt -> Name) -> GlobalRdrElt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName) [GlobalRdrElt]
all_gres
where
all_gres :: [GlobalRdrElt]
all_gres = HscEnv -> Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails HscEnv
hsc_env (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just ImportSpec
imp_spec) (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface)
imp_spec :: ImportSpec
imp_spec = ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }
filterImports
:: HasDebugCallStack
=> HscEnv
-> ModIface
-> ImpDeclSpec
-> Maybe (ImportListInterpretation, LocatedLI [LIE GhcPs])
-> RnM (Maybe (ImportListInterpretation, LocatedLI [LIE GhcRn]),
ImpUserList,
GlobalRdrEnv)
filterImports :: HasDebugCallStack =>
HscEnv
-> ModIface
-> ImpDeclSpec
-> Maybe
(ImportListInterpretation, LocatedLI [LIE (GhcPass 'Parsed)])
-> RnM
(Maybe (ImportListInterpretation, LocatedLI [LIE GhcRn]),
ImpUserList, GlobalRdrEnv)
filterImports HscEnv
hsc_env ModIface
iface ImpDeclSpec
decl_spec Maybe (ImportListInterpretation, LocatedLI [LIE (GhcPass 'Parsed)])
Nothing
= (Maybe
(ImportListInterpretation,
LocatedLI [GenLocated SrcSpanAnnA (IE GhcRn)]),
ImpUserList, GlobalRdrEnv)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe
(ImportListInterpretation,
LocatedLI [GenLocated SrcSpanAnnA (IE GhcRn)]),
ImpUserList, GlobalRdrEnv)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
(ImportListInterpretation,
LocatedLI [GenLocated SrcSpanAnnA (IE GhcRn)])
forall a. Maybe a
Nothing, ImpUserList
ImpUserAll, HscEnv -> ModIface -> ImpDeclSpec -> Maybe Defs -> GlobalRdrEnv
importsFromIface HscEnv
hsc_env ModIface
iface ImpDeclSpec
decl_spec Maybe Defs
forall a. Maybe a
Nothing)
filterImports HscEnv
hsc_env ModIface
iface ImpDeclSpec
decl_spec (Just (ImportListInterpretation
want_hiding, L SrcSpanAnnLI
l [LIE (GhcPass 'Parsed)]
import_items))
= do
items1 <- (GenLocated SrcSpanAnnA (IE (GhcPass 'Parsed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])])
-> [GenLocated SrcSpanAnnA (IE (GhcPass 'Parsed))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[[(GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LIE (GhcPass 'Parsed) -> TcRn [(LIE GhcRn, [GlobalRdrElt])]
GenLocated SrcSpanAnnA (IE (GhcPass 'Parsed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])]
lookup_lie [LIE (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (IE (GhcPass 'Parsed))]
import_items
let items2 :: [(LIE GhcRn, [GlobalRdrElt])]
items2 = [[(GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])]]
-> [(GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])]]
items1
(gres, imp_user_list) = case want_hiding of
ImportListInterpretation
Exactly ->
let gre_env :: GlobalRdrEnv
gre_env = [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv ([GlobalRdrElt] -> GlobalRdrEnv) -> [GlobalRdrElt] -> GlobalRdrEnv
forall a b. (a -> b) -> a -> b
$ ((GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])
-> [GlobalRdrElt])
-> [(GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])]
-> [GlobalRdrElt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ImpDeclSpec -> (LIE GhcRn, [GlobalRdrElt]) -> [GlobalRdrElt]
gresFromIE ImpDeclSpec
decl_spec) [(LIE GhcRn, [GlobalRdrElt])]
[(GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])]
items2
in (GlobalRdrEnv
gre_env, GlobalRdrEnv -> ImpUserList
ImpUserExplicit GlobalRdrEnv
gre_env)
ImportListInterpretation
EverythingBut ->
let hidden_names :: Defs
hidden_names = [Name] -> Defs
mkNameSet ([Name] -> Defs) -> [Name] -> Defs
forall a b. (a -> b) -> a -> b
$ ((GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt]) -> [Name])
-> [(GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName ([GlobalRdrElt] -> [Name])
-> ((GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])
-> [GlobalRdrElt])
-> (GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])
-> [GlobalRdrElt]
forall a b. (a, b) -> b
snd) [(LIE GhcRn, [GlobalRdrElt])]
[(GenLocated SrcSpanAnnA (IE GhcRn), [GlobalRdrElt])]
items2
in (HscEnv -> ModIface -> ImpDeclSpec -> Maybe Defs -> GlobalRdrEnv
importsFromIface HscEnv
hsc_env ModIface
iface ImpDeclSpec
decl_spec (Defs -> Maybe Defs
forall a. a -> Maybe a
Just Defs
hidden_names), Defs -> ImpUserList
ImpUserEverythingBut Defs
hidden_names)
return (Just (want_hiding, L l (map fst items2)), imp_user_list, gres)
where
import_mod :: Module
import_mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
all_avails :: [AvailInfo]
all_avails = ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
imp_occ_env :: OccEnv (NameEnv ImpOccItem)
imp_occ_env = HscEnv -> ImpDeclSpec -> [AvailInfo] -> OccEnv (NameEnv ImpOccItem)
mkImportOccEnv HscEnv
hsc_env ImpDeclSpec
decl_spec [AvailInfo]
all_avails
lookup_parent :: IE GhcPs -> RdrName -> IELookupM ImpOccItem
lookup_parent :: IE (GhcPass 'Parsed) -> RdrName -> IELookupM ImpOccItem
lookup_parent IE (GhcPass 'Parsed)
ie RdrName
rdr =
Bool -> SDoc -> IELookupM ImpOccItem -> IELookupM ImpOccItem
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ NameSpace -> Bool
isVarNameSpace NameSpace
ns)
([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"filterImports lookup_parent: unexpected variable"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"rdr:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"namespace:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSpace -> SDoc
pprNameSpace NameSpace
ns ]) (IELookupM ImpOccItem -> IELookupM ImpOccItem)
-> IELookupM ImpOccItem -> IELookupM ImpOccItem
forall a b. (a -> b) -> a -> b
$
do { xs <- IE (GhcPass 'Parsed) -> RdrName -> IELookupM (NonEmpty ImpOccItem)
lookup_names IE (GhcPass 'Parsed)
ie RdrName
rdr
; case xs of
ImpOccItem
cax :| [] -> ImpOccItem -> IELookupM ImpOccItem
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ImpOccItem
cax
NonEmpty ImpOccItem
_ -> String -> SDoc -> IELookupM ImpOccItem
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"filter_imports lookup_parent ambiguous" (SDoc -> IELookupM ImpOccItem) -> SDoc -> IELookupM ImpOccItem
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"rdr:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lookups:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NonEmpty GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((ImpOccItem -> GlobalRdrElt)
-> NonEmpty ImpOccItem -> NonEmpty GlobalRdrElt
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImpOccItem -> GlobalRdrElt
imp_item NonEmpty ImpOccItem
xs) ] }
where
occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr
ns :: NameSpace
ns = OccName -> NameSpace
occNameSpace OccName
occ
lookup_names :: IE GhcPs -> RdrName -> IELookupM (NonEmpty ImpOccItem)
lookup_names :: IE (GhcPass 'Parsed) -> RdrName -> IELookupM (NonEmpty ImpOccItem)
lookup_names IE (GhcPass 'Parsed)
ie RdrName
rdr
| RdrName -> Bool
isQual RdrName
rdr
= IELookupError -> IELookupM (NonEmpty ImpOccItem)
forall a. IELookupError -> IELookupM a
failLookupWith (RdrName -> IELookupError
QualImportError RdrName
rdr)
| Bool
otherwise
= case [ImpOccItem]
lookups of
[] -> IELookupError -> IELookupM (NonEmpty ImpOccItem)
forall a. IELookupError -> IELookupM a
failLookupWith (IE (GhcPass 'Parsed) -> IsSubordinate -> IELookupError
BadImport IE (GhcPass 'Parsed)
ie IsSubordinate
IsNotSubordinate)
ImpOccItem
item:[ImpOccItem]
items -> NonEmpty ImpOccItem -> IELookupM (NonEmpty ImpOccItem)
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty ImpOccItem -> IELookupM (NonEmpty ImpOccItem))
-> NonEmpty ImpOccItem -> IELookupM (NonEmpty ImpOccItem)
forall a b. (a -> b) -> a -> b
$ ImpOccItem
item ImpOccItem -> [ImpOccItem] -> NonEmpty ImpOccItem
forall a. a -> [a] -> NonEmpty a
:| [ImpOccItem]
items
where
lookups :: [ImpOccItem]
lookups = (NameEnv ImpOccItem -> [ImpOccItem])
-> [NameEnv ImpOccItem] -> [ImpOccItem]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NameEnv ImpOccItem -> [ImpOccItem]
forall a. NameEnv a -> [a]
nonDetNameEnvElts
([NameEnv ImpOccItem] -> [ImpOccItem])
-> [NameEnv ImpOccItem] -> [ImpOccItem]
forall a b. (a -> b) -> a -> b
$ WhichGREs GREInfo
-> OccEnv (NameEnv ImpOccItem) -> OccName -> [NameEnv ImpOccItem]
lookupImpOccEnv (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) OccEnv (NameEnv ImpOccItem)
imp_occ_env (RdrName -> OccName
rdrNameOcc RdrName
rdr)
lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, [GlobalRdrElt])]
lookup_lie :: LIE (GhcPass 'Parsed) -> TcRn [(LIE GhcRn, [GlobalRdrElt])]
lookup_lie (L SrcSpanAnnA
loc IE (GhcPass 'Parsed)
ieRdr)
= SrcSpanAnnA
-> TcRn [(LIE GhcRn, [GlobalRdrElt])]
-> TcRn [(LIE GhcRn, [GlobalRdrElt])]
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc (TcRn [(LIE GhcRn, [GlobalRdrElt])]
-> TcRn [(LIE GhcRn, [GlobalRdrElt])])
-> TcRn [(LIE GhcRn, [GlobalRdrElt])]
-> TcRn [(LIE GhcRn, [GlobalRdrElt])]
forall a b. (a -> b) -> a -> b
$
do (stuff, warns) <- (Maybe ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> Maybe ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a. a -> Maybe a -> a
fromMaybe ([],[])) (IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
forall a. IELookupM a -> TcRn (Maybe a)
run_lookup (IE (GhcPass 'Parsed)
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
lookup_ie IE (GhcPass 'Parsed)
ieRdr)
mapM_ (addTcRnDiagnostic <=< warning_msg) warns
return [ (L loc ie, gres) | (ie,gres) <- stuff ]
where
warning_msg :: IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) TcRnMessage
warning_msg (DodgyImport GlobalRdrElt
n) =
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) TcRnMessage
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DodgyImportsReason -> TcRnMessage
TcRnDodgyImports (GlobalRdrElt -> DodgyImportsReason
DodgyImportsEmptyParent GlobalRdrElt
n))
warning_msg IELookupWarning
MissingImportList =
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) TcRnMessage
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IE (GhcPass 'Parsed) -> TcRnMessage
TcRnMissingImportList IE (GhcPass 'Parsed)
ieRdr)
warning_msg (BadImportW IE (GhcPass 'Parsed)
ie) = do
reason <- ModIface
-> ImpDeclSpec
-> IE (GhcPass 'Parsed)
-> IsSubordinate
-> [AvailInfo]
-> TcRn ImportLookupReason
badImportItemErr ModIface
iface ImpDeclSpec
decl_spec IE (GhcPass 'Parsed)
ie IsSubordinate
IsNotSubordinate [AvailInfo]
all_avails
pure (TcRnDodgyImports (DodgyImportsHiding reason))
warning_msg (DeprecatedExport Name
n WarningTxt GhcRn
w) =
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) TcRnMessage
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) TcRnMessage)
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) TcRnMessage
forall a b. (a -> b) -> a -> b
$ PragmaWarningInfo -> WarningTxt GhcRn -> TcRnMessage
TcRnPragmaWarning
PragmaWarningExport
{ pwarn_occname :: OccName
pwarn_occname = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
n
, pwarn_impmod :: ModuleName
pwarn_impmod = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
import_mod }
WarningTxt GhcRn
w
run_lookup :: IELookupM a -> TcRn (Maybe a)
run_lookup :: forall a. IELookupM a -> TcRn (Maybe a)
run_lookup IELookupM a
m = case IELookupM a
m of
Failed IELookupError
err -> do
msg <- IELookupError -> TcRn ImportLookupReason
lookup_err_msg IELookupError
err
addErr (TcRnImportLookup msg)
return Nothing
Succeeded a
a -> Maybe a -> TcRn (Maybe a)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
lookup_err_msg :: IELookupError -> TcRn ImportLookupReason
lookup_err_msg IELookupError
err = case IELookupError
err of
BadImport IE (GhcPass 'Parsed)
ie IsSubordinate
sub -> ModIface
-> ImpDeclSpec
-> IE (GhcPass 'Parsed)
-> IsSubordinate
-> [AvailInfo]
-> TcRn ImportLookupReason
badImportItemErr ModIface
iface ImpDeclSpec
decl_spec IE (GhcPass 'Parsed)
ie IsSubordinate
sub [AvailInfo]
all_avails
IELookupError
IllegalImport -> ImportLookupReason -> TcRn ImportLookupReason
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportLookupReason
ImportLookupIllegal
QualImportError RdrName
rdr -> ImportLookupReason -> TcRn ImportLookupReason
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RdrName -> ImportLookupReason
ImportLookupQualified RdrName
rdr)
lookup_ie :: IE GhcPs
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
lookup_ie :: IE (GhcPass 'Parsed)
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
lookup_ie IE (GhcPass 'Parsed)
ie = IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
handle_bad_import (IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
case IE (GhcPass 'Parsed)
ie of
IEVar XIEVar (GhcPass 'Parsed)
_ (L SrcSpanAnnA
l IEWrappedName (GhcPass 'Parsed)
n) Maybe (ExportDoc (GhcPass 'Parsed))
_ -> do
xs <- IE (GhcPass 'Parsed) -> RdrName -> IELookupM (NonEmpty ImpOccItem)
lookup_names IE (GhcPass 'Parsed)
ie (IEWrappedName (GhcPass 'Parsed) -> IdP (GhcPass 'Parsed)
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName (GhcPass 'Parsed)
n)
let gres = (ImpOccItem -> GlobalRdrElt) -> [ImpOccItem] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map ImpOccItem -> GlobalRdrElt
imp_item ([ImpOccItem] -> [GlobalRdrElt]) -> [ImpOccItem] -> [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ NonEmpty ImpOccItem -> [ImpOccItem]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ImpOccItem
xs
export_depr_warns
| ImportListInterpretation
want_hiding ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
Exactly
= (GlobalRdrElt -> Maybe IELookupWarning)
-> [GlobalRdrElt] -> [IELookupWarning]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GlobalRdrElt -> Maybe IELookupWarning
mk_depr_export_warning [GlobalRdrElt]
gres
| Bool
otherwise = []
return ( [ (IEVar Nothing (L l (replaceWrappedName n name)) noDocstring, [gre])
| gre <- gres
, let name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre ]
, export_depr_warns )
IEThingAll XIEThingAll (GhcPass 'Parsed)
_ (L SrcSpanAnnA
l IEWrappedName (GhcPass 'Parsed)
tc) Maybe (ExportDoc (GhcPass 'Parsed))
_ -> do
ImpOccItem { imp_item = gre
, imp_bundled = bundled_gres
, imp_is_parent = is_par
}
<- IE (GhcPass 'Parsed) -> RdrName -> IELookupM ImpOccItem
lookup_parent IE (GhcPass 'Parsed)
ie (RdrName -> IELookupM ImpOccItem)
-> RdrName -> IELookupM ImpOccItem
forall a b. (a -> b) -> a -> b
$ IEWrappedName (GhcPass 'Parsed) -> IdP (GhcPass 'Parsed)
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName (GhcPass 'Parsed)
tc
let name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
child_gres = if Bool
is_par then [GlobalRdrElt]
bundled_gres else []
imp_list_warn
| [GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
child_gres
= [GlobalRdrElt -> IELookupWarning
DodgyImport GlobalRdrElt
gre]
| Bool -> Bool
not (ImpDeclSpec -> Bool
is_qual ImpDeclSpec
decl_spec)
= [IELookupWarning
MissingImportList]
| Bool
otherwise
= []
renamed_ie = XIEThingAll GhcRn
-> LIEWrappedName GhcRn -> Maybe (ExportDoc GhcRn) -> IE GhcRn
forall pass.
XIEThingAll pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEThingAll (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
forall a. Maybe a
Nothing, (EpToken "(", EpToken "..", EpToken ")")
forall a. NoAnn a => a
noAnn) (SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName (GhcPass 'Parsed) -> IdP GhcRn -> IEWrappedName GhcRn
replaceWrappedName IEWrappedName (GhcPass 'Parsed)
tc IdP GhcRn
Name
name)) Maybe (ExportDoc GhcRn)
forall a. Maybe a
noDocstring
export_depr_warn
| ImportListInterpretation
want_hiding ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
Exactly
= Maybe IELookupWarning -> [IELookupWarning]
forall a. Maybe a -> [a]
maybeToList (Maybe IELookupWarning -> [IELookupWarning])
-> Maybe IELookupWarning -> [IELookupWarning]
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe IELookupWarning
mk_depr_export_warning GlobalRdrElt
gre
| Bool
otherwise = []
return ( [(renamed_ie, gre:child_gres)]
, imp_list_warn ++ export_depr_warn)
IEThingAbs XIEThingAbs (GhcPass 'Parsed)
_ (L SrcSpanAnnA
l IEWrappedName (GhcPass 'Parsed)
tc') Maybe (ExportDoc (GhcPass 'Parsed))
_
| ImportListInterpretation
want_hiding ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut
-> let tc :: IdP (GhcPass 'Parsed)
tc = IEWrappedName (GhcPass 'Parsed) -> IdP (GhcPass 'Parsed)
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName (GhcPass 'Parsed)
tc'
tc_name :: IELookupM ImpOccItem
tc_name = IE (GhcPass 'Parsed) -> RdrName -> IELookupM ImpOccItem
lookup_parent IE (GhcPass 'Parsed)
ie IdP (GhcPass 'Parsed)
RdrName
tc
dc_name :: IELookupM ImpOccItem
dc_name = IE (GhcPass 'Parsed) -> RdrName -> IELookupM ImpOccItem
lookup_parent IE (GhcPass 'Parsed)
ie (RdrName -> NameSpace -> RdrName
setRdrNameSpace IdP (GhcPass 'Parsed)
RdrName
tc NameSpace
srcDataName)
in
case [IELookupM ImpOccItem] -> [ImpOccItem]
forall a. [IELookupM a] -> [a]
catIELookupM [ IELookupM ImpOccItem
tc_name, IELookupM ImpOccItem
dc_name ] of
[] -> IELookupError
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith (IE (GhcPass 'Parsed) -> IsSubordinate -> IELookupError
BadImport IE (GhcPass 'Parsed)
ie IsSubordinate
IsNotSubordinate)
[ImpOccItem]
names -> ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ( [IEWrappedName (GhcPass 'Parsed)
-> SrcSpanAnnA -> GlobalRdrElt -> (IE GhcRn, [GlobalRdrElt])
forall {info}.
IEWrappedName (GhcPass 'Parsed)
-> SrcSpanAnnA
-> GlobalRdrEltX info
-> (IE GhcRn, [GlobalRdrEltX info])
mkIEThingAbs IEWrappedName (GhcPass 'Parsed)
tc' SrcSpanAnnA
l (ImpOccItem -> GlobalRdrElt
imp_item ImpOccItem
name) | ImpOccItem
name <- [ImpOccItem]
names], [])
| Bool
otherwise
-> do ImpOccItem { imp_item = gre } <- IE (GhcPass 'Parsed) -> RdrName -> IELookupM ImpOccItem
lookup_parent IE (GhcPass 'Parsed)
ie (IEWrappedName (GhcPass 'Parsed) -> IdP (GhcPass 'Parsed)
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName (GhcPass 'Parsed)
tc')
return ( [mkIEThingAbs tc' l gre]
, maybeToList $ mk_depr_export_warning gre)
IEThingWith (Maybe (GenLocated SrcSpanAnnP (WarningTxt (GhcPass 'Parsed)))
deprecation, IEThingWithAnns
ann) ltc :: LIEWrappedName (GhcPass 'Parsed)
ltc@(L SrcSpanAnnA
l IEWrappedName (GhcPass 'Parsed)
rdr_tc) IEWildcard
wc [LIEWrappedName (GhcPass 'Parsed)]
rdr_ns Maybe (ExportDoc (GhcPass 'Parsed))
_ -> do
ImpOccItem { imp_item = gre, imp_bundled = subnames }
<- IE (GhcPass 'Parsed) -> RdrName -> IELookupM ImpOccItem
lookup_parent (XIEThingAbs (GhcPass 'Parsed)
-> LIEWrappedName (GhcPass 'Parsed)
-> Maybe (ExportDoc (GhcPass 'Parsed))
-> IE (GhcPass 'Parsed)
forall pass.
XIEThingAbs pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEThingAbs Maybe (GenLocated SrcSpanAnnP (WarningTxt (GhcPass 'Parsed)))
XIEThingAbs (GhcPass 'Parsed)
forall a. Maybe a
Nothing LIEWrappedName (GhcPass 'Parsed)
ltc Maybe (ExportDoc (GhcPass 'Parsed))
forall a. Maybe a
noDocstring) (IEWrappedName (GhcPass 'Parsed) -> IdP (GhcPass 'Parsed)
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName (GhcPass 'Parsed)
rdr_tc)
let name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
case lookupChildren subnames rdr_ns of
Failed [LIEWrappedName (GhcPass 'Parsed)]
rdrs -> IELookupError
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith (IELookupError
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> IELookupError
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
IE (GhcPass 'Parsed) -> IsSubordinate -> IELookupError
BadImport (XIEThingWith (GhcPass 'Parsed)
-> LIEWrappedName (GhcPass 'Parsed)
-> IEWildcard
-> [LIEWrappedName (GhcPass 'Parsed)]
-> Maybe (ExportDoc (GhcPass 'Parsed))
-> IE (GhcPass 'Parsed)
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> Maybe (ExportDoc pass)
-> IE pass
IEThingWith (Maybe (GenLocated SrcSpanAnnP (WarningTxt (GhcPass 'Parsed)))
deprecation, IEThingWithAnns
ann) LIEWrappedName (GhcPass 'Parsed)
ltc IEWildcard
wc [LIEWrappedName (GhcPass 'Parsed)]
rdrs Maybe (ExportDoc (GhcPass 'Parsed))
forall a. Maybe a
noDocstring) IsSubordinate
IsSubordinate
Succeeded [LocatedA GlobalRdrElt]
childnames ->
([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ (XIEThingWith GhcRn
-> LIEWrappedName GhcRn
-> IEWildcard
-> [LIEWrappedName GhcRn]
-> Maybe (ExportDoc GhcRn)
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> Maybe (ExportDoc pass)
-> IE pass
IEThingWith (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
forall a. Maybe a
Nothing, IEThingWithAnns
ann) (SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l IEWrappedName GhcRn
name') IEWildcard
wc [LIEWrappedName GhcRn]
[GenLocated SrcSpanAnnA (IEWrappedName GhcRn)]
childnames' Maybe (ExportDoc GhcRn)
forall a. Maybe a
noDocstring
,[GlobalRdrElt]
gres)]
, [IELookupWarning]
export_depr_warns)
where name' :: IEWrappedName GhcRn
name' = IEWrappedName (GhcPass 'Parsed) -> IdP GhcRn -> IEWrappedName GhcRn
replaceWrappedName IEWrappedName (GhcPass 'Parsed)
rdr_tc IdP GhcRn
Name
name
childnames' :: [GenLocated SrcSpanAnnA (IEWrappedName GhcRn)]
childnames' = (LocatedA GlobalRdrElt
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> [LocatedA GlobalRdrElt]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
GenLocated SrcSpanAnnA Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
to_ie_post_rn (GenLocated SrcSpanAnnA Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> (LocatedA GlobalRdrElt -> GenLocated SrcSpanAnnA Name)
-> LocatedA GlobalRdrElt
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalRdrElt -> Name)
-> LocatedA GlobalRdrElt -> GenLocated SrcSpanAnnA Name
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName) [LocatedA GlobalRdrElt]
childnames
gres :: [GlobalRdrElt]
gres = GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: (LocatedA GlobalRdrElt -> GlobalRdrElt)
-> [LocatedA GlobalRdrElt] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA GlobalRdrElt -> GlobalRdrElt
forall l e. GenLocated l e -> e
unLoc [LocatedA GlobalRdrElt]
childnames
export_depr_warns :: [IELookupWarning]
export_depr_warns
| ImportListInterpretation
want_hiding ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
Exactly = (GlobalRdrElt -> Maybe IELookupWarning)
-> [GlobalRdrElt] -> [IELookupWarning]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GlobalRdrElt -> Maybe IELookupWarning
mk_depr_export_warning [GlobalRdrElt]
gres
| Bool
otherwise = []
IE (GhcPass 'Parsed)
_other -> IELookupError
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
IllegalImport
where
mkIEThingAbs :: IEWrappedName (GhcPass 'Parsed)
-> SrcSpanAnnA
-> GlobalRdrEltX info
-> (IE GhcRn, [GlobalRdrEltX info])
mkIEThingAbs IEWrappedName (GhcPass 'Parsed)
tc SrcSpanAnnA
l GlobalRdrEltX info
gre
= (XIEThingAbs GhcRn
-> LIEWrappedName GhcRn -> Maybe (ExportDoc GhcRn) -> IE GhcRn
forall pass.
XIEThingAbs pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEThingAbs Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
XIEThingAbs GhcRn
forall a. Maybe a
Nothing (SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName (GhcPass 'Parsed) -> IdP GhcRn -> IEWrappedName GhcRn
replaceWrappedName IEWrappedName (GhcPass 'Parsed)
tc IdP GhcRn
Name
n)) Maybe (ExportDoc GhcRn)
forall a. Maybe a
noDocstring, [GlobalRdrEltX info
gre])
where n :: Name
n = GlobalRdrEltX info -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX info
gre
noDocstring :: Maybe a
noDocstring = Maybe a
forall a. Maybe a
Nothing
handle_bad_import :: IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
handle_bad_import IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
m = IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> (IELookupError
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a.
IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
m ((IELookupError
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> (IELookupError
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$ \IELookupError
err -> case IELookupError
err of
BadImport IE (GhcPass 'Parsed)
ie IsSubordinate
_
| ImportListInterpretation
want_hiding ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut
-> ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [IE (GhcPass 'Parsed) -> IELookupWarning
BadImportW IE (GhcPass 'Parsed)
ie])
IELookupError
_ -> IELookupError
-> IELookupM ([(IE GhcRn, [GlobalRdrElt])], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
err
mk_depr_export_warning :: GlobalRdrElt -> Maybe IELookupWarning
mk_depr_export_warning GlobalRdrElt
gre
= Name -> WarningTxt GhcRn -> IELookupWarning
DeprecatedExport Name
name (WarningTxt GhcRn -> IELookupWarning)
-> Maybe (WarningTxt GhcRn) -> Maybe IELookupWarning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModIfaceBackend -> Name -> Maybe (WarningTxt GhcRn)
mi_export_warn_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) Name
name
where
name :: Name
name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
type IELookupM = MaybeErr IELookupError
data IELookupWarning
= BadImportW (IE GhcPs)
| MissingImportList
| DodgyImport GlobalRdrElt
| DeprecatedExport Name (WarningTxt GhcRn)
data IsSubordinate
= IsSubordinate | IsNotSubordinate
data IELookupError
= QualImportError RdrName
| BadImport (IE GhcPs) IsSubordinate
| IllegalImport
failLookupWith :: IELookupError -> IELookupM a
failLookupWith :: forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
err = IELookupError -> MaybeErr IELookupError a
forall err val. err -> MaybeErr err val
Failed IELookupError
err
catchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup :: forall a.
IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup IELookupM a
m IELookupError -> IELookupM a
h = case IELookupM a
m of
Succeeded a
r -> a -> IELookupM a
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
Failed IELookupError
err -> IELookupError -> IELookupM a
h IELookupError
err
catIELookupM :: [IELookupM a] -> [a]
catIELookupM :: forall a. [IELookupM a] -> [a]
catIELookupM [IELookupM a]
ms = [ a
a | Succeeded a
a <- [IELookupM a]
ms ]
data ImpOccItem
= ImpOccItem
{ ImpOccItem -> GlobalRdrElt
imp_item :: GlobalRdrElt
, ImpOccItem -> [GlobalRdrElt]
imp_bundled :: [GlobalRdrElt]
, ImpOccItem -> Bool
imp_is_parent :: Bool
}
instance Outputable ImpOccItem where
ppr :: ImpOccItem -> SDoc
ppr (ImpOccItem { imp_item :: ImpOccItem -> GlobalRdrElt
imp_item = GlobalRdrElt
item, imp_bundled :: ImpOccItem -> [GlobalRdrElt]
imp_bundled = [GlobalRdrElt]
bundled, imp_is_parent :: ImpOccItem -> Bool
imp_is_parent = Bool
is_par })
= SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep
[ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ImpOccItem"
, if Bool
is_par then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"[is_par]" else SDoc
forall doc. IsOutput doc => doc
empty
, Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
item) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Parent -> SDoc
forall a. Outputable a => a -> SDoc
ppr (GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
item)
, SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bundled:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName [GlobalRdrElt]
bundled) ]
mkImportOccEnv :: HscEnv -> ImpDeclSpec -> [IfaceExport] -> OccEnv (NameEnv ImpOccItem)
mkImportOccEnv :: HscEnv -> ImpDeclSpec -> [AvailInfo] -> OccEnv (NameEnv ImpOccItem)
mkImportOccEnv HscEnv
hsc_env ImpDeclSpec
decl_spec [AvailInfo]
all_avails =
(NameEnv ImpOccItem -> NameEnv ImpOccItem -> NameEnv ImpOccItem)
-> [(OccName, NameEnv ImpOccItem)] -> OccEnv (NameEnv ImpOccItem)
forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C ((ImpOccItem -> ImpOccItem -> ImpOccItem)
-> NameEnv ImpOccItem -> NameEnv ImpOccItem -> NameEnv ImpOccItem
forall a. (a -> a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C ImpOccItem -> ImpOccItem -> ImpOccItem
combine)
[ (OccName
occ, [(Name, ImpOccItem)] -> NameEnv ImpOccItem
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name
nm, ImpOccItem
item)])
| AvailInfo
avail <- [AvailInfo]
all_avails
, let gres :: [GlobalRdrElt]
gres = HasDebugCallStack =>
HscEnv -> Maybe ImportSpec -> AvailInfo -> [GlobalRdrElt]
HscEnv -> Maybe ImportSpec -> AvailInfo -> [GlobalRdrElt]
gresFromAvail HscEnv
hsc_env (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just ImportSpec
hiding_spec) AvailInfo
avail
, GlobalRdrElt
gre <- [GlobalRdrElt]
gres
, let nm :: Name
nm = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
occ :: OccName
occ = GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre
(Bool
is_parent, [GlobalRdrElt]
bundled) = case AvailInfo
avail of
AvailTC Name
c [Name]
_
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
nm
-> ( Bool
True, Int -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. Int -> [a] -> [a]
drop Int
1 [GlobalRdrElt]
gres )
| Bool
otherwise
-> ( Bool
False, [GlobalRdrElt]
gres )
AvailInfo
_ -> ( Bool
False, [] )
item :: ImpOccItem
item = ImpOccItem
{ imp_item :: GlobalRdrElt
imp_item = GlobalRdrElt
gre
, imp_bundled :: [GlobalRdrElt]
imp_bundled = [GlobalRdrElt]
bundled
, imp_is_parent :: Bool
imp_is_parent = Bool
is_parent }
]
where
hiding_spec :: ImportSpec
hiding_spec = ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }
combine :: ImpOccItem -> ImpOccItem -> ImpOccItem
combine :: ImpOccItem -> ImpOccItem -> ImpOccItem
combine item1 :: ImpOccItem
item1@(ImpOccItem { imp_item :: ImpOccItem -> GlobalRdrElt
imp_item = GlobalRdrElt
gre1, imp_is_parent :: ImpOccItem -> Bool
imp_is_parent = Bool
is_parent1 })
item2 :: ImpOccItem
item2@(ImpOccItem { imp_item :: ImpOccItem -> GlobalRdrElt
imp_item = GlobalRdrElt
gre2, imp_is_parent :: ImpOccItem -> Bool
imp_is_parent = Bool
is_parent2 })
| Bool
is_parent1 Bool -> Bool -> Bool
|| Bool
is_parent2
, Bool -> Bool
not (GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE GlobalRdrElt
gre1 Bool -> Bool -> Bool
|| GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE GlobalRdrElt
gre2)
, let name1 :: Name
name1 = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre1
name2 :: Name
name2 = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre2
gre :: GlobalRdrElt
gre = GlobalRdrElt
gre1 GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
`plusGRE` GlobalRdrElt
gre2
= Bool -> SDoc -> ImpOccItem -> ImpOccItem
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name
name1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name2)
(Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name2) (ImpOccItem -> ImpOccItem) -> ImpOccItem -> ImpOccItem
forall a b. (a -> b) -> a -> b
$
if Bool
is_parent1
then ImpOccItem
item1 { imp_item = gre }
else ImpOccItem
item2 { imp_item = gre }
combine item1 :: ImpOccItem
item1@(ImpOccItem { imp_item :: ImpOccItem -> GlobalRdrElt
imp_item = GlobalRdrElt
c1, imp_bundled :: ImpOccItem -> [GlobalRdrElt]
imp_bundled = [GlobalRdrElt]
kids1 })
item2 :: ImpOccItem
item2@(ImpOccItem { imp_item :: ImpOccItem -> GlobalRdrElt
imp_item = GlobalRdrElt
c2, imp_bundled :: ImpOccItem -> [GlobalRdrElt]
imp_bundled = [GlobalRdrElt]
kids2 })
= Bool -> SDoc -> ImpOccItem -> ImpOccItem
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
c1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
c2
Bool -> Bool -> Bool
&& (Bool -> Bool
not ([GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
kids1 Bool -> Bool -> Bool
&& [GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
kids2)))
(GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
c1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
c2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
kids1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
kids2) (ImpOccItem -> ImpOccItem) -> ImpOccItem -> ImpOccItem
forall a b. (a -> b) -> a -> b
$
if [GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
kids1
then ImpOccItem
item2
else ImpOccItem
item1
lookupImpOccEnv :: WhichGREs GREInfo
-> OccEnv (NameEnv ImpOccItem) -> OccName -> [NameEnv ImpOccItem]
lookupImpOccEnv :: WhichGREs GREInfo
-> OccEnv (NameEnv ImpOccItem) -> OccName -> [NameEnv ImpOccItem]
lookupImpOccEnv WhichGREs GREInfo
which_gres OccEnv (NameEnv ImpOccItem)
env OccName
occ =
(NameEnv ImpOccItem -> Maybe (NameEnv ImpOccItem))
-> [NameEnv ImpOccItem] -> [NameEnv ImpOccItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NameEnv ImpOccItem -> Maybe (NameEnv ImpOccItem)
relevant_items ([NameEnv ImpOccItem] -> [NameEnv ImpOccItem])
-> [NameEnv ImpOccItem] -> [NameEnv ImpOccItem]
forall a b. (a -> b) -> a -> b
$ OccEnv (NameEnv ImpOccItem) -> OccName -> [NameEnv ImpOccItem]
forall a. OccEnv a -> OccName -> [a]
lookupOccEnv_AllNameSpaces OccEnv (NameEnv ImpOccItem)
env OccName
occ
where
is_relevant :: ImpOccItem -> Bool
is_relevant :: ImpOccItem -> Bool
is_relevant (ImpOccItem { imp_item :: ImpOccItem -> GlobalRdrElt
imp_item = GlobalRdrElt
gre }) =
WhichGREs GREInfo -> NameSpace -> GlobalRdrElt -> Bool
greIsRelevant WhichGREs GREInfo
which_gres (OccName -> NameSpace
occNameSpace OccName
occ) GlobalRdrElt
gre
relevant_items :: NameEnv ImpOccItem -> Maybe (NameEnv ImpOccItem)
relevant_items :: NameEnv ImpOccItem -> Maybe (NameEnv ImpOccItem)
relevant_items NameEnv ImpOccItem
nms
| let nms' :: NameEnv ImpOccItem
nms' = (ImpOccItem -> Bool) -> NameEnv ImpOccItem -> NameEnv ImpOccItem
forall elt. (elt -> Bool) -> NameEnv elt -> NameEnv elt
filterNameEnv ImpOccItem -> Bool
is_relevant NameEnv ImpOccItem
nms
= if NameEnv ImpOccItem -> Bool
forall a. NameEnv a -> Bool
isEmptyNameEnv NameEnv ImpOccItem
nms'
then Maybe (NameEnv ImpOccItem)
forall a. Maybe a
Nothing
else NameEnv ImpOccItem -> Maybe (NameEnv ImpOccItem)
forall a. a -> Maybe a
Just NameEnv ImpOccItem
nms'
gresFromIE :: ImpDeclSpec -> (LIE GhcRn, [GlobalRdrElt]) -> [GlobalRdrElt]
gresFromIE :: ImpDeclSpec -> (LIE GhcRn, [GlobalRdrElt]) -> [GlobalRdrElt]
gresFromIE ImpDeclSpec
decl_spec (L SrcSpanAnnA
loc IE GhcRn
ie, [GlobalRdrElt]
gres)
= (GlobalRdrElt -> GlobalRdrElt) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> GlobalRdrElt
set_gre_imp [GlobalRdrElt]
gres
where
is_explicit :: Name -> Bool
is_explicit = case IE GhcRn
ie of
IEThingAll XIEThingAll GhcRn
_ LIEWrappedName GhcRn
name Maybe (ExportDoc GhcRn)
_ -> \Name
n -> Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== LIEWrappedName GhcRn -> IdP GhcRn
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
lieWrappedName LIEWrappedName GhcRn
name
IE GhcRn
_ -> \Name
_ -> Bool
True
prov_fn :: Name -> ImportSpec
prov_fn Name
name
= ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
item_spec }
where
item_spec :: ImpItemSpec
item_spec = ImpSome { is_explicit :: Bool
is_explicit = Name -> Bool
is_explicit Name
name
, is_iloc :: SrcSpan
is_iloc = SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc }
set_gre_imp :: GlobalRdrElt -> GlobalRdrElt
set_gre_imp gre :: GlobalRdrElt
gre@( GRE { gre_name :: forall info. GlobalRdrEltX info -> Name
gre_name = Name
nm } )
= GlobalRdrElt
gre { gre_imp = unitBag $ prov_fn nm }
mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv [GlobalRdrElt]
gres = (GlobalRdrElt -> NameEnv [GlobalRdrElt] -> NameEnv [GlobalRdrElt])
-> NameEnv [GlobalRdrElt]
-> [GlobalRdrElt]
-> NameEnv [GlobalRdrElt]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobalRdrElt -> NameEnv [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
forall {info}.
GlobalRdrEltX info
-> NameEnv [GlobalRdrEltX info] -> NameEnv [GlobalRdrEltX info]
add NameEnv [GlobalRdrElt]
forall a. NameEnv a
emptyNameEnv [GlobalRdrElt]
gres
where
add :: GlobalRdrEltX info
-> NameEnv [GlobalRdrEltX info] -> NameEnv [GlobalRdrEltX info]
add GlobalRdrEltX info
gre NameEnv [GlobalRdrEltX info]
env = case GlobalRdrEltX info -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrEltX info
gre of
ParentIs Name
p -> (GlobalRdrEltX info
-> [GlobalRdrEltX info] -> [GlobalRdrEltX info])
-> (GlobalRdrEltX info -> [GlobalRdrEltX info])
-> NameEnv [GlobalRdrEltX info]
-> Name
-> GlobalRdrEltX info
-> NameEnv [GlobalRdrEltX info]
forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc (:) GlobalRdrEltX info -> [GlobalRdrEltX info]
forall a. a -> [a]
Utils.singleton NameEnv [GlobalRdrEltX info]
env Name
p GlobalRdrEltX info
gre
Parent
NoParent -> NameEnv [GlobalRdrEltX info]
env
findChildren :: NameEnv [a] -> Name -> [a]
findChildren :: forall a. NameEnv [a] -> Name -> [a]
findChildren NameEnv [a]
env Name
n = NameEnv [a] -> Name -> Maybe [a]
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv [a]
env Name
n Maybe [a] -> [a] -> [a]
forall a. Maybe a -> a -> a
`orElse` []
lookupChildren :: [GlobalRdrElt]
-> [LIEWrappedName GhcPs]
-> MaybeErr [LIEWrappedName GhcPs]
[LocatedA GlobalRdrElt]
lookupChildren :: [GlobalRdrElt]
-> [LIEWrappedName (GhcPass 'Parsed)]
-> MaybeErr
[LIEWrappedName (GhcPass 'Parsed)] [LocatedA GlobalRdrElt]
lookupChildren [GlobalRdrElt]
all_kids [LIEWrappedName (GhcPass 'Parsed)]
rdr_items
| [GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))]
fails
= [LocatedA GlobalRdrElt]
-> MaybeErr
[GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))]
[LocatedA GlobalRdrElt]
forall err val. val -> MaybeErr err val
Succeeded ([[LocatedA GlobalRdrElt]] -> [LocatedA GlobalRdrElt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LocatedA GlobalRdrElt]]
oks)
| Bool
otherwise
= [GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))]
-> MaybeErr
[GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))]
[LocatedA GlobalRdrElt]
forall err val. err -> MaybeErr err val
Failed [GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))]
fails
where
mb_xs :: [MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt]]
mb_xs = (GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt])
-> [GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))]
-> [MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt]]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt]
doOne [LIEWrappedName (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))]
rdr_items
fails :: [GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))]
fails = [ GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
bad_rdr | Failed GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
bad_rdr <- [MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt]]
mb_xs ]
oks :: [[LocatedA GlobalRdrElt]]
oks = [ [LocatedA GlobalRdrElt]
ok | Succeeded [LocatedA GlobalRdrElt]
ok <- [MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt]]
mb_xs ]
oks :: [[LocatedA GlobalRdrElt]]
doOne :: GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt]
doOne item :: GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
item@(L SrcSpanAnnA
l IEWrappedName (GhcPass 'Parsed)
r)
= case (FastStringEnv [GlobalRdrElt] -> FastString -> Maybe [GlobalRdrElt]
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv [GlobalRdrElt]
kid_env (FastString -> Maybe [GlobalRdrElt])
-> (IEWrappedName (GhcPass 'Parsed) -> FastString)
-> IEWrappedName (GhcPass 'Parsed)
-> Maybe [GlobalRdrElt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS (OccName -> FastString)
-> (IEWrappedName (GhcPass 'Parsed) -> OccName)
-> IEWrappedName (GhcPass 'Parsed)
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (IEWrappedName (GhcPass 'Parsed) -> RdrName)
-> IEWrappedName (GhcPass 'Parsed)
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IEWrappedName (GhcPass 'Parsed) -> IdP (GhcPass 'Parsed)
IEWrappedName (GhcPass 'Parsed) -> RdrName
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName) IEWrappedName (GhcPass 'Parsed)
r of
Just [GlobalRdrElt
g]
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE GlobalRdrElt
g
-> [LocatedA GlobalRdrElt]
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt]
forall err val. val -> MaybeErr err val
Succeeded [SrcSpanAnnA -> GlobalRdrElt -> LocatedA GlobalRdrElt
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l GlobalRdrElt
g]
Just [GlobalRdrElt]
gs
| (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE [GlobalRdrElt]
gs
-> [LocatedA GlobalRdrElt]
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt]
forall err val. val -> MaybeErr err val
Succeeded ([LocatedA GlobalRdrElt]
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt])
-> [LocatedA GlobalRdrElt]
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ (GlobalRdrElt -> LocatedA GlobalRdrElt)
-> [GlobalRdrElt] -> [LocatedA GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanAnnA -> GlobalRdrElt -> LocatedA GlobalRdrElt
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l) [GlobalRdrElt]
gs
Maybe [GlobalRdrElt]
_ -> GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed)))
[LocatedA GlobalRdrElt]
forall err val. err -> MaybeErr err val
Failed GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
item
kid_env :: FastStringEnv [GlobalRdrElt]
kid_env = ([GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt])
-> FastStringEnv [GlobalRdrElt]
-> [(FastString, [GlobalRdrElt])]
-> FastStringEnv [GlobalRdrElt]
forall a.
(a -> a -> a)
-> FastStringEnv a -> [(FastString, a)] -> FastStringEnv a
extendFsEnvList_C [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
(++) FastStringEnv [GlobalRdrElt]
forall a. FastStringEnv a
emptyFsEnv
[(OccName -> FastString
occNameFS (GlobalRdrElt -> OccName
forall name. HasOccName name => name -> OccName
occName GlobalRdrElt
x), [GlobalRdrElt
x]) | GlobalRdrElt
x <- [GlobalRdrElt]
all_kids]
reportUnusedNames :: TcGblEnv -> HscSource -> RnM ()
reportUnusedNames :: TcGblEnv -> HscSource -> IOEnv (Env TcGblEnv TcLclEnv) ()
reportUnusedNames TcGblEnv
gbl_env HscSource
hsc_src
= do { keep <- TcRef Defs -> IOEnv (Env TcGblEnv TcLclEnv) Defs
forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
readTcRef (TcGblEnv -> TcRef Defs
tcg_keep TcGblEnv
gbl_env)
; traceRn "RUN" (ppr (tcg_dus gbl_env))
; warnUnusedImportDecls gbl_env hsc_src
; warnUnusedTopBinds $ unused_locals keep
; warnMissingSignatures gbl_env
; warnMissingKindSignatures gbl_env }
where
used_names :: NameSet -> NameSet
used_names :: Defs -> Defs
used_names Defs
keep = DefUses -> Defs -> Defs
findUses (TcGblEnv -> DefUses
tcg_dus TcGblEnv
gbl_env) Defs
emptyNameSet Defs -> Defs -> Defs
`unionNameSet` Defs
keep
defined_names :: [GlobalRdrElt]
defined_names :: [GlobalRdrElt]
defined_names = GlobalRdrEnv -> [GlobalRdrElt]
forall info. GlobalRdrEnvX info -> [GlobalRdrEltX info]
globalRdrEnvElts (TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env)
kids_env :: NameEnv [GlobalRdrElt]
kids_env = [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv [GlobalRdrElt]
defined_names
gre_is_used :: NameSet -> GlobalRdrElt -> Bool
gre_is_used :: Defs -> GlobalRdrElt -> Bool
gre_is_used Defs
used_names GlobalRdrElt
gre0
= Name
name Name -> Defs -> Bool
`elemNameSet` Defs
used_names
Bool -> Bool -> Bool
|| (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ GlobalRdrElt
gre -> GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre Name -> Defs -> Bool
`elemNameSet` Defs
used_names) (NameEnv [GlobalRdrElt] -> Name -> [GlobalRdrElt]
forall a. NameEnv [a] -> Name -> [a]
findChildren NameEnv [GlobalRdrElt]
kids_env Name
name)
where
name :: Name
name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre0
unused_locals :: NameSet -> [GlobalRdrElt]
unused_locals :: Defs -> [GlobalRdrElt]
unused_locals Defs
keep =
let
_defined_and_used, defined_but_not_used :: [GlobalRdrElt]
([GlobalRdrElt]
_defined_and_used, [GlobalRdrElt]
defined_but_not_used)
= (GlobalRdrElt -> Bool)
-> [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Defs -> GlobalRdrElt -> Bool
gre_is_used (Defs -> Defs
used_names Defs
keep)) [GlobalRdrElt]
defined_names
in (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
is_unused_local [GlobalRdrElt]
defined_but_not_used
is_unused_local :: GlobalRdrElt -> Bool
is_unused_local :: GlobalRdrElt -> Bool
is_unused_local GlobalRdrElt
gre = GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isLocalGRE GlobalRdrElt
gre
Bool -> Bool -> Bool
&& Name -> Bool
isExternalName (GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
warnMissingSignatures :: TcGblEnv -> RnM ()
warnMissingSignatures :: TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingSignatures TcGblEnv
gbl_env
= do { let exports :: Defs
exports = [AvailInfo] -> Defs
availsToNameSet (TcGblEnv -> [AvailInfo]
tcg_exports TcGblEnv
gbl_env)
sig_ns :: Defs
sig_ns = TcGblEnv -> Defs
tcg_sigs TcGblEnv
gbl_env
binds :: [IdP GhcTc]
binds = CollectFlag GhcTc -> LHsBindsLR GhcTc GhcTc -> [IdP GhcTc]
forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
collectHsBindsBinders CollectFlag GhcTc
forall p. CollectFlag p
CollNoDictBinders (LHsBindsLR GhcTc GhcTc -> [IdP GhcTc])
-> LHsBindsLR GhcTc GhcTc -> [IdP GhcTc]
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> LHsBindsLR GhcTc GhcTc
tcg_binds TcGblEnv
gbl_env
pat_syns :: [PatSyn]
pat_syns = TcGblEnv -> [PatSyn]
tcg_patsyns TcGblEnv
gbl_env
not_ghc_generated :: Name -> Bool
not_ghc_generated :: Name -> Bool
not_ghc_generated Name
name = Name
name Name -> Defs -> Bool
`elemNameSet` Defs
sig_ns
add_binding_warn :: Id -> RnM ()
add_binding_warn :: Id -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_binding_warn Id
id =
Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Bool
not_ghc_generated Name
name) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
do { env <- ZonkM TidyEnv -> TcM TidyEnv
forall a. ZonkM a -> TcM a
liftZonkM (ZonkM TidyEnv -> TcM TidyEnv) -> ZonkM TidyEnv -> TcM TidyEnv
forall a b. (a -> b) -> a -> b
$ ZonkM TidyEnv
tcInitTidyEnv
; let ty = TidyEnv -> Type -> Type
tidyOpenType TidyEnv
env (Id -> Type
idType Id
id)
missing = Name -> Type -> MissingSignature
MissingTopLevelBindingSig Name
name Type
ty
diag = MissingSignature -> Exported -> TcRnMessage
TcRnMissingSignature MissingSignature
missing Exported
exported
; addDiagnosticAt (getSrcSpan name) diag }
where
name :: Name
name = Id -> Name
idName Id
id
exported :: Exported
exported = if Name
name Name -> Defs -> Bool
`elemNameSet` Defs
exports
then Exported
IsExported
else Exported
IsNotExported
add_patsyn_warn :: PatSyn -> RnM ()
add_patsyn_warn :: PatSyn -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_patsyn_warn PatSyn
ps =
Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Bool
not_ghc_generated Name
name) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
name)
(MissingSignature -> Exported -> TcRnMessage
TcRnMissingSignature MissingSignature
missing Exported
exported)
where
name :: Name
name = PatSyn -> Name
patSynName PatSyn
ps
missing :: MissingSignature
missing = PatSyn -> MissingSignature
MissingPatSynSig PatSyn
ps
exported :: Exported
exported = if Name
name Name -> Defs -> Bool
`elemNameSet` Defs
exports
then Exported
IsExported
else Exported
IsNotExported
; (Id -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [Id] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Id -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_binding_warn [IdP GhcTc]
[Id]
binds
; (PatSyn -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [PatSyn] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PatSyn -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_patsyn_warn [PatSyn]
pat_syns
}
warnMissingKindSignatures :: TcGblEnv -> RnM ()
warnMissingKindSignatures :: TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingKindSignatures TcGblEnv
gbl_env
= do { cusks_enabled <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.CUSKs
; mapM_ (add_ty_warn cusks_enabled) tcs
}
where
tcs :: [TyCon]
tcs = TcGblEnv -> [TyCon]
tcg_tcs TcGblEnv
gbl_env
ksig_ns :: Defs
ksig_ns = TcGblEnv -> Defs
tcg_ksigs TcGblEnv
gbl_env
exports :: Defs
exports = [AvailInfo] -> Defs
availsToNameSet (TcGblEnv -> [AvailInfo]
tcg_exports TcGblEnv
gbl_env)
has_kind_signature :: Name -> Bool
has_kind_signature :: Name -> Bool
has_kind_signature Name
name = Name
name Name -> Defs -> Bool
`elemNameSet` Defs
ksig_ns
add_ty_warn :: Bool -> TyCon -> RnM ()
add_ty_warn :: Bool -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_ty_warn Bool
cusks_enabled TyCon
tyCon =
Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Bool
has_kind_signature Name
name) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
name) TcRnMessage
diag
where
name :: Name
name = TyCon -> Name
tyConName TyCon
tyCon
diag :: TcRnMessage
diag = MissingSignature -> Exported -> TcRnMessage
TcRnMissingSignature MissingSignature
missing Exported
exported
missing :: MissingSignature
missing = TyCon -> Bool -> MissingSignature
MissingTyConKindSig TyCon
tyCon Bool
cusks_enabled
exported :: Exported
exported = if Name
name Name -> Defs -> Bool
`elemNameSet` Defs
exports
then Exported
IsExported
else Exported
IsNotExported
type ImportDeclUsage
= ( LImportDecl GhcRn
, [GlobalRdrElt]
, [Name] )
warnUnusedImportDecls :: TcGblEnv -> HscSource -> RnM ()
warnUnusedImportDecls :: TcGblEnv -> HscSource -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImportDecls TcGblEnv
gbl_env HscSource
hsc_src
= do { uses <- IORef [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a env. IORef a -> IOEnv env a
readMutVar (TcGblEnv -> IORef [GlobalRdrElt]
tcg_used_gres TcGblEnv
gbl_env)
; let user_imports = (GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> Bool)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
forall a. (a -> Bool) -> [a] -> [a]
filterOut
(XImportDeclPass -> Bool
ideclImplicit (XImportDeclPass -> Bool)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> XImportDeclPass)
-> GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcRn -> XCImportDecl GhcRn
ImportDecl GhcRn -> XImportDeclPass
forall pass. ImportDecl pass -> XCImportDecl pass
ideclExt (ImportDecl GhcRn -> XImportDeclPass)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> ImportDecl GhcRn)
-> GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> XImportDeclPass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> ImportDecl GhcRn
forall l e. GenLocated l e -> e
unLoc)
(TcGblEnv -> [LImportDecl GhcRn]
tcg_rn_imports TcGblEnv
gbl_env)
rdr_env = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env
; let usage :: [ImportDeclUsage]
usage = [LImportDecl GhcRn] -> [GlobalRdrElt] -> [ImportDeclUsage]
findImportUsage [LImportDecl GhcRn]
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
user_imports [GlobalRdrElt]
uses
; traceRn "warnUnusedImportDecls" $
(vcat [ text "Uses:" <+> ppr uses
, text "Import usage" <+> ppr usage])
; mapM_ (warnUnusedImport rdr_env) usage
; whenGOptM Opt_D_dump_minimal_imports $
printMinimalImports hsc_src usage }
findImportUsage :: [LImportDecl GhcRn]
-> [GlobalRdrElt]
-> [ImportDeclUsage]
findImportUsage :: [LImportDecl GhcRn] -> [GlobalRdrElt] -> [ImportDeclUsage]
findImportUsage [LImportDecl GhcRn]
imports [GlobalRdrElt]
used_gres
= (GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name]))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcRn -> ImportDeclUsage
GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])
unused_decl [LImportDecl GhcRn]
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
imports
where
import_usage :: ImportMap
import_usage :: ImportMap
import_usage = [GlobalRdrElt] -> ImportMap
mkImportMap [GlobalRdrElt]
used_gres
unused_decl :: LImportDecl GhcRn -> (LImportDecl GhcRn, [GlobalRdrElt], [Name])
unused_decl :: LImportDecl GhcRn -> ImportDeclUsage
unused_decl decl :: LImportDecl GhcRn
decl@(L SrcSpanAnnA
loc (ImportDecl { ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList = Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
imps }))
= (LImportDecl GhcRn
decl, [GlobalRdrElt]
used_gres, Defs -> [Name]
nameSetElemsStable Defs
unused_imps)
where
used_gres :: [GlobalRdrElt]
used_gres = SrcLoc -> ImportMap -> Maybe [GlobalRdrElt]
forall a. SrcLoc -> Map RealSrcLoc a -> Maybe a
lookupSrcLoc (SrcSpan -> SrcLoc
srcSpanEnd (SrcSpan -> SrcLoc) -> SrcSpan -> SrcLoc
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) ImportMap
import_usage
Maybe [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. Maybe a -> a -> a
`orElse` []
used_names :: Defs
used_names = [Name] -> Defs
mkNameSet ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName [GlobalRdrElt]
used_gres)
used_parents :: Defs
used_parents = [Name] -> Defs
mkNameSet ((GlobalRdrElt -> Maybe Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GlobalRdrElt -> Maybe Name
forall info. GlobalRdrEltX info -> Maybe Name
greParent_maybe [GlobalRdrElt]
used_gres)
unused_imps :: Defs
unused_imps
= case Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
imps of
Just (ImportListInterpretation
Exactly, L SrcSpanAnnLI
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
imp_ies) ->
(GenLocated SrcSpanAnnA (IE GhcRn) -> Defs -> Defs)
-> Defs -> [GenLocated SrcSpanAnnA (IE GhcRn)] -> Defs
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (IE GhcRn -> Defs -> Defs
add_unused (IE GhcRn -> Defs -> Defs)
-> (GenLocated SrcSpanAnnA (IE GhcRn) -> IE GhcRn)
-> GenLocated SrcSpanAnnA (IE GhcRn)
-> Defs
-> Defs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcRn) -> IE GhcRn
forall l e. GenLocated l e -> e
unLoc) Defs
emptyNameSet [GenLocated SrcSpanAnnA (IE GhcRn)]
imp_ies
Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
_other -> Defs
emptyNameSet
add_unused :: IE GhcRn -> NameSet -> NameSet
add_unused :: IE GhcRn -> Defs -> Defs
add_unused (IEVar XIEVar GhcRn
_ LIEWrappedName GhcRn
n Maybe (ExportDoc GhcRn)
_) Defs
acc = Name -> Defs -> Defs
add_unused_name (LIEWrappedName GhcRn -> IdP GhcRn
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
lieWrappedName LIEWrappedName GhcRn
n) Defs
acc
add_unused (IEThingAbs XIEThingAbs GhcRn
_ LIEWrappedName GhcRn
n Maybe (ExportDoc GhcRn)
_) Defs
acc = Name -> Defs -> Defs
add_unused_name (LIEWrappedName GhcRn -> IdP GhcRn
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
lieWrappedName LIEWrappedName GhcRn
n) Defs
acc
add_unused (IEThingAll XIEThingAll GhcRn
_ LIEWrappedName GhcRn
n Maybe (ExportDoc GhcRn)
_) Defs
acc = Name -> Defs -> Defs
add_unused_all (LIEWrappedName GhcRn -> IdP GhcRn
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
lieWrappedName LIEWrappedName GhcRn
n) Defs
acc
add_unused (IEThingWith XIEThingWith GhcRn
_ LIEWrappedName GhcRn
p IEWildcard
wc [LIEWrappedName GhcRn]
ns Maybe (ExportDoc GhcRn)
_) Defs
acc =
Defs -> Defs
add_wc_all (Name -> [Name] -> Defs -> Defs
add_unused_with IdP GhcRn
Name
pn [Name]
xs Defs
acc)
where pn :: IdP GhcRn
pn = LIEWrappedName GhcRn -> IdP GhcRn
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
lieWrappedName LIEWrappedName GhcRn
p
xs :: [Name]
xs = (GenLocated SrcSpanAnnA (IEWrappedName GhcRn) -> Name)
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcRn)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map LIEWrappedName GhcRn -> IdP GhcRn
GenLocated SrcSpanAnnA (IEWrappedName GhcRn) -> Name
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
lieWrappedName [LIEWrappedName GhcRn]
[GenLocated SrcSpanAnnA (IEWrappedName GhcRn)]
ns
add_wc_all :: Defs -> Defs
add_wc_all = case IEWildcard
wc of
IEWildcard
NoIEWildcard -> Defs -> Defs
forall a. a -> a
id
IEWildcard Int
_ -> Name -> Defs -> Defs
add_unused_all IdP GhcRn
Name
pn
add_unused IE GhcRn
_ Defs
acc = Defs
acc
add_unused_name :: Name -> Defs -> Defs
add_unused_name Name
n Defs
acc
| Name
n Name -> Defs -> Bool
`elemNameSet` Defs
used_names = Defs
acc
| Bool
otherwise = Defs
acc Defs -> Name -> Defs
`extendNameSet` Name
n
add_unused_all :: Name -> Defs -> Defs
add_unused_all Name
n Defs
acc
| Name
n Name -> Defs -> Bool
`elemNameSet` Defs
used_names = Defs
acc
| Name
n Name -> Defs -> Bool
`elemNameSet` Defs
used_parents = Defs
acc
| Bool
otherwise = Defs
acc Defs -> Name -> Defs
`extendNameSet` Name
n
add_unused_with :: Name -> [Name] -> Defs -> Defs
add_unused_with Name
p [Name]
ns Defs
acc
| (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Name -> Defs -> Bool
`elemNameSet` Defs
acc1) [Name]
ns = Name -> Defs -> Defs
add_unused_name Name
p Defs
acc1
| Bool
otherwise = Defs
acc1
where
acc1 :: Defs
acc1 = (Name -> Defs -> Defs) -> Defs -> [Name] -> Defs
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Name -> Defs -> Defs
add_unused_name Defs
acc [Name]
ns
type ImportMap = Map RealSrcLoc [GlobalRdrElt]
mkImportMap :: [GlobalRdrElt] -> ImportMap
mkImportMap :: [GlobalRdrElt] -> ImportMap
mkImportMap [GlobalRdrElt]
gres
= (GlobalRdrElt -> ImportMap -> ImportMap)
-> ImportMap -> [GlobalRdrElt] -> ImportMap
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobalRdrElt -> ImportMap -> ImportMap
forall {info}.
Outputable info =>
GlobalRdrEltX info
-> Map RealSrcLoc [GlobalRdrEltX info]
-> Map RealSrcLoc [GlobalRdrEltX info]
add_one ImportMap
forall k a. Map k a
Map.empty [GlobalRdrElt]
gres
where
add_one :: GlobalRdrEltX info
-> Map RealSrcLoc [GlobalRdrEltX info]
-> Map RealSrcLoc [GlobalRdrEltX info]
add_one gre :: GlobalRdrEltX info
gre@(GRE { gre_imp :: forall info. GlobalRdrEltX info -> Bag ImportSpec
gre_imp = Bag ImportSpec
imp_specs }) Map RealSrcLoc [GlobalRdrEltX info]
imp_map =
case SrcSpan -> SrcLoc
srcSpanEnd (ImpDeclSpec -> SrcSpan
is_dloc (ImportSpec -> ImpDeclSpec
is_decl ImportSpec
best_imp_spec)) of
RealSrcLoc RealSrcLoc
decl_loc Maybe BufPos
_ -> ([GlobalRdrEltX info]
-> [GlobalRdrEltX info] -> [GlobalRdrEltX info])
-> RealSrcLoc
-> [GlobalRdrEltX info]
-> Map RealSrcLoc [GlobalRdrEltX info]
-> Map RealSrcLoc [GlobalRdrEltX info]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [GlobalRdrEltX info]
-> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
add RealSrcLoc
decl_loc [GlobalRdrEltX info
gre] Map RealSrcLoc [GlobalRdrEltX info]
imp_map
UnhelpfulLoc FastString
_ -> Map RealSrcLoc [GlobalRdrEltX info]
imp_map
where
best_imp_spec :: ImportSpec
best_imp_spec =
case Bag ImportSpec -> [ImportSpec]
forall a. Bag a -> [a]
bagToList Bag ImportSpec
imp_specs of
[] -> String -> SDoc -> ImportSpec
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mkImportMap: GRE with no ImportSpecs" (GlobalRdrEltX info -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrEltX info
gre)
ImportSpec
is:[ImportSpec]
iss -> NonEmpty ImportSpec -> ImportSpec
bestImport (ImportSpec
is ImportSpec -> [ImportSpec] -> NonEmpty ImportSpec
forall a. a -> [a] -> NonEmpty a
NE.:| [ImportSpec]
iss)
add :: [GlobalRdrEltX info]
-> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
add [GlobalRdrEltX info]
_ [GlobalRdrEltX info]
gres = GlobalRdrEltX info
gre GlobalRdrEltX info -> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
forall a. a -> [a] -> [a]
: [GlobalRdrEltX info]
gres
warnUnusedImport :: GlobalRdrEnv -> ImportDeclUsage -> RnM ()
warnUnusedImport :: GlobalRdrEnv -> ImportDeclUsage -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImport GlobalRdrEnv
rdr_env (L SrcSpanAnnA
loc ImportDecl GhcRn
decl, [GlobalRdrElt]
used, [Name]
unused)
| Just (ImportListInterpretation
Exactly, L SrcSpanAnnLI
_ []) <- ImportDecl GhcRn
-> Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcRn
decl
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just (ImportListInterpretation
EverythingBut, L SrcSpanAnnLI
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
hides) <- ImportDecl GhcRn
-> Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcRn
decl
, Bool -> Bool
not ([GenLocated SrcSpanAnnA (IE GhcRn)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (IE GhcRn)]
hides)
, ModuleName
pRELUDE_NAME ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcRn -> XRec GhcRn ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcRn
decl)
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| [GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
used
= SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (ImportDecl GhcRn -> UnusedImportReason -> TcRnMessage
TcRnUnusedImport ImportDecl GhcRn
decl UnusedImportReason
UnusedImportNone)
| [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
unused
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just (ImportListInterpretation
_, L SrcSpanAnnLI
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
imports) <- ImportDecl GhcRn
-> Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcRn
decl
, [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
unused Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
, Just (L SrcSpanAnnA
loc IE GhcRn
_) <- (GenLocated SrcSpanAnnA (IE GhcRn) -> Bool)
-> [GenLocated SrcSpanAnnA (IE GhcRn)]
-> Maybe (GenLocated SrcSpanAnnA (IE GhcRn))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L SrcSpanAnnA
_ IE GhcRn
ie) -> ((IE GhcRn -> IdP GhcRn
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcRn
ie) :: Name) Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
unused) [GenLocated SrcSpanAnnA (IE GhcRn)]
imports
= SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (ImportDecl GhcRn -> UnusedImportReason -> TcRnMessage
TcRnUnusedImport ImportDecl GhcRn
decl ([UnusedImportName] -> UnusedImportReason
UnusedImportSome [UnusedImportName]
sort_unused))
| Bool
otherwise
= SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (ImportDecl GhcRn -> UnusedImportReason -> TcRnMessage
TcRnUnusedImport ImportDecl GhcRn
decl ([UnusedImportName] -> UnusedImportReason
UnusedImportSome [UnusedImportName]
sort_unused))
where
possible_field :: Name -> UnusedImportName
possible_field Name
n =
case GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env Name
n of
Just (GRE { gre_par :: forall info. GlobalRdrEltX info -> Parent
gre_par = Parent
par, gre_info :: forall info. GlobalRdrEltX info -> info
gre_info = IAmRecField RecFieldInfo
info }) ->
let fld_occ :: OccName
fld_occ :: OccName
fld_occ = Name -> OccName
nameOccName (Name -> OccName) -> Name -> OccName
forall a b. (a -> b) -> a -> b
$ FieldLabel -> Name
flSelector (FieldLabel -> Name) -> FieldLabel -> Name
forall a b. (a -> b) -> a -> b
$ RecFieldInfo -> FieldLabel
recFieldLabel RecFieldInfo
info
in Parent -> OccName -> UnusedImportName
UnusedImportNameRecField Parent
par OccName
fld_occ
Maybe GlobalRdrElt
_ -> Name -> UnusedImportName
UnusedImportNameRegular Name
n
sort_unused :: [UnusedImportName]
sort_unused :: [UnusedImportName]
sort_unused = (Name -> UnusedImportName) -> [Name] -> [UnusedImportName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> UnusedImportName
possible_field ([Name] -> [UnusedImportName]) -> [Name] -> [UnusedImportName]
forall a b. (a -> b) -> a -> b
$
(Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Name -> OccName) -> Name -> Name -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Name -> OccName
nameOccName) [Name]
unused
getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports [ImportDeclUsage]
ie_decls
= do { rdr_env <- IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
getGlobalRdrEnv
; fmap combine $ mapM (mk_minimal rdr_env) ie_decls }
where
mk_minimal :: GlobalRdrEnv
-> (GenLocated SrcSpanAnnA (ImportDecl GhcRn),
[GlobalRdrEltX info], t a)
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (ImportDecl GhcRn))
mk_minimal GlobalRdrEnv
rdr_env (L SrcSpanAnnA
l ImportDecl GhcRn
decl, [GlobalRdrEltX info]
used_gres, t a
unused)
| t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
unused
, Just (ImportListInterpretation
Exactly, XRec GhcRn [LIE GhcRn]
_) <- ImportDecl GhcRn
-> Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcRn
decl
= GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (ImportDecl GhcRn))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> ImportDecl GhcRn -> GenLocated SrcSpanAnnA (ImportDecl GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ImportDecl GhcRn
decl)
| Bool
otherwise
= do { let ImportDecl { ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = L SrcSpanAnnA
_ ModuleName
mod_name
, ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSource = IsBootInterface
is_boot
, ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual = ImportDeclPkgQual GhcRn
pkg_qual } = ImportDecl GhcRn
decl
; iface <- SDoc -> ModuleName -> IsBootInterface -> PkgQual -> RnM ModIface
loadSrcInterface SDoc
doc ModuleName
mod_name IsBootInterface
is_boot ImportDeclPkgQual GhcRn
PkgQual
pkg_qual
; let used_avails = [GlobalRdrEltX info] -> [AvailInfo]
forall info. [GlobalRdrEltX info] -> [AvailInfo]
gresToAvailInfo [GlobalRdrEltX info]
used_gres
; lies <- map (L l) <$> concatMapM (to_ie rdr_env iface) used_avails
; return (L l (decl { ideclImportList = Just (Exactly, L (l2l l) lies) })) }
where
doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Compute minimal imports for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ImportDecl GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr ImportDecl GhcRn
decl
to_ie :: GlobalRdrEnv -> ModIface -> AvailInfo -> RnM [IE GhcRn]
to_ie :: GlobalRdrEnv
-> ModIface
-> AvailInfo
-> IOEnv (Env TcGblEnv TcLclEnv) [IE GhcRn]
to_ie GlobalRdrEnv
rdr_env ModIface
_ (Avail Name
c)
= do { let
gre :: GlobalRdrElt
gre = String -> Maybe GlobalRdrElt -> GlobalRdrElt
forall a. HasDebugCallStack => String -> Maybe a -> a
expectJust String
"getMinimalImports Avail" (Maybe GlobalRdrElt -> GlobalRdrElt)
-> Maybe GlobalRdrElt -> GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env Name
c
; [IE GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [IE GhcRn]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([IE GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [IE GhcRn])
-> [IE GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [IE GhcRn]
forall a b. (a -> b) -> a -> b
$ [XIEVar GhcRn
-> LIEWrappedName GhcRn -> Maybe (ExportDoc GhcRn) -> IE GhcRn
forall pass.
XIEVar pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEVar Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
XIEVar GhcRn
forall a. Maybe a
Nothing (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn)
-> LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
forall a b. (a -> b) -> a -> b
$ Name -> GenLocated SrcSpanAnnA Name
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Name -> GenLocated SrcSpanAnnA Name)
-> Name -> GenLocated SrcSpanAnnA Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre) Maybe (ExportDoc GhcRn)
forall a. Maybe a
Nothing] }
to_ie GlobalRdrEnv
_ ModIface
_ avail :: AvailInfo
avail@(AvailTC Name
n [Name
_])
| AvailInfo -> Bool
availExportsDecl AvailInfo
avail
= [IE GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [IE GhcRn]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [XIEThingAbs GhcRn
-> LIEWrappedName GhcRn -> Maybe (ExportDoc GhcRn) -> IE GhcRn
forall pass.
XIEThingAbs pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEThingAbs Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
XIEThingAbs GhcRn
forall a. Maybe a
Nothing (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn)
-> LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
forall a b. (a -> b) -> a -> b
$ IdP GhcRn -> LocatedA (IdP GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA IdP GhcRn
Name
n) Maybe (ExportDoc GhcRn)
forall a. Maybe a
Nothing]
to_ie GlobalRdrEnv
rdr_env ModIface
iface (AvailTC Name
n [Name]
cs) =
case [ [Name]
xs | avail :: AvailInfo
avail@(AvailTC Name
x [Name]
xs) <- ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
, Name
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n
, AvailInfo -> Bool
availExportsDecl AvailInfo
avail
] of
[[Name]
xs]
| [Name] -> Bool
all_used [Name]
xs
-> [IE GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [IE GhcRn]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [XIEThingAll GhcRn
-> LIEWrappedName GhcRn -> Maybe (ExportDoc GhcRn) -> IE GhcRn
forall pass.
XIEThingAll pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEThingAll (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
forall a. Maybe a
Nothing, (EpToken "(", EpToken "..", EpToken ")")
forall a. NoAnn a => a
noAnn) (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn)
-> LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
forall a b. (a -> b) -> a -> b
$ IdP GhcRn -> LocatedA (IdP GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA IdP GhcRn
Name
n) Maybe (ExportDoc GhcRn)
forall a. Maybe a
Nothing]
| Bool
otherwise
-> do { let ns_gres :: [GlobalRdrElt]
ns_gres = (Name -> GlobalRdrElt) -> [Name] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe GlobalRdrElt -> GlobalRdrElt
forall a. HasDebugCallStack => String -> Maybe a -> a
expectJust String
"getMinimalImports AvailTC" (Maybe GlobalRdrElt -> GlobalRdrElt)
-> (Name -> Maybe GlobalRdrElt) -> Name -> GlobalRdrElt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env) [Name]
cs
ns :: [Name]
ns = (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName [GlobalRdrElt]
ns_gres
; [IE GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [IE GhcRn]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [XIEThingWith GhcRn
-> LIEWrappedName GhcRn
-> IEWildcard
-> [LIEWrappedName GhcRn]
-> Maybe (ExportDoc GhcRn)
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> Maybe (ExportDoc pass)
-> IE pass
IEThingWith (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
forall a. Maybe a
Nothing, IEThingWithAnns
forall a. NoAnn a => a
noAnn) (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn)
-> LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
forall a b. (a -> b) -> a -> b
$ IdP GhcRn -> LocatedA (IdP GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA IdP GhcRn
Name
n) IEWildcard
NoIEWildcard
((Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> [Name] -> [GenLocated SrcSpanAnnA (IEWrappedName GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
GenLocated SrcSpanAnnA Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
to_ie_post_rn (GenLocated SrcSpanAnnA Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> (Name -> GenLocated SrcSpanAnnA Name)
-> Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GenLocated SrcSpanAnnA Name
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA) ((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
n) [Name]
ns)) Maybe (ExportDoc GhcRn)
forall a. Maybe a
Nothing] }
[[Name]]
_other
-> do { let infos :: [GlobalRdrElt]
infos = (Name -> GlobalRdrElt) -> [Name] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe GlobalRdrElt -> GlobalRdrElt
forall a. HasDebugCallStack => String -> Maybe a -> a
expectJust String
"getMinimalImports AvailTC" (Maybe GlobalRdrElt -> GlobalRdrElt)
-> (Name -> Maybe GlobalRdrElt) -> Name -> GlobalRdrElt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env) [Name]
cs
([GlobalRdrElt]
ns_gres,[GlobalRdrElt]
fs_gres) = [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
classifyGREs [GlobalRdrElt]
infos
ns :: [Name]
ns = (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName ([GlobalRdrElt]
ns_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
fs_gres)
fs :: [RecFieldInfo]
fs = (GlobalRdrElt -> RecFieldInfo) -> [GlobalRdrElt] -> [RecFieldInfo]
forall a b. (a -> b) -> [a] -> [b]
map HasDebugCallStack => GlobalRdrElt -> RecFieldInfo
GlobalRdrElt -> RecFieldInfo
fieldGREInfo [GlobalRdrElt]
fs_gres
; [IE GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [IE GhcRn]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([IE GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [IE GhcRn])
-> [IE GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [IE GhcRn]
forall a b. (a -> b) -> a -> b
$
if [RecFieldInfo] -> Bool
all_non_overloaded [RecFieldInfo]
fs
then (Name -> IE GhcRn) -> [Name] -> [IE GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
nm -> XIEVar GhcRn
-> LIEWrappedName GhcRn -> Maybe (ExportDoc GhcRn) -> IE GhcRn
forall pass.
XIEVar pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEVar Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
XIEVar GhcRn
forall a. Maybe a
Nothing (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn_var (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn)
-> LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
forall a b. (a -> b) -> a -> b
$ IdP GhcRn -> LocatedA (IdP GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA IdP GhcRn
Name
nm) Maybe (ExportDoc GhcRn)
forall a. Maybe a
Nothing) [Name]
ns
else [XIEThingWith GhcRn
-> LIEWrappedName GhcRn
-> IEWildcard
-> [LIEWrappedName GhcRn]
-> Maybe (ExportDoc GhcRn)
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> Maybe (ExportDoc pass)
-> IE pass
IEThingWith (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
forall a. Maybe a
Nothing, IEThingWithAnns
forall a. NoAnn a => a
noAnn) (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn)
-> LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
forall a b. (a -> b) -> a -> b
$ IdP GhcRn -> LocatedA (IdP GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA IdP GhcRn
Name
n) IEWildcard
NoIEWildcard
((Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> [Name] -> [GenLocated SrcSpanAnnA (IEWrappedName GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
GenLocated SrcSpanAnnA Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
to_ie_post_rn (GenLocated SrcSpanAnnA Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> (Name -> GenLocated SrcSpanAnnA Name)
-> Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GenLocated SrcSpanAnnA Name
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA) ((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
n) [Name]
ns)) Maybe (ExportDoc GhcRn)
forall a. Maybe a
Nothing] }
where
all_used :: [Name] -> Bool
all_used [Name]
avail_cs = (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
cs) [Name]
avail_cs
all_non_overloaded :: [RecFieldInfo] -> Bool
all_non_overloaded = (RecFieldInfo -> Bool) -> [RecFieldInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (RecFieldInfo -> Bool) -> RecFieldInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> Bool
flIsOverloaded (FieldLabel -> Bool)
-> (RecFieldInfo -> FieldLabel) -> RecFieldInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecFieldInfo -> FieldLabel
recFieldLabel)
combine :: [LImportDecl GhcRn] -> [LImportDecl GhcRn]
combine :: [LImportDecl GhcRn] -> [LImportDecl GhcRn]
combine = (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcRn))
-> GenLocated SrcSpanAnnA (ImportDecl GhcRn))
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcRn))]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty (LImportDecl GhcRn) -> LImportDecl GhcRn
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcRn))
-> GenLocated SrcSpanAnnA (ImportDecl GhcRn)
merge ([NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcRn))]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)])
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcRn))])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> (Bool, Maybe ModuleName, ModuleName))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcRn))]
forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NE.groupAllWith LImportDecl GhcRn -> (Bool, Maybe ModuleName, ModuleName)
GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> (Bool, Maybe ModuleName, ModuleName)
getKey
getKey :: LImportDecl GhcRn -> (Bool, Maybe ModuleName, ModuleName)
getKey :: LImportDecl GhcRn -> (Bool, Maybe ModuleName, ModuleName)
getKey LImportDecl GhcRn
decl =
( ImportDeclQualifiedStyle -> Bool
isImportDeclQualified (ImportDeclQualifiedStyle -> Bool)
-> (ImportDecl GhcRn -> ImportDeclQualifiedStyle)
-> ImportDecl GhcRn
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcRn -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified (ImportDecl GhcRn -> Bool) -> ImportDecl GhcRn -> Bool
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcRn
idecl
, GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> Maybe (GenLocated SrcSpanAnnA ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImportDecl GhcRn -> Maybe (XRec GhcRn ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcRn
idecl
, GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> (ImportDecl GhcRn -> GenLocated SrcSpanAnnA ModuleName)
-> ImportDecl GhcRn
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcRn -> XRec GhcRn ModuleName
ImportDecl GhcRn -> GenLocated SrcSpanAnnA ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName (ImportDecl GhcRn -> ModuleName) -> ImportDecl GhcRn -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcRn
idecl
)
where
idecl :: ImportDecl GhcRn
idecl :: ImportDecl GhcRn
idecl = GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> ImportDecl GhcRn
forall l e. GenLocated l e -> e
unLoc LImportDecl GhcRn
GenLocated SrcSpanAnnA (ImportDecl GhcRn)
decl
merge :: NonEmpty (LImportDecl GhcRn) -> LImportDecl GhcRn
merge :: NonEmpty (LImportDecl GhcRn) -> LImportDecl GhcRn
merge decls :: NonEmpty (LImportDecl GhcRn)
decls@((L SrcSpanAnnA
l ImportDecl GhcRn
decl) :| [LImportDecl GhcRn]
_) = SrcSpanAnnA
-> ImportDecl GhcRn -> GenLocated SrcSpanAnnA (ImportDecl GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (ImportDecl GhcRn
decl { ideclImportList = Just (Exactly, L (noAnnSrcSpan (locA l)) lies) })
where lies :: [LIE GhcRn]
lies = ((ImportListInterpretation, LocatedLI [LIE GhcRn]) -> [LIE GhcRn])
-> [(ImportListInterpretation, LocatedLI [LIE GhcRn])]
-> [LIE GhcRn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LocatedLI [LIE GhcRn] -> [LIE GhcRn]
forall l e. GenLocated l e -> e
unLoc (LocatedLI [LIE GhcRn] -> [LIE GhcRn])
-> ((ImportListInterpretation, LocatedLI [LIE GhcRn])
-> LocatedLI [LIE GhcRn])
-> (ImportListInterpretation, LocatedLI [LIE GhcRn])
-> [LIE GhcRn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportListInterpretation, LocatedLI [LIE GhcRn])
-> LocatedLI [LIE GhcRn]
forall a b. (a, b) -> b
snd) ([(ImportListInterpretation, LocatedLI [LIE GhcRn])]
-> [LIE GhcRn])
-> [(ImportListInterpretation, LocatedLI [LIE GhcRn])]
-> [LIE GhcRn]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> Maybe (ImportListInterpretation, LocatedLI [LIE GhcRn]))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [(ImportListInterpretation, LocatedLI [LIE GhcRn])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportDecl GhcRn
-> Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
ImportDecl GhcRn
-> Maybe (ImportListInterpretation, LocatedLI [LIE GhcRn])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList (ImportDecl GhcRn
-> Maybe (ImportListInterpretation, LocatedLI [LIE GhcRn]))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> ImportDecl GhcRn)
-> GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> Maybe (ImportListInterpretation, LocatedLI [LIE GhcRn])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> ImportDecl GhcRn
forall l e. GenLocated l e -> e
unLoc) ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [(ImportListInterpretation, LocatedLI [LIE GhcRn])])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [(ImportListInterpretation, LocatedLI [LIE GhcRn])]
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcRn))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcRn)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcRn))
decls
classifyGREs :: [GlobalRdrElt] -> ([GlobalRdrElt], [FieldGlobalRdrElt])
classifyGREs :: [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
classifyGREs = (GlobalRdrElt -> Bool)
-> [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Bool -> Bool
not (Bool -> Bool) -> (GlobalRdrElt -> Bool) -> GlobalRdrElt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE)
printMinimalImports :: HscSource -> [ImportDeclUsage] -> RnM ()
printMinimalImports :: HscSource -> [ImportDeclUsage] -> IOEnv (Env TcGblEnv TcLclEnv) ()
printMinimalImports HscSource
hsc_src [ImportDeclUsage]
imports_w_usage
= do { imports' <- [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports [ImportDeclUsage]
imports_w_usage
; this_mod <- getModule
; dflags <- getDynFlags
; liftIO $ withFile (mkFilename dflags this_mod) WriteMode $ \Handle
h ->
DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO ()
printForUser DynFlags
dflags Handle
h NamePprCtx
neverQualify Depth
AllTheWay ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> SDoc)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
imports'))
}
where
mkFilename :: DynFlags -> Module -> String
mkFilename DynFlags
dflags Module
this_mod
| Just String
d <- DynFlags -> Maybe String
dumpDir DynFlags
dflags = String
d String -> String -> String
</> String
basefn
| Bool
otherwise = String
basefn
where
suffix :: String
suffix = case HscSource
hsc_src of
HscSource
HsBootFile -> String
".imports-boot"
HscSource
HsSrcFile -> String
".imports"
HscSource
HsigFile -> String
".imports"
basefn :: String
basefn = ModuleName -> String
moduleNameString (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix
to_ie_post_rn_var :: LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn_var :: LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn_var (L SrcSpanAnnA
l IdP GhcRn
n)
| OccName -> Bool
isDataOcc (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> OccName
forall name. HasOccName name => name -> OccName
occName IdP GhcRn
Name
n = SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XIEPattern GhcRn -> LIdP GhcRn -> IEWrappedName GhcRn
forall p. XIEPattern p -> LIdP p -> IEWrappedName p
IEPattern XIEPattern GhcRn
EpToken "pattern"
forall a. NoAnn a => a
noAnn (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
l) IdP GhcRn
Name
n))
| Bool
otherwise = SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XIEName GhcRn -> LIdP GhcRn -> IEWrappedName GhcRn
forall p. XIEName p -> LIdP p -> IEWrappedName p
IEName XIEName GhcRn
NoExtField
noExtField (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
l) IdP GhcRn
Name
n))
to_ie_post_rn :: LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn :: LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn (L SrcSpanAnnA
l IdP GhcRn
n)
| OccName -> Bool
isTcOcc OccName
occ Bool -> Bool -> Bool
&& OccName -> Bool
isSymOcc OccName
occ = SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XIEType GhcRn -> LIdP GhcRn -> IEWrappedName GhcRn
forall p. XIEType p -> LIdP p -> IEWrappedName p
IEType XIEType GhcRn
EpToken "type"
forall a. NoAnn a => a
noAnn (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
l) IdP GhcRn
Name
n))
| Bool
otherwise = SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XIEName GhcRn -> LIdP GhcRn -> IEWrappedName GhcRn
forall p. XIEName p -> LIdP p -> IEWrappedName p
IEName XIEName GhcRn
NoExtField
noExtField (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnA
l) IdP GhcRn
Name
n))
where occ :: OccName
occ = Name -> OccName
forall name. HasOccName name => name -> OccName
occName IdP GhcRn
Name
n
badImportItemErr
:: ModIface -> ImpDeclSpec -> IE GhcPs -> IsSubordinate
-> [AvailInfo]
-> TcRn ImportLookupReason
badImportItemErr :: ModIface
-> ImpDeclSpec
-> IE (GhcPass 'Parsed)
-> IsSubordinate
-> [AvailInfo]
-> TcRn ImportLookupReason
badImportItemErr ModIface
iface ImpDeclSpec
decl_spec IE (GhcPass 'Parsed)
ie IsSubordinate
sub [AvailInfo]
avails = do
patsyns_enabled <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.PatternSynonyms
expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces
dflags <- getDynFlags
hsc_env <- getTopEnv
let rdr_env = [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv
([GlobalRdrElt] -> GlobalRdrEnv) -> [GlobalRdrElt] -> GlobalRdrEnv
forall a b. (a -> b) -> a -> b
$ HscEnv -> Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails HscEnv
hsc_env (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just ImportSpec
imp_spec) [AvailInfo]
all_avails
pure (ImportLookupBad (importErrorKind dflags rdr_env expl_ns_enabled) iface decl_spec ie patsyns_enabled)
where
importErrorKind :: DynFlags -> GlobalRdrEnv -> Bool -> BadImportKind
importErrorKind DynFlags
dflags GlobalRdrEnv
rdr_env Bool
expl_ns_enabled
| (AvailInfo -> Bool) -> [AvailInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any AvailInfo -> Bool
checkIfTyCon [AvailInfo]
avails = case IsSubordinate
sub of
IsSubordinate
IsNotSubordinate -> Bool -> BadImportKind
BadImportAvailTyCon Bool
expl_ns_enabled
IsSubordinate
IsSubordinate -> [OccName] -> BadImportKind
BadImportNotExportedSubordinates [OccName]
unavailableChildren
| (AvailInfo -> Bool) -> [AvailInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any AvailInfo -> Bool
checkIfVarName [AvailInfo]
avails = BadImportKind
BadImportAvailVar
| Just AvailInfo
con <- (AvailInfo -> Bool) -> [AvailInfo] -> Maybe AvailInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find AvailInfo -> Bool
checkIfDataCon [AvailInfo]
avails = OccName -> BadImportKind
BadImportAvailDataCon (AvailInfo -> OccName
availOccName AvailInfo
con)
| Bool
otherwise = [GhcHint] -> BadImportKind
BadImportNotExported [GhcHint]
suggs
where
suggs :: [GhcHint]
suggs = [GhcHint]
similar_suggs [GhcHint] -> [GhcHint] -> [GhcHint]
forall a. [a] -> [a] -> [a]
++ GlobalRdrEnv -> RdrName -> [GhcHint]
fieldSelectorSuggestions GlobalRdrEnv
rdr_env IdP (GhcPass 'Parsed)
RdrName
rdr
similar_names :: [SimilarName]
similar_names =
LookingFor
-> DynFlags
-> GlobalRdrEnv
-> LocalRdrEnv
-> RdrName
-> [SimilarName]
similarNameSuggestions (WhatLooking -> WhereLooking -> LookingFor
Unbound.LF WhatLooking
WL_Anything WhereLooking
WL_Global)
DynFlags
dflags GlobalRdrEnv
rdr_env LocalRdrEnv
emptyLocalRdrEnv IdP (GhcPass 'Parsed)
RdrName
rdr
similar_suggs :: [GhcHint]
similar_suggs =
case [SimilarName] -> Maybe (NonEmpty SimilarName)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([SimilarName] -> Maybe (NonEmpty SimilarName))
-> [SimilarName] -> Maybe (NonEmpty SimilarName)
forall a b. (a -> b) -> a -> b
$ (SimilarName -> Maybe SimilarName)
-> [SimilarName] -> [SimilarName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SimilarName -> Maybe SimilarName
imported_item ([SimilarName] -> [SimilarName]) -> [SimilarName] -> [SimilarName]
forall a b. (a -> b) -> a -> b
$ [SimilarName]
similar_names of
Just NonEmpty SimilarName
similar -> [ RdrName -> NonEmpty SimilarName -> GhcHint
SuggestSimilarNames IdP (GhcPass 'Parsed)
RdrName
rdr NonEmpty SimilarName
similar ]
Maybe (NonEmpty SimilarName)
Nothing -> [ ]
imported_item :: SimilarName -> Maybe SimilarName
imported_item (SimilarRdrName RdrName
rdr_name (Just (ImportedBy {})))
= SimilarName -> Maybe SimilarName
forall a. a -> Maybe a
Just (RdrName -> Maybe HowInScope -> SimilarName
SimilarRdrName RdrName
rdr_name Maybe HowInScope
forall a. Maybe a
Nothing)
imported_item SimilarName
_ = Maybe SimilarName
forall a. Maybe a
Nothing
checkIfDataCon :: AvailInfo -> Bool
checkIfDataCon = (Name -> Bool) -> AvailInfo -> Bool
checkIfAvailMatches Name -> Bool
isDataConName
checkIfTyCon :: AvailInfo -> Bool
checkIfTyCon = (Name -> Bool) -> AvailInfo -> Bool
checkIfAvailMatches Name -> Bool
isTyConName
checkIfVarName :: AvailInfo -> Bool
checkIfVarName =
\case
AvailTC{} -> Bool
False
Avail Name
n -> FastString
importedFS FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== OccName -> FastString
occNameFS (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
n)
Bool -> Bool -> Bool
&& (OccName -> Bool
isVarOcc (OccName -> Bool) -> (OccName -> Bool) -> OccName -> Bool
forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
<||> OccName -> Bool
isFieldOcc) (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
n)
checkIfAvailMatches :: (Name -> Bool) -> AvailInfo -> Bool
checkIfAvailMatches Name -> Bool
namePred =
\case
AvailTC Name
_ [Name]
ns ->
case (Name -> Bool) -> [Name] -> Maybe Name
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Name
n -> FastString
importedFS FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== OccName -> FastString
occNameFS (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
n)) [Name]
ns of
Just Name
n -> Name -> Bool
namePred Name
n
Maybe Name
Nothing -> Bool
False
Avail{} -> Bool
False
availOccName :: AvailInfo -> OccName
availOccName = Name -> OccName
forall name. HasOccName name => name -> OccName
occName (Name -> OccName) -> (AvailInfo -> Name) -> AvailInfo -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvailInfo -> Name
availName
rdr :: IdP (GhcPass 'Parsed)
rdr = IE (GhcPass 'Parsed) -> IdP (GhcPass 'Parsed)
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE (GhcPass 'Parsed)
ie
importedFS :: FastString
importedFS = OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc IdP (GhcPass 'Parsed)
RdrName
rdr
imp_spec :: ImportSpec
imp_spec = ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }
all_avails :: [AvailInfo]
all_avails = ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
unavailableChildren :: [OccName]
unavailableChildren = case IE (GhcPass 'Parsed)
ie of
IEThingWith XIEThingWith (GhcPass 'Parsed)
_ LIEWrappedName (GhcPass 'Parsed)
_ IEWildcard
_ [LIEWrappedName (GhcPass 'Parsed)]
ns Maybe (ExportDoc (GhcPass 'Parsed))
_ -> (GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
-> OccName)
-> [GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))]
-> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map (RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
-> RdrName)
-> GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IEWrappedName (GhcPass 'Parsed) -> IdP (GhcPass 'Parsed)
IEWrappedName (GhcPass 'Parsed) -> RdrName
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName (IEWrappedName (GhcPass 'Parsed) -> RdrName)
-> (GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
-> IEWrappedName (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))
-> IEWrappedName (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc) [LIEWrappedName (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Parsed))]
ns
IE (GhcPass 'Parsed)
_ -> String -> [OccName]
forall a. HasCallStack => String -> a
panic String
"importedChildren failed pattern match: no children"
addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn ()
addDupDeclErr :: NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDupDeclErr gres :: NonEmpty GlobalRdrElt
gres@(GlobalRdrElt
gre :| [GlobalRdrElt]
_)
= SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan (NonEmpty Name -> Name
forall a. NonEmpty a -> a
NE.last NonEmpty Name
sorted_names)) (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ (OccName -> NonEmpty Name -> TcRnMessage
TcRnDuplicateDecls (GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre) NonEmpty Name
sorted_names)
where
sorted_names :: NonEmpty Name
sorted_names =
(Name -> Name -> Ordering) -> NonEmpty Name -> NonEmpty Name
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy (SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (Name -> SrcSpan) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> SrcSpan
nameSrcSpan)
((GlobalRdrElt -> Name) -> NonEmpty GlobalRdrElt -> NonEmpty Name
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName NonEmpty GlobalRdrElt
gres)
checkConName :: RdrName -> TcRn ()
checkConName :: RdrName -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkConName RdrName
name
= Bool -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkErr (RdrName -> Bool
isRdrDataCon RdrName
name Bool -> Bool -> Bool
|| RdrName -> Bool
isRdrTc RdrName
name) (RdrName -> TcRnMessage
TcRnIllegalDataCon RdrName
name)