{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Rename.Names (
rnImports, getLocalNonValBinders, newRecordSelector,
extendGlobalRdrEnvRn,
gresFromAvails,
calculateAvails,
reportUnusedNames,
checkConName,
mkChildEnv,
findChildren,
findImportUsage,
getMinimalImports,
printMinimalImports,
renamePkgQual, renameRawPkgQual,
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, mkFieldEnv )
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.Monad
import GHC.Hs
import GHC.Iface.Load ( loadSrcInterface )
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.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.Error
import GHC.Types.PkgQual
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.Maybe
import GHC.Data.FastString
import GHC.Data.FastString.Env
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
import Control.Monad
import Data.Either ( partitionEithers )
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 Data.Foldable ( toList )
import System.FilePath ((</>))
import System.IO
import GHC.Data.Bag
rnImports :: [(LImportDecl GhcPs, SDoc)]
-> RnM ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImports :: [(LImportDecl GhcPs, SDoc)]
-> RnM ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, Bool)
rnImports [(LImportDecl GhcPs, SDoc)]
imports = do
TcGblEnv
tcg_env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
let this_mod :: Module
this_mod = TcGblEnv -> Module
tcg_mod TcGblEnv
tcg_env
let ([(GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)]
source, [(GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)]
ordinary) = ((GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc) -> Bool)
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)]
-> ([(GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)],
[(GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool
forall {l} {pass}. GenLocated l (ImportDecl pass) -> Bool
is_source_import (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool)
-> ((GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a b. (a, b) -> a
fst) [(LImportDecl GhcPs, SDoc)]
[(GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)]
imports
is_source_import :: GenLocated l (ImportDecl pass) -> Bool
is_source_import GenLocated l (ImportDecl pass)
d = ImportDecl pass -> IsBootInterface
forall pass. ImportDecl pass -> IsBootInterface
ideclSource (GenLocated l (ImportDecl pass) -> ImportDecl pass
forall l e. GenLocated l e -> e
unLoc GenLocated l (ImportDecl pass)
d) IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
[(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
stuff1 <- ((GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)
-> TcRn
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool))
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)]
-> TcRn
[(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
mapAndReportM (Module
-> (LImportDecl GhcPs, SDoc)
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)
rnImportDecl Module
this_mod) [(GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)]
ordinary
[(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
stuff2 <- ((GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)
-> TcRn
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool))
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)]
-> TcRn
[(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
mapAndReportM (Module
-> (LImportDecl GhcPs, SDoc)
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)
rnImportDecl Module
this_mod) [(GenLocated SrcSpanAnnA (ImportDecl GhcPs), SDoc)]
source
let ([LImportDecl GhcRn]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails, Bool
hpc_usage) = [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)]
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, Bool)
combine ([(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
stuff1 [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
forall a. [a] -> [a] -> [a]
++ [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
stuff2)
let merged_import_avail :: ImportAvails
merged_import_avail = ImportAvails -> ImportAvails
clobberSourceImports ImportAvails
imp_avails
DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
let final_import_avail :: ImportAvails
final_import_avail =
ImportAvails
merged_import_avail { imp_dep_direct_pkgs = S.fromList (implicitPackageDeps dflags)
`S.union` imp_dep_direct_pkgs merged_import_avail}
([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], GlobalRdrEnv,
ImportAvails, Bool)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], GlobalRdrEnv,
ImportAvails, Bool)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LImportDecl GhcRn]
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
decls, GlobalRdrEnv
rdr_env, ImportAvails
final_import_avail, Bool
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, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
combine :: [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)]
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, Bool)
combine [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)]
ss =
let ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails, Bool
hpc_usage, ModuleSet
finsts) = ((GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], GlobalRdrEnv,
ImportAvails, Bool, ModuleSet)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], GlobalRdrEnv,
ImportAvails, Bool, ModuleSet))
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], GlobalRdrEnv,
ImportAvails, Bool, ModuleSet)
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], GlobalRdrEnv,
ImportAvails, 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), GlobalRdrEnv,
ImportAvails, Bool)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], GlobalRdrEnv,
ImportAvails, Bool, ModuleSet)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)], GlobalRdrEnv,
ImportAvails, Bool, ModuleSet)
forall {a}.
(a, GlobalRdrEnv, ImportAvails, Bool)
-> ([a], GlobalRdrEnv, ImportAvails, Bool, ModuleSet)
-> ([a], GlobalRdrEnv, ImportAvails, Bool, ModuleSet)
plus
([], GlobalRdrEnv
emptyGlobalRdrEnv, ImportAvails
emptyImportAvails, Bool
False, ModuleSet
emptyModuleSet)
[(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)]
[(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)]
ss
in ([LImportDecl GhcRn]
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails { imp_finsts = moduleSetElts finsts },
Bool
hpc_usage)
plus :: (a, GlobalRdrEnv, ImportAvails, Bool)
-> ([a], GlobalRdrEnv, ImportAvails, Bool, ModuleSet)
-> ([a], GlobalRdrEnv, ImportAvails, Bool, ModuleSet)
plus (a
decl, GlobalRdrEnv
gbl_env1, ImportAvails
imp_avails1, Bool
hpc_usage1)
([a]
decls, GlobalRdrEnv
gbl_env2, ImportAvails
imp_avails2, Bool
hpc_usage2, ModuleSet
finsts_set)
= ( a
decla -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
decls,
GlobalRdrEnv
gbl_env1 GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
`plusGlobalRdrEnv` GlobalRdrEnv
gbl_env2,
ImportAvails
imp_avails1' ImportAvails -> ImportAvails -> ImportAvails
`plusImportAvails` ImportAvails
imp_avails2,
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, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl :: Module
-> (LImportDecl GhcPs, SDoc)
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)
rnImportDecl Module
this_mod
(L SrcSpanAnnA
loc decl :: ImportDecl GhcPs
decl@(ImportDecl { ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = XRec GhcPs ModuleName
loc_imp_mod_name
, ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual = ImportDeclPkgQual GhcPs
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 GhcPs ModuleName)
as_mod, ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList = Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
imp_details }), SDoc
import_reason)
= SrcSpanAnnA
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc (RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool))
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, Bool)
forall a b. (a -> b) -> a -> b
$ do
case ImportDeclPkgQual GhcPs
raw_pkg_qual of
ImportDeclPkgQual GhcPs
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
Bool
pkg_imports <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.PackageImports
Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
pkg_imports) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr TcRnMessage
packageImportErr
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 GhcPs 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
HscEnv
hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
UnitEnv
unit_env <- HscEnv -> UnitEnv
hsc_unit_env (HscEnv -> UnitEnv)
-> TcRnIf TcGblEnv TcLclEnv HscEnv
-> IOEnv (Env TcGblEnv TcLclEnv) UnitEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
let pkg_qual :: PkgQual
pkg_qual = UnitEnv -> ModuleName -> RawPkgQual -> PkgQual
renameRawPkgQual UnitEnv
unit_env ModuleName
imp_mod_name ImportDeclPkgQual GhcPs
RawPkgQual
raw_pkg_qual
Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ModuleName
imp_mod_name ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod Bool -> Bool -> Bool
&&
(case PkgQual
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))
(TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A module cannot import itself:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
imp_mod_name))
case Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
imp_details of
Just (ImportListInterpretation
Exactly, XRec GhcPs [LIE GhcPs]
_) -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
_ | 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 -> WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnMissingImportList (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ do
let msg :: TcRnMessage
msg = DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingImportList)
[GhcHint]
noHints
(ModuleName -> SDoc
missingImportListWarn ModuleName
imp_mod_name)
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic TcRnMessage
msg
ModIface
iface <- SDoc -> ModuleName -> IsBootInterface -> PkgQual -> RnM ModIface
loadSrcInterface SDoc
doc ModuleName
imp_mod_name IsBootInterface
want_boot PkgQual
pkg_qual
Bool
-> String
-> SDoc
-> TcRn
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)
-> TcRn
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)
forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace ((IsBootInterface
want_boot IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
NotBoot) Bool -> Bool -> Bool
&& (ModIface -> IsBootInterface
mi_boot ModIface
iface IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot)) String
"rnImportDecl" (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
imp_mod_name) (TcRn
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)
-> TcRn
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool))
-> TcRn
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)
-> TcRn
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)
forall a b. (a -> b) -> a -> b
$ do
DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Bool -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIf ((IsBootInterface
want_boot IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot) Bool -> Bool -> Bool
&& (ModIface -> IsBootInterface
mi_boot ModIface
iface IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
NotBoot) Bool -> Bool -> Bool
&& GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode DynFlags
dflags))
(ModuleName -> TcRnMessage
warnRedundantSourceImport ModuleName
imp_mod_name)
Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
mod_safe Bool -> Bool -> Bool
&& Bool -> Bool
not (DynFlags -> Bool
safeImportsOn DynFlags
dflags)) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"safe import can't be used as Safe Haskell isn't on!"
SDoc -> SDoc -> SDoc
$+$ String -> SDoc
forall doc. IsLine doc => String -> doc
text (String
"please enable Safe Haskell through either Safe, Trustworthy or Unsafe"))
let
qual_mod_name :: ModuleName
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 GhcPs 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
imp_spec = ImpDeclSpec { is_mod :: ModuleName
is_mod = ModuleName
imp_mod_name, is_qual :: Bool
is_qual = Bool
qual_only,
is_dloc :: SrcSpan
is_dloc = SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, is_as :: ModuleName
is_as = ModuleName
qual_mod_name }
(Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)])
new_imp_details, [GlobalRdrElt]
gres) <- ModIface
-> ImpDeclSpec
-> Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])
-> RnM
(Maybe (ImportListInterpretation, LocatedL [LIE GhcRn]),
[GlobalRdrElt])
filterImports ModIface
iface ImpDeclSpec
imp_spec Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])
imp_details
GlobalRdrEnv
potential_gres <- [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv ([GlobalRdrElt] -> GlobalRdrEnv)
-> ((Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)]),
[GlobalRdrElt])
-> [GlobalRdrElt])
-> (Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)]),
[GlobalRdrElt])
-> GlobalRdrEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)]),
[GlobalRdrElt])
-> [GlobalRdrElt]
forall a b. (a, b) -> b
snd ((Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)]),
[GlobalRdrElt])
-> GlobalRdrEnv)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)]),
[GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModIface
-> ImpDeclSpec
-> Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])
-> RnM
(Maybe (ImportListInterpretation, LocatedL [LIE GhcRn]),
[GlobalRdrElt])
filterImports ModIface
iface ImpDeclSpec
imp_spec Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])
Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. Maybe a
Nothing
let gbl_env :: GlobalRdrEnv
gbl_env = [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv [GlobalRdrElt]
gres
is_hiding :: Bool
is_hiding | Just (ImportListInterpretation
EverythingBut,XRec GhcPs [LIE GhcPs]
_) <- Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
imp_details = Bool
True
| Bool
otherwise = Bool
False
mod_safe' :: Bool
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)
HscEnv
hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
other_home_units :: Set UnitId
other_home_units = HscEnv -> Set UnitId
hsc_all_home_unit_ids HscEnv
hsc_env
imv :: ImportedModsVal
imv = ImportedModsVal
{ imv_name :: ModuleName
imv_name = ModuleName
qual_mod_name
, imv_span :: SrcSpan
imv_span = SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' 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 :: ImportAvails
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 ModIface -> Warnings GhcRn
forall (phase :: ModIfacePhase). ModIface_ phase -> Warnings GhcRn
mi_warns ModIface
iface of
WarnAll WarningTxt GhcRn
txt -> do
let msg :: TcRnMessage
msg = DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnWarningsDeprecations)
[GhcHint]
noHints
(ModuleName -> WarningTxt GhcRn -> SDoc
moduleWarn ModuleName
imp_mod_name WarningTxt GhcRn
txt)
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic TcRnMessage
msg
Warnings GhcRn
_ -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ImportDecl GhcPs -> ModIface -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnqualifiedImport ImportDecl GhcPs
decl ModIface
iface
let new_imp_decl :: ImportDecl GhcRn
new_imp_decl = ImportDecl
{ ideclExt :: XCImportDecl GhcRn
ideclExt = ImportDecl GhcPs -> XCImportDecl GhcPs
forall pass. ImportDecl pass -> XCImportDecl pass
ideclExt ImportDecl GhcPs
decl
, ideclName :: XRec GhcRn ModuleName
ideclName = ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
decl
, ideclPkgQual :: ImportDeclPkgQual GhcRn
ideclPkgQual = ImportDeclPkgQual GhcRn
PkgQual
pkg_qual
, ideclSource :: IsBootInterface
ideclSource = ImportDecl GhcPs -> IsBootInterface
forall pass. ImportDecl pass -> IsBootInterface
ideclSource ImportDecl GhcPs
decl
, ideclSafe :: Bool
ideclSafe = Bool
mod_safe'
, ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
decl
, ideclAs :: Maybe (XRec GhcRn ModuleName)
ideclAs = ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
decl
, ideclImportList :: Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
ideclImportList = Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)])
new_imp_details
}
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)
-> TcRn
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
ImportAvails, Bool)
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
loc ImportDecl GhcRn
new_imp_decl, GlobalRdrEnv
gbl_env, ImportAvails
imports, ModIface -> Bool
forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_hpc ModIface
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 ((() :: Constraint) => 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 ((() :: Constraint) => UnitId -> UnitEnv -> HomeUnitEnv
UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
unit_env)))) [UnitId]
hpt_deps
units :: UnitState
units = (() :: Constraint) => 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 a. Module -> a -> ModuleEnv a
unitModuleEnv (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
}
warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM ()
warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnqualifiedImport ImportDecl GhcPs
decl ModIface
iface =
Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
bad_import (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ do
let msg :: TcRnMessage
msg = DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnCompatUnqualifiedImports)
[GhcHint]
noHints
SDoc
warning
SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt SrcSpan
loc TcRnMessage
msg
where
mod :: Module
mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
loc :: SrcSpan
loc = GenLocated SrcSpanAnnA ModuleName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA ModuleName -> SrcSpan)
-> GenLocated SrcSpanAnnA ModuleName -> SrcSpan
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
decl
is_qual :: Bool
is_qual = ImportDeclQualifiedStyle -> Bool
isImportDeclQualified (ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
decl)
has_import_list :: Bool
has_import_list =
case ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
decl of
Just (ImportListInterpretation
Exactly, XRec GhcPs [LIE GhcPs]
_) -> Bool
True
Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
_ -> Bool
False
bad_import :: Bool
bad_import =
Bool -> Bool
not Bool
is_qual
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
has_import_list
Bool -> Bool -> Bool
&& Module
mod Module -> ModuleSet -> Bool
`elemModuleSet` ModuleSet
qualifiedMods
warning :: SDoc
warning = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
[ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"To ensure compatibility with future core libraries changes"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"imports to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
decl) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"should be"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"either qualified or have an explicit import list."
]
qualifiedMods :: ModuleSet
qualifiedMods = [Module] -> ModuleSet
mkModuleSet [ Module
dATA_LIST ]
warnRedundantSourceImport :: ModuleName -> TcRnMessage
warnRedundantSourceImport :: ModuleName -> TcRnMessage
warnRedundantSourceImport ModuleName
mod_name
= DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic DiagnosticReason
WarningWithoutFlag [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unnecessary {-# SOURCE #-} in the import of module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name)
extendGlobalRdrEnvRn :: [AvailInfo]
-> MiniFixityEnv
-> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn :: [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [AvailInfo]
avails 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 { (TcGblEnv
gbl_env, TcLclEnv
lcl_env) <- RnM (TcGblEnv, TcLclEnv)
forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
getEnvs
; ThStage
stage <- TcM ThStage
getStage
; Bool
isGHCi <- TcRnIf TcGblEnv TcLclEnv Bool
getIsGHCi
; let rdr_env :: GlobalRdrEnv
rdr_env = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env
fix_env :: FixityEnv
fix_env = TcGblEnv -> FixityEnv
tcg_fix_env TcGblEnv
gbl_env
th_bndrs :: ThBindEnv
th_bndrs = TcLclEnv -> ThBindEnv
tcl_th_bndrs TcLclEnv
lcl_env
th_lvl :: Int
th_lvl = ThStage -> Int
thLevel ThStage
stage
inBracket :: Bool
inBracket = ThStage -> Bool
isBrackStage ThStage
stage
lcl_env_TH :: TcLclEnv
lcl_env_TH = TcLclEnv
lcl_env { tcl_rdr = minusLocalRdrEnv (tcl_rdr lcl_env) new_occs }
lcl_env2 :: TcLclEnv
lcl_env2 | Bool
inBracket = TcLclEnv
lcl_env_TH
| Bool
otherwise = TcLclEnv
lcl_env
want_shadowing :: Bool
want_shadowing = Bool
isGHCi Bool -> Bool -> Bool
|| Bool
inBracket
rdr_env1 :: GlobalRdrEnv
rdr_env1 | Bool
want_shadowing = GlobalRdrEnv -> OccEnv OccName -> GlobalRdrEnv
forall a. GlobalRdrEnv -> OccEnv a -> GlobalRdrEnv
shadowNames GlobalRdrEnv
rdr_env OccEnv OccName
new_occs
| Bool
otherwise = GlobalRdrEnv
rdr_env
lcl_env3 :: TcLclEnv
lcl_env3 = TcLclEnv
lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs
[ ( greNameMangledName n
, (TopLevel, th_lvl) )
| n <- new_names ] }
; GlobalRdrEnv
rdr_env2 <- (GlobalRdrEnv
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv)
-> GlobalRdrEnv
-> [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM GlobalRdrEnv
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
add_gre GlobalRdrEnv
rdr_env1 [GlobalRdrElt]
new_gres
; let fix_env' :: FixityEnv
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' = TcGblEnv
gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' }
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"extendGlobalRdrEnvRn 2" (Bool -> GlobalRdrEnv -> SDoc
pprGlobalRdrEnv Bool
True GlobalRdrEnv
rdr_env2)
; (TcGblEnv, TcLclEnv) -> RnM (TcGblEnv, TcLclEnv)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TcGblEnv
gbl_env', TcLclEnv
lcl_env3) }
where
new_names :: [GreName]
new_names = (AvailInfo -> [GreName]) -> [AvailInfo] -> [GreName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [GreName]
availGreNames [AvailInfo]
avails
new_occs :: OccEnv OccName
new_occs = OccSet -> OccEnv OccName
occSetToEnv ([OccName] -> OccSet
mkOccSet ((GreName -> OccName) -> [GreName] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map GreName -> OccName
forall name. HasOccName name => name -> OccName
occName [GreName]
new_names))
extend_fix_env :: FixityEnv -> GlobalRdrElt -> FixityEnv
extend_fix_env FixityEnv
fix_env GlobalRdrElt
gre
| Just (L SrcSpan
_ Fixity
fi) <- MiniFixityEnv -> FastString -> Maybe (Located Fixity)
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv MiniFixityEnv
new_fixities (OccName -> FastString
occNameFS OccName
occ)
= 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
greMangledName GlobalRdrElt
gre
occ :: OccName
occ = GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre
new_gres :: [GlobalRdrElt]
new_gres :: [GlobalRdrElt]
new_gres = (AvailInfo -> [GlobalRdrElt]) -> [AvailInfo] -> [GlobalRdrElt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [GlobalRdrElt]
localGREsFromAvail [AvailInfo]
avails
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
isDupGRE (GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env (GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre))
isDupGRE :: GlobalRdrElt -> Bool
isDupGRE GlobalRdrElt
gre' = GlobalRdrElt -> Bool
isLocalGRE GlobalRdrElt
gre' Bool -> Bool -> Bool
&& Bool -> Bool
not (GlobalRdrElt -> Bool
isAllowedDup GlobalRdrElt
gre')
isAllowedDup :: GlobalRdrElt -> Bool
isAllowedDup GlobalRdrElt
gre' =
case (GlobalRdrElt -> Bool
isRecFldGRE GlobalRdrElt
gre, GlobalRdrElt -> Bool
isRecFldGRE GlobalRdrElt
gre') of
(Bool
True, Bool
True) -> GlobalRdrElt -> GreName
gre_name GlobalRdrElt
gre GreName -> GreName -> Bool
forall a. Eq a => a -> a -> Bool
/= GlobalRdrElt -> GreName
gre_name GlobalRdrElt
gre'
Bool -> Bool -> Bool
&& GlobalRdrElt -> Bool
isDuplicateRecFldGRE GlobalRdrElt
gre'
(Bool
True, Bool
False) -> GlobalRdrElt -> Bool
isNoFieldSelectorGRE GlobalRdrElt
gre
(Bool
False, Bool
True) -> GlobalRdrElt -> Bool
isNoFieldSelectorGRE GlobalRdrElt
gre'
(Bool
False, Bool
False) -> Bool
False
getLocalNonValBinders :: MiniFixityEnv -> HsGroup GhcPs
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
getLocalNonValBinders :: MiniFixityEnv -> HsGroup GhcPs -> RnM ((TcGblEnv, TcLclEnv), Defs)
getLocalNonValBinders MiniFixityEnv
fixity_env
(HsGroup { hs_valds :: forall p. HsGroup p -> HsValBinds p
hs_valds = HsValBinds GhcPs
binds,
hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
hs_tyclds = [TyClGroup GhcPs]
tycl_decls,
hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
hs_fords = [LForeignDecl GhcPs]
foreign_decls })
= do {
; let inst_decls :: [GenLocated SrcSpanAnnA (InstDecl GhcPs)]
inst_decls = [TyClGroup GhcPs]
tycl_decls [TyClGroup GhcPs]
-> (TyClGroup GhcPs -> [GenLocated SrcSpanAnnA (InstDecl GhcPs)])
-> [GenLocated SrcSpanAnnA (InstDecl GhcPs)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TyClGroup GhcPs -> [LInstDecl GhcPs]
TyClGroup GhcPs -> [GenLocated SrcSpanAnnA (InstDecl GhcPs)]
forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds
; DuplicateRecordFields
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
; FieldSelectors
has_sel <- DynFlags -> FieldSelectors
xopt_FieldSelectors (DynFlags -> FieldSelectors)
-> IOEnv (Env TcGblEnv TcLclEnv) DynFlags
-> IOEnv (Env TcGblEnv TcLclEnv) FieldSelectors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; ([AvailInfo]
tc_avails, [[(Name, [FieldLabel])]]
tc_fldss)
<- ([(AvailInfo, [(Name, [FieldLabel])])]
-> ([AvailInfo], [[(Name, [FieldLabel])]]))
-> IOEnv
(Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]])
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(AvailInfo, [(Name, [FieldLabel])])]
-> ([AvailInfo], [[(Name, [FieldLabel])]])
forall a b. [(a, b)] -> ([a], [b])
unzip (IOEnv
(Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]]))
-> IOEnv
(Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]])
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (TyClDecl GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])]))
-> [GenLocated SrcSpanAnnA (TyClDecl GhcPs)]
-> IOEnv
(Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
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 (DuplicateRecordFields
-> FieldSelectors
-> LTyClDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_tc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel)
([TyClGroup GhcPs] -> [LTyClDecl GhcPs]
forall pass. [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls [TyClGroup GhcPs]
tycl_decls)
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 1" ([AvailInfo] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [AvailInfo]
tc_avails)
; (TcGblEnv, TcLclEnv)
envs <- [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [AvailInfo]
tc_avails MiniFixityEnv
fixity_env
; (TcGblEnv, TcLclEnv)
-> RnM ((TcGblEnv, TcLclEnv), Defs)
-> RnM ((TcGblEnv, TcLclEnv), Defs)
forall a. (TcGblEnv, TcLclEnv) -> TcRn a -> TcRn a
restoreEnvs (TcGblEnv, TcLclEnv)
envs (RnM ((TcGblEnv, TcLclEnv), Defs)
-> RnM ((TcGblEnv, TcLclEnv), Defs))
-> RnM ((TcGblEnv, TcLclEnv), Defs)
-> RnM ((TcGblEnv, TcLclEnv), Defs)
forall a b. (a -> b) -> a -> b
$ do {
; ([[AvailInfo]]
nti_availss, [[(Name, [FieldLabel])]]
nti_fldss) <- (GenLocated SrcSpanAnnA (InstDecl GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])]))
-> [GenLocated SrcSpanAnnA (InstDecl GhcPs)]
-> IOEnv
(Env TcGblEnv TcLclEnv) ([[AvailInfo]], [[(Name, [FieldLabel])]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM (DuplicateRecordFields
-> FieldSelectors
-> LInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
new_assoc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel)
[GenLocated SrcSpanAnnA (InstDecl GhcPs)]
inst_decls
; Bool
is_boot <- TcRnIf TcGblEnv TcLclEnv Bool
tcIsHsBootOrSig
; let val_bndrs :: [GenLocated SrcSpanAnnN RdrName]
val_bndrs
| Bool
is_boot = case HsValBinds GhcPs
binds of
ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
_val_binds [LSig GhcPs]
val_sigs ->
[ SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a ann. SrcSpanAnn' a -> SrcAnn ann
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 GhcPs
_ [LIdP GhcPs]
ns LHsSigWcType GhcPs
_) <- [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
val_sigs, GenLocated SrcSpanAnnN RdrName
n <- [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ns]
HsValBinds GhcPs
_ -> 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
; [AvailInfo]
val_avails <- (GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo)
-> [GenLocated SrcSpanAnnN RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [AvailInfo]
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 GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo
new_simple [GenLocated SrcSpanAnnN RdrName]
val_bndrs
; let avails :: [AvailInfo]
avails = [[AvailInfo]] -> [AvailInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[AvailInfo]]
nti_availss [AvailInfo] -> [AvailInfo] -> [AvailInfo]
forall a. [a] -> [a] -> [a]
++ [AvailInfo]
val_avails
new_bndrs :: Defs
new_bndrs = [AvailInfo] -> Defs
availsToNameSetWithSelectors [AvailInfo]
avails Defs -> Defs -> Defs
`unionNameSet`
[AvailInfo] -> Defs
availsToNameSetWithSelectors [AvailInfo]
tc_avails
flds :: [(Name, [FieldLabel])]
flds = [[(Name, [FieldLabel])]] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
nti_fldss [(Name, [FieldLabel])]
-> [(Name, [FieldLabel])] -> [(Name, [FieldLabel])]
forall a. [a] -> [a] -> [a]
++ [[(Name, [FieldLabel])]] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
tc_fldss
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 2" ([AvailInfo] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [AvailInfo]
avails)
; (TcGblEnv
tcg_env, TcLclEnv
tcl_env) <- [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [AvailInfo]
avails MiniFixityEnv
fixity_env
; let !old_field_env :: NameEnv [FieldLabel]
old_field_env = TcGblEnv -> NameEnv [FieldLabel]
tcg_field_env TcGblEnv
tcg_env
field_env :: NameEnv [FieldLabel]
field_env = NameEnv [FieldLabel]
-> [(Name, [FieldLabel])] -> NameEnv [FieldLabel]
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList NameEnv [FieldLabel]
old_field_env [(Name, [FieldLabel])]
flds
envs :: (TcGblEnv, TcLclEnv)
envs = (TcGblEnv
tcg_env { tcg_field_env = field_env }, TcLclEnv
tcl_env)
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 3" ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [[(Name, [FieldLabel])] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(Name, [FieldLabel])]
flds, NameEnv [FieldLabel] -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameEnv [FieldLabel]
field_env])
; ((TcGblEnv, TcLclEnv), Defs) -> RnM ((TcGblEnv, TcLclEnv), Defs)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((TcGblEnv, TcLclEnv)
envs, Defs
new_bndrs) } }
where
for_hs_bndrs :: [LocatedN RdrName]
for_hs_bndrs :: [GenLocated SrcSpanAnnN RdrName]
for_hs_bndrs = [LForeignDecl GhcPs] -> [LIdP GhcPs]
forall (p :: Pass) a.
(UnXRec (GhcPass p), IsSrcSpanAnn p a) =>
[LForeignDecl (GhcPass p)] -> [LIdP (GhcPass p)]
hsForeignDeclsBinders [LForeignDecl GhcPs]
foreign_decls
new_simple :: LocatedN RdrName -> RnM AvailInfo
new_simple :: GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo
new_simple GenLocated SrcSpanAnnN RdrName
rdr_name = do{ Name
nm <- GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder GenLocated SrcSpanAnnN RdrName
rdr_name
; AvailInfo -> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> AvailInfo
avail Name
nm) }
new_tc :: DuplicateRecordFields -> FieldSelectors -> LTyClDecl GhcPs
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_tc :: DuplicateRecordFields
-> FieldSelectors
-> LTyClDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_tc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel LTyClDecl GhcPs
tc_decl
= do { let ([LocatedA (IdP GhcPs)]
bndrs, [LFieldOcc GhcPs]
flds) = GenLocated SrcSpanAnnA (TyClDecl GhcPs)
-> ([LocatedA (IdP GhcPs)], [LFieldOcc GhcPs])
forall (p :: Pass).
IsPass p =>
LocatedA (TyClDecl (GhcPass p))
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLTyClDeclBinders LTyClDecl GhcPs
GenLocated SrcSpanAnnA (TyClDecl GhcPs)
tc_decl
; names :: [Name]
names@(Name
main_name : [Name]
sub_names) <- (LocatedAn AnnListItem RdrName -> RnM Name)
-> [LocatedAn AnnListItem RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
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 (GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder (GenLocated SrcSpanAnnN RdrName -> RnM Name)
-> (LocatedAn AnnListItem RdrName
-> GenLocated SrcSpanAnnN RdrName)
-> LocatedAn AnnListItem RdrName
-> RnM Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedAn AnnListItem RdrName -> GenLocated SrcSpanAnnN RdrName
forall a1 a2. LocatedAn a1 a2 -> LocatedN a2
l2n) [LocatedA (IdP GhcPs)]
[LocatedAn AnnListItem RdrName]
bndrs
; [FieldLabel]
flds' <- (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel)
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
-> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
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 (DuplicateRecordFields
-> FieldSelectors
-> [Name]
-> LFieldOcc GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
newRecordSelector DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel [Name]
sub_names) [LFieldOcc GhcPs]
[GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
flds
; let fld_env :: [(Name, [FieldLabel])]
fld_env = case GenLocated SrcSpanAnnA (TyClDecl GhcPs) -> TyClDecl GhcPs
forall l e. GenLocated l e -> e
unLoc LTyClDecl GhcPs
GenLocated SrcSpanAnnA (TyClDecl GhcPs)
tc_decl of
DataDecl { tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn GhcPs
d } -> HsDataDefn GhcPs
-> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
mk_fld_env HsDataDefn GhcPs
d [Name]
names [FieldLabel]
flds'
TyClDecl GhcPs
_ -> []
; (AvailInfo, [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
main_name [Name]
names [FieldLabel]
flds', [(Name, [FieldLabel])]
fld_env) }
mk_fld_env :: HsDataDefn GhcPs -> [Name] -> [FieldLabel]
-> [(Name, [FieldLabel])]
mk_fld_env :: HsDataDefn GhcPs
-> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
mk_fld_env HsDataDefn GhcPs
d [Name]
names [FieldLabel]
flds = (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> [(Name, [FieldLabel])])
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
-> [(Name, [FieldLabel])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (ConDecl GhcPs) -> [(Name, [FieldLabel])]
find_con_flds (HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons HsDataDefn GhcPs
d)
where
find_con_flds :: GenLocated SrcSpanAnnA (ConDecl GhcPs) -> [(Name, [FieldLabel])]
find_con_flds (L SrcSpanAnnA
_ (ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = L SrcSpanAnnN
_ RdrName
rdr
, con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = RecCon XRec GhcPs [LConDeclField GhcPs]
cdflds }))
= [( RdrName -> Name
find_con_name RdrName
rdr
, (GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> [FieldLabel])
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> [FieldLabel]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> [FieldLabel]
find_con_decl_flds (GenLocated
(Anno [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LConDeclField GhcPs]
GenLocated
(Anno [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
cdflds) )]
find_con_flds (L SrcSpanAnnA
_ (ConDeclGADT { con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_names = NonEmpty (LIdP GhcPs)
rdrs
, con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = RecConGADT XRec GhcPs [LConDeclField GhcPs]
flds LHsUniToken "->" "\8594" GhcPs
_ }))
= [ ( RdrName -> Name
find_con_name RdrName
rdr
, (GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> [FieldLabel])
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> [FieldLabel]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> [FieldLabel]
find_con_decl_flds (GenLocated
(Anno [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LConDeclField GhcPs]
GenLocated
(Anno [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds))
| L SrcSpanAnnN
_ RdrName
rdr <- NonEmpty (GenLocated SrcSpanAnnN RdrName)
-> [GenLocated SrcSpanAnnN RdrName]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (LIdP GhcPs)
NonEmpty (GenLocated SrcSpanAnnN RdrName)
rdrs ]
find_con_flds GenLocated SrcSpanAnnA (ConDecl GhcPs)
_ = []
find_con_name :: RdrName -> Name
find_con_name RdrName
rdr
= String -> Maybe Name -> Name
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"getLocalNonValBinders/find_con_name" (Maybe Name -> Name) -> Maybe Name -> Name
forall a b. (a -> b) -> a -> b
$
(Name -> Bool) -> [Name] -> Maybe Name
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ Name
n -> Name -> OccName
nameOccName Name
n OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> OccName
rdrNameOcc RdrName
rdr) [Name]
names
find_con_decl_flds :: GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> [FieldLabel]
find_con_decl_flds (L SrcSpanAnnA
_ ConDeclField GhcPs
x)
= (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> FieldLabel)
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)] -> [FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> FieldLabel
find_con_decl_fld (ConDeclField GhcPs -> [LFieldOcc GhcPs]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names ConDeclField GhcPs
x)
find_con_decl_fld :: GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> FieldLabel
find_con_decl_fld (L SrcAnn NoEpAnns
_ (FieldOcc XCFieldOcc GhcPs
_ (L SrcSpanAnnN
_ RdrName
rdr)))
= String -> Maybe FieldLabel -> FieldLabel
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"getLocalNonValBinders/find_con_decl_fld" (Maybe FieldLabel -> FieldLabel) -> Maybe FieldLabel -> FieldLabel
forall a b. (a -> b) -> a -> b
$
(FieldLabel -> Bool) -> [FieldLabel] -> Maybe FieldLabel
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ FieldLabel
fl -> FieldLabel -> FieldLabelString
flLabel FieldLabel
fl FieldLabelString -> FieldLabelString -> Bool
forall a. Eq a => a -> a -> Bool
== FieldLabelString
lbl) [FieldLabel]
flds
where lbl :: FieldLabelString
lbl = FastString -> FieldLabelString
FieldLabelString (FastString -> FieldLabelString) -> FastString -> FieldLabelString
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdr)
new_assoc :: DuplicateRecordFields -> FieldSelectors -> LInstDecl GhcPs
-> RnM ([AvailInfo], [(Name, [FieldLabel])])
new_assoc :: DuplicateRecordFields
-> FieldSelectors
-> LInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
new_assoc DuplicateRecordFields
_ FieldSelectors
_ (L SrcSpanAnnA
_ (TyFamInstD {})) = ([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
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 GhcPs
_ DataFamInstDecl GhcPs
d))
= do { (AvailInfo
avail, [(Name, [FieldLabel])]
flds) <- DuplicateRecordFields
-> FieldSelectors
-> Maybe Name
-> DataFamInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_di DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel Maybe Name
forall a. Maybe a
Nothing DataFamInstDecl GhcPs
d
; ([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AvailInfo
avail], [(Name, [FieldLabel])]
flds) }
new_assoc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel (L SrcSpanAnnA
_ (ClsInstD XClsInstD GhcPs
_ (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = LHsSigType GhcPs
inst_ty
, cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts = [LDataFamInstDecl GhcPs]
adts })))
= do
Maybe Name
mb_cls_nm <- MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name))
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall a b. (a -> b) -> a -> b
$ do
L SrcSpanAnnN
loc RdrName
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 GhcPs -> Maybe (LocatedN (IdP GhcPs))
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsSigType (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
getLHsInstDeclClass_maybe LHsSigType GhcPs
inst_ty
IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) (IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name))
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall a b. (a -> b) -> a -> b
$ RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
lookupGlobalOccRn_maybe RdrName
cls_rdr
case Maybe Name
mb_cls_nm of
Maybe Name
Nothing -> ([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
Just Name
cls_nm -> do
([AvailInfo]
avails, [[(Name, [FieldLabel])]]
fldss)
<- (GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])]))
-> [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM (DuplicateRecordFields
-> FieldSelectors
-> Maybe Name
-> LDataFamInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_loc_di DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
cls_nm)) [LDataFamInstDecl GhcPs]
[GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
adts
([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([AvailInfo]
avails, [[(Name, [FieldLabel])]] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
fldss)
new_di :: DuplicateRecordFields -> FieldSelectors -> Maybe Name -> DataFamInstDecl GhcPs
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_di :: DuplicateRecordFields
-> FieldSelectors
-> Maybe Name
-> DataFamInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_di DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel Maybe Name
mb_cls dfid :: DataFamInstDecl GhcPs
dfid@(DataFamInstDecl { dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
dfid_eqn = FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl })
= do { GenLocated SrcSpanAnnN Name
main_name <- Maybe Name
-> GenLocated SrcSpanAnnN RdrName
-> RnM (GenLocated SrcSpanAnnN Name)
lookupFamInstName Maybe Name
mb_cls (FamEqn GhcPs (HsDataDefn GhcPs) -> LIdP GhcPs
forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl)
; let ([LocatedA (IdP GhcPs)]
bndrs, [LFieldOcc GhcPs]
flds) = DataFamInstDecl GhcPs
-> ([LocatedA (IdP GhcPs)], [LFieldOcc GhcPs])
forall (p :: Pass).
IsPass p =>
DataFamInstDecl (GhcPass p)
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataFamInstBinders DataFamInstDecl GhcPs
dfid
; [Name]
sub_names <- (LocatedAn AnnListItem RdrName -> RnM Name)
-> [LocatedAn AnnListItem RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
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 (GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder (GenLocated SrcSpanAnnN RdrName -> RnM Name)
-> (LocatedAn AnnListItem RdrName
-> GenLocated SrcSpanAnnN RdrName)
-> LocatedAn AnnListItem RdrName
-> RnM Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LocatedAn AnnListItem RdrName -> GenLocated SrcSpanAnnN RdrName
forall a1 a2. LocatedAn a1 a2 -> LocatedN a2
l2n) [LocatedA (IdP GhcPs)]
[LocatedAn AnnListItem RdrName]
bndrs
; [FieldLabel]
flds' <- (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel)
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
-> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
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 (DuplicateRecordFields
-> FieldSelectors
-> [Name]
-> LFieldOcc GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
newRecordSelector DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel [Name]
sub_names) [LFieldOcc GhcPs]
[GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
flds
; let avail :: AvailInfo
avail = Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN Name
main_name) [Name]
sub_names [FieldLabel]
flds'
fld_env :: [(Name, [FieldLabel])]
fld_env = HsDataDefn GhcPs
-> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
mk_fld_env (FamEqn GhcPs (HsDataDefn GhcPs) -> HsDataDefn GhcPs
forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl) [Name]
sub_names [FieldLabel]
flds'
; (AvailInfo, [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (AvailInfo
avail, [(Name, [FieldLabel])]
fld_env) }
new_loc_di :: DuplicateRecordFields -> FieldSelectors -> Maybe Name -> LDataFamInstDecl GhcPs
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_loc_di :: DuplicateRecordFields
-> FieldSelectors
-> Maybe Name
-> LDataFamInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_loc_di DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel Maybe Name
mb_cls (L SrcSpanAnnA
_ DataFamInstDecl GhcPs
d) = DuplicateRecordFields
-> FieldSelectors
-> Maybe Name
-> DataFamInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_di DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel Maybe Name
mb_cls DataFamInstDecl GhcPs
d
newRecordSelector :: DuplicateRecordFields -> FieldSelectors -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel
newRecordSelector :: DuplicateRecordFields
-> FieldSelectors
-> [Name]
-> LFieldOcc GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
newRecordSelector DuplicateRecordFields
_ FieldSelectors
_ [] LFieldOcc GhcPs
_ = String -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall a. HasCallStack => String -> a
error String
"newRecordSelector: datatype has no constructors!"
newRecordSelector DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel (Name
dc:[Name]
_) (L SrcAnn NoEpAnns
loc (FieldOcc XCFieldOcc GhcPs
_ (L SrcSpanAnnN
_ RdrName
fld)))
= do { Name
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 (SrcAnn NoEpAnns -> SrcSpanAnnN
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcAnn NoEpAnns
loc) (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. (a -> b) -> a -> b
$ RdrName
field
; FieldLabel -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel)
-> FieldLabel -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall a b. (a -> b) -> a -> b
$ FieldLabel { flLabel :: FieldLabelString
flLabel = FieldLabelString
fieldLabelString
, flHasDuplicateRecordFields :: DuplicateRecordFields
flHasDuplicateRecordFields = DuplicateRecordFields
dup_fields_ok
, flHasFieldSelector :: FieldSelectors
flHasFieldSelector = FieldSelectors
has_sel
, flSelector :: Name
flSelector = Name
selName } }
where
fieldLabelString :: FieldLabelString
fieldLabelString = FastString -> FieldLabelString
FieldLabelString (FastString -> FieldLabelString) -> FastString -> FieldLabelString
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
fld
selOccName :: OccName
selOccName = FieldLabelString
-> OccName -> DuplicateRecordFields -> FieldSelectors -> OccName
fieldSelectorOccName FieldLabelString
fieldLabelString (Name -> OccName
nameOccName Name
dc) DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel
field :: RdrName
field | RdrName -> Bool
isExact RdrName
fld = RdrName
fld
| Bool
otherwise = OccName -> RdrName
mkRdrUnqual OccName
selOccName
filterImports
:: ModIface
-> ImpDeclSpec
-> Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])
-> RnM (Maybe (ImportListInterpretation, LocatedL [LIE GhcRn]),
[GlobalRdrElt])
filterImports :: ModIface
-> ImpDeclSpec
-> Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])
-> RnM
(Maybe (ImportListInterpretation, LocatedL [LIE GhcRn]),
[GlobalRdrElt])
filterImports ModIface
iface ImpDeclSpec
decl_spec Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])
Nothing
= (Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)]),
[GlobalRdrElt])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)]),
[GlobalRdrElt])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)])
forall a. Maybe a
Nothing, Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just ImportSpec
imp_spec) (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface))
where
imp_spec :: ImportSpec
imp_spec = ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }
filterImports ModIface
iface ImpDeclSpec
decl_spec (Just (ImportListInterpretation
want_hiding, L SrcSpanAnnL
l [LIE GhcPs]
import_items))
= do
[[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]]
items1 <- (GenLocated SrcSpanAnnA (IE GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]]
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 GhcPs -> TcRn [(LIE GhcRn, AvailInfo)]
GenLocated SrcSpanAnnA (IE GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]
lookup_lie [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
import_items
let items2 :: [(LIE GhcRn, AvailInfo)]
items2 :: [(LIE GhcRn, AvailInfo)]
items2 = [[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]]
-> [(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]]
items1
names :: Defs
names = [AvailInfo] -> Defs
availsToNameSetWithSelectors (((GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo) -> AvailInfo)
-> [(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)] -> [AvailInfo]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo) -> AvailInfo
forall a b. (a, b) -> b
snd [(LIE GhcRn, AvailInfo)]
[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]
items2)
keep :: Name -> Bool
keep Name
n = Bool -> Bool
not (Name
n Name -> Defs -> Bool
`elemNameSet` Defs
names)
pruned_avails :: [AvailInfo]
pruned_avails = (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
filterAvails Name -> Bool
keep [AvailInfo]
all_avails
hiding_spec :: ImportSpec
hiding_spec = ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }
gres :: [GlobalRdrElt]
gres | ImportListInterpretation
want_hiding ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut = Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just ImportSpec
hiding_spec) [AvailInfo]
pruned_avails
| Bool
otherwise = ((GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo) -> [GlobalRdrElt])
-> [(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]
-> [GlobalRdrElt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
gresFromIE ImpDeclSpec
decl_spec) [(LIE GhcRn, AvailInfo)]
[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]
items2
(Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)]),
[GlobalRdrElt])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)]),
[GlobalRdrElt])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)])
-> Maybe
(ImportListInterpretation,
LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)])
forall a. a -> Maybe a
Just (ImportListInterpretation
want_hiding, SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (IE GhcRn)]
-> LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l (((GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)
-> GenLocated SrcSpanAnnA (IE GhcRn))
-> [(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]
-> [GenLocated SrcSpanAnnA (IE GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)
-> GenLocated SrcSpanAnnA (IE GhcRn)
forall a b. (a, b) -> a
fst [(LIE GhcRn, AvailInfo)]
[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]
items2)), [GlobalRdrElt]
gres)
where
all_avails :: [AvailInfo]
all_avails = ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
imp_occ_env :: OccEnv (NameEnv (GreName,
AvailInfo,
Maybe Name))
imp_occ_env :: OccEnv (NameEnv (GreName, AvailInfo, Maybe Name))
imp_occ_env = (NameEnv (GreName, AvailInfo, Maybe Name)
-> NameEnv (GreName, AvailInfo, Maybe Name)
-> NameEnv (GreName, AvailInfo, Maybe Name))
-> [(OccName, NameEnv (GreName, AvailInfo, Maybe Name))]
-> OccEnv (NameEnv (GreName, AvailInfo, Maybe Name))
forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C (((GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name))
-> NameEnv (GreName, AvailInfo, Maybe Name)
-> NameEnv (GreName, AvailInfo, Maybe Name)
-> NameEnv (GreName, AvailInfo, Maybe Name)
forall a. (a -> a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
combine)
[ (GreName -> OccName
forall name. HasOccName name => name -> OccName
occName GreName
c, [(Name, (GreName, AvailInfo, Maybe Name))]
-> NameEnv (GreName, AvailInfo, Maybe Name)
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(GreName -> Name
greNameMangledName GreName
c, (GreName
c, AvailInfo
a, Maybe Name
forall a. Maybe a
Nothing))])
| AvailInfo
a <- [AvailInfo]
all_avails
, GreName
c <- AvailInfo -> [GreName]
availGreNames AvailInfo
a]
combine :: (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
combine :: (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
combine (NormalGreName Name
name1, a1 :: AvailInfo
a1@(AvailTC Name
p1 [GreName]
_), Maybe Name
mb1)
(NormalGreName Name
name2, a2 :: AvailInfo
a2@(AvailTC Name
p2 [GreName]
_), Maybe Name
mb2)
= Bool
-> SDoc
-> (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name
name1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name2 Bool -> Bool -> Bool
&& Maybe Name -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Name
mb1 Bool -> Bool -> Bool
&& Maybe Name -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Name
mb2)
(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 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Name
mb1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Name
mb2) ((GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name))
-> (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
forall a b. (a -> b) -> a -> b
$
if Name
p1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name1 then (Name -> GreName
NormalGreName Name
name1, AvailInfo
a1, Name -> Maybe Name
forall a. a -> Maybe a
Just Name
p2)
else (Name -> GreName
NormalGreName Name
name1, AvailInfo
a2, Name -> Maybe Name
forall a. a -> Maybe a
Just Name
p1)
combine (GreName
c1, AvailInfo
a1, Maybe Name
mb1) (GreName
c2, AvailInfo
a2, Maybe Name
mb2)
= Bool
-> SDoc
-> (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (GreName
c1 GreName -> GreName -> Bool
forall a. Eq a => a -> a -> Bool
== GreName
c2 Bool -> Bool -> Bool
&& Maybe Name -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Name
mb1 Bool -> Bool -> Bool
&& Maybe Name -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Name
mb2
Bool -> Bool -> Bool
&& (AvailInfo -> Bool
isAvailTC AvailInfo
a1 Bool -> Bool -> Bool
|| AvailInfo -> Bool
isAvailTC AvailInfo
a2))
(GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
c1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
c2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
a1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
a2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Name
mb1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Name
mb2) ((GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name))
-> (GreName, AvailInfo, Maybe Name)
-> (GreName, AvailInfo, Maybe Name)
forall a b. (a -> b) -> a -> b
$
if AvailInfo -> Bool
isAvailTC AvailInfo
a1 then (GreName
c1, AvailInfo
a1, Maybe Name
forall a. Maybe a
Nothing)
else (GreName
c1, AvailInfo
a2, Maybe Name
forall a. Maybe a
Nothing)
isAvailTC :: AvailInfo -> Bool
isAvailTC AvailTC{} = Bool
True
isAvailTC AvailInfo
_ = Bool
False
lookup_name :: IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name :: IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie RdrName
rdr = do
[(Name, AvailInfo, Maybe Name)]
xs <- IE GhcPs -> RdrName -> IELookupM [(Name, AvailInfo, Maybe Name)]
lookup_names IE GhcPs
ie RdrName
rdr
case [(Name, AvailInfo, Maybe Name)]
xs of
[(Name, AvailInfo, Maybe Name)
cax] -> (Name, AvailInfo, Maybe Name)
-> IELookupM (Name, AvailInfo, Maybe Name)
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name, AvailInfo, Maybe Name)
cax
[(Name, AvailInfo, Maybe Name)]
_ -> IELookupError -> IELookupM (Name, AvailInfo, Maybe Name)
forall a. IELookupError -> IELookupM a
failLookupWith (RdrName -> [AvailInfo] -> IELookupError
AmbiguousImport RdrName
rdr (((Name, AvailInfo, Maybe Name) -> AvailInfo)
-> [(Name, AvailInfo, Maybe Name)] -> [AvailInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Name, AvailInfo, Maybe Name) -> AvailInfo
forall a b c. (a, b, c) -> b
sndOf3 [(Name, AvailInfo, Maybe Name)]
xs))
lookup_names :: IE GhcPs -> RdrName -> IELookupM [(Name, AvailInfo, Maybe Name)]
lookup_names :: IE GhcPs -> RdrName -> IELookupM [(Name, AvailInfo, Maybe Name)]
lookup_names IE GhcPs
ie RdrName
rdr
| RdrName -> Bool
isQual RdrName
rdr = IELookupError -> IELookupM [(Name, AvailInfo, Maybe Name)]
forall a. IELookupError -> IELookupM a
failLookupWith (RdrName -> IELookupError
QualImportError RdrName
rdr)
| Just NameEnv (GreName, AvailInfo, Maybe Name)
succ <- Maybe (NameEnv (GreName, AvailInfo, Maybe Name))
mb_success = [(Name, AvailInfo, Maybe Name)]
-> IELookupM [(Name, AvailInfo, Maybe Name)]
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, AvailInfo, Maybe Name)]
-> IELookupM [(Name, AvailInfo, Maybe Name)])
-> [(Name, AvailInfo, Maybe Name)]
-> IELookupM [(Name, AvailInfo, Maybe Name)]
forall a b. (a -> b) -> a -> b
$ ((GreName, AvailInfo, Maybe Name) -> (Name, AvailInfo, Maybe Name))
-> [(GreName, AvailInfo, Maybe Name)]
-> [(Name, AvailInfo, Maybe Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (GreName
c,AvailInfo
a,Maybe Name
x) -> (GreName -> Name
greNameMangledName GreName
c, AvailInfo
a, Maybe Name
x)) (NameEnv (GreName, AvailInfo, Maybe Name)
-> [(GreName, AvailInfo, Maybe Name)]
forall a. NameEnv a -> [a]
nonDetNameEnvElts NameEnv (GreName, AvailInfo, Maybe Name)
succ)
| Bool
otherwise = IELookupError -> IELookupM [(Name, AvailInfo, Maybe Name)]
forall a. IELookupError -> IELookupM a
failLookupWith (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie)
where
mb_success :: Maybe (NameEnv (GreName, AvailInfo, Maybe Name))
mb_success = OccEnv (NameEnv (GreName, AvailInfo, Maybe Name))
-> OccName -> Maybe (NameEnv (GreName, AvailInfo, Maybe Name))
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (NameEnv (GreName, AvailInfo, Maybe Name))
imp_occ_env (RdrName -> OccName
rdrNameOcc RdrName
rdr)
lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, AvailInfo)]
lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, AvailInfo)]
lookup_lie (L SrcSpanAnnA
loc IE GhcPs
ieRdr)
= do ([(IE GhcRn, AvailInfo)]
stuff, [IELookupWarning]
warns) <- SrcSpanAnnA
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc (TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
(Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> Maybe a -> a
fromMaybe ([],[])) (IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
forall a. IELookupM a -> TcRn (Maybe a)
run_lookup (IE GhcPs -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
lookup_ie IE GhcPs
ieRdr)
(IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [IELookupWarning] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) ()
emit_warning [IELookupWarning]
warns
[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ (SrcSpanAnnA -> IE GhcRn -> GenLocated SrcSpanAnnA (IE GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc IE GhcRn
ie, AvailInfo
avail) | (IE GhcRn
ie,AvailInfo
avail) <- [(IE GhcRn, AvailInfo)]
stuff ]
where
emit_warning :: IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) ()
emit_warning (DodgyImport RdrName
n) = WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnDodgyImports (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addTcRnDiagnostic (RdrName -> TcRnMessage
TcRnDodgyImports RdrName
n)
emit_warning IELookupWarning
MissingImportList = WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnMissingImportList (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addTcRnDiagnostic (IE GhcPs -> TcRnMessage
TcRnMissingImportList IE GhcPs
ieRdr)
emit_warning (BadImportW IE GhcPs
ie) = WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnDodgyImports (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ do
let msg :: TcRnMessage
msg = DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDodgyImports)
[GhcHint]
noHints
(IELookupError -> SDoc
lookup_err_msg (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie))
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic TcRnMessage
msg
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
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (IELookupError -> SDoc
lookup_err_msg IELookupError
err)
Maybe a -> TcRn (Maybe a)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
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 -> SDoc
lookup_err_msg IELookupError
err = case IELookupError
err of
BadImport IE GhcPs
ie -> ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> SDoc
badImportItemErr ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie [AvailInfo]
all_avails
IELookupError
IllegalImport -> SDoc
illegalImportItemErr
QualImportError RdrName
rdr -> RdrName -> SDoc
qualImportItemErr RdrName
rdr
AmbiguousImport RdrName
rdr [AvailInfo]
xs -> RdrName -> [AvailInfo] -> SDoc
ambiguousImportItemErr RdrName
rdr [AvailInfo]
xs
lookup_ie :: IE GhcPs
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
lookup_ie :: IE GhcPs -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
lookup_ie IE GhcPs
ie = IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
handle_bad_import (IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
case IE GhcPs
ie of
IEVar XIEVar GhcPs
_ (L SrcSpanAnnA
l IEWrappedName GhcPs
n) -> do
[(Name, AvailInfo, Maybe Name)]
xs <- IE GhcPs -> RdrName -> IELookupM [(Name, AvailInfo, Maybe Name)]
lookup_names IE GhcPs
ie (IEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName GhcPs
n)
([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(XIEVar GhcRn -> LIEWrappedName GhcRn -> IE GhcRn
forall pass. XIEVar pass -> LIEWrappedName pass -> IE pass
IEVar XIEVar GhcRn
NoExtField
noExtField (SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName GhcPs -> IdP GhcRn -> IEWrappedName GhcRn
replaceWrappedName IEWrappedName GhcPs
n IdP GhcRn
Name
name)),
AvailInfo -> Name -> AvailInfo
trimAvail AvailInfo
avail Name
name)
| (Name
name, AvailInfo
avail, Maybe Name
_) <- [(Name, AvailInfo, Maybe Name)]
xs ], [])
IEThingAll XIEThingAll GhcPs
_ (L SrcSpanAnnA
l IEWrappedName GhcPs
tc) -> do
(Name
name, AvailInfo
avail, Maybe Name
mb_parent) <- IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie (RdrName -> IELookupM (Name, AvailInfo, Maybe Name))
-> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
forall a b. (a -> b) -> a -> b
$ IEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName GhcPs
tc
let warns :: [IELookupWarning]
warns = case AvailInfo
avail of
Avail {}
-> [RdrName -> IELookupWarning
DodgyImport (RdrName -> IELookupWarning) -> RdrName -> IELookupWarning
forall a b. (a -> b) -> a -> b
$ IEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName GhcPs
tc]
AvailTC Name
_ [GreName]
subs
| [GreName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Int -> [GreName] -> [GreName]
forall a. Int -> [a] -> [a]
drop Int
1 [GreName]
subs)
-> [RdrName -> IELookupWarning
DodgyImport (RdrName -> IELookupWarning) -> RdrName -> IELookupWarning
forall a b. (a -> b) -> a -> b
$ IEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName GhcPs
tc]
| Bool -> Bool
not (ImpDeclSpec -> Bool
is_qual ImpDeclSpec
decl_spec)
-> [IELookupWarning
MissingImportList]
| Bool
otherwise
-> []
renamed_ie :: IE GhcRn
renamed_ie = XIEThingAll GhcRn -> LIEWrappedName GhcRn -> IE GhcRn
forall pass. XIEThingAll pass -> LIEWrappedName pass -> IE pass
IEThingAll XIEThingAll GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName GhcPs -> IdP GhcRn -> IEWrappedName GhcRn
replaceWrappedName IEWrappedName GhcPs
tc IdP GhcRn
Name
name))
sub_avails :: [(IE GhcRn, AvailInfo)]
sub_avails = case AvailInfo
avail of
Avail {} -> []
AvailTC Name
name2 [GreName]
subs -> [(IE GhcRn
renamed_ie, Name -> [GreName] -> AvailInfo
AvailTC Name
name2 ([GreName]
subs [GreName] -> [GreName] -> [GreName]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name -> GreName
NormalGreName Name
name]))]
case Maybe Name
mb_parent of
Maybe Name
Nothing -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(IE GhcRn
renamed_ie, AvailInfo
avail)], [IELookupWarning]
warns)
Just Name
parent -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IE GhcRn
renamed_ie, Name -> [GreName] -> AvailInfo
AvailTC Name
parent [Name -> GreName
NormalGreName Name
name]) (IE GhcRn, AvailInfo)
-> [(IE GhcRn, AvailInfo)] -> [(IE GhcRn, AvailInfo)]
forall a. a -> [a] -> [a]
: [(IE GhcRn, AvailInfo)]
sub_avails, [IELookupWarning]
warns)
IEThingAbs XIEThingAbs GhcPs
_ (L SrcSpanAnnA
l IEWrappedName GhcPs
tc')
| ImportListInterpretation
want_hiding ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut
-> let tc :: IdP GhcPs
tc = IEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName GhcPs
tc'
tc_name :: IELookupM (Name, AvailInfo, Maybe Name)
tc_name = IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie IdP GhcPs
RdrName
tc
dc_name :: IELookupM (Name, AvailInfo, Maybe Name)
dc_name = IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie (RdrName -> NameSpace -> RdrName
setRdrNameSpace IdP GhcPs
RdrName
tc NameSpace
srcDataName)
in
case [IELookupM (Name, AvailInfo, Maybe Name)]
-> [(Name, AvailInfo, Maybe Name)]
forall a. [IELookupM a] -> [a]
catIELookupM [ IELookupM (Name, AvailInfo, Maybe Name)
tc_name, IELookupM (Name, AvailInfo, Maybe Name)
dc_name ] of
[] -> IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie)
[(Name, AvailInfo, Maybe Name)]
names -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([IEWrappedName GhcPs
-> SrcSpanAnnA
-> (Name, AvailInfo, Maybe Name)
-> (IE GhcRn, AvailInfo)
mkIEThingAbs IEWrappedName GhcPs
tc' SrcSpanAnnA
l (Name, AvailInfo, Maybe Name)
name | (Name, AvailInfo, Maybe Name)
name <- [(Name, AvailInfo, Maybe Name)]
names], [])
| Bool
otherwise
-> do (Name, AvailInfo, Maybe Name)
nameAvail <- IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie (IEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName GhcPs
tc')
([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([IEWrappedName GhcPs
-> SrcSpanAnnA
-> (Name, AvailInfo, Maybe Name)
-> (IE GhcRn, AvailInfo)
mkIEThingAbs IEWrappedName GhcPs
tc' SrcSpanAnnA
l (Name, AvailInfo, Maybe Name)
nameAvail]
, [])
IEThingWith XIEThingWith GhcPs
xt ltc :: LIEWrappedName GhcPs
ltc@(L SrcSpanAnnA
l IEWrappedName GhcPs
rdr_tc) IEWildcard
wc [LIEWrappedName GhcPs]
rdr_ns -> do
(Name
name, AvailInfo
avail, Maybe Name
mb_parent)
<- IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name (XIEThingAbs GhcPs -> LIEWrappedName GhcPs -> IE GhcPs
forall pass. XIEThingAbs pass -> LIEWrappedName pass -> IE pass
IEThingAbs XIEThingAbs GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIEWrappedName GhcPs
ltc) (IEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName GhcPs
rdr_tc)
let subnames :: [GreName]
subnames = AvailInfo -> [GreName]
availSubordinateGreNames AvailInfo
avail
case [GreName]
-> [LIEWrappedName GhcPs]
-> MaybeErr
[LIEWrappedName GhcPs] ([LocatedA Name], [Located FieldLabel])
lookupChildren [GreName]
subnames [LIEWrappedName GhcPs]
rdr_ns of
Failed [LIEWrappedName GhcPs]
rdrs -> IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith (IE GhcPs -> IELookupError
BadImport (XIEThingWith GhcPs
-> LIEWrappedName GhcPs
-> IEWildcard
-> [LIEWrappedName GhcPs]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
IEThingWith XIEThingWith GhcPs
xt LIEWrappedName GhcPs
ltc IEWildcard
wc [LIEWrappedName GhcPs]
rdrs))
Succeeded ([LocatedA Name]
childnames, [Located FieldLabel]
childflds) ->
case Maybe Name
mb_parent of
Maybe Name
Nothing
-> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(XIEThingWith GhcRn
-> LIEWrappedName GhcRn
-> IEWildcard
-> [LIEWrappedName GhcRn]
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
IEThingWith [Located FieldLabel]
XIEThingWith GhcRn
childflds (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',
Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
name (Name
nameName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:(LocatedA Name -> Name) -> [LocatedA Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA Name -> Name
forall l e. GenLocated l e -> e
unLoc [LocatedA Name]
childnames) ((Located FieldLabel -> FieldLabel)
-> [Located FieldLabel] -> [FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map Located FieldLabel -> FieldLabel
forall l e. GenLocated l e -> e
unLoc [Located FieldLabel]
childflds))],
[])
where name' :: IEWrappedName GhcRn
name' = IEWrappedName GhcPs -> IdP GhcRn -> IEWrappedName GhcRn
replaceWrappedName IEWrappedName GhcPs
rdr_tc IdP GhcRn
Name
name
childnames' :: [GenLocated SrcSpanAnnA (IEWrappedName GhcRn)]
childnames' = (LocatedA Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> [LocatedA Name]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
LocatedA Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
to_ie_post_rn [LocatedA Name]
childnames
Just Name
parent
-> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(XIEThingWith GhcRn
-> LIEWrappedName GhcRn
-> IEWildcard
-> [LIEWrappedName GhcRn]
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
IEThingWith [Located FieldLabel]
XIEThingWith GhcRn
childflds (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',
Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
name ((LocatedA Name -> Name) -> [LocatedA Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA Name -> Name
forall l e. GenLocated l e -> e
unLoc [LocatedA Name]
childnames) ((Located FieldLabel -> FieldLabel)
-> [Located FieldLabel] -> [FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map Located FieldLabel -> FieldLabel
forall l e. GenLocated l e -> e
unLoc [Located FieldLabel]
childflds)),
(XIEThingWith GhcRn
-> LIEWrappedName GhcRn
-> IEWildcard
-> [LIEWrappedName GhcRn]
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
IEThingWith [Located FieldLabel]
XIEThingWith GhcRn
childflds (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',
Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
parent [Name
name] [])],
[])
where name' :: IEWrappedName GhcRn
name' = IEWrappedName GhcPs -> IdP GhcRn -> IEWrappedName GhcRn
replaceWrappedName IEWrappedName GhcPs
rdr_tc IdP GhcRn
Name
name
childnames' :: [GenLocated SrcSpanAnnA (IEWrappedName GhcRn)]
childnames' = (LocatedA Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> [LocatedA Name]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
LocatedA Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
to_ie_post_rn [LocatedA Name]
childnames
IE GhcPs
_other -> IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
IllegalImport
where
mkIEThingAbs :: IEWrappedName GhcPs
-> SrcSpanAnnA
-> (Name, AvailInfo, Maybe Name)
-> (IE GhcRn, AvailInfo)
mkIEThingAbs IEWrappedName GhcPs
tc SrcSpanAnnA
l (Name
n, AvailInfo
av, Maybe Name
Nothing )
= (XIEThingAbs GhcRn -> LIEWrappedName GhcRn -> IE GhcRn
forall pass. XIEThingAbs pass -> LIEWrappedName pass -> IE pass
IEThingAbs XIEThingAbs GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName GhcPs -> IdP GhcRn -> IEWrappedName GhcRn
replaceWrappedName IEWrappedName GhcPs
tc IdP GhcRn
Name
n)), AvailInfo -> Name -> AvailInfo
trimAvail AvailInfo
av Name
n)
mkIEThingAbs IEWrappedName GhcPs
tc SrcSpanAnnA
l (Name
n, AvailInfo
_, Just Name
parent)
= (XIEThingAbs GhcRn -> LIEWrappedName GhcRn -> IE GhcRn
forall pass. XIEThingAbs pass -> LIEWrappedName pass -> IE pass
IEThingAbs XIEThingAbs GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (SrcSpanAnnA
-> IEWrappedName GhcRn
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName GhcPs -> IdP GhcRn -> IEWrappedName GhcRn
replaceWrappedName IEWrappedName GhcPs
tc IdP GhcRn
Name
n))
, Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
parent [Name
n] [])
handle_bad_import :: IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
handle_bad_import IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
m = IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> (IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a.
IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
m ((IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> (IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$ \IELookupError
err -> case IELookupError
err of
BadImport IE GhcPs
ie | ImportListInterpretation
want_hiding ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> MaybeErr IELookupError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [IE GhcPs -> IELookupWarning
BadImportW IE GhcPs
ie])
IELookupError
_ -> IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
err
type IELookupM = MaybeErr IELookupError
data IELookupWarning
= BadImportW (IE GhcPs)
| MissingImportList
| DodgyImport RdrName
data IELookupError
= QualImportError RdrName
| BadImport (IE GhcPs)
| IllegalImport
| AmbiguousImport RdrName [AvailInfo]
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 ]
gresFromIE :: ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
gresFromIE :: ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
gresFromIE ImpDeclSpec
decl_spec (L SrcSpanAnnA
loc IE GhcRn
ie, AvailInfo
avail)
= (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail Name -> Maybe ImportSpec
prov_fn AvailInfo
avail
where
is_explicit :: Name -> Bool
is_explicit = case IE GhcRn
ie of
IEThingAll XIEThingAll GhcRn
_ LIEWrappedName GhcRn
name -> \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 -> Maybe ImportSpec
prov_fn Name
name
= ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just (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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc }
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]
add NameEnv [GlobalRdrElt]
forall a. NameEnv a
emptyNameEnv [GlobalRdrElt]
gres
where
add :: GlobalRdrElt -> NameEnv [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
add GlobalRdrElt
gre NameEnv [GlobalRdrElt]
env = case GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre of
ParentIs Name
p -> (GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt])
-> (GlobalRdrElt -> [GlobalRdrElt])
-> NameEnv [GlobalRdrElt]
-> Name
-> GlobalRdrElt
-> NameEnv [GlobalRdrElt]
forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc (:) GlobalRdrElt -> [GlobalRdrElt]
forall a. a -> [a]
Utils.singleton NameEnv [GlobalRdrElt]
env Name
p GlobalRdrElt
gre
Parent
NoParent -> NameEnv [GlobalRdrElt]
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 :: [GreName] -> [LIEWrappedName GhcPs]
-> MaybeErr [LIEWrappedName GhcPs]
([LocatedA Name], [Located FieldLabel])
lookupChildren :: [GreName]
-> [LIEWrappedName GhcPs]
-> MaybeErr
[LIEWrappedName GhcPs] ([LocatedA Name], [Located FieldLabel])
lookupChildren [GreName]
all_kids [LIEWrappedName GhcPs]
rdr_items
| [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
fails
= ([LocatedA Name], [Located FieldLabel])
-> MaybeErr
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
([LocatedA Name], [Located FieldLabel])
forall err val. val -> MaybeErr err val
Succeeded (([[Located FieldLabel]] -> [Located FieldLabel])
-> ([LocatedA Name], [[Located FieldLabel]])
-> ([LocatedA Name], [Located FieldLabel])
forall a b.
(a -> b) -> ([LocatedA Name], a) -> ([LocatedA Name], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Located FieldLabel]] -> [Located FieldLabel]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Either (LocatedA Name) [Located FieldLabel]]
-> ([LocatedA Name], [[Located FieldLabel]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (LocatedA Name) [Located FieldLabel]]
oks))
| Bool
otherwise
= [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> MaybeErr
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
([LocatedA Name], [Located FieldLabel])
forall err val. err -> MaybeErr err val
Failed [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
fails
where
mb_xs :: [MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
(Either (LocatedA Name) [Located FieldLabel])]
mb_xs = (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
(Either (LocatedA Name) [Located FieldLabel]))
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> [MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
(Either (LocatedA Name) [Located FieldLabel])]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
(Either (LocatedA Name) [Located FieldLabel])
doOne [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
rdr_items
fails :: [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
fails = [ GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
bad_rdr | Failed GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
bad_rdr <- [MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
(Either (LocatedA Name) [Located FieldLabel])]
mb_xs ]
oks :: [Either (LocatedA Name) [Located FieldLabel]]
oks = [ Either (LocatedA Name) [Located FieldLabel]
ok | Succeeded Either (LocatedA Name) [Located FieldLabel]
ok <- [MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
(Either (LocatedA Name) [Located FieldLabel])]
mb_xs ]
oks :: [Either (LocatedA Name) [Located FieldLabel]]
doOne :: GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
(Either (LocatedA Name) [Located FieldLabel])
doOne item :: GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
item@(L SrcSpanAnnA
l IEWrappedName GhcPs
r)
= case (FastStringEnv [GreName] -> FastString -> Maybe [GreName]
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv [GreName]
kid_env (FastString -> Maybe [GreName])
-> (IEWrappedName GhcPs -> FastString)
-> IEWrappedName GhcPs
-> Maybe [GreName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS (OccName -> FastString)
-> (IEWrappedName GhcPs -> OccName)
-> IEWrappedName GhcPs
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (IEWrappedName GhcPs -> RdrName)
-> IEWrappedName GhcPs
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IEWrappedName GhcPs -> IdP GhcPs
IEWrappedName GhcPs -> RdrName
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName) IEWrappedName GhcPs
r of
Just [NormalGreName Name
n] -> Either (LocatedA Name) [Located FieldLabel]
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
(Either (LocatedA Name) [Located FieldLabel])
forall err val. val -> MaybeErr err val
Succeeded (LocatedA Name -> Either (LocatedA Name) [Located FieldLabel]
forall a b. a -> Either a b
Left (SrcSpanAnnA -> Name -> LocatedA Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l Name
n))
Just [GreName]
rs | Just [FieldLabel]
fs <- (GreName -> Maybe FieldLabel) -> [GreName] -> Maybe [FieldLabel]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse GreName -> Maybe FieldLabel
greNameFieldLabel [GreName]
rs -> Either (LocatedA Name) [Located FieldLabel]
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
(Either (LocatedA Name) [Located FieldLabel])
forall err val. val -> MaybeErr err val
Succeeded ([Located FieldLabel] -> Either (LocatedA Name) [Located FieldLabel]
forall a b. b -> Either a b
Right ((FieldLabel -> Located FieldLabel)
-> [FieldLabel] -> [Located FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> FieldLabel -> Located FieldLabel
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)) [FieldLabel]
fs))
Maybe [GreName]
_ -> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> MaybeErr
(GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
(Either (LocatedA Name) [Located FieldLabel])
forall err val. err -> MaybeErr err val
Failed GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
item
kid_env :: FastStringEnv [GreName]
kid_env = ([GreName] -> [GreName] -> [GreName])
-> FastStringEnv [GreName]
-> [(FastString, [GreName])]
-> FastStringEnv [GreName]
forall a.
(a -> a -> a)
-> FastStringEnv a -> [(FastString, a)] -> FastStringEnv a
extendFsEnvList_C [GreName] -> [GreName] -> [GreName]
forall a. [a] -> [a] -> [a]
(++) FastStringEnv [GreName]
forall a. FastStringEnv a
emptyFsEnv
[(OccName -> FastString
occNameFS (GreName -> OccName
forall name. HasOccName name => name -> OccName
occName GreName
x), [GreName
x]) | GreName
x <- [GreName]
all_kids]
reportUnusedNames :: TcGblEnv -> HscSource -> RnM ()
reportUnusedNames :: TcGblEnv -> HscSource -> IOEnv (Env TcGblEnv TcLclEnv) ()
reportUnusedNames TcGblEnv
gbl_env HscSource
hsc_src
= do { Defs
keep <- TcRef Defs -> TcRnIf TcGblEnv TcLclEnv Defs
forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
readTcRef (TcGblEnv -> TcRef Defs
tcg_keep TcGblEnv
gbl_env)
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"RUN" (DefUses -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcGblEnv -> DefUses
tcg_dus TcGblEnv
gbl_env))
; TcGblEnv -> HscSource -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImportDecls TcGblEnv
gbl_env HscSource
hsc_src
; [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedTopBinds ([GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ Defs -> [GlobalRdrElt]
unused_locals Defs
keep
; TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingSignatures TcGblEnv
gbl_env
; TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingKindSignatures TcGblEnv
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]
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
greMangledName 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
greMangledName 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
isLocalGRE GlobalRdrElt
gre Bool -> Bool -> Bool
&& Name -> Bool
isExternalName (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre)
warnMissingSignatures :: TcGblEnv -> RnM ()
warnMissingSignatures :: TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingSignatures TcGblEnv
gbl_env
= do { Bool
warn_binds <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
woptM WarningFlag
Opt_WarnMissingSignatures
; Bool
warn_pat_syns <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
woptM WarningFlag
Opt_WarnMissingPatternSynonymSignatures
; 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 { TidyEnv
env <- TcM TidyEnv
tcInitTidyEnv
; let (TidyEnv
_, Type
ty) = TidyEnv -> Type -> (TidyEnv, Type)
tidyOpenType TidyEnv
env (Id -> Type
idType Id
id)
missing :: MissingSignature
missing = Name -> Type -> MissingSignature
MissingTopLevelBindingSig Name
name Type
ty
diag :: TcRnMessage
diag = MissingSignature -> Exported -> Bool -> TcRnMessage
TcRnMissingSignature MissingSignature
missing Exported
exported Bool
warn_binds
; SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
name) TcRnMessage
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 -> Bool -> TcRnMessage
TcRnMissingSignature MissingSignature
missing Exported
exported Bool
warn_pat_syns)
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 { Bool
cusks_enabled <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.CUSKs
; (TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [TyCon] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_ty_warn Bool
cusks_enabled) [TyCon]
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)
not_ghc_generated :: Name -> Bool
not_ghc_generated :: Name -> Bool
not_ghc_generated 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
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) TcRnMessage
diag
where
name :: Name
name = TyCon -> Name
tyConName TyCon
tyCon
diag :: TcRnMessage
diag = MissingSignature -> Exported -> Bool -> TcRnMessage
TcRnMissingSignature MissingSignature
missing Exported
exported Bool
False
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 { [GlobalRdrElt]
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)]
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 :: GlobalRdrEnv
rdr_env = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env
fld_env :: NameEnv (FieldLabelString, Parent)
fld_env = GlobalRdrEnv -> NameEnv (FieldLabelString, Parent)
mkFieldEnv GlobalRdrEnv
rdr_env
; let usage :: [ImportDeclUsage]
usage :: [ImportDeclUsage]
usage = [LImportDecl GhcRn] -> [GlobalRdrElt] -> [ImportDeclUsage]
findImportUsage [LImportDecl GhcRn]
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
user_imports [GlobalRdrElt]
uses
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"warnUnusedImportDecls" (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
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
"Uses:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
uses
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Import usage" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])]
-> SDoc
forall a. Outputable a => a -> SDoc
ppr [ImportDeclUsage]
[(GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])]
usage])
; WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnUnusedImports (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
((GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WarningFlag
-> NameEnv (FieldLabelString, Parent)
-> ImportDeclUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImport WarningFlag
Opt_WarnUnusedImports NameEnv (FieldLabelString, Parent)
fld_env) [ImportDeclUsage]
[(GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])]
usage
; GeneralFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenGOptM GeneralFlag
Opt_D_dump_minimal_imports (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
HscSource -> [ImportDeclUsage] -> IOEnv (Env TcGblEnv TcLclEnv) ()
printMinimalImports HscSource
hsc_src [ImportDeclUsage]
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. SrcSpanAnn' 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
greMangledName [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
greParent_maybe [GlobalRdrElt]
used_gres)
unused_imps :: Defs
unused_imps
= case Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
imps of
Just (ImportListInterpretation
Exactly, L SrcSpanAnnL
_ [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) 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) 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) 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
fs LIEWrappedName GhcRn
p IEWildcard
wc [LIEWrappedName GhcRn]
ns) 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 [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (Located FieldLabel -> Name) -> [Located FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (FieldLabel -> Name
flSelector (FieldLabel -> Name)
-> (Located FieldLabel -> FieldLabel) -> Located FieldLabel -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located FieldLabel -> FieldLabel
forall l e. GenLocated l e -> e
unLoc) [Located FieldLabel]
XIEThingWith GhcRn
fs
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
add_one ImportMap
forall k a. Map k a
Map.empty [GlobalRdrElt]
gres
where
add_one :: GlobalRdrElt -> ImportMap -> ImportMap
add_one gre :: GlobalRdrElt
gre@(GRE { gre_imp :: GlobalRdrElt -> Bag ImportSpec
gre_imp = Bag ImportSpec
imp_specs }) ImportMap
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
_ -> ([GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt])
-> RealSrcLoc -> [GlobalRdrElt] -> ImportMap -> ImportMap
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
add RealSrcLoc
decl_loc [GlobalRdrElt
gre] ImportMap
imp_map
UnhelpfulLoc FastString
_ -> ImportMap
imp_map
where
best_imp_spec :: ImportSpec
best_imp_spec = [ImportSpec] -> ImportSpec
bestImport (Bag ImportSpec -> [ImportSpec]
forall a. Bag a -> [a]
bagToList Bag ImportSpec
imp_specs)
add :: [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
add [GlobalRdrElt]
_ [GlobalRdrElt]
gres = GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: [GlobalRdrElt]
gres
warnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Parent)
-> ImportDeclUsage -> RnM ()
warnUnusedImport :: WarningFlag
-> NameEnv (FieldLabelString, Parent)
-> ImportDeclUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImport WarningFlag
flag NameEnv (FieldLabelString, Parent)
fld_env (L SrcSpanAnnA
loc ImportDecl GhcRn
decl, [GlobalRdrElt]
used, [Name]
unused)
| Just (ImportListInterpretation
Exactly, L SrcSpanAnnL
_ []) <- 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 SrcSpanAnnL
_ [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
= let dia :: TcRnMessage
dia = DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
flag) [GhcHint]
noHints SDoc
msg1
in SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) TcRnMessage
dia
| [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 SrcSpanAnnL
_ [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
= let dia :: TcRnMessage
dia = DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
flag) [GhcHint]
noHints SDoc
msg2
in SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) TcRnMessage
dia
| Bool
otherwise
= let dia :: TcRnMessage
dia = DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
flag) [GhcHint]
noHints SDoc
msg2
in SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) TcRnMessage
dia
where
msg1 :: SDoc
msg1 = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
pp_herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pp_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
is_redundant
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"except perhaps to import instances from"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pp_mod)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"To import instances alone, use:"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
forall doc. IsOutput doc => doc
Outputable.empty ]
msg2 :: SDoc
msg2 = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc
pp_herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
sort_unused
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"from module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pp_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
is_redundant]
pp_herald :: SDoc
pp_herald = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_qual SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import of"
pp_qual :: SDoc
pp_qual
| ImportDeclQualifiedStyle -> Bool
isImportDeclQualified (ImportDecl GhcRn -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcRn
decl)= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"qualified"
| Bool
otherwise = SDoc
forall doc. IsOutput doc => doc
Outputable.empty
pp_mod :: SDoc
pp_mod = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (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))
is_redundant :: SDoc
is_redundant = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is redundant"
ppr_possible_field :: Name -> SDoc
ppr_possible_field Name
n = case NameEnv (FieldLabelString, Parent)
-> Name -> Maybe (FieldLabelString, Parent)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv (FieldLabelString, Parent)
fld_env Name
n of
Just (FieldLabelString
fld, ParentIs Name
p) -> Name -> SDoc
pprNameUnqualified Name
p SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
fld)
Just (FieldLabelString
fld, Parent
NoParent) -> FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
fld
Maybe (FieldLabelString, Parent)
Nothing -> Name -> SDoc
pprNameUnqualified Name
n
sort_unused :: SDoc
sort_unused :: SDoc
sort_unused = (Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Name -> SDoc
ppr_possible_field ([Name] -> SDoc) -> [Name] -> SDoc
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 = ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)])
-> IOEnv
(Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> IOEnv
(Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [LImportDecl GhcRn] -> [LImportDecl GhcRn]
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
combine (IOEnv
(Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)])
-> ([(GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)])
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])]
-> IOEnv
(Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (ImportDecl GhcRn)))
-> [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt],
[Name])]
-> IOEnv
(Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
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 (GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt], [Name])
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (ImportDecl GhcRn))
forall {t :: * -> *} {a}.
Foldable t =>
(GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt], t a)
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (ImportDecl GhcRn))
mk_minimal
where
mk_minimal :: (GenLocated SrcSpanAnnA (ImportDecl GhcRn), [GlobalRdrElt], t a)
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (ImportDecl GhcRn))
mk_minimal (L SrcSpanAnnA
l ImportDecl GhcRn
decl, [GlobalRdrElt]
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
; ModIface
iface <- SDoc -> ModuleName -> IsBootInterface -> PkgQual -> RnM ModIface
loadSrcInterface SDoc
doc ModuleName
mod_name IsBootInterface
is_boot ImportDeclPkgQual GhcRn
PkgQual
pkg_qual
; let used_avails :: [AvailInfo]
used_avails = [GlobalRdrElt] -> [AvailInfo]
gresToAvailInfo [GlobalRdrElt]
used_gres
lies :: [GenLocated SrcSpanAnnA (IE GhcRn)]
lies = (IE GhcRn -> GenLocated SrcSpanAnnA (IE GhcRn))
-> [IE GhcRn] -> [GenLocated SrcSpanAnnA (IE GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanAnnA -> IE GhcRn -> GenLocated SrcSpanAnnA (IE GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l) ((AvailInfo -> [IE GhcRn]) -> [AvailInfo] -> [IE GhcRn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModIface -> AvailInfo -> [IE GhcRn]
to_ie ModIface
iface) [AvailInfo]
used_avails)
; 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 { 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 :: ModIface -> AvailInfo -> [IE GhcRn]
to_ie :: ModIface -> AvailInfo -> [IE GhcRn]
to_ie ModIface
_ (Avail GreName
c)
= [XIEVar GhcRn -> LIEWrappedName GhcRn -> IE GhcRn
forall pass. XIEVar pass -> LIEWrappedName pass -> IE pass
IEVar XIEVar GhcRn
NoExtField
noExtField (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 -> LocatedA Name
forall a an. a -> LocatedAn an a
noLocA (GreName -> Name
greNamePrintableName GreName
c))]
to_ie ModIface
_ avail :: AvailInfo
avail@(AvailTC Name
n [GreName
_])
| AvailInfo -> Bool
availExportsDecl AvailInfo
avail = [XIEThingAbs GhcRn -> LIEWrappedName GhcRn -> IE GhcRn
forall pass. XIEThingAbs pass -> LIEWrappedName pass -> IE pass
IEThingAbs XIEThingAbs GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn 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
$ Name -> LocatedA Name
forall a an. a -> LocatedAn an a
noLocA Name
n)]
to_ie ModIface
iface (AvailTC Name
n [GreName]
cs)
= case [[GreName]
xs | avail :: AvailInfo
avail@(AvailTC Name
x [GreName]
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
[[GreName]
xs] | [GreName] -> Bool
all_used [GreName]
xs ->
[XIEThingAll GhcRn -> LIEWrappedName GhcRn -> IE GhcRn
forall pass. XIEThingAll pass -> LIEWrappedName pass -> IE pass
IEThingAll XIEThingAll GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn 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
$ Name -> LocatedA Name
forall a an. a -> LocatedAn an a
noLocA Name
n)]
| Bool
otherwise ->
[XIEThingWith GhcRn
-> LIEWrappedName GhcRn
-> IEWildcard
-> [LIEWrappedName GhcRn]
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
IEThingWith ((FieldLabel -> Located FieldLabel)
-> [FieldLabel] -> [Located FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Located FieldLabel
forall e. e -> Located e
noLoc [FieldLabel]
fs) (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 -> LocatedA Name
forall a an. a -> LocatedAn an a
noLocA 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
LocatedA Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
to_ie_post_rn (LocatedA Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> (Name -> LocatedA Name)
-> Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> LocatedA Name
forall a an. a -> LocatedAn an 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))]
[[GreName]]
_other | [FieldLabel] -> Bool
all_non_overloaded [FieldLabel]
fs
-> (Name -> IE GhcRn) -> [Name] -> [IE GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (XIEVar GhcRn -> LIEWrappedName GhcRn -> IE GhcRn
forall pass. XIEVar pass -> LIEWrappedName pass -> IE pass
IEVar XIEVar GhcRn
NoExtField
noExtField (GenLocated SrcSpanAnnA (IEWrappedName GhcRn) -> IE GhcRn)
-> (Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> Name
-> IE GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
LocatedA Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
to_ie_post_rn_var (LocatedA Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> (Name -> LocatedA Name)
-> Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> LocatedA Name
forall a an. a -> LocatedAn an a
noLocA) ([Name] -> [IE GhcRn]) -> [Name] -> [IE GhcRn]
forall a b. (a -> b) -> a -> b
$ [Name]
ns
[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FieldLabel -> Name) -> [FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Name
flSelector [FieldLabel]
fs
| Bool
otherwise ->
[XIEThingWith GhcRn
-> LIEWrappedName GhcRn
-> IEWildcard
-> [LIEWrappedName GhcRn]
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
IEThingWith ((FieldLabel -> Located FieldLabel)
-> [FieldLabel] -> [Located FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Located FieldLabel
forall e. e -> Located e
noLoc [FieldLabel]
fs) (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 -> LocatedA Name
forall a an. a -> LocatedAn an a
noLocA 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
LocatedA Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
to_ie_post_rn (LocatedA Name -> GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> (Name -> LocatedA Name)
-> Name
-> GenLocated SrcSpanAnnA (IEWrappedName GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> LocatedA Name
forall a an. a -> LocatedAn an 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))]
where
([Name]
ns, [FieldLabel]
fs) = [GreName] -> ([Name], [FieldLabel])
partitionGreNames [GreName]
cs
all_used :: [GreName] -> Bool
all_used [GreName]
avail_cs = (GreName -> Bool) -> [GreName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (GreName -> [GreName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GreName]
cs) [GreName]
avail_cs
all_non_overloaded :: [FieldLabel] -> Bool
all_non_overloaded = (FieldLabel -> Bool) -> [FieldLabel] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (FieldLabel -> Bool) -> FieldLabel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> Bool
flIsOverloaded)
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, LocatedL [LIE GhcRn]) -> [LIE GhcRn])
-> [(ImportListInterpretation, LocatedL [LIE GhcRn])]
-> [LIE GhcRn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LocatedL [LIE GhcRn] -> [LIE GhcRn]
forall l e. GenLocated l e -> e
unLoc (LocatedL [LIE GhcRn] -> [LIE GhcRn])
-> ((ImportListInterpretation, LocatedL [LIE GhcRn])
-> LocatedL [LIE GhcRn])
-> (ImportListInterpretation, LocatedL [LIE GhcRn])
-> [LIE GhcRn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportListInterpretation, LocatedL [LIE GhcRn])
-> LocatedL [LIE GhcRn]
forall a b. (a, b) -> b
snd) ([(ImportListInterpretation, LocatedL [LIE GhcRn])] -> [LIE GhcRn])
-> [(ImportListInterpretation, LocatedL [LIE GhcRn])]
-> [LIE GhcRn]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> Maybe (ImportListInterpretation, LocatedL [LIE GhcRn]))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [(ImportListInterpretation, LocatedL [LIE GhcRn])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportDecl GhcRn
-> Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
ImportDecl GhcRn
-> Maybe (ImportListInterpretation, LocatedL [LIE GhcRn])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList (ImportDecl GhcRn
-> Maybe (ImportListInterpretation, LocatedL [LIE GhcRn]))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> ImportDecl GhcRn)
-> GenLocated SrcSpanAnnA (ImportDecl GhcRn)
-> Maybe (ImportListInterpretation, LocatedL [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, LocatedL [LIE GhcRn])])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [(ImportListInterpretation, LocatedL [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
printMinimalImports :: HscSource -> [ImportDeclUsage] -> RnM ()
printMinimalImports :: HscSource -> [ImportDeclUsage] -> IOEnv (Env TcGblEnv TcLclEnv) ()
printMinimalImports HscSource
hsc_src [ImportDeclUsage]
imports_w_usage
= do { [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
imports' <- [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports [ImportDeclUsage]
imports_w_usage
; Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile (DynFlags -> Module -> String
mkFilename DynFlags
dflags Module
this_mod) IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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 (SrcSpanAnnA -> EpaLocation
forall a. SrcSpanAnn' a -> EpaLocation
la2e SrcSpanAnnA
l) (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a. SrcSpanAnn' a -> SrcSpanAnnN
la2na 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. SrcSpanAnn' a -> SrcSpanAnnN
la2na 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 (SrcSpanAnnA -> EpaLocation
forall a. SrcSpanAnn' a -> EpaLocation
la2e SrcSpanAnnA
l) (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a. SrcSpanAnn' a -> SrcSpanAnnN
la2na 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. SrcSpanAnn' a -> SrcSpanAnnN
la2na SrcSpanAnnA
l) IdP GhcRn
Name
n))
where occ :: OccName
occ = Name -> OccName
forall name. HasOccName name => name -> OccName
occName IdP GhcRn
Name
n
qualImportItemErr :: RdrName -> SDoc
qualImportItemErr :: RdrName -> SDoc
qualImportItemErr RdrName
rdr
= SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal qualified name in import item:")
Int
2 (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr)
ambiguousImportItemErr :: RdrName -> [AvailInfo] -> SDoc
ambiguousImportItemErr :: RdrName -> [AvailInfo] -> SDoc
ambiguousImportItemErr RdrName
rdr [AvailInfo]
avails
= SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ambiguous name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in import item. It could refer to:")
Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((AvailInfo -> SDoc) -> [AvailInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map AvailInfo -> SDoc
ppr_avail [AvailInfo]
avails))
where
ppr_avail :: AvailInfo -> SDoc
ppr_avail (AvailTC Name
parent [GreName]
_) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
parent SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr)
ppr_avail (Avail GreName
name) = GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
name
pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec =
SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case ModIface -> IsBootInterface
mi_boot ModIface
iface of
IsBootInterface
IsBoot -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(hi-boot interface)"
IsBootInterface
NotBoot -> SDoc
forall doc. IsOutput doc => doc
Outputable.empty
badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE GhcPs -> SDoc
badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE GhcPs -> SDoc
badImportItemErrStd ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module", ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec,
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not export", SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie)]
badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE GhcPs
-> SDoc
badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE GhcPs -> SDoc
badImportItemErrDataCon OccName
dataType_occ ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In module"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
, Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
quotes SDoc
datacon
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a data constructor of"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
dataType
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"To import it use"
, Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens_sp (SDoc
dataType SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens_sp SDoc
datacon)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or"
, Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens_sp (SDoc
dataType SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(..)")
]
where
datacon_occ :: OccName
datacon_occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
datacon :: SDoc
datacon = OccName -> SDoc -> SDoc
parenSymOcc OccName
datacon_occ (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
datacon_occ)
dataType :: SDoc
dataType = OccName -> SDoc -> SDoc
parenSymOcc OccName
dataType_occ (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
dataType_occ)
parens_sp :: doc -> doc
parens_sp doc
d = doc -> doc
forall doc. IsLine doc => doc -> doc
parens (doc
forall doc. IsLine doc => doc
space doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
d doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
space)
badImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> SDoc
badImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> SDoc
badImportItemErr ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie [AvailInfo]
avails
= case (AvailInfo -> Bool) -> [AvailInfo] -> Maybe AvailInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find AvailInfo -> Bool
checkIfDataCon [AvailInfo]
avails of
Just AvailInfo
con -> OccName -> ModIface -> ImpDeclSpec -> IE GhcPs -> SDoc
badImportItemErrDataCon (AvailInfo -> OccName
availOccName AvailInfo
con) ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
Maybe AvailInfo
Nothing -> ModIface -> ImpDeclSpec -> IE GhcPs -> SDoc
badImportItemErrStd ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
where
checkIfDataCon :: AvailInfo -> Bool
checkIfDataCon (AvailTC Name
_ [GreName]
ns) =
case (GreName -> Bool) -> [GreName] -> Maybe GreName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\GreName
n -> FastString
importedFS FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== OccName -> FastString
occNameFS (GreName -> OccName
forall name. HasOccName name => name -> OccName
occName GreName
n)) [GreName]
ns of
Just GreName
n -> Name -> Bool
isDataConName (GreName -> Name
greNameMangledName GreName
n)
Maybe GreName
Nothing -> Bool
False
checkIfDataCon AvailInfo
_ = Bool
False
availOccName :: AvailInfo -> OccName
availOccName = GreName -> OccName
forall name. HasOccName name => name -> OccName
occName (GreName -> OccName)
-> (AvailInfo -> GreName) -> AvailInfo -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvailInfo -> GreName
availGreName
importedFS :: FastString
importedFS = OccName -> FastString
occNameFS (OccName -> FastString)
-> (RdrName -> OccName) -> RdrName -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> FastString) -> RdrName -> FastString
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
illegalImportItemErr :: SDoc
illegalImportItemErr :: SDoc
illegalImportItemErr = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal import item"
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
$ DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
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
"Multiple declarations of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre)),
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Declared at:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (NonEmpty SDoc -> [SDoc]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty SDoc -> [SDoc]) -> NonEmpty SDoc -> [SDoc]
forall a b. (a -> b) -> a -> b
$ SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcLoc -> SDoc) -> (Name -> SrcLoc) -> Name -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SrcLoc
nameSrcLoc (Name -> SDoc) -> NonEmpty Name -> NonEmpty SDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
greMangledName NonEmpty GlobalRdrElt
gres)
missingImportListWarn :: ModuleName -> SDoc
missingImportListWarn :: ModuleName -> SDoc
missingImportListWarn ModuleName
mod
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have an explicit import list"
moduleWarn :: ModuleName -> WarningTxt GhcRn -> SDoc
moduleWarn :: ModuleName -> WarningTxt GhcRn -> SDoc
moduleWarn ModuleName
mod (WarningTxt Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
txt)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon,
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Located (WithHsDocIdentifiers StringLiteral GhcRn) -> SDoc)
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (StringLiteral -> SDoc
forall a. Outputable a => a -> SDoc
ppr (StringLiteral -> SDoc)
-> (Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> StringLiteral)
-> Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithHsDocIdentifiers StringLiteral GhcRn -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString (WithHsDocIdentifiers StringLiteral GhcRn -> StringLiteral)
-> (Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn)
-> Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn
forall l e. GenLocated l e -> e
unLoc) [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
txt)) ]
moduleWarn ModuleName
mod (DeprecatedTxt Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
txt)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is deprecated:",
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Located (WithHsDocIdentifiers StringLiteral GhcRn) -> SDoc)
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (StringLiteral -> SDoc
forall a. Outputable a => a -> SDoc
ppr (StringLiteral -> SDoc)
-> (Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> StringLiteral)
-> Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithHsDocIdentifiers StringLiteral GhcRn -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString (WithHsDocIdentifiers StringLiteral GhcRn -> StringLiteral)
-> (Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn)
-> Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn
forall l e. GenLocated l e -> e
unLoc) [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
txt)) ]
packageImportErr :: TcRnMessage
packageImportErr :: TcRnMessage
packageImportErr
= DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Package-qualified imports are not enabled; use PackageImports"
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
badDataCon RdrName
name)
badDataCon :: RdrName -> TcRnMessage
badDataCon :: RdrName -> TcRnMessage
badDataCon RdrName
name
= DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
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
"Illegal data constructor name", SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)]