{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

Extracting imported and top-level names in scope
-}

{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

module GHC.Rename.Names (
        rnImports, getLocalNonValBinders, newRecordSelector,
        extendGlobalRdrEnvRn,
        gresFromAvails,
        calculateAvails,
        reportUnusedNames,
        checkConName,
        mkChildEnv,
        findChildren,
        findImportUsage,
        getMinimalImports,
        printMinimalImports,
        renamePkgQual, renameRawPkgQual,
        ImportDeclUsage
    ) where

import GHC.Prelude

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.Utils.Trace

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 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, groupBy, sortOn )
import Data.Function    ( on )
import qualified Data.Set as S
import System.FilePath  ((</>))

import System.IO
import GHC.Data.Bag

{-
************************************************************************
*                                                                      *
\subsection{rnImports}
*                                                                      *
************************************************************************

Note [Tracking Trust Transitively]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we import a package as well as checking that the direct imports are safe
according to the rules outlined in the Note [Safe Haskell Trust Check] in GHC.Driver.Main
we must also check that these rules hold transitively for all dependent modules
and packages. Doing this without caching any trust information would be very
slow as we would need to touch all packages and interface files a module depends
on. To avoid this we make use of the property that if a modules Safe Haskell
mode changes, this triggers a recompilation from that module in the dependecy
graph. So we can just worry mostly about direct imports.

There is one trust property that can change for a package though without
recompilation being triggered: package trust. So we must check that all
packages a module transitively depends on to be trusted are still trusted when
we are compiling this module (as due to recompilation avoidance some modules
below may not be considered trusted any more without recompilation being
triggered).

We handle this by augmenting the existing transitive list of packages a module M
depends on with a bool for each package that says if it must be trusted when the
module M is being checked for trust. This list of trust required packages for a
single import is gathered in the rnImportDecl function and stored in an
ImportAvails data structure. The union of these trust required packages for all
imports is done by the rnImports function using the combine function which calls
the plusImportAvails function that is a union operation for the ImportAvails
type. This gives us in an ImportAvails structure all packages required to be
trusted for the module we are currently compiling. Checking that these packages
are still trusted (and that direct imports are trusted) is done in
GHC.Driver.Main.checkSafeImports.

See the note below, [Trust Own Package] for a corner case in this method and
how its handled.


Note [Trust Own Package]
~~~~~~~~~~~~~~~~~~~~~~~~
There is a corner case of package trust checking that the usual transitive check
doesn't cover. (For how the usual check operates see the Note [Tracking Trust
Transitively] below). The case is when you import a -XSafe module M and M
imports a -XTrustworthy module N. If N resides in a different package than M,
then the usual check works as M will record a package dependency on N's package
and mark it as required to be trusted. If N resides in the same package as M
though, then importing M should require its own package be trusted due to N
(since M is -XSafe so doesn't create this requirement by itself). The usual
check fails as a module doesn't record a package dependency of its own package.
So instead we now have a bool field in a modules interface file that simply
states if the module requires its own package to be trusted. This field avoids
us having to load all interface files that the module depends on to see if one
is trustworthy.


Note [Trust Transitive Property]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
So there is an interesting design question in regards to transitive trust
checking. Say I have a module B compiled with -XSafe. B is dependent on a bunch
of modules and packages, some packages it requires to be trusted as its using
-XTrustworthy modules from them. Now if I have a module A that doesn't use safe
haskell at all and simply imports B, should A inherit all the trust
requirements from B? Should A now also require that a package p is trusted since
B required it?

We currently say no but saying yes also makes sense. The difference is, if a
module M that doesn't use Safe Haskell imports a module N that does, should all
the trusted package requirements be dropped since M didn't declare that it cares
about Safe Haskell (so -XSafe is more strongly associated with the module doing
the importing) or should it be done still since the author of the module N that
uses Safe Haskell said they cared (so -XSafe is more strongly associated with
the module that was compiled that used it).

Going with yes is a simpler semantics we think and harder for the user to stuff
up but it does mean that Safe Haskell will affect users who don't care about
Safe Haskell as they might grab a package from Cabal which uses safe haskell (say
network) and that packages imports -XTrustworthy modules from another package
(say bytestring), so requires that package is trusted. The user may now get
compilation errors in code that doesn't do anything with Safe Haskell simply
because they are using the network package. They will have to call 'ghc-pkg
trust network' to get everything working. Due to this invasive nature of going
with yes we have gone with no for now.
-}

-- | Process Import Decls.  See 'rnImportDecl' for a description of what
-- the return types represent.
-- Note: Do the non SOURCE ones first, so that we get a helpful warning
-- for SOURCE ones that are unnecessary
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 <- forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
    -- NB: want an identity module here, because it's OK for a signature
    -- module to import from its implementor
    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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall {l} {pass}. GenLocated l (ImportDecl pass) -> Bool
is_source_import forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(LImportDecl GhcPs, SDoc)]
imports
        is_source_import :: GenLocated l (ImportDecl pass) -> Bool
is_source_import GenLocated l (ImportDecl pass)
d = forall pass. ImportDecl pass -> IsBootInterface
ideclSource (forall l e. GenLocated l e -> e
unLoc GenLocated l (ImportDecl pass)
d) forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
    [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
  ImportAvails, Bool)]
stuff1 <- 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 <- 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
    -- Safe Haskell: See Note [Tracking Trust Transitively]
    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 forall a. [a] -> [a] -> [a]
++ [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), GlobalRdrEnv,
  ImportAvails, Bool)]
stuff2)
    -- Update imp_boot_mods if imp_direct_mods mentions any of them
    let merged_import_avail :: ImportAvails
merged_import_avail = ImportAvails -> ImportAvails
clobberSourceImports ImportAvails
imp_avails
    DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    let final_import_avail :: ImportAvails
final_import_avail  =
          ImportAvails
merged_import_avail { imp_dep_direct_pkgs :: Set UnitId
imp_dep_direct_pkgs = forall a. Ord a => [a] -> Set a
S.fromList (DynFlags -> [UnitId]
implicitPackageDeps DynFlags
dflags)
                                                        forall a. Ord a => Set a -> Set a -> Set a
`S.union` ImportAvails -> Set UnitId
imp_dep_direct_pkgs ImportAvails
merged_import_avail}
    forall (m :: * -> *) a. Monad m => a -> m a
return ([LImportDecl 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 :: InstalledModuleEnv ModuleNameWithIsBoot
imp_boot_mods = InstalledModuleEnv ModuleNameWithIsBoot
imp_boot_mods' }
      where
        imp_boot_mods' :: InstalledModuleEnv ModuleNameWithIsBoot
imp_boot_mods' = forall elta eltb eltc.
(elta -> eltb -> Maybe eltc)
-> (InstalledModuleEnv elta -> InstalledModuleEnv eltc)
-> (InstalledModuleEnv eltb -> InstalledModuleEnv eltc)
-> InstalledModuleEnv elta
-> InstalledModuleEnv eltb
-> InstalledModuleEnv eltc
mergeInstalledModuleEnv forall {mod}.
GenWithIsBoot mod -> GenWithIsBoot mod -> Maybe (GenWithIsBoot mod)
combJ forall a. a -> a
id (forall a b. a -> b -> a
const forall a. InstalledModuleEnv a
emptyInstalledModuleEnv)
                            (ImportAvails -> InstalledModuleEnv ModuleNameWithIsBoot
imp_boot_mods ImportAvails
imp_avails)
                            (ImportAvails -> InstalledModuleEnv ModuleNameWithIsBoot
imp_direct_dep_mods ImportAvails
imp_avails)

        combJ :: GenWithIsBoot mod -> GenWithIsBoot mod -> Maybe (GenWithIsBoot mod)
combJ (GWIB mod
_ IsBootInterface
IsBoot) GenWithIsBoot mod
x = forall a. a -> Maybe a
Just GenWithIsBoot mod
x
        combJ GenWithIsBoot mod
r GenWithIsBoot mod
_               = forall a. a -> Maybe a
Just GenWithIsBoot mod
r
    -- See Note [Combining ImportAvails]
    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) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            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)]
ss
      in ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails { imp_finsts :: [Module]
imp_finsts = ModuleSet -> [Module]
moduleSetElts ModuleSet
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
declforall 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 :: [Module]
imp_finsts = [] }
      new_finsts :: [Module]
new_finsts = ImportAvails -> [Module]
imp_finsts ImportAvails
imp_avails1

{-
Note [Combining ImportAvails]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
imp_finsts in ImportAvails is a list of family instance modules
transitively depended on by an import. imp_finsts for a currently
compiled module is a union of all the imp_finsts of imports.
Computing the union of two lists of size N is O(N^2) and if we
do it to M imports we end up with O(M*N^2). That can get very
expensive for bigger module hierarchies.

Union can be optimized to O(N log N) if we use a Set.
imp_finsts is converted back and forth between dep_finsts, so
changing a type of imp_finsts means either paying for the conversions
or changing the type of dep_finsts as well.

I've measured that the conversions would cost 20% of allocations on my
test case, so that can be ruled out.

Changing the type of dep_finsts forces checkFamInsts to
get the module lists in non-deterministic order. If we wanted to restore
the deterministic order, we'd have to sort there, which is an additional
cost. As far as I can tell, using a non-deterministic order is fine there,
but that's a brittle nonlocal property which I'd like to avoid.

Additionally, dep_finsts is read from an interface file, so its "natural"
type is a list. Which makes it a natural type for imp_finsts.

Since rnImports.combine is really the only place that would benefit from
it being a Set, it makes sense to optimize the hot loop in rnImports.combine
without changing the representation.

So here's what we do: instead of naively merging ImportAvails with
plusImportAvails in a loop, we make plusImportAvails merge empty imp_finsts
and compute the union on the side using Sets. When we're done, we can
convert it back to a list. One nice side effect of this approach is that
if there's a lot of overlap in the imp_finsts of imports, the
Set doesn't really need to grow and we don't need to allocate.

Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in
23s before, and 11s after.
-}



-- | Given a located import declaration @decl@ from @this_mod@,
-- calculate the following pieces of information:
--
--  1. An updated 'LImportDecl', where all unresolved 'RdrName' in
--     the entity lists have been resolved into 'Name's,
--
--  2. A 'GlobalRdrEnv' representing the new identifiers that were
--     brought into scope (taking into account module qualification
--     and hiding),
--
--  3. 'ImportAvails' summarizing the identifiers that were imported
--     by this declaration, and
--
--  4. A boolean 'AnyHpcUsage' which is true if the imported module
--     used HPC.
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, ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclImplicit = Bool
implicit
                                     , ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs = Maybe (XRec GhcPs ModuleName)
as_mod, ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding = Maybe (Bool, XRec GhcPs [LIE GhcPs])
imp_details }), SDoc
import_reason)
  = forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc forall a b. (a -> b) -> a -> b
$ do

    case ImportDeclPkgQual GhcPs
raw_pkg_qual of
      ImportDeclPkgQual GhcPs
RawPkgQual
NoRawPkgQual -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      RawPkgQual StringLiteral
_ -> do
        Bool
pkg_imports <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.PackageImports
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
pkg_imports) 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

    -- If there's an error in loadInterface, (e.g. interface
    -- file not found) we get lots of spurious errors from 'filterImports'
    let imp_mod_name :: ModuleName
imp_mod_name = forall l e. GenLocated l e -> e
unLoc XRec GhcPs ModuleName
loc_imp_mod_name
        doc :: SDoc
doc = forall a. Outputable a => a -> SDoc
ppr ModuleName
imp_mod_name SDoc -> SDoc -> SDoc
<+> SDoc
import_reason

    HscEnv
hsc_env <- forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
    UnitEnv
unit_env <- HscEnv -> UnitEnv
hsc_unit_env forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
raw_pkg_qual

    -- Check for self-import, which confuses the typechecker (#9032)
    -- ghc --make rejects self-import cycles already, but batch-mode may not
    -- at least not until GHC.IfaceToCore.tcHiBootIface, which is too late to avoid
    -- typechecker crashes.  (Indirect self imports are not caught until
    -- GHC.IfaceToCore, see #10337 tracking how to make this error better.)
    --
    -- Originally, we also allowed 'import {-# SOURCE #-} M', but this
    -- caused bug #10182: in one-shot mode, we should never load an hs-boot
    -- file for the module we are compiling into the EPS.  In principle,
    -- it should be possible to support this mode of use, but we would have to
    -- extend Provenance to support a local definition in a qualified location.
    -- For now, we don't support it, but see #10336
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ModuleName
imp_mod_name forall a. Eq a => a -> a -> Bool
== forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod Bool -> Bool -> Bool
&&
          (case PkgQual
pkg_qual of -- If we have import "<pkg>" M, then we should
                            -- check that "<pkg>" is "this" (which is magic)
                            -- or the name of this_mod's package.  Yurgh!
                            -- c.f. GHC.findModule, and #9997
             PkgQual
NoPkgQual         -> Bool
True
             ThisPkg UnitId
uid       -> UnitId
uid 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 forall a b. (a -> b) -> a -> b
$ forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints forall a b. (a -> b) -> a -> b
$
           (String -> SDoc
text String
"A module cannot import itself:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr ModuleName
imp_mod_name))

    -- Check for a missing import list (Opt_WarnMissingImportList also
    -- checks for T(..) items but that is done in checkDodgyImport below)
    case Maybe (Bool, XRec GhcPs [LIE GhcPs])
imp_details of
        Just (Bool
False, XRec GhcPs [LIE GhcPs]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- Explicit import list
        Maybe (Bool, XRec GhcPs [LIE GhcPs])
_  | Bool
implicit   -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- Do not bleat for implicit imports
           | Bool
qual_only  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
           | Bool
otherwise  -> forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnMissingImportList forall a b. (a -> b) -> a -> b
$ do
                             let msg :: TcRnMessage
msg = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage 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

    -- Compiler sanity check: if the import didn't say
    -- {-# SOURCE #-} we should not get a hi-boot file
    forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace ((IsBootInterface
want_boot forall a. Eq a => a -> a -> Bool
== IsBootInterface
NotBoot) Bool -> Bool -> Bool
&& (ModIface -> IsBootInterface
mi_boot ModIface
iface forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot)) String
"rnImportDecl" (forall a. Outputable a => a -> SDoc
ppr ModuleName
imp_mod_name) forall a b. (a -> b) -> a -> b
$ do

    -- Issue a user warning for a redundant {- SOURCE -} import
    -- NB that we arrange to read all the ordinary imports before
    -- any of the {- SOURCE -} imports.
    --
    -- in --make and GHCi, the compilation manager checks for this,
    -- and indeed we shouldn't do it here because the existence of
    -- the non-boot module depends on the compilation order, which
    -- is not deterministic.  The hs-boot test can show this up.
    DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    Bool -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIf ((IsBootInterface
want_boot forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot) Bool -> Bool -> Bool
&& (ModIface -> IsBootInterface
mi_boot ModIface
iface 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)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
mod_safe Bool -> Bool -> Bool
&& Bool -> Bool
not (DynFlags -> Bool
safeImportsOn DynFlags
dflags)) forall a b. (a -> b) -> a -> b
$
        TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr forall a b. (a -> b) -> a -> b
$ forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints forall a b. (a -> b) -> a -> b
$
          (String -> SDoc
text String
"safe import can't be used as Safe Haskell isn't on!"
                SDoc -> SDoc -> SDoc
$+$ String -> SDoc
text (String
"please enable Safe Haskell through either Safe, Trustworthy or Unsafe"))

    let
        qual_mod_name :: ModuleName
qual_mod_name = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l e. GenLocated l e -> e
unLoc Maybe (XRec GhcPs ModuleName)
as_mod 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 = forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, is_as :: ModuleName
is_as = ModuleName
qual_mod_name }

    -- filter the imports according to the import declaration
    (Maybe (Bool, LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)])
new_imp_details, [GlobalRdrElt]
gres) <- ModIface
-> ImpDeclSpec
-> Maybe (Bool, LocatedL [LIE GhcPs])
-> RnM (Maybe (Bool, LocatedL [LIE GhcRn]), [GlobalRdrElt])
filterImports ModIface
iface ImpDeclSpec
imp_spec Maybe (Bool, XRec GhcPs [LIE GhcPs])
imp_details

    -- for certain error messages, we’d like to know what could be imported
    -- here, if everything were imported
    GlobalRdrEnv
potential_gres <- [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModIface
-> ImpDeclSpec
-> Maybe (Bool, LocatedL [LIE GhcPs])
-> RnM (Maybe (Bool, LocatedL [LIE GhcRn]), [GlobalRdrElt])
filterImports ModIface
iface ImpDeclSpec
imp_spec forall a. Maybe a
Nothing

    let gbl_env :: GlobalRdrEnv
gbl_env = [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv [GlobalRdrElt]
gres

        is_hiding :: Bool
is_hiding | Just (Bool
True,XRec GhcPs [LIE GhcPs]
_) <- Maybe (Bool, XRec GhcPs [LIE GhcPs])
imp_details = Bool
True
                  | Bool
otherwise                    = Bool
False

        -- should the import be safe?
        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 <- 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        = 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)

    -- Complain if we import a deprecated module
    case forall (phase :: ModIfacePhase). ModIface_ phase -> Warnings GhcRn
mi_warns ModIface
iface of
       WarnAll WarningTxt GhcRn
txt -> do
         let msg :: TcRnMessage
msg = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage 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
_           -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- Complain about -Wcompat-unqualified-imports violations.
    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       = NoExtField
noExtField
          , ideclSourceSrc :: SourceText
ideclSourceSrc = forall pass. ImportDecl pass -> SourceText
ideclSourceSrc ImportDecl GhcPs
decl
          , ideclName :: XRec GhcRn ModuleName
ideclName      = forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
decl
          , ideclPkgQual :: ImportDeclPkgQual GhcRn
ideclPkgQual   = PkgQual
pkg_qual
          , ideclSource :: IsBootInterface
ideclSource    = forall pass. ImportDecl pass -> IsBootInterface
ideclSource ImportDecl GhcPs
decl
          , ideclSafe :: Bool
ideclSafe      = Bool
mod_safe'
          , ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
decl
          , ideclImplicit :: Bool
ideclImplicit  = forall pass. ImportDecl pass -> Bool
ideclImplicit ImportDecl GhcPs
decl
          , ideclAs :: Maybe (XRec GhcRn ModuleName)
ideclAs        = forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
decl
          , ideclHiding :: Maybe (Bool, XRec GhcRn [LIE GhcRn])
ideclHiding    = Maybe (Bool, LocatedL [GenLocated SrcSpanAnnA (IE GhcRn)])
new_imp_details
          }

    forall (m :: * -> *) a. Monad m => a -> m a
return (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc ImportDecl GhcRn
new_imp_decl, GlobalRdrEnv
gbl_env, ImportAvails
imports, forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_hpc ModIface
iface)


-- | Rename raw package imports
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 (forall a. a -> Maybe a
Just (StringLiteral -> FastString
sl_fs StringLiteral
p))

-- | Rename raw package imports
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 <- forall u. GenHomeUnit u -> UnitId
homeUnitId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnitEnv -> Maybe HomeUnit
ue_homeUnit UnitEnv
unit_env
    , FastString
pkg_fs forall a. Eq a => a -> a -> Bool
== String -> FastString
fsLit String
"this"
    -> UnitId -> PkgQual
ThisPkg UnitId
uid

    | Just (UnitId
uid, Maybe FastString
_) <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. a -> Maybe a -> a
fromMaybe Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
== FastString
pkg_fs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(UnitId, Maybe FastString)]
home_names
    -> UnitId -> PkgQual
ThisPkg UnitId
uid

    | Just UnitId
uid <- UnitState -> ModuleName -> PackageName -> Maybe UnitId
resolvePackageImport (HasDebugCallStack => UnitEnv -> UnitState
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)
       -- not really correct as pkg_fs is unlikely to be a valid unit-id but
       -- we will report the failure later...
  where
    home_names :: [(UnitId, Maybe FastString)]
home_names  = forall a b. (a -> b) -> [a] -> [b]
map (\UnitId
uid -> (UnitId
uid, String -> FastString
mkFastString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> Maybe String
thisPackageName (HomeUnitEnv -> DynFlags
homeUnitEnv_dflags (HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
unit_env)))) [UnitId]
hpt_deps

    units :: UnitState
units = HasDebugCallStack => UnitEnv -> UnitState
ue_units UnitEnv
unit_env

    hpt_deps :: [UnitId]
    hpt_deps :: [UnitId]
hpt_deps  = UnitState -> [UnitId]
homeUnitDepends UnitState
units


-- | Calculate the 'ImportAvails' induced by an import of a particular
-- interface, but without 'imp_mods'.
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    = forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
      imp_sem_mod :: Module
imp_sem_mod= forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface
      orph_iface :: Bool
orph_iface = ModIfaceBackend -> Bool
mi_orphan (forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
      has_finsts :: Bool
has_finsts = ModIfaceBackend -> Bool
mi_finsts (forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
      deps :: Dependencies
deps       = forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface
      trust :: SafeHaskellMode
trust      = IfaceTrustInfo -> SafeHaskellMode
getSafeMode forall a b. (a -> b) -> a -> b
$ forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust ModIface
iface
      trust_pkg :: Bool
trust_pkg  = forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_trust_pkg ModIface
iface
      is_sig :: Bool
is_sig     = forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src ModIface
iface forall a. Eq a => a -> a -> Bool
== HscSource
HsigFile

      -- If the module exports anything defined in this module, just
      -- ignore it.  Reason: otherwise it looks as if there are two
      -- local definition sites for the thing, and an error gets
      -- reported.  Easiest thing is just to filter them out up
      -- front. This situation only arises if a module imports
      -- itself, or another module that imported it.  (Necessarily,
      -- this involves a loop.)
      --
      -- We do this *after* filterImports, so that if you say
      --      module A where
      --         import B( AType )
      --         type AType = ...
      --
      --      module B( AType ) where
      --         import {-# SOURCE #-} A( AType )
      --
      -- then you won't get a 'B does not export AType' message.


      -- Compute new transitive dependencies
      --
      -- 'dep_orphs' and 'dep_finsts' do NOT include the imported module
      -- itself, but we DO need to include this module in 'imp_orphs' and
      -- 'imp_finsts' if it defines an orphan or instance family; thus the
      -- orph_iface/has_iface tests.

      deporphs :: [Module]
deporphs  = Dependencies -> [Module]
dep_orphs Dependencies
deps
      depfinsts :: [Module]
depfinsts = Dependencies -> [Module]
dep_finsts Dependencies
deps

      orphans :: [Module]
orphans | Bool
orph_iface = forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Bool -> Bool
not (Module
imp_sem_mod forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Module]
deporphs)) (forall a. Outputable a => a -> SDoc
ppr Module
imp_sem_mod SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [Module]
deporphs) forall a b. (a -> b) -> a -> b
$
                             Module
imp_sem_mod forall a. a -> [a] -> [a]
: [Module]
deporphs
              | Bool
otherwise  = [Module]
deporphs

      finsts :: [Module]
finsts | Bool
has_finsts = forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Bool -> Bool
not (Module
imp_sem_mod forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Module]
depfinsts)) (forall a. Outputable a => a -> SDoc
ppr Module
imp_sem_mod SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [Module]
depfinsts) forall a b. (a -> b) -> a -> b
$
                            Module
imp_sem_mod forall a. a -> [a] -> [a]
: [Module]
depfinsts
             | Bool
otherwise  = [Module]
depfinsts

      -- Trusted packages are a lot like orphans.
      trusted_pkgs :: Set UnitId
trusted_pkgs | Bool
mod_safe' = Dependencies -> Set UnitId
dep_trusted_pkgs Dependencies
deps
                   | Bool
otherwise = forall a. Set a
S.empty


      pkg :: GenUnit UnitId
pkg = forall unit. GenModule unit -> unit
moduleUnit (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)
      ipkg :: UnitId
ipkg = GenUnit UnitId -> UnitId
toUnitId GenUnit UnitId
pkg

      -- Does this import mean we now require our own pkg
      -- to be trusted? See Note [Trust Own Package]
      ptrust :: Bool
ptrust = SafeHaskellMode
trust 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 forall a. Ord a => a -> Set a -> Bool
`S.member` Set UnitId
other_home_units
                        then forall a. Set a
S.empty
                        else forall a. a -> Set a
S.singleton UnitId
ipkg

      direct_mods :: InstalledModuleEnv ModuleNameWithIsBoot
direct_mods = Set (UnitId, ModuleNameWithIsBoot)
-> InstalledModuleEnv ModuleNameWithIsBoot
mkModDeps forall a b. (a -> b) -> a -> b
$ if GenUnit UnitId -> UnitId
toUnitId GenUnit UnitId
pkg forall a. Ord a => a -> Set a -> Bool
`S.member` Set UnitId
other_home_units
                      then forall a. a -> Set a
S.singleton (Module -> UnitId
moduleUnitId Module
imp_mod, (forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB (forall unit. GenModule unit -> ModuleName
moduleName Module
imp_mod) IsBootInterface
want_boot))
                      else forall a. Set a
S.empty

      dep_boot_mods_map :: InstalledModuleEnv ModuleNameWithIsBoot
dep_boot_mods_map = Set (UnitId, ModuleNameWithIsBoot)
-> InstalledModuleEnv ModuleNameWithIsBoot
mkModDeps (Dependencies -> Set (UnitId, ModuleNameWithIsBoot)
dep_boot_mods Dependencies
deps)

      boot_mods :: InstalledModuleEnv ModuleNameWithIsBoot
boot_mods
        -- If we are looking for a boot module, it must be HPT
        | IsBootInterface
IsBoot <- IsBootInterface
want_boot = forall a.
InstalledModuleEnv a
-> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv InstalledModuleEnv ModuleNameWithIsBoot
dep_boot_mods_map (GenUnit UnitId -> UnitId
toUnitId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module
imp_mod) (forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB (forall unit. GenModule unit -> ModuleName
moduleName Module
imp_mod) IsBootInterface
IsBoot)
        -- Now we are importing A properly, so don't go looking for
        -- A.hs-boot
        | HomeUnit -> GenUnit UnitId -> Bool
isHomeUnit HomeUnit
home_unit GenUnit UnitId
pkg = InstalledModuleEnv ModuleNameWithIsBoot
dep_boot_mods_map
        -- There's no boot files to find in external imports
        | Bool
otherwise = forall a. InstalledModuleEnv a
emptyInstalledModuleEnv

      sig_mods :: [ModuleName]
sig_mods =
        if Bool
is_sig
          then forall unit. GenModule unit -> ModuleName
moduleName Module
imp_mod 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       = forall a. Module -> a -> ModuleEnv a
unitModuleEnv (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 ModuleNameWithIsBoot
imp_direct_dep_mods = InstalledModuleEnv ModuleNameWithIsBoot
direct_mods,
          imp_dep_direct_pkgs :: Set UnitId
imp_dep_direct_pkgs = Set UnitId
dependent_pkgs,
          imp_boot_mods :: InstalledModuleEnv ModuleNameWithIsBoot
imp_boot_mods = InstalledModuleEnv ModuleNameWithIsBoot
boot_mods,

          -- Add in the imported modules trusted package
          -- requirements. ONLY do this though if we import the
          -- module as a safe import.
          -- See Note [Tracking Trust Transitively]
          -- and Note [Trust Transitive Property]
          imp_trust_pkgs :: Set UnitId
imp_trust_pkgs = Set UnitId
trusted_pkgs,
          -- Do we require our own pkg to be trusted?
          -- See Note [Trust Own Package]
          imp_trust_own_pkg :: Bool
imp_trust_own_pkg = Bool
pkg_trust_req
     }


-- | Issue a warning if the user imports Data.List without either an import
-- list or `qualified`. This is part of the migration plan for the
-- `Data.List.singleton` proposal. See #17244.
warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM ()
warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnqualifiedImport ImportDecl GhcPs
decl ModIface
iface =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
bad_import forall a b. (a -> b) -> a -> b
$ do
      let msg :: TcRnMessage
msg = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage 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 = forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
    loc :: SrcSpan
loc = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall a b. (a -> b) -> a -> b
$ forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
decl

    is_qual :: Bool
is_qual = ImportDeclQualifiedStyle -> Bool
isImportDeclQualified (forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
decl)
    has_import_list :: Bool
has_import_list =
      -- We treat a `hiding` clause as not having an import list although
      -- it's not entirely clear this is the right choice.
      case forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding ImportDecl GhcPs
decl of
        Just (Bool
False, XRec GhcPs [LIE GhcPs]
_) -> Bool
True
        Maybe (Bool, 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
vcat
      [ String -> SDoc
text String
"To ensure compatibility with future core libraries changes"
      , String -> SDoc
text String
"imports to" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
decl) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"should be"
      , String -> SDoc
text String
"either qualified or have an explicit import list."
      ]

    -- Modules for which we warn if we see unqualified imports
    qualifiedMods :: ModuleSet
qualifiedMods = [Module] -> ModuleSet
mkModuleSet [ Module
dATA_LIST ]


warnRedundantSourceImport :: ModuleName -> TcRnMessage
warnRedundantSourceImport :: ModuleName -> TcRnMessage
warnRedundantSourceImport ModuleName
mod_name
  = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic DiagnosticReason
WarningWithoutFlag [GhcHint]
noHints forall a b. (a -> b) -> a -> b
$
      String -> SDoc
text String
"Unnecessary {-# SOURCE #-} in the import of module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name)

{-
************************************************************************
*                                                                      *
\subsection{importsFromLocalDecls}
*                                                                      *
************************************************************************

From the top-level declarations of this module produce
        * the lexical environment
        * the ImportAvails
created by its bindings.

Note [Top-level Names in Template Haskell decl quotes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See also: Note [Interactively-bound Ids in GHCi] in GHC.Driver.Env
          Note [Looking up Exact RdrNames] in GHC.Rename.Env

Consider a Template Haskell declaration quotation like this:
      module M where
        f x = h [d| f = 3 |]
When renaming the declarations inside [d| ...|], we treat the
top level binders specially in two ways

1.  We give them an Internal Name, not (as usual) an External one.
    This is done by GHC.Rename.Env.newTopSrcBinder.

2.  We make them *shadow* the outer bindings.
    See Note [GlobalRdrEnv shadowing]

3. We find out whether we are inside a [d| ... |] by testing the TH
   stage. This is a slight hack, because the stage field was really
   meant for the type checker, and here we are not interested in the
   fields of Brack, hence the error thunks in thRnBrack.
-}

extendGlobalRdrEnvRn :: [AvailInfo]
                     -> MiniFixityEnv
                     -> RnM (TcGblEnv, TcLclEnv)
-- Updates both the GlobalRdrEnv and the FixityEnv
-- We return a new TcLclEnv only because we might have to
-- delete some bindings from it;
-- see Note [Top-level Names in Template Haskell decl quotes]

extendGlobalRdrEnvRn :: [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [AvailInfo]
avails MiniFixityEnv
new_fixities
  = forall r. TcM r -> TcM r
checkNoErrs forall a b. (a -> b) -> a -> b
$  -- See Note [Fail fast on duplicate definitions]
    do  { (TcGblEnv
gbl_env, TcLclEnv
lcl_env) <- forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
getEnvs
        ; ThStage
stage <- TcM ThStage
getStage
        ; Bool
isGHCi <- TcRn 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

              -- Delete new_occs from global and local envs
              -- If we are in a TemplateHaskell decl bracket,
              --    we are going to shadow them
              -- See Note [GlobalRdrEnv shadowing]
              inBracket :: Bool
inBracket = ThStage -> Bool
isBrackStage ThStage
stage

              lcl_env_TH :: TcLclEnv
lcl_env_TH = TcLclEnv
lcl_env { tcl_rdr :: LocalRdrEnv
tcl_rdr = forall a. LocalRdrEnv -> OccEnv a -> LocalRdrEnv
minusLocalRdrEnv (TcLclEnv -> LocalRdrEnv
tcl_rdr TcLclEnv
lcl_env) OccEnv OccName
new_occs }
                           -- See Note [GlobalRdrEnv shadowing]

              lcl_env2 :: TcLclEnv
lcl_env2 | Bool
inBracket = TcLclEnv
lcl_env_TH
                       | Bool
otherwise = TcLclEnv
lcl_env

              -- Deal with shadowing: see Note [GlobalRdrEnv shadowing]
              want_shadowing :: Bool
want_shadowing = Bool
isGHCi Bool -> Bool -> Bool
|| Bool
inBracket
              rdr_env1 :: GlobalRdrEnv
rdr_env1 | Bool
want_shadowing = 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 :: ThBindEnv
tcl_th_bndrs = forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList ThBindEnv
th_bndrs
                                                       [ ( GreName -> Name
greNameMangledName GreName
n
                                                         , (TopLevelFlag
TopLevel, Int
th_lvl) )
                                                       | GreName
n <- [GreName]
new_names ] }

        ; GlobalRdrEnv
rdr_env2 <- 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' = 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 :: GlobalRdrEnv
tcg_rdr_env = GlobalRdrEnv
rdr_env2, tcg_fix_env :: FixityEnv
tcg_fix_env = FixityEnv
fix_env' }

        ; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"extendGlobalRdrEnvRn 2" (Bool -> GlobalRdrEnv -> SDoc
pprGlobalRdrEnv Bool
True GlobalRdrEnv
rdr_env2)
        ; forall (m :: * -> *) a. Monad m => a -> m a
return (TcGblEnv
gbl_env', TcLclEnv
lcl_env3) }
  where
    new_names :: [GreName]
new_names = 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 (forall a b. (a -> b) -> [a] -> [b]
map forall name. HasOccName name => name -> OccName
occName [GreName]
new_names))

    -- If there is a fixity decl for the gre, add it to the fixity env
    extend_fix_env :: FixityEnv -> GlobalRdrElt -> FixityEnv
extend_fix_env FixityEnv
fix_env GlobalRdrElt
gre
      | Just (L SrcSpan
_ Fixity
fi) <- forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv MiniFixityEnv
new_fixities (OccName -> FastString
occNameFS OccName
occ)
      = 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 LocalDef GREs, derived from avails
    new_gres :: [GlobalRdrElt]
new_gres = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [GlobalRdrElt]
localGREsFromAvail [AvailInfo]
avails

    add_gre :: GlobalRdrEnv -> GlobalRdrElt -> RnM GlobalRdrEnv
    -- Extend the GlobalRdrEnv with a LocalDef GRE
    -- If there is already a LocalDef GRE with the same OccName,
    --    report an error and discard the new GRE
    -- This establishes INVARIANT 1 of GlobalRdrEnvs
    add_gre :: GlobalRdrEnv
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
add_gre GlobalRdrEnv
env GlobalRdrElt
gre
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
dups)    -- Same OccName defined twice
      = do { [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDupDeclErr (GlobalRdrElt
gre forall a. a -> [a] -> [a]
: [GlobalRdrElt]
dups); forall (m :: * -> *) a. Monad m => a -> m a
return GlobalRdrEnv
env }

      | Bool
otherwise
      = forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
extendGlobalRdrEnv GlobalRdrEnv
env GlobalRdrElt
gre)
      where
        -- See Note [Reporting duplicate local declarations]
        dups :: [GlobalRdrElt]
dups = 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 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

{- Note [Fail fast on duplicate definitions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If there are duplicate bindings for the same thing, we want to fail
fast. Having two bindings for the same thing can cause follow-on errors.
Example (test T9975a):
   data Test = Test { x :: Int }
   pattern Test wat = Test { x = wat }
This defines 'Test' twice.  The second defn has no field-names; and then
we get an error from Test { x=wat }, saying "Test has no field 'x'".

Easiest thing is to bale out fast on duplicate definitions, which
we do via `checkNoErrs` on `extendGlobalRdrEnvRn`.

Note [Reporting duplicate local declarations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In general, a single module may not define the same OccName multiple times. This
is checked in extendGlobalRdrEnvRn: when adding a new locally-defined GRE to the
GlobalRdrEnv we report an error if there are already duplicates in the
environment.  This establishes INVARIANT 1 (see comments on GlobalRdrEnv in
GHC.Types.Name.Reader), which says that for a given OccName, all the
GlobalRdrElts to which it maps must have distinct 'gre_name's.

For example, the following will be rejected:

  f x = x
  g x = x
  f x = x  -- Duplicate!

Two GREs with the same OccName are OK iff:
-------------------------------------------------------------------
  Existing GRE     |          Newly-defined GRE
                   |  NormalGre            FieldGre
-------------------------------------------------------------------
  Imported         |  Always               Always
                   |
  Local NormalGre  |  Never                NoFieldSelectors
                   |
  Local FieldGre   |  NoFieldSelectors     DuplicateRecordFields
                   |                       and not in same record
-------------------------------------------------------------------            -
In this table "NoFieldSelectors" means "NoFieldSelectors was enabled at the
definition site of the fields; ditto "DuplicateRecordFields".  These facts are
recorded in the 'FieldLabel' (but where both GREs are local, both will
necessarily have the same extensions enabled).

More precisely:

* The programmer is allowed to make a new local definition that clashes with an
  imported one (although attempting to refer to either may lead to ambiguity
  errors at use sites).  For example, the following definition is allowed:

    import M (f)
    f x = x

  Thus isDupGRE reports errors only if the existing GRE is a LocalDef.

* When DuplicateRecordFields is enabled, the same field label may be defined in
  multiple records. For example, this is allowed:

    {-# LANGUAGE DuplicateRecordFields #-}
    data S1 = MkS1 { f :: Int }
    data S2 = MkS2 { f :: Int }

  Even though both fields have the same OccName, this does not violate INVARIANT
  1 of the GlobalRdrEnv, because the fields have distinct selector names, which
  form part of the gre_name (see Note [GreNames] in GHC.Types.Name.Reader).

* However, we must be careful to reject the following (#9156):

    {-# LANGUAGE DuplicateRecordFields #-}
    data T = MkT { f :: Int, f :: Int }  -- Duplicate!

  In this case, both 'gre_name's are the same (because the fields belong to the
  same type), and adding them both to the environment would be a violation of
  INVARIANT 1. Thus isAllowedDup checks both GREs have distinct 'gre_name's
  if they are both record fields.

* With DuplicateRecordFields, we reject attempts to define a field and a
  non-field with the same OccName (#17965):

    {-# LANGUAGE DuplicateRecordFields #-}
    f x = x
    data T = MkT { f :: Int}

  In principle this could be supported, but the current "specification" of
  DuplicateRecordFields does not allow it. Thus isAllowedDup checks for
  DuplicateRecordFields only if *both* GREs being compared are record fields.

* However, with NoFieldSelectors, it is possible by design to define a field and
  a non-field with the same OccName:

    {-# LANGUAGE NoFieldSelectors #-}
    f x = x
    data T = MkT { f :: Int}

  Thus isAllowedDup checks for NoFieldSelectors if either the existing or the
  new GRE are record fields.  See Note [NoFieldSelectors] in GHC.Rename.Env.

See also Note [Skipping ambiguity errors at use sites of local declarations] in
GHC.Rename.Utils.
-}


{- *********************************************************************
*                                                                      *
    getLocalDeclBindersd@ returns the names for an HsDecl
             It's used for source code.

        *** See Note [The Naming story] in GHC.Hs.Decls ****
*                                                                      *
********************************************************************* -}

getLocalNonValBinders :: MiniFixityEnv -> HsGroup GhcPs
    -> RnM ((TcGblEnv, TcLclEnv), NameSet)
-- Get all the top-level binders bound the group *except*
-- for value bindings, which are treated separately
-- Specifically we return AvailInfo for
--      * type decls (incl constructors and record selectors)
--      * class decls (including class ops)
--      * associated types
--      * foreign imports
--      * value signatures (in hs-boot files only)

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  { -- Process all type/class decls *except* family instances
        ; let inst_decls :: [GenLocated SrcSpanAnnA (InstDecl GhcPs)]
inst_decls = [TyClGroup GhcPs]
tycl_decls forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds
        ; DuplicateRecordFields
dup_fields_ok <- DynFlags -> DuplicateRecordFields
xopt_DuplicateRecordFields forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        ; FieldSelectors
has_sel <- DynFlags -> FieldSelectors
xopt_FieldSelectors forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        ; ([AvailInfo]
tc_avails, [[(Name, [FieldLabel])]]
tc_fldss)
            <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DuplicateRecordFields
-> FieldSelectors
-> LTyClDecl GhcPs
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_tc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel)
                                 (forall pass. [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls [TyClGroup GhcPs]
tycl_decls)
        ; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 1" (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
        ; forall a. (TcGblEnv, TcLclEnv) -> TcRn a -> TcRn a
restoreEnvs (TcGblEnv, TcLclEnv)
envs forall a b. (a -> b) -> a -> b
$ do {
            -- Bring these things into scope first
            -- See Note [Looking up family names in family instances]

          -- Process all family instances
          -- to bring new data constructors into scope
        ; ([[AvailInfo]]
nti_availss, [[(Name, [FieldLabel])]]
nti_fldss) <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM (DuplicateRecordFields
-> FieldSelectors
-> LInstDecl GhcPs
-> RnM ([AvailInfo], [(Name, [FieldLabel])])
new_assoc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel)
                                                   [GenLocated SrcSpanAnnA (InstDecl GhcPs)]
inst_decls

          -- Finish off with value binders:
          --    foreign decls and pattern synonyms for an ordinary module
          --    type sigs in case of a hs-boot file only
        ; Bool
is_boot <- TcRn Bool
tcIsHsBootOrSig
        ; let val_bndrs :: [GenLocated SrcSpanAnnN RdrName]
val_bndrs | Bool
is_boot   = [GenLocated SrcSpanAnnN RdrName]
hs_boot_sig_bndrs
                        | Bool
otherwise = [GenLocated SrcSpanAnnN RdrName]
for_hs_bndrs
        ; [AvailInfo]
val_avails <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated SrcSpanAnnN RdrName -> RnM AvailInfo
new_simple [GenLocated SrcSpanAnnN RdrName]
val_bndrs

        ; let avails :: [AvailInfo]
avails    = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[AvailInfo]]
nti_availss 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      = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
nti_fldss forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
tc_fldss
        ; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 2" (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

        -- Force the field access so that tcg_env is not retained. The
        -- selector thunk optimisation doesn't kick-in, see #20139
        ; let !old_field_env :: NameEnv [FieldLabel]
old_field_env = TcGblEnv -> NameEnv [FieldLabel]
tcg_field_env TcGblEnv
tcg_env
        -- Extend tcg_field_env with new fields (this used to be the
        -- work of extendRecordFieldEnv)
              field_env :: NameEnv [FieldLabel]
field_env = 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 :: NameEnv [FieldLabel]
tcg_field_env = NameEnv [FieldLabel]
field_env }, TcLclEnv
tcl_env)

        ; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 3" ([SDoc] -> SDoc
vcat [forall a. Outputable a => a -> SDoc
ppr [(Name, [FieldLabel])]
flds, forall a. Outputable a => a -> SDoc
ppr NameEnv [FieldLabel]
field_env])
        ; forall (m :: * -> *) a. Monad m => a -> m a
return ((TcGblEnv, TcLclEnv)
envs, Defs
new_bndrs) } }
  where
    ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
_val_binds [LSig GhcPs]
val_sigs = HsValBinds GhcPs
binds

    for_hs_bndrs :: [LocatedN RdrName]
    for_hs_bndrs :: [GenLocated SrcSpanAnnN RdrName]
for_hs_bndrs = forall (p :: Pass) a.
(UnXRec (GhcPass p), IsSrcSpanAnn p a) =>
[LForeignDecl (GhcPass p)] -> [LIdP (GhcPass p)]
hsForeignDeclsBinders [LForeignDecl GhcPs]
foreign_decls

    -- In a hs-boot file, the value binders come from the
    --  *signatures*, and there should be no foreign binders
    hs_boot_sig_bndrs :: [GenLocated SrcSpanAnnN RdrName]
hs_boot_sig_bndrs = [ forall l e. l -> e -> GenLocated l e
L (forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
decl_loc) (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]
val_sigs, GenLocated SrcSpanAnnN RdrName
n <- [LIdP GhcPs]
ns]

      -- the SrcSpan attached to the input should be the span of the
      -- declaration, not just the name
    new_simple :: LocatedN RdrName -> RnM AvailInfo
    new_simple :: GenLocated SrcSpanAnnN RdrName -> RnM AvailInfo
new_simple GenLocated SrcSpanAnnN RdrName
rdr_name = do{ Name
nm <- GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder GenLocated SrcSpanAnnN RdrName
rdr_name
                            ; 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
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_tc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel LTyClDecl GhcPs
tc_decl -- NOT for type/data instances
        = do { let ([LocatedA (IdP GhcPs)]
bndrs, [LFieldOcc GhcPs]
flds) = forall (p :: Pass).
IsPass p =>
LocatedA (TyClDecl (GhcPass p))
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLTyClDeclBinders LTyClDecl GhcPs
tc_decl
             ; names :: [Name]
names@(Name
main_name : [Name]
sub_names) <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. LocatedAn a1 a2 -> LocatedN a2
l2n) [LocatedA (IdP GhcPs)]
bndrs
             ; [FieldLabel]
flds' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DuplicateRecordFields
-> FieldSelectors -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel
newRecordSelector DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel [Name]
sub_names) [LFieldOcc GhcPs]
flds
             ; let fld_env :: [(Name, [FieldLabel])]
fld_env = case forall l e. GenLocated l e -> e
unLoc LTyClDecl 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
_                            -> []
             ; 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) }


    -- Calculate the mapping from constructor names to fields, which
    -- will go in tcg_field_env. It's convenient to do this here where
    -- we are working with a single datatype definition.
    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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (ConDecl GhcPs) -> [(Name, [FieldLabel])]
find_con_flds (forall pass. HsDataDefn pass -> [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
               , forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> [FieldLabel]
find_con_decl_flds (forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LConDeclField GhcPs]
cdflds) )]
        find_con_flds (L SrcSpanAnnA
_ (ConDeclGADT { con_names :: forall pass. ConDecl pass -> [LIdP pass]
con_names = [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
                 , forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> [FieldLabel]
find_con_decl_flds (forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LConDeclField GhcPs]
flds))
              | L SrcSpanAnnN
_ RdrName
rdr <- [LIdP GhcPs]
rdrs ]

        find_con_flds GenLocated SrcSpanAnnA (ConDecl GhcPs)
_ = []

        find_con_name :: RdrName -> Name
find_con_name RdrName
rdr
          = forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"getLocalNonValBinders/find_con_name" forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ Name
n -> Name -> OccName
nameOccName Name
n 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)
          = forall a b. (a -> b) -> [a] -> [b]
map GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> FieldLabel
find_con_decl_fld (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)))
          = forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"getLocalNonValBinders/find_con_decl_fld" forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ FieldLabel
fl -> FieldLabel -> FastString
flLabel FieldLabel
fl forall a. Eq a => a -> a -> Bool
== FastString
lbl) [FieldLabel]
flds
          where lbl :: FastString
lbl = OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdr)

    new_assoc :: DuplicateRecordFields -> FieldSelectors -> LInstDecl GhcPs
              -> RnM ([AvailInfo], [(Name, [FieldLabel])])
    new_assoc :: DuplicateRecordFields
-> FieldSelectors
-> LInstDecl GhcPs
-> RnM ([AvailInfo], [(Name, [FieldLabel])])
new_assoc DuplicateRecordFields
_ FieldSelectors
_ (L SrcSpanAnnA
_ (TyFamInstD {})) = forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
      -- type instances don't bind new names

    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
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_di DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel forall a. Maybe a
Nothing DataFamInstDecl GhcPs
d
           ; 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 -- First, attempt to grab the name of the class from the instance.
           -- This step could fail if the instance is not headed by a class,
           -- such as in the following examples:
           --
           -- (1) The class is headed by a bang pattern, such as in
           --     `instance !Show Int` (#3811c)
           -- (2) The class is headed by a type variable, such as in
           --     `instance c` (#16385)
           --
           -- If looking up the class name fails, then mb_cls_nm will
           -- be Nothing.
           Maybe Name
mb_cls_nm <- forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
             -- See (1) above
             L SrcSpanAnnN
loc RdrName
cls_rdr <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsSigType (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
getLHsInstDeclClass_maybe LHsSigType GhcPs
inst_ty
             -- See (2) above
             forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) forall a b. (a -> b) -> a -> b
$ RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
lookupGlobalOccRn_maybe RdrName
cls_rdr
           -- Assuming the previous step succeeded, process any associated data
           -- family instances. If the previous step failed, bail out.
           case Maybe Name
mb_cls_nm of
             Maybe Name
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
             Just Name
cls_nm -> do
               ([AvailInfo]
avails, [[(Name, [FieldLabel])]]
fldss)
                 <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM (DuplicateRecordFields
-> FieldSelectors
-> Maybe Name
-> LDataFamInstDecl GhcPs
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_loc_di DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel (forall a. a -> Maybe a
Just Name
cls_nm)) [LDataFamInstDecl GhcPs]
adts
               forall (f :: * -> *) a. Applicative f => a -> f a
pure ([AvailInfo]
avails, 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
-> RnM (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 (forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl)
             ; let ([LocatedA (IdP GhcPs)]
bndrs, [LFieldOcc GhcPs]
flds) = forall (p :: Pass).
IsPass p =>
DataFamInstDecl (GhcPass p)
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataFamInstBinders DataFamInstDecl GhcPs
dfid
             ; [Name]
sub_names <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (GenLocated SrcSpanAnnN RdrName -> RnM Name
newTopSrcBinder forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a1 a2. LocatedAn a1 a2 -> LocatedN a2
l2n) [LocatedA (IdP GhcPs)]
bndrs
             ; [FieldLabel]
flds' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DuplicateRecordFields
-> FieldSelectors -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel
newRecordSelector DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel [Name]
sub_names) [LFieldOcc GhcPs]
flds
             ; let avail :: AvailInfo
avail    = Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC (forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN Name
main_name) [Name]
sub_names [FieldLabel]
flds'
                                  -- main_name is not bound here!
                   fld_env :: [(Name, [FieldLabel])]
fld_env  = HsDataDefn GhcPs
-> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
mk_fld_env (forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl) [Name]
sub_names [FieldLabel]
flds'
             ; 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
-> RnM (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
-> RnM (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 -> RnM FieldLabel
newRecordSelector DuplicateRecordFields
_ FieldSelectors
_ [] LFieldOcc GhcPs
_ = 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 forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L (forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcAnn NoEpAnns
loc) forall a b. (a -> b) -> a -> b
$ RdrName
field
       ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FieldLabel { flLabel :: FastString
flLabel = FastString
fieldLabelString
                             , flHasDuplicateRecordFields :: DuplicateRecordFields
flHasDuplicateRecordFields = DuplicateRecordFields
dup_fields_ok
                             , flHasFieldSelector :: FieldSelectors
flHasFieldSelector = FieldSelectors
has_sel
                             , flSelector :: Name
flSelector = Name
selName } }
  where
    fieldLabelString :: FastString
fieldLabelString = OccName -> FastString
occNameFS forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
fld
    selOccName :: OccName
selOccName = FastString
-> OccName -> DuplicateRecordFields -> FieldSelectors -> OccName
fieldSelectorOccName FastString
fieldLabelString (Name -> OccName
nameOccName Name
dc) DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel
    field :: RdrName
field | RdrName -> Bool
isExact RdrName
fld = RdrName
fld
              -- use an Exact RdrName as is to preserve the bindings
              -- of an already renamer-resolved field and its use
              -- sites. This is needed to correctly support record
              -- selectors in Template Haskell. See Note [Binders in
              -- Template Haskell] in "GHC.ThToHs" and Note [Looking up
              -- Exact RdrNames] in "GHC.Rename.Env".
          | Bool
otherwise   = OccName -> RdrName
mkRdrUnqual OccName
selOccName

{-
Note [Looking up family names in family instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider

  module M where
    type family T a :: *
    type instance M.T Int = Bool

We might think that we can simply use 'lookupOccRn' when processing the type
instance to look up 'M.T'.  Alas, we can't!  The type family declaration is in
the *same* HsGroup as the type instance declaration.  Hence, as we are
currently collecting the binders declared in that HsGroup, these binders will
not have been added to the global environment yet.

Solution is simple: process the type family declarations first, extend
the environment, and then process the type instances.


************************************************************************
*                                                                      *
\subsection{Filtering imports}
*                                                                      *
************************************************************************

@filterImports@ takes the @ExportEnv@ telling what the imported module makes
available, and filters it through the import spec (if any).

Note [Dealing with imports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
For import M( ies ), we take the mi_exports of M, and make
   imp_occ_env :: OccEnv (NameEnv (GreName, AvailInfo, Maybe Name))
One entry for each OccName that M exports, mapping each corresponding Name to
its GreName, the AvailInfo exported from M that exports that Name, and
optionally a Name for an associated type's parent class. (Typically there will
be a single Name in the NameEnv, but see Note [Importing DuplicateRecordFields]
for why we may need more than one.)

The situation is made more complicated by associated types. E.g.
   module M where
     class    C a    where { data T a }
     instance C Int  where { data T Int = T1 | T2 }
     instance C Bool where { data T Int = T3 }
Then M's export_avails are (recall the AvailTC invariant from Avails.hs)
  C(C,T), T(T,T1,T2,T3)
Notice that T appears *twice*, once as a child and once as a parent. From
this list we construct a raw list including
   T -> (T, T( T1, T2, T3 ), Nothing)
   T -> (T, C( C, T ),       Nothing)
and we combine these (in function 'combine' in 'imp_occ_env' in
'filterImports') to get
   T  -> (T,  T(T,T1,T2,T3), Just C)

So the overall imp_occ_env is
   C  -> (C,  C(C,T),        Nothing)
   T  -> (T,  T(T,T1,T2,T3), Just C)
   T1 -> (T1, T(T,T1,T2,T3), Nothing)   -- similarly T2,T3

If we say
   import M( T(T1,T2) )
then we get *two* Avails:  C(T), T(T1,T2)

Note that the imp_occ_env will have entries for data constructors too,
although we never look up data constructors.

Note [Importing PatternSynonyms]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As described in Note [Dealing with imports], associated types can lead to the
same Name appearing twice, both as a child and once as a parent, when
constructing the imp_occ_env.  The same thing can happen with pattern synonyms
if they are exported bundled with a type.

A simplified example, based on #11959:

  {-# LANGUAGE PatternSynonyms #-}
  module M (T(P), pattern P) where  -- Duplicate export warning, but allowed
    data T = MkT
    pattern P = MkT

Here we have T(P) and P in export_avails, and construct both
  P -> (P, P, Nothing)
  P -> (P, T(P), Nothing)
which are 'combine'd to leave
  P -> (P, T(P), Nothing)
i.e. we simply discard the non-bundled Avail.

Note [Importing DuplicateRecordFields]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In filterImports, another complicating factor is DuplicateRecordFields.
Suppose we have:

  {-# LANGUAGE DuplicateRecordFields #-}
  module M (S(foo), T(foo)) where
    data S = MkS { foo :: Int }
    data T = mkT { foo :: Int }

  module N where
    import M (foo)    -- this is an ambiguity error (A)
    import M (S(foo)) -- this is allowed (B)

Here M exports the OccName 'foo' twice, so we get an imp_occ_env where 'foo'
maps to a NameEnv containing an entry for each of the two mangled field selector
names (see Note [FieldLabel] in GHC.Types.FieldLabel).

  foo -> [ $sel:foo:MkS -> (foo, S(foo), Nothing)
         , $sel:foo:MKT -> (foo, T(foo), Nothing)
         ]

Then when we look up 'foo' in lookup_name for case (A) we get both entries and
hence report an ambiguity error.  Whereas in case (B) we reach the lookup_ie
case for IEThingWith, which looks up 'S' and then finds the unique 'foo' amongst
its children.

See T16745 for a test of this.

-}

filterImports
    :: ModIface
    -> ImpDeclSpec                     -- The span for the entire import decl
    -> Maybe (Bool, LocatedL [LIE GhcPs])    -- Import spec; True => hiding
    -> RnM (Maybe (Bool, LocatedL [LIE GhcRn]), -- Import spec w/ Names
            [GlobalRdrElt])                   -- Same again, but in GRE form
filterImports :: ModIface
-> ImpDeclSpec
-> Maybe (Bool, LocatedL [LIE GhcPs])
-> RnM (Maybe (Bool, LocatedL [LIE GhcRn]), [GlobalRdrElt])
filterImports ModIface
iface ImpDeclSpec
decl_spec Maybe (Bool, LocatedL [LIE GhcPs])
Nothing
  = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails (forall a. a -> Maybe a
Just ImportSpec
imp_spec) (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 (Bool
want_hiding, L SrcSpanAnnL
l [LIE GhcPs]
import_items))
  = do  -- check for errors, convert RdrNames to Names
        [[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]]
items1 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LIE GhcPs -> TcRn [(LIE GhcRn, AvailInfo)]
lookup_lie [LIE GhcPs]
import_items

        let items2 :: [(LIE GhcRn, AvailInfo)]
            items2 :: [(LIE GhcRn, AvailInfo)]
items2 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(GenLocated SrcSpanAnnA (IE GhcRn), AvailInfo)]]
items1
                -- NB the AvailInfo may have duplicates, and several items
                --    for the same parent; e.g N(x) and N(y)

            names :: Defs
names  = [AvailInfo] -> Defs
availsToNameSetWithSelectors (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(LIE 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 | Bool
want_hiding = Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails (forall a. a -> Maybe a
Just ImportSpec
hiding_spec) [AvailInfo]
pruned_avails
                 | Bool
otherwise   = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
gresFromIE ImpDeclSpec
decl_spec) [(LIE GhcRn, AvailInfo)]
items2

        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (Bool
want_hiding, forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(LIE GhcRn, AvailInfo)]
items2)), [GlobalRdrElt]
gres)
  where
    all_avails :: [AvailInfo]
all_avails = forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface

        -- See Note [Dealing with imports]
    imp_occ_env :: OccEnv (NameEnv (GreName,    -- the name or field
                           AvailInfo,   -- the export item providing it
                           Maybe Name))   -- the parent of associated types
    imp_occ_env :: OccEnv (NameEnv (GreName, AvailInfo, Maybe Name))
imp_occ_env = forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C (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)
                             [ (forall name. HasOccName name => name -> OccName
occName GreName
c, forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(GreName -> Name
greNameMangledName GreName
c, (GreName
c, AvailInfo
a, forall a. Maybe a
Nothing))])
                                     | AvailInfo
a <- [AvailInfo]
all_avails
                                     , GreName
c <- AvailInfo -> [GreName]
availGreNames AvailInfo
a]
    -- See Note [Dealing with imports]
    -- 'combine' may be called for associated data types which appear
    -- twice in the all_avails. In the example, we combine
    --    T(T,T1,T2,T3) and C(C,T)  to give   (T, T(T,T1,T2,T3), Just C)
    -- NB: the AvailTC can have fields as well as data constructors (#12127)
    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)
      = forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name
name1 forall a. Eq a => a -> a -> Bool
== Name
name2 Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe Name
mb1 Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe Name
mb2)
                  (forall a. Outputable a => a -> SDoc
ppr Name
name1 SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
name2 SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Maybe Name
mb1 SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Maybe Name
mb2) forall a b. (a -> b) -> a -> b
$
        if Name
p1 forall a. Eq a => a -> a -> Bool
== Name
name1 then (Name -> GreName
NormalGreName Name
name1, AvailInfo
a1, forall a. a -> Maybe a
Just Name
p2)
                       else (Name -> GreName
NormalGreName Name
name1, AvailInfo
a2, forall a. a -> Maybe a
Just Name
p1)
    -- 'combine' may also be called for pattern synonyms which appear both
    -- unassociated and associated (see Note [Importing PatternSynonyms]).
    combine (GreName
c1, AvailInfo
a1, Maybe Name
mb1) (GreName
c2, AvailInfo
a2, Maybe Name
mb2)
      = forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (GreName
c1 forall a. Eq a => a -> a -> Bool
== GreName
c2 Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe Name
mb1 Bool -> Bool -> 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))
                  (forall a. Outputable a => a -> SDoc
ppr GreName
c1 SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr GreName
c2 SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr AvailInfo
a1 SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr AvailInfo
a2 SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Maybe Name
mb1 SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Maybe Name
mb2) forall a b. (a -> b) -> a -> b
$
        if AvailInfo -> Bool
isAvailTC AvailInfo
a1 then (GreName
c1, AvailInfo
a1, forall a. Maybe a
Nothing)
                        else (GreName
c1, AvailInfo
a2, 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
       | RdrName -> Bool
isQual RdrName
rdr              = 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 = case forall a. NameEnv a -> [a]
nonDetNameEnvElts NameEnv (GreName, AvailInfo, Maybe Name)
succ of
                                     -- See Note [Importing DuplicateRecordFields]
                                     [(GreName
c,AvailInfo
a,Maybe Name
x)] -> forall (m :: * -> *) a. Monad m => a -> m a
return (GreName -> Name
greNameMangledName GreName
c, AvailInfo
a, Maybe Name
x)
                                     [(GreName, AvailInfo, Maybe Name)]
xs -> forall a. IELookupError -> IELookupM a
failLookupWith (RdrName -> [AvailInfo] -> IELookupError
AmbiguousImport RdrName
rdr (forall a b. (a -> b) -> [a] -> [b]
map forall a b c. (a, b, c) -> b
sndOf3 [(GreName, AvailInfo, Maybe Name)]
xs))
       | Bool
otherwise               = forall a. IELookupError -> IELookupM a
failLookupWith (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie)
      where
        mb_success :: Maybe (NameEnv (GreName, AvailInfo, Maybe Name))
mb_success = 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) <- forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc forall a b. (a -> b) -> a -> b
$
                               forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. a -> Maybe a -> a
fromMaybe ([],[])) forall a b. (a -> b) -> a -> b
$
                               forall a. IELookupM a -> TcRn (Maybe a)
run_lookup (IE GhcPs -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
lookup_ie IE GhcPs
ieRdr)
             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
             forall (m :: * -> *) a. Monad m => a -> m a
return [ (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
            -- Warn when importing T(..) if T was exported abstractly
            emit_warning :: IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) ()
emit_warning (DodgyImport RdrName
n) = forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnDodgyImports forall a b. (a -> b) -> a -> b
$
              TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addTcRnDiagnostic (RdrName -> TcRnMessage
TcRnDodgyImports RdrName
n)
            emit_warning IELookupWarning
MissingImportList = forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnMissingImportList 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) = forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnDodgyImports forall a b. (a -> b) -> a -> b
$ do
              let msg :: TcRnMessage
msg = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage 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 forall a b. (a -> b) -> a -> b
$ forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (IELookupError -> SDoc
lookup_err_msg IELookupError
err)
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
              Succeeded a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (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

        -- For each import item, we convert its RdrNames to Names,
        -- and at the same time construct an AvailInfo corresponding
        -- to what is actually imported by this item.
        -- Returns Nothing on error.
        -- We return a list here, because in the case of an import
        -- item like C, if we are hiding, then C refers to *both* a
        -- type/class and a data constructor.  Moreover, when we import
        -- data constructors of an associated family, we need separate
        -- AvailInfos for the data constructors and the family (as they have
        -- different parents).  See Note [Dealing with imports]
    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 forall a b. (a -> b) -> a -> b
$
      case IE GhcPs
ie of
        IEVar XIEVar GhcPs
_ (L SrcSpanAnnA
l IEWrappedName (IdP GhcPs)
n) -> do
            (Name
name, AvailInfo
avail, Maybe Name
_) <- IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie forall a b. (a -> b) -> a -> b
$ forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
n
            forall (m :: * -> *) a. Monad m => a -> m a
return ([(forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
noExtField (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName (IdP GhcPs)
n Name
name)),
                                                  AvailInfo -> Name -> AvailInfo
trimAvail AvailInfo
avail Name
name)], [])

        IEThingAll XIEThingAll GhcPs
_ (L SrcSpanAnnA
l IEWrappedName (IdP GhcPs)
tc) -> do
            (Name
name, AvailInfo
avail, Maybe Name
mb_parent) <- IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie forall a b. (a -> b) -> a -> b
$ forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
tc
            let warns :: [IELookupWarning]
warns = case AvailInfo
avail of
                          Avail {}                     -- e.g. f(..)
                            -> [RdrName -> IELookupWarning
DodgyImport forall a b. (a -> b) -> a -> b
$ forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
tc]

                          AvailTC Name
_ [GreName]
subs
                            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Int -> [a] -> [a]
drop Int
1 [GreName]
subs) -- e.g. T(..) where T is a synonym
                            -> [RdrName -> IELookupWarning
DodgyImport forall a b. (a -> b) -> a -> b
$ forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
tc]

                            | Bool -> Bool
not (ImpDeclSpec -> Bool
is_qual ImpDeclSpec
decl_spec)  -- e.g. import M( T(..) )
                            -> [IELookupWarning
MissingImportList]

                            | Bool
otherwise
                            -> []

                renamed_ie :: IE GhcRn
renamed_ie = forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll forall a. EpAnn a
noAnn (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName (IdP GhcPs)
tc 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 forall a. Eq a => [a] -> [a] -> [a]
\\ [Name -> GreName
NormalGreName Name
name]))]
            case Maybe Name
mb_parent of
              Maybe Name
Nothing     -> forall (m :: * -> *) a. Monad m => a -> m a
return ([(IE GhcRn
renamed_ie, AvailInfo
avail)], [IELookupWarning]
warns)
                             -- non-associated ty/cls
              Just Name
parent -> forall (m :: * -> *) a. Monad m => a -> m a
return ((IE GhcRn
renamed_ie, Name -> [GreName] -> AvailInfo
AvailTC Name
parent [Name -> GreName
NormalGreName Name
name]) forall a. a -> [a] -> [a]
: [(IE GhcRn, AvailInfo)]
sub_avails, [IELookupWarning]
warns)
                             -- associated type

        IEThingAbs XIEThingAbs GhcPs
_ (L SrcSpanAnnA
l IEWrappedName (IdP GhcPs)
tc')
            | Bool
want_hiding   -- hiding ( C )
                       -- Here the 'C' can be a data constructor
                       --  *or* a type/class, or even both
            -> let tc :: RdrName
tc = forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
tc'
                   tc_name :: IELookupM (Name, AvailInfo, Maybe Name)
tc_name = IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie 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 RdrName
tc NameSpace
srcDataName)
               in
               case forall a. [IELookupM a] -> [a]
catIELookupM [ IELookupM (Name, AvailInfo, Maybe Name)
tc_name, IELookupM (Name, AvailInfo, Maybe Name)
dc_name ] of
                 []    -> forall a. IELookupError -> IELookupM a
failLookupWith (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie)
                 [(Name, AvailInfo, Maybe Name)]
names -> forall (m :: * -> *) a. Monad m => a -> m a
return ([forall {pass} {a} {name1}.
(IdP pass ~ Name, XIEThingAbs pass ~ EpAnn a) =>
IEWrappedName name1
-> SrcSpanAnnA
-> (Name, AvailInfo, Maybe Name)
-> (IE pass, AvailInfo)
mkIEThingAbs IEWrappedName (IdP 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 (forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
tc')
                  forall (m :: * -> *) a. Monad m => a -> m a
return ([forall {pass} {a} {name1}.
(IdP pass ~ Name, XIEThingAbs pass ~ EpAnn a) =>
IEWrappedName name1
-> SrcSpanAnnA
-> (Name, AvailInfo, Maybe Name)
-> (IE pass, AvailInfo)
mkIEThingAbs IEWrappedName (IdP GhcPs)
tc' SrcSpanAnnA
l (Name, AvailInfo, Maybe Name)
nameAvail]
                         , [])

        IEThingWith XIEThingWith GhcPs
xt ltc :: GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
ltc@(L SrcSpanAnnA
l IEWrappedName (IdP GhcPs)
rdr_tc) IEWildcard
wc [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
rdr_ns -> do
           (Name
name, AvailInfo
avail, Maybe Name
mb_parent)
               <- IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name (forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs forall a. EpAnn a
noAnn GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
ltc) (forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
rdr_tc)

           -- Look up the children in the sub-names of the parent
           -- See Note [Importing DuplicateRecordFields]
           let subnames :: [GreName]
subnames = AvailInfo -> [GreName]
availSubordinateGreNames AvailInfo
avail
           case [GreName]
-> [LIEWrappedName RdrName]
-> MaybeErr
     [LIEWrappedName RdrName] ([LocatedA Name], [Located FieldLabel])
lookupChildren [GreName]
subnames [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
rdr_ns of

             Failed [LIEWrappedName RdrName]
rdrs -> forall a. IELookupError -> IELookupM a
failLookupWith (IE GhcPs -> IELookupError
BadImport (forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith XIEThingWith GhcPs
xt GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
ltc IEWildcard
wc [LIEWrappedName RdrName]
rdrs))
                                -- We are trying to import T( a,b,c,d ), and failed
                                -- to find 'b' and 'd'.  So we make up an import item
                                -- to report as failing, namely T( b, d ).
                                -- c.f. #15412

             Succeeded ([LocatedA Name]
childnames, [Located FieldLabel]
childflds) ->
               case Maybe Name
mb_parent of
                 -- non-associated ty/cls
                 Maybe Name
Nothing
                   -> forall (m :: * -> *) a. Monad m => a -> m a
return ([(forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith [Located FieldLabel]
childflds (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l IEWrappedName Name
name') IEWildcard
wc [LIEWrappedName Name]
childnames',
                               Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
name (Name
nameforall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc [LocatedA Name]
childnames) (forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc [Located FieldLabel]
childflds))],
                              [])
                   where name' :: IEWrappedName Name
name' = forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName (IdP GhcPs)
rdr_tc Name
name
                         childnames' :: [LIEWrappedName Name]
childnames' = forall a b. (a -> b) -> [a] -> [b]
map forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn [LocatedA Name]
childnames
                         -- childnames' = postrn_ies childnames
                 -- associated ty
                 Just Name
parent
                   -> forall (m :: * -> *) a. Monad m => a -> m a
return ([(forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith [Located FieldLabel]
childflds (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l IEWrappedName Name
name') IEWildcard
wc [LIEWrappedName Name]
childnames',
                                Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
name (forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc [LocatedA Name]
childnames) (forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc [Located FieldLabel]
childflds)),
                               (forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith [Located FieldLabel]
childflds (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l IEWrappedName Name
name') IEWildcard
wc [LIEWrappedName Name]
childnames',
                                Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
parent [Name
name] [])],
                              [])
                   where name' :: IEWrappedName Name
name' = forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName (IdP GhcPs)
rdr_tc Name
name
                         childnames' :: [LIEWrappedName Name]
childnames' = forall a b. (a -> b) -> [a] -> [b]
map forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn [LocatedA Name]
childnames

        IE GhcPs
_other -> forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
IllegalImport
        -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
        -- all errors.

      where
        mkIEThingAbs :: IEWrappedName name1
-> SrcSpanAnnA
-> (Name, AvailInfo, Maybe Name)
-> (IE pass, AvailInfo)
mkIEThingAbs IEWrappedName name1
tc SrcSpanAnnA
l (Name
n, AvailInfo
av, Maybe Name
Nothing    )
          = (forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs forall a. EpAnn a
noAnn (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName name1
tc Name
n)), AvailInfo -> Name -> AvailInfo
trimAvail AvailInfo
av Name
n)
        mkIEThingAbs IEWrappedName name1
tc SrcSpanAnnA
l (Name
n, AvailInfo
_,  Just Name
parent)
          = (forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs forall a. EpAnn a
noAnn (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName name1
tc 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 = forall a.
IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
m forall a b. (a -> b) -> a -> b
$ \IELookupError
err -> case IELookupError
err of
          BadImport IE GhcPs
ie | Bool
want_hiding -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], [IE GhcPs -> IELookupWarning
BadImportW IE GhcPs
ie])
          IELookupError
_                          -> forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
err

type IELookupM = MaybeErr IELookupError

data IELookupWarning
  = BadImportW (IE GhcPs)
  | MissingImportList
  | DodgyImport RdrName
  -- NB. use the RdrName for reporting a "dodgy" import

data IELookupError
  = QualImportError RdrName
  | BadImport (IE GhcPs)
  | IllegalImport
  | AmbiguousImport RdrName [AvailInfo] -- e.g. a duplicated field name as a top-level import

failLookupWith :: IELookupError -> IELookupM a
failLookupWith :: forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
err = 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 -> 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 ]

{-
************************************************************************
*                                                                      *
\subsection{Import/Export Utils}
*                                                                      *
************************************************************************
-}

-- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
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 (IdP GhcRn)
name -> \Name
n -> Name
n forall a. Eq a => a -> a -> Bool
== forall name. LIEWrappedName name -> name
lieWrappedName LIEWrappedName (IdP GhcRn)
name
                    IE GhcRn
_                 -> \Name
_ -> Bool
True
    prov_fn :: Name -> Maybe ImportSpec
prov_fn Name
name
      = 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 = forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc }


{-
Note [Children for duplicate record fields]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the module

    {-# LANGUAGE DuplicateRecordFields #-}
    module M (F(foo, MkFInt, MkFBool)) where
      data family F a
      data instance F Int = MkFInt { foo :: Int }
      data instance F Bool = MkFBool { foo :: Bool }

The `foo` in the export list refers to *both* selectors! For this
reason, lookupChildren builds an environment that maps the FastString
to a list of items, rather than a single item.
-}

mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv [GlobalRdrElt]
gres = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobalRdrElt -> NameEnv [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
add 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 -> forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc (:) 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 = forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv [a]
env Name
n forall a. Maybe a -> a -> a
`orElse` []

lookupChildren :: [GreName] -> [LIEWrappedName RdrName]
               -> MaybeErr [LIEWrappedName RdrName]   -- The ones for which the lookup failed
                           ([LocatedA Name], [Located FieldLabel])
-- (lookupChildren all_kids rdr_items) maps each rdr_item to its
-- corresponding Name all_kids, if the former exists
-- The matching is done by FastString, not OccName, so that
--    Cls( meth, AssocTy )
-- will correctly find AssocTy among the all_kids of Cls, even though
-- the RdrName for AssocTy may have a (bogus) DataName namespace
-- (Really the rdr_items should be FastStrings in the first place.)
lookupChildren :: [GreName]
-> [LIEWrappedName RdrName]
-> MaybeErr
     [LIEWrappedName RdrName] ([LocatedA Name], [Located FieldLabel])
lookupChildren [GreName]
all_kids [LIEWrappedName RdrName]
rdr_items
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIEWrappedName RdrName]
fails
  = forall err val. val -> MaybeErr err val
Succeeded (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (LocatedA Name) [Located FieldLabel]]
oks))
       -- This 'fmap concat' trickily applies concat to the /second/ component
       -- of the pair, whose type is ([LocatedA Name], [[Located FieldLabel]])
  | Bool
otherwise
  = forall err val. err -> MaybeErr err val
Failed [LIEWrappedName RdrName]
fails
  where
    mb_xs :: [MaybeErr
   (LIEWrappedName RdrName)
   (Either (LocatedA Name) [Located FieldLabel])]
mb_xs = forall a b. (a -> b) -> [a] -> [b]
map LIEWrappedName RdrName
-> MaybeErr
     (LIEWrappedName RdrName)
     (Either (LocatedA Name) [Located FieldLabel])
doOne [LIEWrappedName RdrName]
rdr_items
    fails :: [LIEWrappedName RdrName]
fails = [ LIEWrappedName RdrName
bad_rdr | Failed LIEWrappedName RdrName
bad_rdr <- [MaybeErr
   (LIEWrappedName RdrName)
   (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
   (LIEWrappedName RdrName)
   (Either (LocatedA Name) [Located FieldLabel])]
mb_xs ]
    oks :: [Either (LocatedA Name) [Located FieldLabel]]

    doOne :: LIEWrappedName RdrName
-> MaybeErr
     (LIEWrappedName RdrName)
     (Either (LocatedA Name) [Located FieldLabel])
doOne item :: LIEWrappedName RdrName
item@(L SrcSpanAnnA
l IEWrappedName RdrName
r)
       = case (forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv [GreName]
kid_env forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name. IEWrappedName name -> name
ieWrappedName) IEWrappedName RdrName
r of
           Just [NormalGreName Name
n]                             -> forall err val. val -> MaybeErr err val
Succeeded (forall a b. a -> Either a b
Left (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l Name
n))
           Just [GreName]
rs | Just [FieldLabel]
fs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GreName -> Maybe FieldLabel
greNameFieldLabel [GreName]
rs -> forall err val. val -> MaybeErr err val
Succeeded (forall a b. b -> Either a b
Right (forall a b. (a -> b) -> [a] -> [b]
map (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)) [FieldLabel]
fs))
           Maybe [GreName]
_                                                  -> forall err val. err -> MaybeErr err val
Failed    LIEWrappedName RdrName
item

    -- See Note [Children for duplicate record fields]
    kid_env :: FastStringEnv [GreName]
kid_env = forall a.
(a -> a -> a)
-> FastStringEnv a -> [(FastString, a)] -> FastStringEnv a
extendFsEnvList_C forall a. [a] -> [a] -> [a]
(++) forall a. FastStringEnv a
emptyFsEnv
              [(OccName -> FastString
occNameFS (forall name. HasOccName name => name -> OccName
occName GreName
x), [GreName
x]) | GreName
x <- [GreName]
all_kids]



-------------------------------

{-
*********************************************************
*                                                       *
\subsection{Unused names}
*                                                       *
*********************************************************
-}

reportUnusedNames :: TcGblEnv -> HscSource -> RnM ()
reportUnusedNames :: TcGblEnv -> HscSource -> IOEnv (Env TcGblEnv TcLclEnv) ()
reportUnusedNames TcGblEnv
gbl_env HscSource
hsc_src
  = do  { Defs
keep <- 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" (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 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
    -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
    -- Hence findUses

    -- Collect the defined names from the in-scope environment
    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
    -- This is done in mkExports too; duplicated work

    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
|| 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) (forall a. NameEnv [a] -> Name -> [a]
findChildren NameEnv [GlobalRdrElt]
kids_env Name
name)
                -- A use of C implies a use of T,
                -- if C was brought into scope by T(..) or T(C)
      where
        name :: Name
name = GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre0

    -- Filter out the ones that are
    --  (a) defined in this module, and
    --  (b) not defined by a 'deriving' clause
    -- The latter have an Internal Name, so we can filter them out easily
    unused_locals :: NameSet -> [GlobalRdrElt]
    unused_locals :: Defs -> [GlobalRdrElt]
unused_locals Defs
keep =
      let -- Note that defined_and_used, defined_but_not_used
          -- are both [GRE]; that's why we need defined_and_used
          -- rather than just used_names
          _defined_and_used, defined_but_not_used :: [GlobalRdrElt]
          ([GlobalRdrElt]
_defined_and_used, [GlobalRdrElt]
defined_but_not_used)
              = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Defs -> GlobalRdrElt -> Bool
gre_is_used (Defs -> Defs
used_names Defs
keep)) [GlobalRdrElt]
defined_names

      in 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)

{- *********************************************************************
*                                                                      *
              Missing signatures
*                                                                      *
********************************************************************* -}

{-
Note [Missing signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~
There are four warning flags in play:

  * -Wmissing-exported-signatures
    Warn about any exported top-level function/value without a type signature.
    Does not include pattern synonyms.

  * -Wmissing-signatures
    Warn about any top-level function/value without a type signature. Does not
    include pattern synonyms. Takes priority over -Wmissing-exported-signatures.

  * -Wmissing-exported-pattern-synonym-signatures
    Warn about any exported pattern synonym without a type signature.

  * -Wmissing-pattern-synonym-signatures
    Warn about any pattern synonym without a type signature. Takes priority over
    -Wmissing-exported-pattern-synonym-signatures.

-}

-- | Warn the user about top level binders that lack type signatures.
-- Called /after/ type inference, so that we can report the
-- inferred type of the function
warnMissingSignatures :: TcGblEnv -> RnM ()
warnMissingSignatures :: TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingSignatures TcGblEnv
gbl_env
  = do { Bool
warn_binds    <- forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
woptM WarningFlag
Opt_WarnMissingSignatures
       ; Bool
warn_pat_syns <- 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
               -- We use sig_ns to exclude top-level bindings that are generated by GHC
             binds :: [IdP GhcTc]
binds    = forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
collectHsBindsBinders forall p. CollectFlag p
CollNoDictBinders forall a b. (a -> b) -> a -> b
$ TcGblEnv -> LHsBinds 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 =
               forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Bool
not_ghc_generated Name
name) forall a b. (a -> b) -> a -> b
$
               do { TidyEnv
env <- TcM TidyEnv
tcInitTidyEnv -- Why not use emptyTidyEnv?
                  ; 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 (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 =
               forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Bool
not_ghc_generated Name
name) forall a b. (a -> b) -> a -> b
$
                 SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (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

         -- Warn about missing signatures
         -- Do this only when we have a type to offer
         -- See Note [Missing signatures]
       ; 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]
binds
       ; 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
       }

-- | Warn the user about tycons that lack kind signatures.
-- Called /after/ type (and kind) inference, so that we can report the
-- inferred kinds.
warnMissingKindSignatures :: TcGblEnv -> RnM ()
warnMissingKindSignatures :: TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingKindSignatures TcGblEnv
gbl_env
  = do { Bool
cusks_enabled <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.CUSKs
       ; 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 =
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Bool
not_ghc_generated Name
name) forall a b. (a -> b) -> a -> b
$
        SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (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

{-
*********************************************************
*                                                       *
\subsection{Unused imports}
*                                                       *
*********************************************************

This code finds which import declarations are unused.  The
specification and implementation notes are here:
  https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/unused-imports

See also Note [Choosing the best import declaration] in GHC.Types.Name.Reader
-}

type ImportDeclUsage
   = ( LImportDecl GhcRn   -- The import declaration
     , [GlobalRdrElt]      -- What *is* used (normalised)
     , [Name] )            -- What is imported but *not* used

warnUnusedImportDecls :: TcGblEnv -> HscSource -> RnM ()
warnUnusedImportDecls :: TcGblEnv -> HscSource -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImportDecls TcGblEnv
gbl_env HscSource
hsc_src
  = do { [GlobalRdrElt]
uses <- forall a env. IORef a -> IOEnv env a
readMutVar (TcGblEnv -> TcRef [GlobalRdrElt]
tcg_used_gres TcGblEnv
gbl_env)
       ; let user_imports :: [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
user_imports = forall a. (a -> Bool) -> [a] -> [a]
filterOut
                              (forall pass. ImportDecl pass -> Bool
ideclImplicit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc)
                              (TcGblEnv -> [LImportDecl GhcRn]
tcg_rn_imports TcGblEnv
gbl_env)
                -- This whole function deals only with *user* imports
                -- both for warning about unnecessary ones, and for
                -- deciding the minimal ones
             rdr_env :: GlobalRdrEnv
rdr_env = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env
             fld_env :: NameEnv (FastString, Parent)
fld_env = GlobalRdrEnv -> NameEnv (FastString, Parent)
mkFieldEnv GlobalRdrEnv
rdr_env

       ; let usage :: [ImportDeclUsage]
             usage :: [ImportDeclUsage]
usage = [LImportDecl GhcRn] -> [GlobalRdrElt] -> [ImportDeclUsage]
findImportUsage [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
user_imports [GlobalRdrElt]
uses

       ; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"warnUnusedImportDecls" forall a b. (a -> b) -> a -> b
$
                       ([SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Uses:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
uses
                             , String -> SDoc
text String
"Import usage" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [ImportDeclUsage]
usage])

       ; forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnUnusedImports forall a b. (a -> b) -> a -> b
$
         forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WarningFlag
-> NameEnv (FastString, Parent)
-> ImportDeclUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImport WarningFlag
Opt_WarnUnusedImports NameEnv (FastString, Parent)
fld_env) [ImportDeclUsage]
usage

       ; forall gbl lcl.
GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenGOptM GeneralFlag
Opt_D_dump_minimal_imports 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
  = forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcRn -> ImportDeclUsage
unused_decl [LImportDecl 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 { ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding = Maybe (Bool, XRec GhcRn [LIE GhcRn])
imps }))
      = (LImportDecl GhcRn
decl, [GlobalRdrElt]
used_gres, Defs -> [Name]
nameSetElemsStable Defs
unused_imps)
      where
        used_gres :: [GlobalRdrElt]
used_gres = forall a. SrcLoc -> Map RealSrcLoc a -> Maybe a
lookupSrcLoc (SrcSpan -> SrcLoc
srcSpanEnd forall a b. (a -> b) -> a -> b
$ forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) ImportMap
import_usage
                               -- srcSpanEnd: see Note [The ImportMap]
                    forall a. Maybe a -> a -> a
`orElse` []

        used_names :: Defs
used_names   = [Name] -> Defs
mkNameSet (forall a b. (a -> b) -> [a] -> [b]
map      GlobalRdrElt -> Name
greMangledName        [GlobalRdrElt]
used_gres)
        used_parents :: Defs
used_parents = [Name] -> Defs
mkNameSet (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GlobalRdrElt -> Maybe Name
greParent_maybe [GlobalRdrElt]
used_gres)

        unused_imps :: Defs
unused_imps   -- Not trivial; see eg #7454
          = case Maybe (Bool, XRec GhcRn [LIE GhcRn])
imps of
              Just (Bool
False, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
imp_ies) ->
                                 forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (IE GhcRn -> Defs -> Defs
add_unused forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) Defs
emptyNameSet [GenLocated SrcSpanAnnA (IE GhcRn)]
imp_ies
              Maybe (Bool, XRec GhcRn [LIE GhcRn])
_other -> Defs
emptyNameSet -- No explicit import list => no unused-name list

        add_unused :: IE GhcRn -> NameSet -> NameSet
        add_unused :: IE GhcRn -> Defs -> Defs
add_unused (IEVar XIEVar GhcRn
_ LIEWrappedName (IdP GhcRn)
n)      Defs
acc = Name -> Defs -> Defs
add_unused_name (forall name. LIEWrappedName name -> name
lieWrappedName LIEWrappedName (IdP GhcRn)
n) Defs
acc
        add_unused (IEThingAbs XIEThingAbs GhcRn
_ LIEWrappedName (IdP GhcRn)
n) Defs
acc = Name -> Defs -> Defs
add_unused_name (forall name. LIEWrappedName name -> name
lieWrappedName LIEWrappedName (IdP GhcRn)
n) Defs
acc
        add_unused (IEThingAll XIEThingAll GhcRn
_ LIEWrappedName (IdP GhcRn)
n) Defs
acc = Name -> Defs -> Defs
add_unused_all  (forall name. LIEWrappedName name -> name
lieWrappedName LIEWrappedName (IdP GhcRn)
n) Defs
acc
        add_unused (IEThingWith XIEThingWith GhcRn
fs LIEWrappedName (IdP GhcRn)
p IEWildcard
wc [LIEWrappedName (IdP GhcRn)]
ns) Defs
acc =
          Defs -> Defs
add_wc_all (Name -> [Name] -> Defs -> Defs
add_unused_with Name
pn [Name]
xs Defs
acc)
          where pn :: Name
pn = forall name. LIEWrappedName name -> name
lieWrappedName LIEWrappedName (IdP GhcRn)
p
                xs :: [Name]
xs = forall a b. (a -> b) -> [a] -> [b]
map forall name. LIEWrappedName name -> name
lieWrappedName [LIEWrappedName (IdP GhcRn)]
ns forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (FieldLabel -> Name
flSelector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) XIEThingWith GhcRn
fs
                add_wc_all :: Defs -> Defs
add_wc_all = case IEWildcard
wc of
                            IEWildcard
NoIEWildcard -> forall a. a -> a
id
                            IEWildcard Int
_ -> Name -> Defs -> Defs
add_unused_all 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
          | 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Name -> Defs -> Defs
add_unused_name Defs
acc [Name]
ns
       -- If you use 'signum' from Num, then the user may well have
       -- imported Num(signum).  We don't want to complain that
       -- Num is not itself mentioned.  Hence the two cases in add_unused_with.


{- Note [The ImportMap]
~~~~~~~~~~~~~~~~~~~~~~~
The ImportMap is a short-lived intermediate data structure records, for
each import declaration, what stuff brought into scope by that
declaration is actually used in the module.

The SrcLoc is the location of the END of a particular 'import'
declaration.  Why *END*?  Because we don't want to get confused
by the implicit Prelude import. Consider (#7476) the module
    import Foo( foo )
    main = print foo
There is an implicit 'import Prelude(print)', and it gets a SrcSpan
of line 1:1 (just the point, not a span). If we use the *START* of
the SrcSpan to identify the import decl, we'll confuse the implicit
import Prelude with the explicit 'import Foo'.  So we use the END.
It's just a cheap hack; we could equally well use the Span too.

The [GlobalRdrElt] are the things imported from that decl.
-}

type ImportMap = Map RealSrcLoc [GlobalRdrElt]  -- See [The ImportMap]
     -- If loc :-> gres, then
     --   'loc' = the end loc of the bestImport of each GRE in 'gres'

mkImportMap :: [GlobalRdrElt] -> ImportMap
-- For each of a list of used GREs, find all the import decls that brought
-- it into scope; choose one of them (bestImport), and record
-- the RdrName in that import decl's entry in the ImportMap
mkImportMap :: [GlobalRdrElt] -> ImportMap
mkImportMap [GlobalRdrElt]
gres
  = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobalRdrElt -> ImportMap -> ImportMap
add_one 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
                              -- For srcSpanEnd see Note [The ImportMap]
       RealSrcLoc RealSrcLoc
decl_loc Maybe BufPos
_ -> 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 (forall a. Bag a -> [a]
bagToList Bag ImportSpec
imp_specs)
          add :: [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
add [GlobalRdrElt]
_ [GlobalRdrElt]
gres = GlobalRdrElt
gre forall a. a -> [a] -> [a]
: [GlobalRdrElt]
gres

warnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Parent)
                 -> ImportDeclUsage -> RnM ()
warnUnusedImport :: WarningFlag
-> NameEnv (FastString, Parent)
-> ImportDeclUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImport WarningFlag
flag NameEnv (FastString, Parent)
fld_env (L SrcSpanAnnA
loc ImportDecl GhcRn
decl, [GlobalRdrElt]
used, [Name]
unused)

  -- Do not warn for 'import M()'
  | Just (Bool
False,L SrcSpanAnnL
_ []) <- forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding ImportDecl GhcRn
decl
  = forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Note [Do not warn about Prelude hiding]
  | Just (Bool
True, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
hides) <- forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding ImportDecl GhcRn
decl
  , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (IE GhcRn)]
hides)
  , ModuleName
pRELUDE_NAME forall a. Eq a => a -> a -> Bool
== forall l e. GenLocated l e -> e
unLoc (forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcRn
decl)
  = forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Nothing used; drop entire declaration
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
used
  = let dia :: TcRnMessage
dia = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage 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 (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) TcRnMessage
dia

  -- Everything imported is used; nop
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
unused
  = forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Only one import is unused, with `SrcSpan` covering only the unused item instead of
  -- the whole import statement
  | Just (Bool
_, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
imports) <- forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding ImportDecl GhcRn
decl
  , forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
unused forall a. Eq a => a -> a -> Bool
== Int
1
  , Just (L SrcSpanAnnA
loc IE GhcRn
_) <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L SrcSpanAnnA
_ IE GhcRn
ie) -> ((forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcRn
ie) :: Name) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
unused) [GenLocated SrcSpanAnnA (IE GhcRn)]
imports
  = let dia :: TcRnMessage
dia = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage 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 (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) TcRnMessage
dia

  -- Some imports are unused
  | Bool
otherwise
  = let dia :: TcRnMessage
dia = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage 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 (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) TcRnMessage
dia

  where
    msg1 :: SDoc
msg1 = [SDoc] -> SDoc
vcat [ SDoc
pp_herald SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
pp_mod SDoc -> SDoc -> SDoc
<+> SDoc
is_redundant
                , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"except perhaps to import instances from"
                                   SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
pp_mod)
                , String -> SDoc
text String
"To import instances alone, use:"
                                   SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"import" SDoc -> SDoc -> SDoc
<+> SDoc
pp_mod SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens SDoc
Outputable.empty ]
    msg2 :: SDoc
msg2 = [SDoc] -> SDoc
sep [ SDoc
pp_herald SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
sort_unused
               , String -> SDoc
text String
"from module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
pp_mod SDoc -> SDoc -> SDoc
<+> SDoc
is_redundant]
    pp_herald :: SDoc
pp_herald  = String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> SDoc
pp_qual SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"import of"
    pp_qual :: SDoc
pp_qual
      | ImportDeclQualifiedStyle -> Bool
isImportDeclQualified (forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcRn
decl)= String -> SDoc
text String
"qualified"
      | Bool
otherwise                                  = SDoc
Outputable.empty
    pp_mod :: SDoc
pp_mod       = forall a. Outputable a => a -> SDoc
ppr (forall l e. GenLocated l e -> e
unLoc (forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcRn
decl))
    is_redundant :: SDoc
is_redundant = String -> SDoc
text String
"is redundant"

    -- In warning message, pretty-print identifiers unqualified unconditionally
    -- to improve the consistent for ambiguous/unambiguous identifiers.
    -- See trac#14881.
    ppr_possible_field :: Name -> SDoc
ppr_possible_field Name
n = case forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv (FastString, Parent)
fld_env Name
n of
                               Just (FastString
fld, ParentIs Name
p) -> Name -> SDoc
pprNameUnqualified Name
p SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens (forall a. Outputable a => a -> SDoc
ppr FastString
fld)
                               Just (FastString
fld, Parent
NoParent)   -> forall a. Outputable a => a -> SDoc
ppr FastString
fld
                               Maybe (FastString, Parent)
Nothing                -> Name -> SDoc
pprNameUnqualified Name
n

    -- Print unused names in a deterministic (lexicographic) order
    sort_unused :: SDoc
    sort_unused :: SDoc
sort_unused = forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Name -> SDoc
ppr_possible_field forall a b. (a -> b) -> a -> b
$
                  forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Name -> OccName
nameOccName) [Name]
unused

{-
Note [Do not warn about Prelude hiding]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We do not warn about
   import Prelude hiding( x, y )
because even if nothing else from Prelude is used, it may be essential to hide
x,y to avoid name-shadowing warnings.  Example (#9061)
   import Prelude hiding( log )
   f x = log where log = ()



Note [Printing minimal imports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
To print the minimal imports we walk over the user-supplied import
decls, and simply trim their import lists.  NB that

  * We do *not* change the 'qualified' or 'as' parts!

  * We do not discard a decl altogether; we might need instances
    from it.  Instead we just trim to an empty import list
-}

getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [LImportDecl GhcRn] -> [LImportDecl GhcRn]
combine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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)
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
unused
      , Just (Bool
False, XRec GhcRn [LIE GhcRn]
_) <- forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding ImportDecl GhcRn
decl
      = forall (m :: * -> *) a. Monad m => a -> m a
return (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
pkg_qual
           ; let used_avails :: [AvailInfo]
used_avails = [GlobalRdrElt] -> [AvailInfo]
gresToAvailInfo [GlobalRdrElt]
used_gres
                 lies :: [GenLocated SrcSpanAnnA (IE GhcRn)]
lies = forall a b. (a -> b) -> [a] -> [b]
map (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModIface -> AvailInfo -> [IE GhcRn]
to_ie ModIface
iface) [AvailInfo]
used_avails)
           ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (ImportDecl GhcRn
decl { ideclHiding :: Maybe (Bool, XRec GhcRn [LIE GhcRn])
ideclHiding = forall a. a -> Maybe a
Just (Bool
False, forall l e. l -> e -> GenLocated l e
L (forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
l) [GenLocated SrcSpanAnnA (IE GhcRn)]
lies) })) }
      where
        doc :: SDoc
doc = String -> SDoc
text String
"Compute minimal imports for" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr ImportDecl GhcRn
decl

    to_ie :: ModIface -> AvailInfo -> [IE GhcRn]
    -- The main trick here is that if we're importing all the constructors
    -- we want to say "T(..)", but if we're importing only a subset we want
    -- to say "T(A,B,C)".  So we have to find out what the module exports.
    to_ie :: ModIface -> AvailInfo -> [IE GhcRn]
to_ie ModIface
_ (Avail GreName
c)  -- Note [Overloaded field import]
       = [forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
noExtField (forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn forall a b. (a -> b) -> a -> b
$ forall a an. a -> LocatedAn an a
noLocA (GreName -> Name
greNamePrintableName GreName
c))]
    to_ie ModIface
_ avail :: AvailInfo
avail@(AvailTC Name
n [GreName
_])  -- Exporting the main decl and nothing else
       | AvailInfo -> Bool
availExportsDecl AvailInfo
avail = [forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs forall a. EpAnn a
noAnn (forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn forall a b. (a -> b) -> a -> b
$ 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) <- forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
                 , Name
x forall a. Eq a => a -> a -> Bool
== Name
n
                 , AvailInfo -> Bool
availExportsDecl AvailInfo
avail  -- Note [Partial export]
                 ] of
           [[GreName]
xs] | [GreName] -> Bool
all_used [GreName]
xs ->
                   [forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll forall a. EpAnn a
noAnn (forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn forall a b. (a -> b) -> a -> b
$ forall a an. a -> LocatedAn an a
noLocA Name
n)]
                | Bool
otherwise   ->
                   [forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith (forall a b. (a -> b) -> [a] -> [b]
map forall e. e -> Located e
noLoc [FieldLabel]
fs) (forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn forall a b. (a -> b) -> a -> b
$ forall a an. a -> LocatedAn an a
noLocA Name
n) IEWildcard
NoIEWildcard
                                (forall a b. (a -> b) -> [a] -> [b]
map (forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a an. a -> LocatedAn an a
noLocA) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Name
n) [Name]
ns))]
                                          -- Note [Overloaded field import]
           [[GreName]]
_other | [FieldLabel] -> Bool
all_non_overloaded [FieldLabel]
fs
                           -> forall a b. (a -> b) -> [a] -> [b]
map (forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
noExtField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn_var forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a an. a -> LocatedAn an a
noLocA) forall a b. (a -> b) -> a -> b
$ [Name]
ns
                                 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Name
flSelector [FieldLabel]
fs
                  | Bool
otherwise ->
                      [forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith (forall a b. (a -> b) -> [a] -> [b]
map forall e. e -> Located e
noLoc [FieldLabel]
fs) (forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn forall a b. (a -> b) -> a -> b
$ forall a an. a -> LocatedAn an a
noLocA Name
n) IEWildcard
NoIEWildcard
                                (forall a b. (a -> b) -> [a] -> [b]
map (forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a an. a -> LocatedAn an a
noLocA) (forall a. (a -> Bool) -> [a] -> [a]
filter (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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> Bool
flIsOverloaded)

    combine :: [LImportDecl GhcRn] -> [LImportDecl GhcRn]
    combine :: [LImportDecl GhcRn] -> [LImportDecl GhcRn]
combine = forall a b. (a -> b) -> [a] -> [b]
map [LImportDecl GhcRn] -> LImportDecl GhcRn
merge forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LImportDecl GhcRn -> (Bool, Maybe ModuleName, ModuleName)
getKey) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn LImportDecl 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified forall a b. (a -> b) -> a -> b
$ ImportDecl GhcRn
idecl -- is this qualified? (important that this be first)
      , forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcRn
idecl -- what is the qualifier (inside Maybe monad)
      , forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName forall a b. (a -> b) -> a -> b
$ ImportDecl GhcRn
idecl -- Module Name
      )
      where
        idecl :: ImportDecl GhcRn
        idecl :: ImportDecl GhcRn
idecl = forall l e. GenLocated l e -> e
unLoc LImportDecl GhcRn
decl

    merge :: [LImportDecl GhcRn] -> LImportDecl GhcRn
    merge :: [LImportDecl GhcRn] -> LImportDecl GhcRn
merge []                     = forall a. HasCallStack => String -> a
error String
"getMinimalImports: unexpected empty list"
    merge decls :: [LImportDecl GhcRn]
decls@((L SrcSpanAnnA
l ImportDecl GhcRn
decl) : [LImportDecl GhcRn]
_) = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (ImportDecl GhcRn
decl { ideclHiding :: Maybe (Bool, XRec GhcRn [LIE GhcRn])
ideclHiding = forall a. a -> Maybe a
Just (Bool
False, forall l e. l -> e -> GenLocated l e
L (forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)) [LIE GhcRn]
lies) })
      where lies :: [LIE GhcRn]
lies = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [LImportDecl GhcRn]
decls


printMinimalImports :: HscSource -> [ImportDeclUsage] -> RnM ()
-- See Note [Printing minimal imports]
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 <- forall (m :: * -> *). HasModule m => m Module
getModule
       ; DynFlags
dflags   <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       ; forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile (DynFlags -> Module -> String
mkFilename DynFlags
dflags Module
this_mod) IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
          DynFlags -> Handle -> PrintUnqualified -> Depth -> SDoc -> IO ()
printForUser DynFlags
dflags Handle
h PrintUnqualified
neverQualify Depth
AllTheWay ([SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
imports'))
              -- The neverQualify is important.  We are printing Names
              -- but they are in the context of an 'import' decl, and
              -- we never qualify things inside there
              -- E.g.   import Blag( f, b )
              -- not    import Blag( Blag.f, Blag.g )!
       }
  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 (forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod) forall a. [a] -> [a] -> [a]
++ String
suffix


to_ie_post_rn_var :: (HasOccName name) => LocatedA name -> LIEWrappedName name
to_ie_post_rn_var :: forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn_var (L SrcSpanAnnA
l name
n)
  | OccName -> Bool
isDataOcc forall a b. (a -> b) -> a -> b
$ forall name. HasOccName name => name -> OccName
occName name
n = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall name. EpaLocation -> LocatedN name -> IEWrappedName name
IEPattern (RealSrcSpan -> EpaLocation
EpaSpan forall a b. (a -> b) -> a -> b
$ forall a. SrcSpanAnn' a -> RealSrcSpan
la2r SrcSpanAnnA
l) (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpanAnnN
la2na SrcSpanAnnA
l) name
n))
  | Bool
otherwise             = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall name. LocatedN name -> IEWrappedName name
IEName                       (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpanAnnN
la2na SrcSpanAnnA
l) name
n))


to_ie_post_rn :: (HasOccName name) => LocatedA name -> LIEWrappedName name
to_ie_post_rn :: forall name.
HasOccName name =>
LocatedA name -> LIEWrappedName name
to_ie_post_rn (L SrcSpanAnnA
l name
n)
  | OccName -> Bool
isTcOcc OccName
occ Bool -> Bool -> Bool
&& OccName -> Bool
isSymOcc OccName
occ = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall name. EpaLocation -> LocatedN name -> IEWrappedName name
IEType (RealSrcSpan -> EpaLocation
EpaSpan forall a b. (a -> b) -> a -> b
$ forall a. SrcSpanAnn' a -> RealSrcSpan
la2r SrcSpanAnnA
l) (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpanAnnN
la2na SrcSpanAnnA
l) name
n))
  | Bool
otherwise                   = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall name. LocatedN name -> IEWrappedName name
IEName                    (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpanAnnN
la2na SrcSpanAnnA
l) name
n))
  where occ :: OccName
occ = forall name. HasOccName name => name -> OccName
occName name
n

{-
Note [Partial export]
~~~~~~~~~~~~~~~~~~~~~
Suppose we have

   module A( op ) where
     class C a where
       op :: a -> a

   module B where
   import A
   f = ..op...

Then the minimal import for module B is
   import A( op )
not
   import A( C( op ) )
which we would usually generate if C was exported from B.  Hence
the availExportsDecl test when deciding what to generate.


Note [Overloaded field import]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On the other hand, if we have

    {-# LANGUAGE DuplicateRecordFields #-}
    module A where
      data T = MkT { foo :: Int }

    module B where
      import A
      f = ...foo...

then the minimal import for module B must be
    import A ( T(foo) )
because when DuplicateRecordFields is enabled, field selectors are
not in scope without their enclosing datatype.

On the third hand, if we have

    {-# LANGUAGE DuplicateRecordFields #-}
    module A where
      pattern MkT { foo } = Just foo

    module B where
      import A
      f = ...foo...

then the minimal import for module B must be
    import A ( foo )
because foo doesn't have a parent.  This might actually be ambiguous if A
exports another field called foo, but there is no good answer to return and this
is a very obscure corner, so it seems to be the best we can do.  See
DRFPatSynExport for a test of this.


************************************************************************
*                                                                      *
\subsection{Errors}
*                                                                      *
************************************************************************
-}

qualImportItemErr :: RdrName -> SDoc
qualImportItemErr :: RdrName -> SDoc
qualImportItemErr RdrName
rdr
  = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Illegal qualified name in import item:")
       Int
2 (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
text String
"Ambiguous name" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in import item. It could refer to:")
       Int
2 ([SDoc] -> SDoc
vcat (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]
_) = forall a. Outputable a => a -> SDoc
ppr Name
parent SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr)
    ppr_avail (Avail GreName
name)       = 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 (forall a. Outputable a => a -> SDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)) SDoc -> SDoc -> SDoc
<+> case ModIface -> IsBootInterface
mi_boot ModIface
iface of
    IsBootInterface
IsBoot -> String -> SDoc
text String
"(hi-boot interface)"
    IsBootInterface
NotBoot -> SDoc
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
sep [String -> SDoc
text String
"Module", ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec,
         String -> SDoc
text String
"does not export", SDoc -> SDoc
quotes (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
vcat [ String -> SDoc
text String
"In module"
             SDoc -> SDoc -> SDoc
<+> ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec
             SDoc -> SDoc -> SDoc
<> SDoc
colon
         , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
quotes SDoc
datacon
             SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is a data constructor of"
             SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
dataType
         , String -> SDoc
text String
"To import it use"
         , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"import"
             SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)
             SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens_sp (SDoc
dataType SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens_sp SDoc
datacon)
         , String -> SDoc
text String
"or"
         , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"import"
             SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)
             SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens_sp (SDoc
dataType SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"(..)")
         ]
  where
    datacon_occ :: OccName
datacon_occ = RdrName -> OccName
rdrNameOcc forall a b. (a -> b) -> a -> b
$ forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
    datacon :: SDoc
datacon = OccName -> SDoc -> SDoc
parenSymOcc OccName
datacon_occ (forall a. Outputable a => a -> SDoc
ppr OccName
datacon_occ)
    dataType :: SDoc
dataType = OccName -> SDoc -> SDoc
parenSymOcc OccName
dataType_occ (forall a. Outputable a => a -> SDoc
ppr OccName
dataType_occ)
    parens_sp :: SDoc -> SDoc
parens_sp SDoc
d = SDoc -> SDoc
parens (SDoc
space SDoc -> SDoc -> SDoc
<> SDoc
d SDoc -> SDoc -> SDoc
<> SDoc
space)  -- T( f,g )

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 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\GreName
n -> FastString
importedFS forall a. Eq a => a -> a -> Bool
== OccName -> FastString
occNameFS (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 = forall name. HasOccName name => name -> OccName
occName forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvailInfo -> GreName
availGreName
    importedFS :: FastString
importedFS = OccName -> FastString
occNameFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc forall a b. (a -> b) -> a -> b
$ forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie

illegalImportItemErr :: SDoc
illegalImportItemErr :: SDoc
illegalImportItemErr = String -> SDoc
text String
"Illegal import item"

addDupDeclErr :: [GlobalRdrElt] -> TcRn ()
addDupDeclErr :: [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDupDeclErr [] = forall a. String -> a
panic String
"addDupDeclErr: empty list"
addDupDeclErr gres :: [GlobalRdrElt]
gres@(GlobalRdrElt
gre : [GlobalRdrElt]
_)
  = SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (forall a. NamedThing a => a -> SrcSpan
getSrcSpan (forall a. [a] -> a
last [Name]
sorted_names)) forall a b. (a -> b) -> a -> b
$ forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints forall a b. (a -> b) -> a -> b
$
    -- Report the error at the later location
    [SDoc] -> SDoc
vcat [String -> SDoc
text String
"Multiple declarations of" SDoc -> SDoc -> SDoc
<+>
             SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr (GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre)),
             -- NB. print the OccName, not the Name, because the
             -- latter might not be in scope in the RdrEnv and so will
             -- be printed qualified.
          String -> SDoc
text String
"Declared at:" SDoc -> SDoc -> SDoc
<+>
                   [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SrcLoc
nameSrcLoc) [Name]
sorted_names)]
  where
    sorted_names :: [Name]
sorted_names =
      forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> SrcSpan
nameSrcSpan)
             (forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
greMangledName [GlobalRdrElt]
gres)



missingImportListWarn :: ModuleName -> SDoc
missingImportListWarn :: ModuleName -> SDoc
missingImportListWarn ModuleName
mod
  = String -> SDoc
text String
"The module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ModuleName
mod) SDoc -> SDoc -> SDoc
<+> String -> SDoc
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
sep [ String -> SDoc
text String
"Module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ModuleName
mod) SDoc -> SDoc -> SDoc
<> SDoc
colon,
          Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
sep [ String -> SDoc
text String
"Module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
                                SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is deprecated:",
          Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
txt)) ]

packageImportErr :: TcRnMessage
packageImportErr :: TcRnMessage
packageImportErr
  = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints forall a b. (a -> b) -> a -> b
$
  String -> SDoc
text String
"Package-qualified imports are not enabled; use PackageImports"

-- This data decl will parse OK
--      data T = a Int
-- treating "a" as the constructor.
-- It is really hard to make the parser spot this malformation.
-- So the renamer has to check that the constructor is legal
--
-- We can get an operator as the constructor, even in the prefix form:
--      data T = :% Int Int
-- from interface files, which always print in prefix form

checkConName :: RdrName -> TcRn ()
checkConName :: RdrName -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkConName RdrName
name = Bool -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkErr (RdrName -> Bool
isRdrDataCon RdrName
name) (RdrName -> TcRnMessage
badDataCon RdrName
name)

badDataCon :: RdrName -> TcRnMessage
badDataCon :: RdrName -> TcRnMessage
badDataCon RdrName
name
   = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints forall a b. (a -> b) -> a -> b
$
   [SDoc] -> SDoc
hsep [String -> SDoc
text String
"Illegal data constructor name", SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
name)]