{-# LANGUAGE CPP, NondecreasingIndentation #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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,
dodgyMsg,
dodgyMsgInsert,
findImportUsage,
getMinimalImports,
printMinimalImports,
ImportDeclUsage
) where
#include "GhclibHsVersions.h"
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.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.TyCo.Ppr
import qualified GHC.LanguageExtensions as LangExt
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Misc as Utils
import GHC.Utils.Panic
import GHC.Types.Fixity.Env
import GHC.Types.SafeHaskell
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.Name.Reader
import GHC.Types.Avail
import GHC.Types.FieldLabel
import GHC.Types.SourceFile
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Basic ( TopLevelFlag(..) )
import GHC.Types.SourceText
import GHC.Types.Id
import GHC.Types.HpcInfo
import GHC.Unit
import GHC.Unit.Module.Warnings
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Imported
import GHC.Unit.Module.Deps
import GHC.Data.Maybe
import GHC.Data.FastString
import GHC.Data.FastString.Env
import Control.Monad
import Data.Either ( partitionEithers, isRight, rights )
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
rnImports :: [LImportDecl GhcPs]
-> RnM ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImports :: [LImportDecl GhcPs]
-> RnM
([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImports [LImportDecl GhcPs]
imports = do
TcGblEnv
tcg_env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
let this_mod :: Module
this_mod = TcGblEnv -> Module
tcg_mod TcGblEnv
tcg_env
let ([GenLocated SrcSpan (ImportDecl GhcPs)]
source, [GenLocated SrcSpan (ImportDecl GhcPs)]
ordinary) = (GenLocated SrcSpan (ImportDecl GhcPs) -> AnyHpcUsage)
-> [GenLocated SrcSpan (ImportDecl GhcPs)]
-> ([GenLocated SrcSpan (ImportDecl GhcPs)],
[GenLocated SrcSpan (ImportDecl GhcPs)])
forall a. (a -> AnyHpcUsage) -> [a] -> ([a], [a])
partition GenLocated SrcSpan (ImportDecl GhcPs) -> AnyHpcUsage
forall l pass. GenLocated l (ImportDecl pass) -> AnyHpcUsage
is_source_import [GenLocated SrcSpan (ImportDecl GhcPs)]
[LImportDecl GhcPs]
imports
is_source_import :: GenLocated l (ImportDecl pass) -> AnyHpcUsage
is_source_import GenLocated l (ImportDecl pass)
d = ImportDecl pass -> IsBootInterface
forall pass. ImportDecl pass -> IsBootInterface
ideclSource (GenLocated l (ImportDecl pass) -> ImportDecl pass
forall l e. GenLocated l e -> e
unLoc GenLocated l (ImportDecl pass)
d) IsBootInterface -> IsBootInterface -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== IsBootInterface
IsBoot
[(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
stuff1 <- (GenLocated SrcSpan (ImportDecl GhcPs)
-> TcRn
(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage))
-> [GenLocated SrcSpan (ImportDecl GhcPs)]
-> TcRn
[(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
mapAndReportM (Module
-> LImportDecl GhcPs
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl Module
this_mod) [GenLocated SrcSpan (ImportDecl GhcPs)]
ordinary
[(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
stuff2 <- (GenLocated SrcSpan (ImportDecl GhcPs)
-> TcRn
(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage))
-> [GenLocated SrcSpan (ImportDecl GhcPs)]
-> TcRn
[(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
mapAndReportM (Module
-> LImportDecl GhcPs
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl Module
this_mod) [GenLocated SrcSpan (ImportDecl GhcPs)]
source
let ([Located (ImportDecl GhcRn)]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails, AnyHpcUsage
hpc_usage) = [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
combine ([(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
stuff1 [(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
-> [(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
-> [(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
forall a. [a] -> [a] -> [a]
++ [(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
stuff2)
([Located (ImportDecl GhcRn)], GlobalRdrEnv, ImportAvails,
AnyHpcUsage)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([Located (ImportDecl GhcRn)], GlobalRdrEnv, ImportAvails,
AnyHpcUsage)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Located (ImportDecl GhcRn)]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails, AnyHpcUsage
hpc_usage)
where
combine :: [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
combine :: [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
combine [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
ss =
let ([Located (ImportDecl GhcRn)]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails, AnyHpcUsage
hpc_usage, ModuleSet
finsts) = ((Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)
-> ([Located (ImportDecl GhcRn)], GlobalRdrEnv, ImportAvails,
AnyHpcUsage, ModuleSet)
-> ([Located (ImportDecl GhcRn)], GlobalRdrEnv, ImportAvails,
AnyHpcUsage, ModuleSet))
-> ([Located (ImportDecl GhcRn)], GlobalRdrEnv, ImportAvails,
AnyHpcUsage, ModuleSet)
-> [(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
-> ([Located (ImportDecl GhcRn)], GlobalRdrEnv, ImportAvails,
AnyHpcUsage, ModuleSet)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)
-> ([Located (ImportDecl GhcRn)], GlobalRdrEnv, ImportAvails,
AnyHpcUsage, ModuleSet)
-> ([Located (ImportDecl GhcRn)], GlobalRdrEnv, ImportAvails,
AnyHpcUsage, ModuleSet)
forall a.
(a, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
-> ([a], GlobalRdrEnv, ImportAvails, AnyHpcUsage, ModuleSet)
-> ([a], GlobalRdrEnv, ImportAvails, AnyHpcUsage, ModuleSet)
plus
([], GlobalRdrEnv
emptyGlobalRdrEnv, ImportAvails
emptyImportAvails, AnyHpcUsage
False, ModuleSet
emptyModuleSet)
[(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)]
[(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
ss
in ([Located (ImportDecl GhcRn)]
[LImportDecl GhcRn]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails { imp_finsts :: [Module]
imp_finsts = ModuleSet -> [Module]
moduleSetElts ModuleSet
finsts },
AnyHpcUsage
hpc_usage)
plus :: (a, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
-> ([a], GlobalRdrEnv, ImportAvails, AnyHpcUsage, ModuleSet)
-> ([a], GlobalRdrEnv, ImportAvails, AnyHpcUsage, ModuleSet)
plus (a
decl, GlobalRdrEnv
gbl_env1, ImportAvails
imp_avails1, AnyHpcUsage
hpc_usage1)
([a]
decls, GlobalRdrEnv
gbl_env2, ImportAvails
imp_avails2, AnyHpcUsage
hpc_usage2, ModuleSet
finsts_set)
= ( a
decla -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
decls,
GlobalRdrEnv
gbl_env1 GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
`plusGlobalRdrEnv` GlobalRdrEnv
gbl_env2,
ImportAvails
imp_avails1' ImportAvails -> ImportAvails -> ImportAvails
`plusImportAvails` ImportAvails
imp_avails2,
AnyHpcUsage
hpc_usage1 AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| AnyHpcUsage
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
rnImportDecl :: Module -> LImportDecl GhcPs
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl :: Module
-> LImportDecl GhcPs
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl Module
this_mod
(L loc decl@(ImportDecl { ideclExt = noExtField
, ideclName = loc_imp_mod_name
, ideclPkgQual = mb_pkg
, ideclSource = want_boot, ideclSafe = mod_safe
, ideclQualified = qual_style, ideclImplicit = implicit
, ideclAs = as_mod, ideclHiding = imp_details }))
= SrcSpan
-> TcRn
(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)
-> TcRn
(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (TcRn
(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)
-> TcRn
(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage))
-> TcRn
(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)
-> TcRn
(Located (ImportDecl GhcRn), GlobalRdrEnv, ImportAvails,
AnyHpcUsage)
forall a b. (a -> b) -> a -> b
$ do
AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (Maybe StringLiteral -> AnyHpcUsage
forall a. Maybe a -> AnyHpcUsage
isJust Maybe StringLiteral
mb_pkg) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ do
AnyHpcUsage
pkg_imports <- Extension -> TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
forall gbl lcl. Extension -> TcRnIf gbl lcl AnyHpcUsage
xoptM Extension
LangExt.PackageImports
AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (AnyHpcUsage -> AnyHpcUsage
not AnyHpcUsage
pkg_imports) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr MsgDoc
packageImportErr
let qual_only :: AnyHpcUsage
qual_only = ImportDeclQualifiedStyle -> AnyHpcUsage
isImportDeclQualified ImportDeclQualifiedStyle
qual_style
let imp_mod_name :: ModuleName
imp_mod_name = GenLocated SrcSpan ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan ModuleName
XRec GhcPs ModuleName
loc_imp_mod_name
doc :: MsgDoc
doc = ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
imp_mod_name MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"is directly imported"
AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (ModuleName
imp_mod_name ModuleName -> ModuleName -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&&
(case Maybe StringLiteral
mb_pkg of
Maybe StringLiteral
Nothing -> AnyHpcUsage
True
Just (StringLiteral SourceText
_ FastString
pkg_fs) -> FastString
pkg_fs FastString -> FastString -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== String -> FastString
fsLit String
"this" AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
||
FastString -> Unit
fsToUnit FastString
pkg_fs Unit -> Unit -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
this_mod))
(MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (String -> MsgDoc
text String
"A module cannot import itself:" MsgDoc -> MsgDoc -> MsgDoc
<+> ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
imp_mod_name))
case Maybe (AnyHpcUsage, XRec GhcPs [LIE GhcPs])
imp_details of
Just (AnyHpcUsage
False, XRec GhcPs [LIE GhcPs]
_) -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe (AnyHpcUsage, XRec GhcPs [LIE GhcPs])
_ | AnyHpcUsage
implicit -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| AnyHpcUsage
qual_only -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| AnyHpcUsage
otherwise -> WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnMissingImportList (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
WarnReason -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarn (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnMissingImportList)
(ModuleName -> MsgDoc
missingImportListWarn ModuleName
imp_mod_name)
ModIface
iface <- MsgDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM ModIface
loadSrcInterface MsgDoc
doc ModuleName
imp_mod_name IsBootInterface
want_boot ((StringLiteral -> FastString)
-> Maybe StringLiteral -> Maybe FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> FastString
sl_fs Maybe StringLiteral
mb_pkg)
WARN( (want_boot == NotBoot) && (mi_boot iface == IsBoot), ppr imp_mod_name ) do
dflags <- getDynFlags
warnIf ((want_boot == IsBoot) && (mi_boot iface == NotBoot) && isOneShot (ghcMode dflags))
(warnRedundantSourceImport imp_mod_name)
when (mod_safe && not (safeImportsOn dflags)) $
addErr (text "safe import can't be used as Safe Haskell isn't on!"
$+$ ptext (sLit $ "please enable Safe Haskell through either "
++ "Safe, Trustworthy or Unsafe"))
let
qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name
imp_spec = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
is_dloc = loc, is_as = qual_mod_name }
(new_imp_details, gres) <- filterImports iface imp_spec imp_details
potential_gres <- mkGlobalRdrEnv . snd <$> filterImports iface imp_spec Nothing
let gbl_env = mkGlobalRdrEnv gres
is_hiding | Just (True,_) <- imp_details = True
| otherwise = False
mod_safe' = mod_safe
|| (not implicit && safeDirectImpsReq dflags)
|| (implicit && safeImplicitImpsReq dflags)
hsc_env <- getTopEnv
let home_unit = hsc_home_unit hsc_env
imv = ImportedModsVal
{ imv_name = qual_mod_name
, imv_span = loc
, imv_is_safe = mod_safe'
, imv_is_hiding = is_hiding
, imv_all_exports = potential_gres
, imv_qualified = qual_only
}
imports = calculateAvails home_unit iface mod_safe' want_boot (ImportedByUser imv)
whenWOptM Opt_WarnWarningsDeprecations (
case (mi_warns iface) of
WarnAll txt -> addWarn (Reason Opt_WarnWarningsDeprecations)
(moduleWarn imp_mod_name txt)
_ -> return ()
)
warnUnqualifiedImport decl iface
let new_imp_decl = L loc (decl { ideclExt = noExtField, ideclSafe = mod_safe'
, ideclHiding = new_imp_details
, ideclName = ideclName decl
, ideclAs = ideclAs decl })
return (new_imp_decl, gbl_env, imports, mi_hpc iface)
calculateAvails :: HomeUnit
-> ModIface
-> IsSafeImport
-> IsBootInterface
-> ImportedBy
-> ImportAvails
calculateAvails :: HomeUnit
-> ModIface
-> AnyHpcUsage
-> IsBootInterface
-> ImportedBy
-> ImportAvails
calculateAvails HomeUnit
home_unit ModIface
iface AnyHpcUsage
mod_safe' IsBootInterface
want_boot ImportedBy
imported_by =
let imp_mod :: Module
imp_mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
imp_sem_mod :: Module
imp_sem_mod= ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface
orph_iface :: AnyHpcUsage
orph_iface = ModIfaceBackend -> AnyHpcUsage
mi_orphan (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
has_finsts :: AnyHpcUsage
has_finsts = ModIfaceBackend -> AnyHpcUsage
mi_finsts (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
deps :: Dependencies
deps = ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface
trust :: SafeHaskellMode
trust = IfaceTrustInfo -> SafeHaskellMode
getSafeMode (IfaceTrustInfo -> SafeHaskellMode)
-> IfaceTrustInfo -> SafeHaskellMode
forall a b. (a -> b) -> a -> b
$ ModIface -> IfaceTrustInfo
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust ModIface
iface
trust_pkg :: AnyHpcUsage
trust_pkg = ModIface -> AnyHpcUsage
forall (phase :: ModIfacePhase). ModIface_ phase -> AnyHpcUsage
mi_trust_pkg ModIface
iface
orphans :: [Module]
orphans | AnyHpcUsage
orph_iface = ASSERT2( not (imp_sem_mod `elem` dep_orphs deps), ppr imp_sem_mod <+> ppr (dep_orphs deps) )
Module
imp_sem_mod Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: Dependencies -> [Module]
dep_orphs Dependencies
deps
| AnyHpcUsage
otherwise = Dependencies -> [Module]
dep_orphs Dependencies
deps
finsts :: [Module]
finsts | AnyHpcUsage
has_finsts = ASSERT2( not (imp_sem_mod `elem` dep_finsts deps), ppr imp_sem_mod <+> ppr (dep_orphs deps) )
Module
imp_sem_mod Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: Dependencies -> [Module]
dep_finsts Dependencies
deps
| AnyHpcUsage
otherwise = Dependencies -> [Module]
dep_finsts Dependencies
deps
pkg :: Unit
pkg = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)
ipkg :: UnitId
ipkg = Unit -> UnitId
toUnitId Unit
pkg
ptrust :: AnyHpcUsage
ptrust = SafeHaskellMode
trust SafeHaskellMode -> SafeHaskellMode -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== SafeHaskellMode
Sf_Trustworthy AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| AnyHpcUsage
trust_pkg
([GenWithIsBoot ModuleName]
dependent_mods, [(UnitId, AnyHpcUsage)]
dependent_pkgs, AnyHpcUsage
pkg_trust_req)
| HomeUnit -> Unit -> AnyHpcUsage
isHomeUnit HomeUnit
home_unit Unit
pkg =
( GWIB :: forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB { gwib_mod :: ModuleName
gwib_mod = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
imp_mod, gwib_isBoot :: IsBootInterface
gwib_isBoot = IsBootInterface
want_boot } GenWithIsBoot ModuleName
-> [GenWithIsBoot ModuleName] -> [GenWithIsBoot ModuleName]
forall a. a -> [a] -> [a]
: Dependencies -> [GenWithIsBoot ModuleName]
dep_mods Dependencies
deps
, Dependencies -> [(UnitId, AnyHpcUsage)]
dep_pkgs Dependencies
deps
, AnyHpcUsage
ptrust
)
| AnyHpcUsage
otherwise =
ASSERT2( not (ipkg `elem` (map fst $ dep_pkgs deps))
, ppr ipkg <+> ppr (dep_pkgs deps) )
([], (UnitId
ipkg, AnyHpcUsage
False) (UnitId, AnyHpcUsage)
-> [(UnitId, AnyHpcUsage)] -> [(UnitId, AnyHpcUsage)]
forall a. a -> [a] -> [a]
: Dependencies -> [(UnitId, AnyHpcUsage)]
dep_pkgs Dependencies
deps, AnyHpcUsage
False)
in ImportAvails :: ImportedMods
-> ModuleNameEnv (GenWithIsBoot ModuleName)
-> Set UnitId
-> Set UnitId
-> AnyHpcUsage
-> [Module]
-> [Module]
-> ImportAvails
ImportAvails {
imp_mods :: ImportedMods
imp_mods = Module -> [ImportedBy] -> ImportedMods
forall a. Module -> a -> ModuleEnv a
unitModuleEnv (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) [ImportedBy
imported_by],
imp_orphs :: [Module]
imp_orphs = [Module]
orphans,
imp_finsts :: [Module]
imp_finsts = [Module]
finsts,
imp_dep_mods :: ModuleNameEnv (GenWithIsBoot ModuleName)
imp_dep_mods = [GenWithIsBoot ModuleName]
-> ModuleNameEnv (GenWithIsBoot ModuleName)
mkModDeps [GenWithIsBoot ModuleName]
dependent_mods,
imp_dep_pkgs :: Set UnitId
imp_dep_pkgs = [UnitId] -> Set UnitId
forall a. Ord a => [a] -> Set a
S.fromList ([UnitId] -> Set UnitId)
-> ([(UnitId, AnyHpcUsage)] -> [UnitId])
-> [(UnitId, AnyHpcUsage)]
-> Set UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnitId, AnyHpcUsage) -> UnitId)
-> [(UnitId, AnyHpcUsage)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, AnyHpcUsage) -> UnitId
forall a b. (a, b) -> a
fst ([(UnitId, AnyHpcUsage)] -> Set UnitId)
-> [(UnitId, AnyHpcUsage)] -> Set UnitId
forall a b. (a -> b) -> a -> b
$ [(UnitId, AnyHpcUsage)]
dependent_pkgs,
imp_trust_pkgs :: Set UnitId
imp_trust_pkgs = if AnyHpcUsage
mod_safe'
then [UnitId] -> Set UnitId
forall a. Ord a => [a] -> Set a
S.fromList ([UnitId] -> Set UnitId)
-> ([(UnitId, AnyHpcUsage)] -> [UnitId])
-> [(UnitId, AnyHpcUsage)]
-> Set UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnitId, AnyHpcUsage) -> UnitId)
-> [(UnitId, AnyHpcUsage)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, AnyHpcUsage) -> UnitId
forall a b. (a, b) -> a
fst ([(UnitId, AnyHpcUsage)] -> Set UnitId)
-> [(UnitId, AnyHpcUsage)] -> Set UnitId
forall a b. (a -> b) -> a -> b
$ ((UnitId, AnyHpcUsage) -> AnyHpcUsage)
-> [(UnitId, AnyHpcUsage)] -> [(UnitId, AnyHpcUsage)]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter (UnitId, AnyHpcUsage) -> AnyHpcUsage
forall a b. (a, b) -> b
snd [(UnitId, AnyHpcUsage)]
dependent_pkgs
else Set UnitId
forall a. Set a
S.empty,
imp_trust_own_pkg :: AnyHpcUsage
imp_trust_own_pkg = AnyHpcUsage
pkg_trust_req
}
warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM ()
warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnqualifiedImport ImportDecl GhcPs
decl ModIface
iface =
WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnCompatUnqualifiedImports
(IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when AnyHpcUsage
bad_import
(IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ WarnReason -> SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarnAt (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnCompatUnqualifiedImports) SrcSpan
loc MsgDoc
warning
where
mod :: Module
mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
loc :: SrcSpan
loc = GenLocated SrcSpan ModuleName -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (GenLocated SrcSpan ModuleName -> SrcSpan)
-> GenLocated SrcSpan ModuleName -> SrcSpan
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
decl
is_qual :: AnyHpcUsage
is_qual = ImportDeclQualifiedStyle -> AnyHpcUsage
isImportDeclQualified (ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
decl)
has_import_list :: AnyHpcUsage
has_import_list =
case ImportDecl GhcPs -> Maybe (AnyHpcUsage, XRec GhcPs [LIE GhcPs])
forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, XRec pass [LIE pass])
ideclHiding ImportDecl GhcPs
decl of
Just (AnyHpcUsage
False, XRec GhcPs [LIE GhcPs]
_) -> AnyHpcUsage
True
Maybe (AnyHpcUsage, XRec GhcPs [LIE GhcPs])
_ -> AnyHpcUsage
False
bad_import :: AnyHpcUsage
bad_import =
Module
mod Module -> ModuleSet -> AnyHpcUsage
`elemModuleSet` ModuleSet
qualifiedMods
AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& AnyHpcUsage -> AnyHpcUsage
not AnyHpcUsage
is_qual
AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& AnyHpcUsage -> AnyHpcUsage
not AnyHpcUsage
has_import_list
warning :: MsgDoc
warning = [MsgDoc] -> MsgDoc
vcat
[ String -> MsgDoc
text String
"To ensure compatibility with future core libraries changes"
, String -> MsgDoc
text String
"imports to" MsgDoc -> MsgDoc -> MsgDoc
<+> GenLocated SrcSpan ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
decl) MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"should be"
, String -> MsgDoc
text String
"either qualified or have an explicit import list."
]
qualifiedMods :: ModuleSet
qualifiedMods = [Module] -> ModuleSet
mkModuleSet [ Module
dATA_LIST ]
warnRedundantSourceImport :: ModuleName -> SDoc
warnRedundantSourceImport :: ModuleName -> MsgDoc
warnRedundantSourceImport ModuleName
mod_name
= String -> MsgDoc
text String
"Unnecessary {-# SOURCE #-} in the import of module"
MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
mod_name)
extendGlobalRdrEnvRn :: [AvailInfo]
-> MiniFixityEnv
-> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn :: [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [AvailInfo]
avails MiniFixityEnv
new_fixities
= do { (TcGblEnv
gbl_env, TcLclEnv
lcl_env) <- RnM (TcGblEnv, TcLclEnv)
forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
getEnvs
; ThStage
stage <- TcM ThStage
getStage
; AnyHpcUsage
isGHCi <- TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
getIsGHCi
; let rdr_env :: GlobalRdrEnv
rdr_env = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env
fix_env :: FixityEnv
fix_env = TcGblEnv -> FixityEnv
tcg_fix_env TcGblEnv
gbl_env
th_bndrs :: ThBindEnv
th_bndrs = TcLclEnv -> ThBindEnv
tcl_th_bndrs TcLclEnv
lcl_env
th_lvl :: Int
th_lvl = ThStage -> Int
thLevel ThStage
stage
inBracket :: AnyHpcUsage
inBracket = ThStage -> AnyHpcUsage
isBrackStage ThStage
stage
lcl_env_TH :: TcLclEnv
lcl_env_TH = TcLclEnv
lcl_env { tcl_rdr :: LocalRdrEnv
tcl_rdr = LocalRdrEnv -> [OccName] -> LocalRdrEnv
delLocalRdrEnvList (TcLclEnv -> LocalRdrEnv
tcl_rdr TcLclEnv
lcl_env) [OccName]
new_occs }
lcl_env2 :: TcLclEnv
lcl_env2 | AnyHpcUsage
inBracket = TcLclEnv
lcl_env_TH
| AnyHpcUsage
otherwise = TcLclEnv
lcl_env
want_shadowing :: AnyHpcUsage
want_shadowing = AnyHpcUsage
isGHCi AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| AnyHpcUsage
inBracket
rdr_env1 :: GlobalRdrEnv
rdr_env1 | AnyHpcUsage
want_shadowing = GlobalRdrEnv -> [Name] -> GlobalRdrEnv
shadowNames GlobalRdrEnv
rdr_env [Name]
new_names
| AnyHpcUsage
otherwise = GlobalRdrEnv
rdr_env
lcl_env3 :: TcLclEnv
lcl_env3 = TcLclEnv
lcl_env2 { tcl_th_bndrs :: ThBindEnv
tcl_th_bndrs = ThBindEnv -> [(Name, (TopLevelFlag, Int))] -> ThBindEnv
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList ThBindEnv
th_bndrs
[ (Name
n, (TopLevelFlag
TopLevel, Int
th_lvl))
| Name
n <- [Name]
new_names ] }
; GlobalRdrEnv
rdr_env2 <- (GlobalRdrEnv
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv)
-> GlobalRdrEnv
-> [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM GlobalRdrEnv
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
add_gre GlobalRdrEnv
rdr_env1 [GlobalRdrElt]
new_gres
; let fix_env' :: FixityEnv
fix_env' = (FixityEnv -> GlobalRdrElt -> FixityEnv)
-> FixityEnv -> [GlobalRdrElt] -> FixityEnv
forall (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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"extendGlobalRdrEnvRn 2" (AnyHpcUsage -> GlobalRdrEnv -> MsgDoc
pprGlobalRdrEnv AnyHpcUsage
True GlobalRdrEnv
rdr_env2)
; (TcGblEnv, TcLclEnv) -> RnM (TcGblEnv, TcLclEnv)
forall (m :: * -> *) a. Monad m => a -> m a
return (TcGblEnv
gbl_env', TcLclEnv
lcl_env3) }
where
new_names :: [Name]
new_names = (AvailInfo -> [Name]) -> [AvailInfo] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [Name]
availNames [AvailInfo]
avails
new_occs :: [OccName]
new_occs = (Name -> OccName) -> [Name] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> OccName
nameOccName [Name]
new_names
extend_fix_env :: FixityEnv -> GlobalRdrElt -> FixityEnv
extend_fix_env FixityEnv
fix_env GlobalRdrElt
gre
| Just (L SrcSpan
_ Fixity
fi) <- MiniFixityEnv -> FastString -> Maybe (Located Fixity)
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv MiniFixityEnv
new_fixities (OccName -> FastString
occNameFS OccName
occ)
= FixityEnv -> Name -> FixItem -> FixityEnv
forall a. NameEnv a -> Name -> a -> NameEnv a
extendNameEnv FixityEnv
fix_env Name
name (OccName -> Fixity -> FixItem
FixItem OccName
occ Fixity
fi)
| AnyHpcUsage
otherwise
= FixityEnv
fix_env
where
name :: Name
name = GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre
occ :: OccName
occ = GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre
new_gres :: [GlobalRdrElt]
new_gres :: [GlobalRdrElt]
new_gres = (AvailInfo -> [GlobalRdrElt]) -> [AvailInfo] -> [GlobalRdrElt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [GlobalRdrElt]
localGREsFromAvail [AvailInfo]
avails
add_gre :: GlobalRdrEnv -> GlobalRdrElt -> RnM GlobalRdrEnv
add_gre :: GlobalRdrEnv
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
add_gre GlobalRdrEnv
env GlobalRdrElt
gre
| AnyHpcUsage -> AnyHpcUsage
not ([GlobalRdrElt] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [GlobalRdrElt]
dups)
= do { [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDupDeclErr (GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: [GlobalRdrElt]
dups); GlobalRdrEnv -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
forall (m :: * -> *) a. Monad m => a -> m a
return GlobalRdrEnv
env }
| AnyHpcUsage
otherwise
= GlobalRdrEnv -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
extendGlobalRdrEnv GlobalRdrEnv
env GlobalRdrElt
gre)
where
occ :: OccName
occ = GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre
dups :: [GlobalRdrElt]
dups = (GlobalRdrElt -> AnyHpcUsage) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter GlobalRdrElt -> AnyHpcUsage
isDupGRE (GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env OccName
occ)
isDupGRE :: GlobalRdrElt -> AnyHpcUsage
isDupGRE GlobalRdrElt
gre' = GlobalRdrElt -> AnyHpcUsage
isLocalGRE GlobalRdrElt
gre'
AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& AnyHpcUsage -> AnyHpcUsage
not (GlobalRdrElt -> AnyHpcUsage
isOverloadedRecFldGRE GlobalRdrElt
gre AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& GlobalRdrElt -> AnyHpcUsage
isOverloadedRecFldGRE GlobalRdrElt
gre')
getLocalNonValBinders :: MiniFixityEnv -> HsGroup GhcPs
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
getLocalNonValBinders :: MiniFixityEnv
-> HsGroup GhcPs -> RnM ((TcGblEnv, TcLclEnv), NameSet)
getLocalNonValBinders MiniFixityEnv
fixity_env
(HsGroup { hs_valds :: forall p. HsGroup p -> HsValBinds p
hs_valds = HsValBinds GhcPs
binds,
hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
hs_tyclds = [TyClGroup GhcPs]
tycl_decls,
hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
hs_fords = [LForeignDecl GhcPs]
foreign_decls })
= do {
; let inst_decls :: [Located (InstDecl GhcPs)]
inst_decls = [TyClGroup GhcPs]
tycl_decls [TyClGroup GhcPs]
-> (TyClGroup GhcPs -> [Located (InstDecl GhcPs)])
-> [Located (InstDecl GhcPs)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TyClGroup GhcPs -> [Located (InstDecl GhcPs)]
forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds
; AnyHpcUsage
overload_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
forall gbl lcl. Extension -> TcRnIf gbl lcl AnyHpcUsage
xoptM Extension
LangExt.DuplicateRecordFields
; ([AvailInfo]
tc_avails, [[(Name, [FieldLabel])]]
tc_fldss)
<- ([(AvailInfo, [(Name, [FieldLabel])])]
-> ([AvailInfo], [[(Name, [FieldLabel])]]))
-> IOEnv
(Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(AvailInfo, [(Name, [FieldLabel])])]
-> ([AvailInfo], [[(Name, [FieldLabel])]])
forall a b. [(a, b)] -> ([a], [b])
unzip (IOEnv
(Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]]))
-> IOEnv
(Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]])
forall a b. (a -> b) -> a -> b
$ (Located (TyClDecl GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])]))
-> [Located (TyClDecl GhcPs)]
-> IOEnv
(Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AnyHpcUsage
-> LTyClDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_tc AnyHpcUsage
overload_ok)
([TyClGroup GhcPs] -> [LTyClDecl GhcPs]
forall pass. [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls [TyClGroup GhcPs]
tycl_decls)
; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 1" ([AvailInfo] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [AvailInfo]
tc_avails)
; (TcGblEnv, TcLclEnv)
envs <- [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [AvailInfo]
tc_avails MiniFixityEnv
fixity_env
; (TcGblEnv, TcLclEnv)
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
forall gbl' lcl' a gbl lcl.
(gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
setEnvs (TcGblEnv, TcLclEnv)
envs (RnM ((TcGblEnv, TcLclEnv), NameSet)
-> RnM ((TcGblEnv, TcLclEnv), NameSet))
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
forall a b. (a -> b) -> a -> b
$ do {
; ([[AvailInfo]]
nti_availss, [[(Name, [FieldLabel])]]
nti_fldss) <- (Located (InstDecl GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])]))
-> [Located (InstDecl GhcPs)]
-> IOEnv
(Env TcGblEnv TcLclEnv) ([[AvailInfo]], [[(Name, [FieldLabel])]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM (AnyHpcUsage
-> LInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
new_assoc AnyHpcUsage
overload_ok)
[Located (InstDecl GhcPs)]
inst_decls
; AnyHpcUsage
is_boot <- TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
tcIsHsBootOrSig
; let val_bndrs :: [GenLocated SrcSpan RdrName]
val_bndrs | AnyHpcUsage
is_boot = [GenLocated SrcSpan RdrName]
hs_boot_sig_bndrs
| AnyHpcUsage
otherwise = [GenLocated SrcSpan RdrName]
for_hs_bndrs
; [AvailInfo]
val_avails <- (GenLocated SrcSpan RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo)
-> [GenLocated SrcSpan RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [AvailInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated SrcSpan RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo
new_simple [GenLocated SrcSpan RdrName]
val_bndrs
; let avails :: [AvailInfo]
avails = [[AvailInfo]] -> [AvailInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[AvailInfo]]
nti_availss [AvailInfo] -> [AvailInfo] -> [AvailInfo]
forall a. [a] -> [a] -> [a]
++ [AvailInfo]
val_avails
new_bndrs :: NameSet
new_bndrs = [AvailInfo] -> NameSet
availsToNameSetWithSelectors [AvailInfo]
avails NameSet -> NameSet -> NameSet
`unionNameSet`
[AvailInfo] -> NameSet
availsToNameSetWithSelectors [AvailInfo]
tc_avails
flds :: [(Name, [FieldLabel])]
flds = [[(Name, [FieldLabel])]] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
nti_fldss [(Name, [FieldLabel])]
-> [(Name, [FieldLabel])] -> [(Name, [FieldLabel])]
forall a. [a] -> [a] -> [a]
++ [[(Name, [FieldLabel])]] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
tc_fldss
; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 2" ([AvailInfo] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [AvailInfo]
avails)
; (TcGblEnv
tcg_env, TcLclEnv
tcl_env) <- [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [AvailInfo]
avails MiniFixityEnv
fixity_env
; let field_env :: NameEnv [FieldLabel]
field_env = NameEnv [FieldLabel]
-> [(Name, [FieldLabel])] -> NameEnv [FieldLabel]
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList (TcGblEnv -> NameEnv [FieldLabel]
tcg_field_env TcGblEnv
tcg_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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 3" ([MsgDoc] -> MsgDoc
vcat [[(Name, [FieldLabel])] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [(Name, [FieldLabel])]
flds, NameEnv [FieldLabel] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameEnv [FieldLabel]
field_env])
; ((TcGblEnv, TcLclEnv), NameSet)
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TcGblEnv, TcLclEnv)
envs, NameSet
new_bndrs) } }
where
ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
_val_binds [LSig GhcPs]
val_sigs = HsValBinds GhcPs
binds
for_hs_bndrs :: [Located RdrName]
for_hs_bndrs :: [GenLocated SrcSpan RdrName]
for_hs_bndrs = [LForeignDecl GhcPs] -> [LIdP GhcPs]
forall pass.
(UnXRec pass, MapXRec pass) =>
[LForeignDecl pass] -> [LIdP pass]
hsForeignDeclsBinders [LForeignDecl GhcPs]
foreign_decls
hs_boot_sig_bndrs :: [GenLocated SrcSpan RdrName]
hs_boot_sig_bndrs = [ SrcSpan -> RdrName -> GenLocated SrcSpan RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
decl_loc (GenLocated SrcSpan RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan RdrName
n)
| L SrcSpan
decl_loc (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
ns LHsSigWcType GhcPs
_) <- [GenLocated SrcSpan (Sig GhcPs)]
[LSig GhcPs]
val_sigs, GenLocated SrcSpan RdrName
n <- [GenLocated SrcSpan RdrName]
[LIdP GhcPs]
ns]
new_simple :: Located RdrName -> RnM AvailInfo
new_simple :: GenLocated SrcSpan RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo
new_simple GenLocated SrcSpan RdrName
rdr_name = do{ Name
nm <- GenLocated SrcSpan RdrName -> RnM Name
newTopSrcBinder GenLocated SrcSpan RdrName
rdr_name
; AvailInfo -> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> AvailInfo
avail Name
nm) }
new_tc :: Bool -> LTyClDecl GhcPs
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_tc :: AnyHpcUsage
-> LTyClDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_tc AnyHpcUsage
overload_ok LTyClDecl GhcPs
tc_decl
= do { let ([GenLocated SrcSpan RdrName]
bndrs, [Located (FieldOcc GhcPs)]
flds) = Located (TyClDecl GhcPs)
-> ([Located (IdP GhcPs)], [LFieldOcc GhcPs])
forall (p :: Pass).
IsPass p =>
Located (TyClDecl (GhcPass p))
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLTyClDeclBinders Located (TyClDecl GhcPs)
LTyClDecl GhcPs
tc_decl
; names :: [Name]
names@(Name
main_name : [Name]
sub_names) <- (GenLocated SrcSpan RdrName -> RnM Name)
-> [GenLocated SrcSpan RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated SrcSpan RdrName -> RnM Name
newTopSrcBinder [GenLocated SrcSpan RdrName]
bndrs
; [FieldLabel]
flds' <- (Located (FieldOcc GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel)
-> [Located (FieldOcc GhcPs)]
-> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AnyHpcUsage
-> [Name]
-> LFieldOcc GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
newRecordSelector AnyHpcUsage
overload_ok [Name]
sub_names) [Located (FieldOcc GhcPs)]
flds
; let fld_env :: [(Name, [FieldLabel])]
fld_env = case Located (TyClDecl GhcPs) -> TyClDecl GhcPs
forall l e. GenLocated l e -> e
unLoc Located (TyClDecl GhcPs)
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
_ -> []
; (AvailInfo, [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
main_name [Name]
names [FieldLabel]
flds', [(Name, [FieldLabel])]
fld_env) }
mk_fld_env :: HsDataDefn GhcPs -> [Name] -> [FieldLabel]
-> [(Name, [FieldLabel])]
mk_fld_env :: HsDataDefn GhcPs
-> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
mk_fld_env HsDataDefn GhcPs
d [Name]
names [FieldLabel]
flds = (GenLocated SrcSpan (ConDecl GhcPs) -> [(Name, [FieldLabel])])
-> [GenLocated SrcSpan (ConDecl GhcPs)] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpan (ConDecl GhcPs) -> [(Name, [FieldLabel])]
find_con_flds (HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcPs
d)
where
find_con_flds :: GenLocated SrcSpan (ConDecl GhcPs) -> [(Name, [FieldLabel])]
find_con_flds (L SrcSpan
_ (ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = L _ rdr
, con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = RecCon XRec GhcPs [LConDeclField GhcPs]
cdflds }))
= [( RdrName -> Name
find_con_name RdrName
rdr
, (GenLocated SrcSpan (ConDeclField GhcPs) -> [FieldLabel])
-> [GenLocated SrcSpan (ConDeclField GhcPs)] -> [FieldLabel]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpan (ConDeclField GhcPs) -> [FieldLabel]
find_con_decl_flds (GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcPs)]
-> [GenLocated SrcSpan (ConDeclField GhcPs)]
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField GhcPs]
cdflds) )]
find_con_flds (L SrcSpan
_ (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 }))
= [ ( RdrName -> Name
find_con_name RdrName
rdr
, (GenLocated SrcSpan (ConDeclField GhcPs) -> [FieldLabel])
-> [GenLocated SrcSpan (ConDeclField GhcPs)] -> [FieldLabel]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpan (ConDeclField GhcPs) -> [FieldLabel]
find_con_decl_flds (GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcPs)]
-> [GenLocated SrcSpan (ConDeclField GhcPs)]
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField GhcPs]
flds))
| L SrcSpan
_ RdrName
rdr <- [GenLocated SrcSpan RdrName]
[LIdP GhcPs]
rdrs ]
find_con_flds GenLocated SrcSpan (ConDecl GhcPs)
_ = []
find_con_name :: RdrName -> Name
find_con_name RdrName
rdr
= String -> Maybe Name -> Name
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"getLocalNonValBinders/find_con_name" (Maybe Name -> Name) -> Maybe Name -> Name
forall a b. (a -> b) -> a -> b
$
(Name -> AnyHpcUsage) -> [Name] -> Maybe Name
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> Maybe a
find (\ Name
n -> Name -> OccName
nameOccName Name
n OccName -> OccName -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== RdrName -> OccName
rdrNameOcc RdrName
rdr) [Name]
names
find_con_decl_flds :: GenLocated SrcSpan (ConDeclField GhcPs) -> [FieldLabel]
find_con_decl_flds (L SrcSpan
_ ConDeclField GhcPs
x)
= (Located (FieldOcc GhcPs) -> FieldLabel)
-> [Located (FieldOcc GhcPs)] -> [FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map Located (FieldOcc GhcPs) -> FieldLabel
find_con_decl_fld (ConDeclField GhcPs -> [LFieldOcc GhcPs]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names ConDeclField GhcPs
x)
find_con_decl_fld :: Located (FieldOcc GhcPs) -> FieldLabel
find_con_decl_fld (L SrcSpan
_ (FieldOcc XCFieldOcc GhcPs
_ (L SrcSpan
_ RdrName
rdr)))
= String -> Maybe FieldLabel -> FieldLabel
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"getLocalNonValBinders/find_con_decl_fld" (Maybe FieldLabel -> FieldLabel) -> Maybe FieldLabel -> FieldLabel
forall a b. (a -> b) -> a -> b
$
(FieldLabel -> AnyHpcUsage) -> [FieldLabel] -> Maybe FieldLabel
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> Maybe a
find (\ FieldLabel
fl -> FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel FieldLabel
fl FastString -> FastString -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== FastString
lbl) [FieldLabel]
flds
where lbl :: FastString
lbl = OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdr)
new_assoc :: Bool -> LInstDecl GhcPs
-> RnM ([AvailInfo], [(Name, [FieldLabel])])
new_assoc :: AnyHpcUsage
-> LInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
new_assoc AnyHpcUsage
_ (L _ (TyFamInstD {})) = ([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
new_assoc AnyHpcUsage
overload_ok (L _ (DataFamInstD _ d))
= do { (AvailInfo
avail, [(Name, [FieldLabel])]
flds) <- AnyHpcUsage
-> Maybe Name
-> DataFamInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_di AnyHpcUsage
overload_ok Maybe Name
forall a. Maybe a
Nothing DataFamInstDecl GhcPs
d
; ([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([AvailInfo
avail], [(Name, [FieldLabel])]
flds) }
new_assoc AnyHpcUsage
overload_ok (L _ (ClsInstD _ (ClsInstDecl { cid_poly_ty = inst_ty
, cid_datafam_insts = adts })))
= do
Maybe Name
mb_cls_nm <- MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name))
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall a b. (a -> b) -> a -> b
$ do
L SrcSpan
loc RdrName
cls_rdr <- IOEnv (Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName))
-> MaybeT
(IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated SrcSpan RdrName)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IOEnv (Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName))
-> MaybeT
(IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated SrcSpan RdrName))
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName))
-> MaybeT
(IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated SrcSpan RdrName)
forall a b. (a -> b) -> a -> b
$ Maybe (GenLocated SrcSpan RdrName)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (GenLocated SrcSpan RdrName)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName)))
-> Maybe (GenLocated SrcSpan RdrName)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName))
forall a b. (a -> b) -> a -> b
$ LHsSigType GhcPs -> Maybe (Located (IdP GhcPs))
forall (p :: Pass).
LHsSigType (GhcPass p) -> Maybe (Located (IdP (GhcPass p)))
getLHsInstDeclClass_maybe LHsSigType GhcPs
inst_ty
IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name))
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall a b. (a -> b) -> a -> b
$ RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
lookupGlobalOccRn_maybe RdrName
cls_rdr
case Maybe Name
mb_cls_nm of
Maybe Name
Nothing -> ([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
Just Name
cls_nm -> do
([AvailInfo]
avails, [[(Name, [FieldLabel])]]
fldss)
<- (Located (DataFamInstDecl GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])]))
-> [Located (DataFamInstDecl GhcPs)]
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM (AnyHpcUsage
-> Maybe Name
-> LDataFamInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_loc_di AnyHpcUsage
overload_ok (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
cls_nm)) [Located (DataFamInstDecl GhcPs)]
[LDataFamInstDecl GhcPs]
adts
([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([AvailInfo]
avails, [[(Name, [FieldLabel])]] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
fldss)
new_di :: Bool -> Maybe Name -> DataFamInstDecl GhcPs
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_di :: AnyHpcUsage
-> Maybe Name
-> DataFamInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_di AnyHpcUsage
overload_ok Maybe Name
mb_cls dfid :: DataFamInstDecl GhcPs
dfid@(DataFamInstDecl { dfid_eqn :: forall pass.
DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
dfid_eqn =
HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl }})
= do { Located Name
main_name <- Maybe Name -> GenLocated SrcSpan RdrName -> RnM (Located Name)
lookupFamInstName Maybe Name
mb_cls (FamEqn GhcPs (HsDataDefn GhcPs) -> LIdP GhcPs
forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl)
; let ([GenLocated SrcSpan RdrName]
bndrs, [Located (FieldOcc GhcPs)]
flds) = DataFamInstDecl GhcPs -> ([Located (IdP GhcPs)], [LFieldOcc GhcPs])
forall (p :: Pass).
IsPass p =>
DataFamInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataFamInstBinders DataFamInstDecl GhcPs
dfid
; [Name]
sub_names <- (GenLocated SrcSpan RdrName -> RnM Name)
-> [GenLocated SrcSpan RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated SrcSpan RdrName -> RnM Name
newTopSrcBinder [GenLocated SrcSpan RdrName]
bndrs
; [FieldLabel]
flds' <- (Located (FieldOcc GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel)
-> [Located (FieldOcc GhcPs)]
-> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AnyHpcUsage
-> [Name]
-> LFieldOcc GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
newRecordSelector AnyHpcUsage
overload_ok [Name]
sub_names) [Located (FieldOcc GhcPs)]
flds
; let avail :: AvailInfo
avail = Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC (Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
main_name) [Name]
sub_names [FieldLabel]
flds'
fld_env :: [(Name, [FieldLabel])]
fld_env = HsDataDefn GhcPs
-> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
mk_fld_env (FamEqn GhcPs (HsDataDefn GhcPs) -> HsDataDefn GhcPs
forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl) [Name]
sub_names [FieldLabel]
flds'
; (AvailInfo, [(Name, [FieldLabel])])
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
forall (m :: * -> *) a. Monad m => a -> m a
return (AvailInfo
avail, [(Name, [FieldLabel])]
fld_env) }
new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl GhcPs
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_loc_di :: AnyHpcUsage
-> Maybe Name
-> LDataFamInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_loc_di AnyHpcUsage
overload_ok Maybe Name
mb_cls (L _ d) = AnyHpcUsage
-> Maybe Name
-> DataFamInstDecl GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_di AnyHpcUsage
overload_ok Maybe Name
mb_cls DataFamInstDecl GhcPs
d
newRecordSelector :: Bool -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel
newRecordSelector :: AnyHpcUsage
-> [Name]
-> LFieldOcc GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
newRecordSelector AnyHpcUsage
_ [] LFieldOcc GhcPs
_ = String -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall a. HasCallStack => String -> a
error String
"newRecordSelector: datatype has no constructors!"
newRecordSelector AnyHpcUsage
overload_ok (Name
dc:[Name]
_) (L loc (FieldOcc _ (L _ fld)))
= do { Name
selName <- GenLocated SrcSpan RdrName -> RnM Name
newTopSrcBinder (GenLocated SrcSpan RdrName -> RnM Name)
-> GenLocated SrcSpan RdrName -> RnM Name
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> GenLocated SrcSpan RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (RdrName -> GenLocated SrcSpan RdrName)
-> RdrName -> GenLocated SrcSpan RdrName
forall a b. (a -> b) -> a -> b
$ RdrName
field
; FieldLabel -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel)
-> FieldLabel -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall a b. (a -> b) -> a -> b
$ FieldLbl OccName
qualFieldLbl { flSelector :: Name
flSelector = Name
selName } }
where
fieldOccName :: FastString
fieldOccName = OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
fld
qualFieldLbl :: FieldLbl OccName
qualFieldLbl = FastString -> OccName -> AnyHpcUsage -> FieldLbl OccName
mkFieldLabelOccs FastString
fieldOccName (Name -> OccName
nameOccName Name
dc) AnyHpcUsage
overload_ok
field :: RdrName
field | RdrName -> AnyHpcUsage
isExact RdrName
fld = RdrName
fld
| AnyHpcUsage
otherwise = OccName -> RdrName
mkRdrUnqual (FieldLbl OccName -> OccName
forall a. FieldLbl a -> a
flSelector FieldLbl OccName
qualFieldLbl)
filterImports
:: ModIface
-> ImpDeclSpec
-> Maybe (Bool, Located [LIE GhcPs])
-> RnM (Maybe (Bool, Located [LIE GhcRn]),
[GlobalRdrElt])
filterImports :: ModIface
-> ImpDeclSpec
-> Maybe (AnyHpcUsage, Located [LIE GhcPs])
-> RnM (Maybe (AnyHpcUsage, Located [LIE GhcRn]), [GlobalRdrElt])
filterImports ModIface
iface ImpDeclSpec
decl_spec Maybe (AnyHpcUsage, Located [LIE GhcPs])
Nothing
= (Maybe (AnyHpcUsage, Located [Located (IE GhcRn)]), [GlobalRdrElt])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe (AnyHpcUsage, Located [Located (IE GhcRn)]), [GlobalRdrElt])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (AnyHpcUsage, Located [Located (IE GhcRn)])
forall a. Maybe a
Nothing, Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just ImportSpec
imp_spec) (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface))
where
imp_spec :: ImportSpec
imp_spec = ImpSpec :: ImpDeclSpec -> ImpItemSpec -> ImportSpec
ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }
filterImports ModIface
iface ImpDeclSpec
decl_spec (Just (AnyHpcUsage
want_hiding, L SrcSpan
l [LIE GhcPs]
import_items))
= do
[[(Located (IE GhcRn), AvailInfo)]]
items1 <- (Located (IE GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) [(Located (IE GhcRn), AvailInfo)])
-> [Located (IE GhcPs)]
-> IOEnv
(Env TcGblEnv TcLclEnv) [[(Located (IE GhcRn), AvailInfo)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located (IE GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) [(Located (IE GhcRn), AvailInfo)]
LIE GhcPs -> TcRn [(LIE GhcRn, AvailInfo)]
lookup_lie [Located (IE GhcPs)]
[LIE GhcPs]
import_items
let items2 :: [(LIE GhcRn, AvailInfo)]
items2 :: [(LIE GhcRn, AvailInfo)]
items2 = [[(Located (IE GhcRn), AvailInfo)]]
-> [(Located (IE GhcRn), AvailInfo)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Located (IE GhcRn), AvailInfo)]]
items1
names :: NameSet
names = [AvailInfo] -> NameSet
availsToNameSetWithSelectors (((Located (IE GhcRn), AvailInfo) -> AvailInfo)
-> [(Located (IE GhcRn), AvailInfo)] -> [AvailInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Located (IE GhcRn), AvailInfo) -> AvailInfo
forall a b. (a, b) -> b
snd [(Located (IE GhcRn), AvailInfo)]
[(LIE GhcRn, AvailInfo)]
items2)
keep :: Name -> AnyHpcUsage
keep Name
n = AnyHpcUsage -> AnyHpcUsage
not (Name
n Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
names)
pruned_avails :: [AvailInfo]
pruned_avails = (Name -> AnyHpcUsage) -> [AvailInfo] -> [AvailInfo]
filterAvails Name -> AnyHpcUsage
keep [AvailInfo]
all_avails
hiding_spec :: ImportSpec
hiding_spec = ImpSpec :: ImpDeclSpec -> ImpItemSpec -> ImportSpec
ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }
gres :: [GlobalRdrElt]
gres | AnyHpcUsage
want_hiding = Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just ImportSpec
hiding_spec) [AvailInfo]
pruned_avails
| AnyHpcUsage
otherwise = ((Located (IE GhcRn), AvailInfo) -> [GlobalRdrElt])
-> [(Located (IE GhcRn), AvailInfo)] -> [GlobalRdrElt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
gresFromIE ImpDeclSpec
decl_spec) [(Located (IE GhcRn), AvailInfo)]
[(LIE GhcRn, AvailInfo)]
items2
(Maybe (AnyHpcUsage, Located [Located (IE GhcRn)]), [GlobalRdrElt])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe (AnyHpcUsage, Located [Located (IE GhcRn)]), [GlobalRdrElt])
forall (m :: * -> *) a. Monad m => a -> m a
return ((AnyHpcUsage, Located [Located (IE GhcRn)])
-> Maybe (AnyHpcUsage, Located [Located (IE GhcRn)])
forall a. a -> Maybe a
Just (AnyHpcUsage
want_hiding, SrcSpan -> [Located (IE GhcRn)] -> Located [Located (IE GhcRn)]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (((Located (IE GhcRn), AvailInfo) -> Located (IE GhcRn))
-> [(Located (IE GhcRn), AvailInfo)] -> [Located (IE GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (Located (IE GhcRn), AvailInfo) -> Located (IE GhcRn)
forall a b. (a, b) -> a
fst [(Located (IE GhcRn), AvailInfo)]
[(LIE GhcRn, AvailInfo)]
items2)), [GlobalRdrElt]
gres)
where
all_avails :: [AvailInfo]
all_avails = ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
imp_occ_env :: OccEnv (Name,
AvailInfo,
Maybe Name)
imp_occ_env :: OccEnv (Name, AvailInfo, Maybe Name)
imp_occ_env = ((Name, AvailInfo, Maybe Name)
-> (Name, AvailInfo, Maybe Name) -> (Name, AvailInfo, Maybe Name))
-> [(OccName, (Name, AvailInfo, Maybe Name))]
-> OccEnv (Name, AvailInfo, Maybe Name)
forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C (Name, AvailInfo, Maybe Name)
-> (Name, AvailInfo, Maybe Name) -> (Name, AvailInfo, Maybe Name)
forall a a.
(Outputable a, Outputable a) =>
(Name, AvailInfo, Maybe a)
-> (Name, AvailInfo, Maybe a) -> (Name, AvailInfo, Maybe Name)
combine [ (OccName
occ, (Name
n, AvailInfo
a, Maybe Name
forall a. Maybe a
Nothing))
| AvailInfo
a <- [AvailInfo]
all_avails
, (Name
n, OccName
occ) <- AvailInfo -> [(Name, OccName)]
availNamesWithOccs AvailInfo
a]
where
combine :: (Name, AvailInfo, Maybe a)
-> (Name, AvailInfo, Maybe a) -> (Name, AvailInfo, Maybe Name)
combine (Name
name1, a1 :: AvailInfo
a1@(AvailTC Name
p1 [Name]
_ [FieldLabel]
_), Maybe a
mp1)
(Name
name2, a2 :: AvailInfo
a2@(AvailTC Name
p2 [Name]
_ [FieldLabel]
_), Maybe a
mp2)
= ASSERT2( name1 == name2 && isNothing mp1 && isNothing mp2
, ppr name1 <+> ppr name2 <+> ppr mp1 <+> ppr mp2 )
if Name
p1 Name -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Name
name1 then (Name
name1, AvailInfo
a1, Name -> Maybe Name
forall a. a -> Maybe a
Just Name
p2)
else (Name
name1, AvailInfo
a2, Name -> Maybe Name
forall a. a -> Maybe a
Just Name
p1)
combine (Name, AvailInfo, Maybe a)
x (Name, AvailInfo, Maybe a)
y = String -> MsgDoc -> (Name, AvailInfo, Maybe Name)
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"filterImports/combine" ((Name, AvailInfo, Maybe a) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Name, AvailInfo, Maybe a)
x MsgDoc -> MsgDoc -> MsgDoc
$$ (Name, AvailInfo, Maybe a) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Name, AvailInfo, Maybe a)
y)
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 -> AnyHpcUsage
isQual RdrName
rdr = IELookupError -> IELookupM (Name, AvailInfo, Maybe Name)
forall a. IELookupError -> IELookupM a
failLookupWith (RdrName -> IELookupError
QualImportError RdrName
rdr)
| Just (Name, AvailInfo, Maybe Name)
succ <- Maybe (Name, AvailInfo, Maybe Name)
mb_success = (Name, AvailInfo, Maybe Name)
-> IELookupM (Name, AvailInfo, Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name, AvailInfo, Maybe Name)
succ
| AnyHpcUsage
otherwise = IELookupError -> IELookupM (Name, AvailInfo, Maybe Name)
forall a. IELookupError -> IELookupM a
failLookupWith (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie)
where
mb_success :: Maybe (Name, AvailInfo, Maybe Name)
mb_success = OccEnv (Name, AvailInfo, Maybe Name)
-> OccName -> Maybe (Name, AvailInfo, Maybe Name)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (Name, 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 loc ieRdr)
= do ([(IE GhcRn, AvailInfo)]
stuff, [IELookupWarning]
warns) <- SrcSpan
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
(Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> Maybe a -> a
fromMaybe ([],[])) (IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
forall a. IELookupM a -> TcRn (Maybe a)
run_lookup (IE GhcPs -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
lookup_ie IE GhcPs
ieRdr)
(IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [IELookupWarning] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) ()
emit_warning [IELookupWarning]
warns
[(Located (IE GhcRn), AvailInfo)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Located (IE GhcRn), AvailInfo)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ (SrcSpan -> IE GhcRn -> Located (IE GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc IE GhcRn
ie, AvailInfo
avail) | (IE GhcRn
ie,AvailInfo
avail) <- [(IE GhcRn, AvailInfo)]
stuff ]
where
emit_warning :: IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) ()
emit_warning (DodgyImport RdrName
n) = WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnDodgyImports (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
WarnReason -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarn (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnDodgyImports) (RdrName -> MsgDoc
dodgyImportWarn RdrName
n)
emit_warning IELookupWarning
MissingImportList = WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnMissingImportList (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
WarnReason -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarn (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnMissingImportList) (IE GhcPs -> MsgDoc
missingImportListItem IE GhcPs
ieRdr)
emit_warning (BadImportW IE GhcPs
ie) = WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnDodgyImports (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
WarnReason -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarn (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnDodgyImports) (IELookupError -> MsgDoc
lookup_err_msg (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie))
run_lookup :: IELookupM a -> TcRn (Maybe a)
run_lookup :: IELookupM a -> TcRn (Maybe a)
run_lookup IELookupM a
m = case IELookupM a
m of
Failed IELookupError
err -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (IELookupError -> MsgDoc
lookup_err_msg IELookupError
err) IOEnv (Env TcGblEnv TcLclEnv) ()
-> TcRn (Maybe a) -> TcRn (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> TcRn (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
Succeeded a
a -> Maybe a -> TcRn (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
lookup_err_msg :: IELookupError -> MsgDoc
lookup_err_msg IELookupError
err = case IELookupError
err of
BadImport IE GhcPs
ie -> ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> MsgDoc
badImportItemErr ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie [AvailInfo]
all_avails
IELookupError
IllegalImport -> MsgDoc
illegalImportItemErr
QualImportError RdrName
rdr -> RdrName -> MsgDoc
qualImportItemErr RdrName
rdr
lookup_ie :: IE GhcPs
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
lookup_ie :: IE GhcPs -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
lookup_ie IE GhcPs
ie = IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
handle_bad_import (IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
case IE GhcPs
ie of
IEVar XIEVar GhcPs
_ (L SrcSpan
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 (RdrName -> IELookupM (Name, AvailInfo, Maybe Name))
-> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
n
([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(XIEVar GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcRn
noExtField (SrcSpan
-> IEWrappedName Name -> GenLocated SrcSpan (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (IEWrappedName RdrName -> Name -> IEWrappedName Name
forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
n Name
name)),
AvailInfo -> Name -> AvailInfo
trimAvail AvailInfo
avail Name
name)], [])
IEThingAll XIEThingAll GhcPs
_ (L SrcSpan
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 (RdrName -> IELookupM (Name, AvailInfo, Maybe Name))
-> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc
let warns :: [IELookupWarning]
warns = case AvailInfo
avail of
Avail {}
-> [RdrName -> IELookupWarning
DodgyImport (RdrName -> IELookupWarning) -> RdrName -> IELookupWarning
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc]
AvailTC Name
_ [Name]
subs [FieldLabel]
fs
| [Name] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
drop Int
1 [Name]
subs) AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& [FieldLabel] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [FieldLabel]
fs
-> [RdrName -> IELookupWarning
DodgyImport (RdrName -> IELookupWarning) -> RdrName -> IELookupWarning
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc]
| AnyHpcUsage -> AnyHpcUsage
not (ImpDeclSpec -> AnyHpcUsage
is_qual ImpDeclSpec
decl_spec)
-> [IELookupWarning
MissingImportList]
| AnyHpcUsage
otherwise
-> []
renamed_ie :: IE GhcRn
renamed_ie = XIEThingAll GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll NoExtField
XIEThingAll GhcRn
noExtField (SrcSpan
-> IEWrappedName Name -> GenLocated SrcSpan (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (IEWrappedName RdrName -> Name -> IEWrappedName Name
forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc Name
name))
sub_avails :: [(IE GhcRn, AvailInfo)]
sub_avails = case AvailInfo
avail of
Avail {} -> []
AvailTC Name
name2 [Name]
subs [FieldLabel]
fs -> [(IE GhcRn
renamed_ie, Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
name2 ([Name]
subs [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name
name]) [FieldLabel]
fs)]
case Maybe Name
mb_parent of
Maybe Name
Nothing -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(IE GhcRn
renamed_ie, AvailInfo
avail)], [IELookupWarning]
warns)
Just Name
parent -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ((IE GhcRn
renamed_ie, Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
parent [Name
name] []) (IE GhcRn, AvailInfo)
-> [(IE GhcRn, AvailInfo)] -> [(IE GhcRn, AvailInfo)]
forall a. a -> [a] -> [a]
: [(IE GhcRn, AvailInfo)]
sub_avails, [IELookupWarning]
warns)
IEThingAbs XIEThingAbs GhcPs
_ (L SrcSpan
l IEWrappedName (IdP GhcPs)
tc')
| AnyHpcUsage
want_hiding
-> let tc :: RdrName
tc = IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
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 [IELookupM (Name, AvailInfo, Maybe Name)]
-> [(Name, AvailInfo, Maybe Name)]
forall a. [IELookupM a] -> [a]
catIELookupM [ IELookupM (Name, AvailInfo, Maybe Name)
tc_name, IELookupM (Name, AvailInfo, Maybe Name)
dc_name ] of
[] -> IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie)
[(Name, AvailInfo, Maybe Name)]
names -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([IEWrappedName RdrName
-> SrcSpan
-> (Name, AvailInfo, Maybe Name)
-> (IE GhcRn, AvailInfo)
forall pass name1.
(XIEThingAbs pass ~ NoExtField, IdP pass ~ Name) =>
IEWrappedName name1
-> SrcSpan -> (Name, AvailInfo, Maybe Name) -> (IE pass, AvailInfo)
mkIEThingAbs IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc' SrcSpan
l (Name, AvailInfo, Maybe Name)
name | (Name, AvailInfo, Maybe Name)
name <- [(Name, AvailInfo, Maybe Name)]
names], [])
| AnyHpcUsage
otherwise
-> do (Name, AvailInfo, Maybe Name)
nameAvail <- IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie (IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc')
([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([IEWrappedName RdrName
-> SrcSpan
-> (Name, AvailInfo, Maybe Name)
-> (IE GhcRn, AvailInfo)
forall pass name1.
(XIEThingAbs pass ~ NoExtField, IdP pass ~ Name) =>
IEWrappedName name1
-> SrcSpan -> (Name, AvailInfo, Maybe Name) -> (IE pass, AvailInfo)
mkIEThingAbs IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc' SrcSpan
l (Name, AvailInfo, Maybe Name)
nameAvail]
, [])
IEThingWith XIEThingWith GhcPs
xt ltc :: GenLocated SrcSpan (IEWrappedName (IdP GhcPs))
ltc@(L SrcSpan
l IEWrappedName (IdP GhcPs)
rdr_tc) IEWildcard
wc [GenLocated SrcSpan (IEWrappedName (IdP GhcPs))]
rdr_ns [XRec GhcPs (FieldLbl (IdP GhcPs))]
rdr_fs ->
ASSERT2(null rdr_fs, ppr rdr_fs) do
(name, avail, mb_parent)
<- lookup_name (IEThingAbs noExtField ltc) (ieWrappedName rdr_tc)
let (ns,subflds) = case avail of
AvailTC _ ns' subflds' -> (ns',subflds')
Avail _ -> panic "filterImports"
let subnames = case ns of
[] -> []
(n1:ns1) | n1 == name -> ns1
| otherwise -> ns
case lookupChildren (map Left subnames ++ map Right subflds) rdr_ns of
Failed rdrs -> failLookupWith (BadImport (IEThingWith xt ltc wc rdrs []))
Succeeded (childnames, childflds) ->
case mb_parent of
Nothing
-> return ([(IEThingWith noExtField (L l name') wc childnames'
childflds,
AvailTC name (name:map unLoc childnames) (map unLoc childflds))],
[])
where name' = replaceWrappedName rdr_tc name
childnames' = map to_ie_post_rn childnames
Just parent
-> return ([(IEThingWith noExtField (L l name') wc childnames'
childflds,
AvailTC name (map unLoc childnames) (map unLoc childflds)),
(IEThingWith noExtField (L l name') wc childnames'
childflds,
AvailTC parent [name] [])],
[])
where name' = replaceWrappedName rdr_tc name
childnames' = map to_ie_post_rn childnames
IE GhcPs
_other -> IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
IllegalImport
where
mkIEThingAbs :: IEWrappedName name1
-> SrcSpan -> (Name, AvailInfo, Maybe Name) -> (IE pass, AvailInfo)
mkIEThingAbs IEWrappedName name1
tc SrcSpan
l (Name
n, AvailInfo
av, Maybe Name
Nothing )
= (XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs NoExtField
XIEThingAbs pass
noExtField (SrcSpan
-> IEWrappedName Name -> GenLocated SrcSpan (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (IEWrappedName name1 -> Name -> IEWrappedName Name
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 SrcSpan
l (Name
n, AvailInfo
_, Just Name
parent)
= (XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs NoExtField
XIEThingAbs pass
noExtField (SrcSpan
-> IEWrappedName Name -> GenLocated SrcSpan (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (IEWrappedName name1 -> Name -> IEWrappedName Name
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 = IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> (IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a.
IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
m ((IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> (IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$ \IELookupError
err -> case IELookupError
err of
BadImport IE GhcPs
ie | AnyHpcUsage
want_hiding -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [IE GhcPs -> IELookupWarning
BadImportW IE GhcPs
ie])
IELookupError
_ -> IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
err
type IELookupM = MaybeErr IELookupError
data IELookupWarning
= BadImportW (IE GhcPs)
| MissingImportList
| DodgyImport RdrName
data IELookupError
= QualImportError RdrName
| BadImport (IE GhcPs)
| IllegalImport
failLookupWith :: IELookupError -> IELookupM a
failLookupWith :: IELookupError -> IELookupM a
failLookupWith IELookupError
err = IELookupError -> IELookupM a
forall err val. err -> MaybeErr err val
Failed IELookupError
err
catchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup IELookupM a
m IELookupError -> IELookupM a
h = case IELookupM a
m of
Succeeded a
r -> a -> IELookupM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
Failed IELookupError
err -> IELookupError -> IELookupM a
h IELookupError
err
catIELookupM :: [IELookupM a] -> [a]
catIELookupM :: [IELookupM a] -> [a]
catIELookupM [IELookupM a]
ms = [ a
a | Succeeded a
a <- [IELookupM a]
ms ]
gresFromIE :: ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
gresFromIE :: ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
gresFromIE ImpDeclSpec
decl_spec (L loc ie, AvailInfo
avail)
= (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail Name -> Maybe ImportSpec
prov_fn AvailInfo
avail
where
is_explicit :: Name -> AnyHpcUsage
is_explicit = case IE GhcRn
ie of
IEThingAll XIEThingAll GhcRn
_ LIEWrappedName (IdP GhcRn)
name -> \Name
n -> Name
n Name -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName GenLocated SrcSpan (IEWrappedName Name)
LIEWrappedName (IdP GhcRn)
name
IE GhcRn
_ -> \Name
_ -> AnyHpcUsage
True
prov_fn :: Name -> Maybe ImportSpec
prov_fn Name
name
= ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just (ImpSpec :: ImpDeclSpec -> ImpItemSpec -> ImportSpec
ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
item_spec })
where
item_spec :: ImpItemSpec
item_spec = ImpSome :: AnyHpcUsage -> SrcSpan -> ImpItemSpec
ImpSome { is_explicit :: AnyHpcUsage
is_explicit = Name -> AnyHpcUsage
is_explicit Name
name, is_iloc :: SrcSpan
is_iloc = SrcSpan
loc }
mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv [GlobalRdrElt]
gres = (GlobalRdrElt -> NameEnv [GlobalRdrElt] -> NameEnv [GlobalRdrElt])
-> NameEnv [GlobalRdrElt]
-> [GlobalRdrElt]
-> NameEnv [GlobalRdrElt]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobalRdrElt -> NameEnv [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
add NameEnv [GlobalRdrElt]
forall a. NameEnv a
emptyNameEnv [GlobalRdrElt]
gres
where
add :: GlobalRdrElt -> NameEnv [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
add GlobalRdrElt
gre NameEnv [GlobalRdrElt]
env = case GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre of
FldParent Name
p Maybe FastString
_ -> (GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt])
-> (GlobalRdrElt -> [GlobalRdrElt])
-> NameEnv [GlobalRdrElt]
-> Name
-> GlobalRdrElt
-> NameEnv [GlobalRdrElt]
forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc (:) GlobalRdrElt -> [GlobalRdrElt]
forall a. a -> [a]
Utils.singleton NameEnv [GlobalRdrElt]
env Name
p GlobalRdrElt
gre
ParentIs Name
p -> (GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt])
-> (GlobalRdrElt -> [GlobalRdrElt])
-> NameEnv [GlobalRdrElt]
-> Name
-> GlobalRdrElt
-> NameEnv [GlobalRdrElt]
forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc (:) GlobalRdrElt -> [GlobalRdrElt]
forall a. a -> [a]
Utils.singleton NameEnv [GlobalRdrElt]
env Name
p GlobalRdrElt
gre
Parent
NoParent -> NameEnv [GlobalRdrElt]
env
findChildren :: NameEnv [a] -> Name -> [a]
findChildren :: NameEnv [a] -> Name -> [a]
findChildren NameEnv [a]
env Name
n = NameEnv [a] -> Name -> Maybe [a]
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv [a]
env Name
n Maybe [a] -> [a] -> [a]
forall a. Maybe a -> a -> a
`orElse` []
lookupChildren :: [Either Name FieldLabel] -> [LIEWrappedName RdrName]
-> MaybeErr [LIEWrappedName RdrName]
([Located Name], [Located FieldLabel])
lookupChildren :: [Either Name FieldLabel]
-> [LIEWrappedName RdrName]
-> MaybeErr
[LIEWrappedName RdrName] ([Located Name], [Located FieldLabel])
lookupChildren [Either Name FieldLabel]
all_kids [LIEWrappedName RdrName]
rdr_items
| [LIEWrappedName RdrName] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [LIEWrappedName RdrName]
fails
= ([Located Name], [Located FieldLabel])
-> MaybeErr
[LIEWrappedName RdrName] ([Located Name], [Located FieldLabel])
forall err val. val -> MaybeErr err val
Succeeded (([[Located FieldLabel]] -> [Located FieldLabel])
-> ([Located Name], [[Located FieldLabel]])
-> ([Located Name], [Located FieldLabel])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Located FieldLabel]] -> [Located FieldLabel]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Either (Located Name) [Located FieldLabel]]
-> ([Located Name], [[Located FieldLabel]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (Located Name) [Located FieldLabel]]
oks))
| AnyHpcUsage
otherwise
= [LIEWrappedName RdrName]
-> MaybeErr
[LIEWrappedName RdrName] ([Located Name], [Located FieldLabel])
forall err val. err -> MaybeErr err val
Failed [LIEWrappedName RdrName]
fails
where
mb_xs :: [MaybeErr
(LIEWrappedName RdrName)
(Either (Located Name) [Located FieldLabel])]
mb_xs = (LIEWrappedName RdrName
-> MaybeErr
(LIEWrappedName RdrName)
(Either (Located Name) [Located FieldLabel]))
-> [LIEWrappedName RdrName]
-> [MaybeErr
(LIEWrappedName RdrName)
(Either (Located Name) [Located FieldLabel])]
forall a b. (a -> b) -> [a] -> [b]
map LIEWrappedName RdrName
-> MaybeErr
(LIEWrappedName RdrName)
(Either (Located 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 (Located Name) [Located FieldLabel])]
mb_xs ]
oks :: [Either (Located Name) [Located FieldLabel]]
oks = [ Either (Located Name) [Located FieldLabel]
ok | Succeeded Either (Located Name) [Located FieldLabel]
ok <- [MaybeErr
(LIEWrappedName RdrName)
(Either (Located Name) [Located FieldLabel])]
mb_xs ]
oks :: [Either (Located Name) [Located FieldLabel]]
doOne :: LIEWrappedName RdrName
-> MaybeErr
(LIEWrappedName RdrName)
(Either (Located Name) [Located FieldLabel])
doOne item :: LIEWrappedName RdrName
item@(L SrcSpan
l IEWrappedName RdrName
r)
= case (FastStringEnv [Either Name FieldLabel]
-> FastString -> Maybe [Either Name FieldLabel]
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv [Either Name FieldLabel]
kid_env (FastString -> Maybe [Either Name FieldLabel])
-> (IEWrappedName RdrName -> FastString)
-> IEWrappedName RdrName
-> Maybe [Either Name FieldLabel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS (OccName -> FastString)
-> (IEWrappedName RdrName -> OccName)
-> IEWrappedName RdrName
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (IEWrappedName RdrName -> RdrName)
-> IEWrappedName RdrName
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName) IEWrappedName RdrName
r of
Just [Left Name
n] -> Either (Located Name) [Located FieldLabel]
-> MaybeErr
(LIEWrappedName RdrName)
(Either (Located Name) [Located FieldLabel])
forall err val. val -> MaybeErr err val
Succeeded (Located Name -> Either (Located Name) [Located FieldLabel]
forall a b. a -> Either a b
Left (SrcSpan -> Name -> Located Name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Name
n))
Just [Either Name FieldLabel]
rs | (Either Name FieldLabel -> AnyHpcUsage)
-> [Either Name FieldLabel] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all Either Name FieldLabel -> AnyHpcUsage
forall a b. Either a b -> AnyHpcUsage
isRight [Either Name FieldLabel]
rs -> Either (Located Name) [Located FieldLabel]
-> MaybeErr
(LIEWrappedName RdrName)
(Either (Located Name) [Located FieldLabel])
forall err val. val -> MaybeErr err val
Succeeded ([Located FieldLabel] -> Either (Located Name) [Located FieldLabel]
forall a b. b -> Either a b
Right ((FieldLabel -> Located FieldLabel)
-> [FieldLabel] -> [Located FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> FieldLabel -> Located FieldLabel
forall l e. l -> e -> GenLocated l e
L SrcSpan
l) ([Either Name FieldLabel] -> [FieldLabel]
forall a b. [Either a b] -> [b]
rights [Either Name FieldLabel]
rs)))
Maybe [Either Name FieldLabel]
_ -> LIEWrappedName RdrName
-> MaybeErr
(LIEWrappedName RdrName)
(Either (Located Name) [Located FieldLabel])
forall err val. err -> MaybeErr err val
Failed LIEWrappedName RdrName
item
kid_env :: FastStringEnv [Either Name FieldLabel]
kid_env = ([Either Name FieldLabel]
-> [Either Name FieldLabel] -> [Either Name FieldLabel])
-> FastStringEnv [Either Name FieldLabel]
-> [(FastString, [Either Name FieldLabel])]
-> FastStringEnv [Either Name FieldLabel]
forall a.
(a -> a -> a)
-> FastStringEnv a -> [(FastString, a)] -> FastStringEnv a
extendFsEnvList_C [Either Name FieldLabel]
-> [Either Name FieldLabel] -> [Either Name FieldLabel]
forall a. [a] -> [a] -> [a]
(++) FastStringEnv [Either Name FieldLabel]
forall a. FastStringEnv a
emptyFsEnv
[((Name -> FastString)
-> (FieldLabel -> FastString)
-> Either Name FieldLabel
-> FastString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (OccName -> FastString
occNameFS (OccName -> FastString) -> (Name -> OccName) -> Name -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel Either Name FieldLabel
x, [Either Name FieldLabel
x]) | Either Name FieldLabel
x <- [Either Name FieldLabel]
all_kids]
reportUnusedNames :: TcGblEnv -> HscSource -> RnM ()
reportUnusedNames :: TcGblEnv -> HscSource -> IOEnv (Env TcGblEnv TcLclEnv) ()
reportUnusedNames TcGblEnv
gbl_env HscSource
hsc_src
= do { NameSet
keep <- TcRef NameSet -> TcRnIf TcGblEnv TcLclEnv NameSet
forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
readTcRef (TcGblEnv -> TcRef NameSet
tcg_keep TcGblEnv
gbl_env)
; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"RUN" (DefUses -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (TcGblEnv -> DefUses
tcg_dus TcGblEnv
gbl_env))
; TcGblEnv -> HscSource -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImportDecls TcGblEnv
gbl_env HscSource
hsc_src
; [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedTopBinds ([GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ NameSet -> [GlobalRdrElt]
unused_locals NameSet
keep
; TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingSignatures TcGblEnv
gbl_env }
where
used_names :: NameSet -> NameSet
used_names :: NameSet -> NameSet
used_names NameSet
keep = DefUses -> NameSet -> NameSet
findUses (TcGblEnv -> DefUses
tcg_dus TcGblEnv
gbl_env) NameSet
emptyNameSet NameSet -> NameSet -> NameSet
`unionNameSet` NameSet
keep
defined_names :: [GlobalRdrElt]
defined_names :: [GlobalRdrElt]
defined_names = GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts (TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env)
kids_env :: NameEnv [GlobalRdrElt]
kids_env = [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv [GlobalRdrElt]
defined_names
gre_is_used :: NameSet -> GlobalRdrElt -> Bool
gre_is_used :: NameSet -> GlobalRdrElt -> AnyHpcUsage
gre_is_used NameSet
used_names (GRE {gre_name :: GlobalRdrElt -> Name
gre_name = Name
name})
= Name
name Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
used_names
AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| (GlobalRdrElt -> AnyHpcUsage) -> [GlobalRdrElt] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
any (\ GlobalRdrElt
gre -> GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
used_names) (NameEnv [GlobalRdrElt] -> Name -> [GlobalRdrElt]
forall a. NameEnv [a] -> Name -> [a]
findChildren NameEnv [GlobalRdrElt]
kids_env Name
name)
unused_locals :: NameSet -> [GlobalRdrElt]
unused_locals :: NameSet -> [GlobalRdrElt]
unused_locals NameSet
keep =
let
_defined_and_used, defined_but_not_used :: [GlobalRdrElt]
([GlobalRdrElt]
_defined_and_used, [GlobalRdrElt]
defined_but_not_used)
= (GlobalRdrElt -> AnyHpcUsage)
-> [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
forall a. (a -> AnyHpcUsage) -> [a] -> ([a], [a])
partition (NameSet -> GlobalRdrElt -> AnyHpcUsage
gre_is_used (NameSet -> NameSet
used_names NameSet
keep)) [GlobalRdrElt]
defined_names
in (GlobalRdrElt -> AnyHpcUsage) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter GlobalRdrElt -> AnyHpcUsage
is_unused_local [GlobalRdrElt]
defined_but_not_used
is_unused_local :: GlobalRdrElt -> Bool
is_unused_local :: GlobalRdrElt -> AnyHpcUsage
is_unused_local GlobalRdrElt
gre = GlobalRdrElt -> AnyHpcUsage
isLocalGRE GlobalRdrElt
gre AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& Name -> AnyHpcUsage
isExternalName (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre)
warnMissingSignatures :: TcGblEnv -> RnM ()
warnMissingSignatures :: TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingSignatures TcGblEnv
gbl_env
= do { let exports :: NameSet
exports = [AvailInfo] -> NameSet
availsToNameSet (TcGblEnv -> [AvailInfo]
tcg_exports TcGblEnv
gbl_env)
sig_ns :: NameSet
sig_ns = TcGblEnv -> NameSet
tcg_sigs TcGblEnv
gbl_env
binds :: [IdP GhcTc]
binds = LHsBindsLR GhcTc GhcTc -> [IdP GhcTc]
forall p idR. CollectPass p => LHsBindsLR p idR -> [IdP p]
collectHsBindsBinders (LHsBindsLR GhcTc GhcTc -> [IdP GhcTc])
-> LHsBindsLR GhcTc GhcTc -> [IdP GhcTc]
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> LHsBindsLR GhcTc GhcTc
tcg_binds TcGblEnv
gbl_env
pat_syns :: [PatSyn]
pat_syns = TcGblEnv -> [PatSyn]
tcg_patsyns TcGblEnv
gbl_env
; AnyHpcUsage
warn_missing_sigs <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl AnyHpcUsage
woptM WarningFlag
Opt_WarnMissingSignatures
; AnyHpcUsage
warn_only_exported <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl AnyHpcUsage
woptM WarningFlag
Opt_WarnMissingExportedSignatures
; AnyHpcUsage
warn_pat_syns <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl AnyHpcUsage
woptM WarningFlag
Opt_WarnMissingPatternSynonymSignatures
; let add_sig_warns :: IOEnv (Env TcGblEnv TcLclEnv) ()
add_sig_warns
| AnyHpcUsage
warn_only_exported = WarningFlag -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warns WarningFlag
Opt_WarnMissingExportedSignatures
| AnyHpcUsage
warn_missing_sigs = WarningFlag -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warns WarningFlag
Opt_WarnMissingSignatures
| AnyHpcUsage
warn_pat_syns = WarningFlag -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warns WarningFlag
Opt_WarnMissingPatternSynonymSignatures
| AnyHpcUsage
otherwise = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
add_warns :: WarningFlag -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warns WarningFlag
flag
= AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when AnyHpcUsage
warn_pat_syns
((PatSyn -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [PatSyn] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PatSyn -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_pat_syn_warn [PatSyn]
pat_syns) IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (AnyHpcUsage
warn_missing_sigs AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| AnyHpcUsage
warn_only_exported)
((Id -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [Id] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Id -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_bind_warn [Id]
[IdP GhcTc]
binds)
where
add_pat_syn_warn :: PatSyn -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_pat_syn_warn PatSyn
p
= Name -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warn Name
name (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Pattern synonym with no type signature:")
Int
2 (String -> MsgDoc
text String
"pattern" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. NamedThing a => a -> MsgDoc
pprPrefixName Name
name MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
dcolon MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
pp_ty)
where
name :: Name
name = PatSyn -> Name
patSynName PatSyn
p
pp_ty :: MsgDoc
pp_ty = PatSyn -> MsgDoc
pprPatSynType PatSyn
p
add_bind_warn :: Id -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_bind_warn :: Id -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_bind_warn Id
id
= do { TidyEnv
env <- TcM TidyEnv
tcInitTidyEnv
; let name :: Name
name = Id -> Name
idName Id
id
(TidyEnv
_, Type
ty) = TidyEnv -> Type -> (TidyEnv, Type)
tidyOpenType TidyEnv
env (Id -> Type
idType Id
id)
ty_msg :: MsgDoc
ty_msg = Type -> MsgDoc
pprSigmaType Type
ty
; Name -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warn Name
name (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Top-level binding with no type signature:")
Int
2 (Name -> MsgDoc
forall a. NamedThing a => a -> MsgDoc
pprPrefixName Name
name MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
dcolon MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
ty_msg) }
add_warn :: Name -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warn Name
name MsgDoc
msg
= AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (Name
name Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
sig_ns AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& Name -> AnyHpcUsage
export_check Name
name)
(WarnReason -> SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarnAt (WarningFlag -> WarnReason
Reason WarningFlag
flag) (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
name) MsgDoc
msg)
export_check :: Name -> AnyHpcUsage
export_check Name
name
= AnyHpcUsage -> AnyHpcUsage
not AnyHpcUsage
warn_only_exported AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| Name
name Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
exports
; IOEnv (Env TcGblEnv TcLclEnv) ()
add_sig_warns }
type ImportDeclUsage
= ( LImportDecl GhcRn
, [GlobalRdrElt]
, [Name] )
warnUnusedImportDecls :: TcGblEnv -> HscSource -> RnM ()
warnUnusedImportDecls :: TcGblEnv -> HscSource -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImportDecls TcGblEnv
gbl_env HscSource
hsc_src
= do { [GlobalRdrElt]
uses <- IORef [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a env. IORef a -> IOEnv env a
readMutVar (TcGblEnv -> IORef [GlobalRdrElt]
tcg_used_gres TcGblEnv
gbl_env)
; let user_imports :: [Located (ImportDecl GhcRn)]
user_imports = (Located (ImportDecl GhcRn) -> AnyHpcUsage)
-> [Located (ImportDecl GhcRn)] -> [Located (ImportDecl GhcRn)]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filterOut
(ImportDecl GhcRn -> AnyHpcUsage
forall pass. ImportDecl pass -> AnyHpcUsage
ideclImplicit (ImportDecl GhcRn -> AnyHpcUsage)
-> (Located (ImportDecl GhcRn) -> ImportDecl GhcRn)
-> Located (ImportDecl GhcRn)
-> AnyHpcUsage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (ImportDecl GhcRn) -> ImportDecl GhcRn
forall l e. GenLocated l e -> e
unLoc)
(TcGblEnv -> [LImportDecl GhcRn]
tcg_rn_imports TcGblEnv
gbl_env)
rdr_env :: GlobalRdrEnv
rdr_env = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env
fld_env :: NameEnv (FastString, Name)
fld_env = GlobalRdrEnv -> NameEnv (FastString, Name)
mkFieldEnv GlobalRdrEnv
rdr_env
; let usage :: [ImportDeclUsage]
usage :: [ImportDeclUsage]
usage = [LImportDecl GhcRn] -> [GlobalRdrElt] -> [ImportDeclUsage]
findImportUsage [Located (ImportDecl GhcRn)]
[LImportDecl GhcRn]
user_imports [GlobalRdrElt]
uses
; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"warnUnusedImportDecls" (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
([MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"Uses:" MsgDoc -> MsgDoc -> MsgDoc
<+> [GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [GlobalRdrElt]
uses
, String -> MsgDoc
text String
"Import usage" MsgDoc -> MsgDoc -> MsgDoc
<+> [(Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [(Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])]
[ImportDeclUsage]
usage])
; WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnUnusedImports (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
((Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [(Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WarningFlag
-> NameEnv (FastString, Name)
-> ImportDeclUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImport WarningFlag
Opt_WarnUnusedImports NameEnv (FastString, Name)
fld_env) [(Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])]
[ImportDeclUsage]
usage
; GeneralFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenGOptM GeneralFlag
Opt_D_dump_minimal_imports (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
HscSource -> [ImportDeclUsage] -> IOEnv (Env TcGblEnv TcLclEnv) ()
printMinimalImports HscSource
hsc_src [ImportDeclUsage]
usage }
findImportUsage :: [LImportDecl GhcRn]
-> [GlobalRdrElt]
-> [ImportDeclUsage]
findImportUsage :: [LImportDecl GhcRn] -> [GlobalRdrElt] -> [ImportDeclUsage]
findImportUsage [LImportDecl GhcRn]
imports [GlobalRdrElt]
used_gres
= (Located (ImportDecl GhcRn)
-> (Located (ImportDecl GhcRn), [GlobalRdrElt], [Name]))
-> [Located (ImportDecl GhcRn)]
-> [(Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])]
forall a b. (a -> b) -> [a] -> [b]
map Located (ImportDecl GhcRn)
-> (Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])
LImportDecl GhcRn -> ImportDeclUsage
unused_decl [Located (ImportDecl GhcRn)]
[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 loc (ImportDecl { ideclHiding = imps }))
= (LImportDecl GhcRn
decl, [GlobalRdrElt]
used_gres, NameSet -> [Name]
nameSetElemsStable NameSet
unused_imps)
where
used_gres :: [GlobalRdrElt]
used_gres = SrcLoc -> ImportMap -> Maybe [GlobalRdrElt]
forall a. SrcLoc -> Map RealSrcLoc a -> Maybe a
lookupSrcLoc (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) ImportMap
import_usage
Maybe [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. Maybe a -> a -> a
`orElse` []
used_names :: NameSet
used_names = [Name] -> NameSet
mkNameSet ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
gre_name [GlobalRdrElt]
used_gres)
used_parents :: NameSet
used_parents = [Name] -> NameSet
mkNameSet ((GlobalRdrElt -> Maybe Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GlobalRdrElt -> Maybe Name
greParent_maybe [GlobalRdrElt]
used_gres)
unused_imps :: NameSet
unused_imps
= case Maybe (AnyHpcUsage, XRec GhcRn [LIE GhcRn])
imps of
Just (AnyHpcUsage
False, L _ imp_ies) ->
(Located (IE GhcRn) -> NameSet -> NameSet)
-> NameSet -> [Located (IE GhcRn)] -> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (IE GhcRn -> NameSet -> NameSet
add_unused (IE GhcRn -> NameSet -> NameSet)
-> (Located (IE GhcRn) -> IE GhcRn)
-> Located (IE GhcRn)
-> NameSet
-> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (IE GhcRn) -> IE GhcRn
forall l e. GenLocated l e -> e
unLoc) NameSet
emptyNameSet [Located (IE GhcRn)]
imp_ies
Maybe (AnyHpcUsage, XRec GhcRn [LIE GhcRn])
_other -> NameSet
emptyNameSet
add_unused :: IE GhcRn -> NameSet -> NameSet
add_unused :: IE GhcRn -> NameSet -> NameSet
add_unused (IEVar XIEVar GhcRn
_ LIEWrappedName (IdP GhcRn)
n) NameSet
acc = Name -> NameSet -> NameSet
add_unused_name (GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName GenLocated SrcSpan (IEWrappedName Name)
LIEWrappedName (IdP GhcRn)
n) NameSet
acc
add_unused (IEThingAbs XIEThingAbs GhcRn
_ LIEWrappedName (IdP GhcRn)
n) NameSet
acc = Name -> NameSet -> NameSet
add_unused_name (GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName GenLocated SrcSpan (IEWrappedName Name)
LIEWrappedName (IdP GhcRn)
n) NameSet
acc
add_unused (IEThingAll XIEThingAll GhcRn
_ LIEWrappedName (IdP GhcRn)
n) NameSet
acc = Name -> NameSet -> NameSet
add_unused_all (GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName GenLocated SrcSpan (IEWrappedName Name)
LIEWrappedName (IdP GhcRn)
n) NameSet
acc
add_unused (IEThingWith XIEThingWith GhcRn
_ LIEWrappedName (IdP GhcRn)
p IEWildcard
wc [LIEWrappedName (IdP GhcRn)]
ns [XRec GhcRn (FieldLbl (IdP GhcRn))]
fs) NameSet
acc =
NameSet -> NameSet
add_wc_all (Name -> [Name] -> NameSet -> NameSet
add_unused_with Name
pn [Name]
xs NameSet
acc)
where pn :: Name
pn = GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName GenLocated SrcSpan (IEWrappedName Name)
LIEWrappedName (IdP GhcRn)
p
xs :: [Name]
xs = (GenLocated SrcSpan (IEWrappedName Name) -> Name)
-> [GenLocated SrcSpan (IEWrappedName Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName [GenLocated SrcSpan (IEWrappedName Name)]
[LIEWrappedName (IdP GhcRn)]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (Located FieldLabel -> Name) -> [Located FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector (FieldLabel -> Name)
-> (Located FieldLabel -> FieldLabel) -> Located FieldLabel -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located FieldLabel -> FieldLabel
forall l e. GenLocated l e -> e
unLoc) [Located FieldLabel]
[XRec GhcRn (FieldLbl (IdP GhcRn))]
fs
add_wc_all :: NameSet -> NameSet
add_wc_all = case IEWildcard
wc of
IEWildcard
NoIEWildcard -> NameSet -> NameSet
forall a. a -> a
id
IEWildcard Int
_ -> Name -> NameSet -> NameSet
add_unused_all Name
pn
add_unused IE GhcRn
_ NameSet
acc = NameSet
acc
add_unused_name :: Name -> NameSet -> NameSet
add_unused_name Name
n NameSet
acc
| Name
n Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
used_names = NameSet
acc
| AnyHpcUsage
otherwise = NameSet
acc NameSet -> Name -> NameSet
`extendNameSet` Name
n
add_unused_all :: Name -> NameSet -> NameSet
add_unused_all Name
n NameSet
acc
| Name
n Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
used_names = NameSet
acc
| Name
n Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
used_parents = NameSet
acc
| AnyHpcUsage
otherwise = NameSet
acc NameSet -> Name -> NameSet
`extendNameSet` Name
n
add_unused_with :: Name -> [Name] -> NameSet -> NameSet
add_unused_with Name
p [Name]
ns NameSet
acc
| (Name -> AnyHpcUsage) -> [Name] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all (Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
acc1) [Name]
ns = Name -> NameSet -> NameSet
add_unused_name Name
p NameSet
acc1
| AnyHpcUsage
otherwise = NameSet
acc1
where
acc1 :: NameSet
acc1 = (Name -> NameSet -> NameSet) -> NameSet -> [Name] -> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Name -> NameSet -> NameSet
add_unused_name NameSet
acc [Name]
ns
type ImportMap = Map RealSrcLoc [GlobalRdrElt]
mkImportMap :: [GlobalRdrElt] -> ImportMap
mkImportMap :: [GlobalRdrElt] -> ImportMap
mkImportMap [GlobalRdrElt]
gres
= (GlobalRdrElt -> ImportMap -> ImportMap)
-> ImportMap -> [GlobalRdrElt] -> ImportMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobalRdrElt -> ImportMap -> ImportMap
add_one ImportMap
forall k a. Map k a
Map.empty [GlobalRdrElt]
gres
where
add_one :: GlobalRdrElt -> ImportMap -> ImportMap
add_one gre :: GlobalRdrElt
gre@(GRE { gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
imp_specs }) ImportMap
imp_map =
case SrcSpan -> SrcLoc
srcSpanEnd (ImpDeclSpec -> SrcSpan
is_dloc (ImportSpec -> ImpDeclSpec
is_decl ImportSpec
best_imp_spec)) of
RealSrcLoc RealSrcLoc
decl_loc Maybe BufPos
_ -> ([GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt])
-> RealSrcLoc -> [GlobalRdrElt] -> ImportMap -> ImportMap
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
add RealSrcLoc
decl_loc [GlobalRdrElt
gre] ImportMap
imp_map
UnhelpfulLoc FastString
_ -> ImportMap
imp_map
where
best_imp_spec :: ImportSpec
best_imp_spec = [ImportSpec] -> ImportSpec
bestImport [ImportSpec]
imp_specs
add :: [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
add [GlobalRdrElt]
_ [GlobalRdrElt]
gres = GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: [GlobalRdrElt]
gres
warnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Name)
-> ImportDeclUsage -> RnM ()
warnUnusedImport :: WarningFlag
-> NameEnv (FastString, Name)
-> ImportDeclUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImport WarningFlag
flag NameEnv (FastString, Name)
fld_env (L loc decl, [GlobalRdrElt]
used, [Name]
unused)
| Just (AnyHpcUsage
False,L _ []) <- ImportDecl GhcRn -> Maybe (AnyHpcUsage, XRec GhcRn [LIE GhcRn])
forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, XRec pass [LIE pass])
ideclHiding ImportDecl GhcRn
decl
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just (AnyHpcUsage
True, L _ hides) <- ImportDecl GhcRn -> Maybe (AnyHpcUsage, XRec GhcRn [LIE GhcRn])
forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, XRec pass [LIE pass])
ideclHiding ImportDecl GhcRn
decl
, AnyHpcUsage -> AnyHpcUsage
not ([Located (IE GhcRn)] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [Located (IE GhcRn)]
hides)
, ModuleName
pRELUDE_NAME ModuleName -> ModuleName -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== GenLocated SrcSpan ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcRn -> XRec GhcRn ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcRn
decl)
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| [GlobalRdrElt] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [GlobalRdrElt]
used
= WarnReason -> SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarnAt (WarningFlag -> WarnReason
Reason WarningFlag
flag) SrcSpan
loc MsgDoc
msg1
| [Name] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [Name]
unused
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just (AnyHpcUsage
_, L _ imports) <- ImportDecl GhcRn -> Maybe (AnyHpcUsage, XRec GhcRn [LIE GhcRn])
forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, XRec pass [LIE pass])
ideclHiding ImportDecl GhcRn
decl
, [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
unused Int -> Int -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Int
1
, Just (L SrcSpan
loc IE GhcRn
_) <- (Located (IE GhcRn) -> AnyHpcUsage)
-> [Located (IE GhcRn)] -> Maybe (Located (IE GhcRn))
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> Maybe a
find (\(L SrcSpan
_ IE GhcRn
ie) -> ((IE GhcRn -> IdP GhcRn
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcRn
ie) :: Name) Name -> [Name] -> AnyHpcUsage
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> AnyHpcUsage
`elem` [Name]
unused) [Located (IE GhcRn)]
imports
= WarnReason -> SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarnAt (WarningFlag -> WarnReason
Reason WarningFlag
flag) SrcSpan
loc MsgDoc
msg2
| AnyHpcUsage
otherwise
= WarnReason -> SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarnAt (WarningFlag -> WarnReason
Reason WarningFlag
flag) SrcSpan
loc MsgDoc
msg2
where
msg1 :: MsgDoc
msg1 = [MsgDoc] -> MsgDoc
vcat [ MsgDoc
pp_herald MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
pp_mod MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
is_redundant
, Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"except perhaps to import instances from"
MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
pp_mod)
, String -> MsgDoc
text String
"To import instances alone, use:"
MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"import" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
pp_mod MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens MsgDoc
Outputable.empty ]
msg2 :: MsgDoc
msg2 = [MsgDoc] -> MsgDoc
sep [ MsgDoc
pp_herald MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
sort_unused
, String -> MsgDoc
text String
"from module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
pp_mod MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
is_redundant]
pp_herald :: MsgDoc
pp_herald = String -> MsgDoc
text String
"The" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
pp_qual MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"import of"
pp_qual :: MsgDoc
pp_qual
| ImportDeclQualifiedStyle -> AnyHpcUsage
isImportDeclQualified (ImportDecl GhcRn -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcRn
decl)= String -> MsgDoc
text String
"qualified"
| AnyHpcUsage
otherwise = MsgDoc
Outputable.empty
pp_mod :: MsgDoc
pp_mod = ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (GenLocated SrcSpan ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcRn -> XRec GhcRn ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcRn
decl))
is_redundant :: MsgDoc
is_redundant = String -> MsgDoc
text String
"is redundant"
ppr_possible_field :: Name -> MsgDoc
ppr_possible_field Name
n = case NameEnv (FastString, Name) -> Name -> Maybe (FastString, Name)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv (FastString, Name)
fld_env Name
n of
Just (FastString
fld, Name
p) -> Name -> MsgDoc
pprNameUnqualified Name
p MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens (FastString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr FastString
fld)
Maybe (FastString, Name)
Nothing -> Name -> MsgDoc
pprNameUnqualified Name
n
sort_unused :: SDoc
sort_unused :: MsgDoc
sort_unused = (Name -> MsgDoc) -> [Name] -> MsgDoc
forall a. (a -> MsgDoc) -> [a] -> MsgDoc
pprWithCommas Name -> MsgDoc
ppr_possible_field ([Name] -> MsgDoc) -> [Name] -> MsgDoc
forall a b. (a -> b) -> a -> b
$
(Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Name -> OccName) -> Name -> Name -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Name -> OccName
nameOccName) [Name]
unused
getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports = ([Located (ImportDecl GhcRn)] -> [Located (ImportDecl GhcRn)])
-> IOEnv (Env TcGblEnv TcLclEnv) [Located (ImportDecl GhcRn)]
-> IOEnv (Env TcGblEnv TcLclEnv) [Located (ImportDecl GhcRn)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Located (ImportDecl GhcRn)] -> [Located (ImportDecl GhcRn)]
[LImportDecl GhcRn] -> [LImportDecl GhcRn]
combine (IOEnv (Env TcGblEnv TcLclEnv) [Located (ImportDecl GhcRn)]
-> IOEnv (Env TcGblEnv TcLclEnv) [Located (ImportDecl GhcRn)])
-> ([(Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])]
-> IOEnv (Env TcGblEnv TcLclEnv) [Located (ImportDecl GhcRn)])
-> [(Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])]
-> IOEnv (Env TcGblEnv TcLclEnv) [Located (ImportDecl GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (ImportDecl GhcRn)))
-> [(Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])]
-> IOEnv (Env TcGblEnv TcLclEnv) [Located (ImportDecl GhcRn)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Located (ImportDecl GhcRn), [GlobalRdrElt], [Name])
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (ImportDecl GhcRn))
forall pass (t :: * -> *) l l a.
(Outputable (ImportDecl pass), Foldable t,
XRec pass ModuleName ~ GenLocated l ModuleName,
XRec pass [XRec pass (IE pass)]
~ GenLocated l [GenLocated l (IE GhcRn)]) =>
(GenLocated l (ImportDecl pass), [GlobalRdrElt], t a)
-> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated l (ImportDecl pass))
mk_minimal
where
mk_minimal :: (GenLocated l (ImportDecl pass), [GlobalRdrElt], t a)
-> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated l (ImportDecl pass))
mk_minimal (L l
l ImportDecl pass
decl, [GlobalRdrElt]
used_gres, t a
unused)
| t a -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null t a
unused
, Just (AnyHpcUsage
False, XRec pass [XRec pass (IE pass)]
_) <- ImportDecl pass
-> Maybe (AnyHpcUsage, XRec pass [XRec pass (IE pass)])
forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, XRec pass [LIE pass])
ideclHiding ImportDecl pass
decl
= GenLocated l (ImportDecl pass)
-> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated l (ImportDecl pass))
forall (m :: * -> *) a. Monad m => a -> m a
return (l -> ImportDecl pass -> GenLocated l (ImportDecl pass)
forall l e. l -> e -> GenLocated l e
L l
l ImportDecl pass
decl)
| AnyHpcUsage
otherwise
= do { let ImportDecl { ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = L _ mod_name
, ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSource = IsBootInterface
is_boot
, ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual = Maybe StringLiteral
mb_pkg } = ImportDecl pass
decl
; ModIface
iface <- MsgDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM ModIface
loadSrcInterface MsgDoc
doc ModuleName
mod_name IsBootInterface
is_boot ((StringLiteral -> FastString)
-> Maybe StringLiteral -> Maybe FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> FastString
sl_fs Maybe StringLiteral
mb_pkg)
; let used_avails :: [AvailInfo]
used_avails = [GlobalRdrElt] -> [AvailInfo]
gresToAvailInfo [GlobalRdrElt]
used_gres
lies :: [GenLocated l (IE GhcRn)]
lies = (IE GhcRn -> GenLocated l (IE GhcRn))
-> [IE GhcRn] -> [GenLocated l (IE GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (l -> IE GhcRn -> GenLocated l (IE GhcRn)
forall l e. l -> e -> GenLocated l e
L l
l) ((AvailInfo -> [IE GhcRn]) -> [AvailInfo] -> [IE GhcRn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModIface -> AvailInfo -> [IE GhcRn]
to_ie ModIface
iface) [AvailInfo]
used_avails)
; GenLocated l (ImportDecl pass)
-> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated l (ImportDecl pass))
forall (m :: * -> *) a. Monad m => a -> m a
return (l -> ImportDecl pass -> GenLocated l (ImportDecl pass)
forall l e. l -> e -> GenLocated l e
L l
l (ImportDecl pass
decl { ideclHiding :: Maybe (AnyHpcUsage, XRec pass [XRec pass (IE pass)])
ideclHiding = (AnyHpcUsage, GenLocated l [GenLocated l (IE GhcRn)])
-> Maybe (AnyHpcUsage, GenLocated l [GenLocated l (IE GhcRn)])
forall a. a -> Maybe a
Just (AnyHpcUsage
False, l
-> [GenLocated l (IE GhcRn)]
-> GenLocated l [GenLocated l (IE GhcRn)]
forall l e. l -> e -> GenLocated l e
L l
l [GenLocated l (IE GhcRn)]
lies) })) }
where
doc :: MsgDoc
doc = String -> MsgDoc
text String
"Compute minimal imports for" MsgDoc -> MsgDoc -> MsgDoc
<+> ImportDecl pass -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ImportDecl pass
decl
to_ie :: ModIface -> AvailInfo -> [IE GhcRn]
to_ie :: ModIface -> AvailInfo -> [IE GhcRn]
to_ie ModIface
_ (Avail Name
n)
= [XIEVar GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcRn
noExtField (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall a b. (a -> b) -> a -> b
$ Name -> Located Name
forall e. e -> Located e
noLoc Name
n)]
to_ie ModIface
_ (AvailTC Name
n [Name
m] [])
| Name
nName -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
==Name
m = [XIEThingAbs GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs NoExtField
XIEThingAbs GhcRn
noExtField (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall a b. (a -> b) -> a -> b
$ Name -> Located Name
forall e. e -> Located e
noLoc Name
n)]
to_ie ModIface
iface (AvailTC Name
n [Name]
ns [FieldLabel]
fs)
= case [([Name]
xs,[FieldLabel]
gs) | AvailTC Name
x [Name]
xs [FieldLabel]
gs <- ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
, Name
x Name -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Name
n
, Name
x Name -> [Name] -> AnyHpcUsage
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> AnyHpcUsage
`elem` [Name]
xs
] of
[([Name], [FieldLabel])
xs] | ([Name], [FieldLabel]) -> AnyHpcUsage
all_used ([Name], [FieldLabel])
xs -> [XIEThingAll GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll NoExtField
XIEThingAll GhcRn
noExtField (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall a b. (a -> b) -> a -> b
$ Name -> Located Name
forall e. e -> Located e
noLoc Name
n)]
| AnyHpcUsage
otherwise ->
[XIEThingWith GhcRn
-> LIEWrappedName (IdP GhcRn)
-> IEWildcard
-> [LIEWrappedName (IdP GhcRn)]
-> [XRec GhcRn (FieldLbl (IdP GhcRn))]
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [XRec pass (FieldLbl (IdP pass))]
-> IE pass
IEThingWith NoExtField
XIEThingWith GhcRn
noExtField (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall a b. (a -> b) -> a -> b
$ Name -> Located Name
forall e. e -> Located e
noLoc Name
n) IEWildcard
NoIEWildcard
((Name -> GenLocated SrcSpan (IEWrappedName Name))
-> [Name] -> [GenLocated SrcSpan (IEWrappedName Name)]
forall a b. (a -> b) -> [a] -> [b]
map (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> (Name -> Located Name)
-> Name
-> GenLocated SrcSpan (IEWrappedName Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall e. e -> Located e
noLoc) ((Name -> AnyHpcUsage) -> [Name] -> [Name]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter (Name -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= Name
n) [Name]
ns))
((FieldLabel -> Located FieldLabel)
-> [FieldLabel] -> [Located FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Located FieldLabel
forall e. e -> Located e
noLoc [FieldLabel]
fs)]
[([Name], [FieldLabel])]
_other | [FieldLabel] -> AnyHpcUsage
forall a. [FieldLbl a] -> AnyHpcUsage
all_non_overloaded [FieldLabel]
fs
-> (Name -> IE GhcRn) -> [Name] -> [IE GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (XIEVar GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcRn
noExtField (GenLocated SrcSpan (IEWrappedName Name) -> IE GhcRn)
-> (Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Name
-> IE GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn_var (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> (Name -> Located Name)
-> Name
-> GenLocated SrcSpan (IEWrappedName Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall e. e -> Located e
noLoc) ([Name] -> [IE GhcRn]) -> [Name] -> [IE GhcRn]
forall a b. (a -> b) -> a -> b
$ [Name]
ns
[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FieldLabel -> Name) -> [FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector [FieldLabel]
fs
| AnyHpcUsage
otherwise ->
[XIEThingWith GhcRn
-> LIEWrappedName (IdP GhcRn)
-> IEWildcard
-> [LIEWrappedName (IdP GhcRn)]
-> [XRec GhcRn (FieldLbl (IdP GhcRn))]
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [XRec pass (FieldLbl (IdP pass))]
-> IE pass
IEThingWith NoExtField
XIEThingWith GhcRn
noExtField (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall a b. (a -> b) -> a -> b
$ Name -> Located Name
forall e. e -> Located e
noLoc Name
n) IEWildcard
NoIEWildcard
((Name -> GenLocated SrcSpan (IEWrappedName Name))
-> [Name] -> [GenLocated SrcSpan (IEWrappedName Name)]
forall a b. (a -> b) -> [a] -> [b]
map (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> (Name -> Located Name)
-> Name
-> GenLocated SrcSpan (IEWrappedName Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall e. e -> Located e
noLoc) ((Name -> AnyHpcUsage) -> [Name] -> [Name]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter (Name -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= Name
n) [Name]
ns))
((FieldLabel -> Located FieldLabel)
-> [FieldLabel] -> [Located FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Located FieldLabel
forall e. e -> Located e
noLoc [FieldLabel]
fs)]
where
fld_lbls :: [FastString]
fld_lbls = (FieldLabel -> FastString) -> [FieldLabel] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel [FieldLabel]
fs
all_used :: ([Name], [FieldLabel]) -> AnyHpcUsage
all_used ([Name]
avail_occs, [FieldLabel]
avail_flds)
= (Name -> AnyHpcUsage) -> [Name] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all (Name -> [Name] -> AnyHpcUsage
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> AnyHpcUsage
`elem` [Name]
ns) [Name]
avail_occs
AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& (FastString -> AnyHpcUsage) -> [FastString] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all (FastString -> [FastString] -> AnyHpcUsage
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> AnyHpcUsage
`elem` [FastString]
fld_lbls) ((FieldLabel -> FastString) -> [FieldLabel] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel [FieldLabel]
avail_flds)
all_non_overloaded :: [FieldLbl a] -> AnyHpcUsage
all_non_overloaded = (FieldLbl a -> AnyHpcUsage) -> [FieldLbl a] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all (AnyHpcUsage -> AnyHpcUsage
not (AnyHpcUsage -> AnyHpcUsage)
-> (FieldLbl a -> AnyHpcUsage) -> FieldLbl a -> AnyHpcUsage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLbl a -> AnyHpcUsage
forall a. FieldLbl a -> AnyHpcUsage
flIsOverloaded)
combine :: [LImportDecl GhcRn] -> [LImportDecl GhcRn]
combine :: [LImportDecl GhcRn] -> [LImportDecl GhcRn]
combine = ([Located (ImportDecl GhcRn)] -> Located (ImportDecl GhcRn))
-> [[Located (ImportDecl GhcRn)]] -> [Located (ImportDecl GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map [Located (ImportDecl GhcRn)] -> Located (ImportDecl GhcRn)
[LImportDecl GhcRn] -> LImportDecl GhcRn
merge ([[Located (ImportDecl GhcRn)]] -> [Located (ImportDecl GhcRn)])
-> ([Located (ImportDecl GhcRn)] -> [[Located (ImportDecl GhcRn)]])
-> [Located (ImportDecl GhcRn)]
-> [Located (ImportDecl GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (ImportDecl GhcRn)
-> Located (ImportDecl GhcRn) -> AnyHpcUsage)
-> [Located (ImportDecl GhcRn)] -> [[Located (ImportDecl GhcRn)]]
forall a. (a -> a -> AnyHpcUsage) -> [a] -> [[a]]
groupBy ((AnyHpcUsage, Maybe ModuleName, ModuleName)
-> (AnyHpcUsage, Maybe ModuleName, ModuleName) -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
(==) ((AnyHpcUsage, Maybe ModuleName, ModuleName)
-> (AnyHpcUsage, Maybe ModuleName, ModuleName) -> AnyHpcUsage)
-> (Located (ImportDecl GhcRn)
-> (AnyHpcUsage, Maybe ModuleName, ModuleName))
-> Located (ImportDecl GhcRn)
-> Located (ImportDecl GhcRn)
-> AnyHpcUsage
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Located (ImportDecl GhcRn)
-> (AnyHpcUsage, Maybe ModuleName, ModuleName)
LImportDecl GhcRn -> (AnyHpcUsage, Maybe ModuleName, ModuleName)
getKey) ([Located (ImportDecl GhcRn)] -> [[Located (ImportDecl GhcRn)]])
-> ([Located (ImportDecl GhcRn)] -> [Located (ImportDecl GhcRn)])
-> [Located (ImportDecl GhcRn)]
-> [[Located (ImportDecl GhcRn)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (ImportDecl GhcRn)
-> (AnyHpcUsage, Maybe ModuleName, ModuleName))
-> [Located (ImportDecl GhcRn)] -> [Located (ImportDecl GhcRn)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Located (ImportDecl GhcRn)
-> (AnyHpcUsage, Maybe ModuleName, ModuleName)
LImportDecl GhcRn -> (AnyHpcUsage, Maybe ModuleName, ModuleName)
getKey
getKey :: LImportDecl GhcRn -> (Bool, Maybe ModuleName, ModuleName)
getKey :: LImportDecl GhcRn -> (AnyHpcUsage, Maybe ModuleName, ModuleName)
getKey LImportDecl GhcRn
decl =
( ImportDeclQualifiedStyle -> AnyHpcUsage
isImportDeclQualified (ImportDeclQualifiedStyle -> AnyHpcUsage)
-> (ImportDecl GhcRn -> ImportDeclQualifiedStyle)
-> ImportDecl GhcRn
-> AnyHpcUsage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcRn -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified (ImportDecl GhcRn -> AnyHpcUsage)
-> ImportDecl GhcRn -> AnyHpcUsage
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcRn
idecl
, GenLocated SrcSpan ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan ModuleName -> ModuleName)
-> Maybe (GenLocated SrcSpan ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImportDecl GhcRn -> Maybe (XRec GhcRn ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcRn
idecl
, GenLocated SrcSpan ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan ModuleName -> ModuleName)
-> (ImportDecl GhcRn -> GenLocated SrcSpan ModuleName)
-> ImportDecl GhcRn
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcRn -> GenLocated SrcSpan ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName (ImportDecl GhcRn -> ModuleName) -> ImportDecl GhcRn -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcRn
idecl
)
where
idecl :: ImportDecl GhcRn
idecl :: ImportDecl GhcRn
idecl = Located (ImportDecl GhcRn) -> ImportDecl GhcRn
forall l e. GenLocated l e -> e
unLoc Located (ImportDecl GhcRn)
LImportDecl GhcRn
decl
merge :: [LImportDecl GhcRn] -> LImportDecl GhcRn
merge :: [LImportDecl GhcRn] -> LImportDecl GhcRn
merge [] = String -> Located (ImportDecl GhcRn)
forall a. HasCallStack => String -> a
error String
"getMinimalImports: unexpected empty list"
merge decls :: [LImportDecl GhcRn]
decls@((L l decl) : [LImportDecl GhcRn]
_) = SrcSpan -> ImportDecl GhcRn -> Located (ImportDecl GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (ImportDecl GhcRn
decl { ideclHiding :: Maybe (AnyHpcUsage, XRec GhcRn [LIE GhcRn])
ideclHiding = (AnyHpcUsage, Located [Located (IE GhcRn)])
-> Maybe (AnyHpcUsage, Located [Located (IE GhcRn)])
forall a. a -> Maybe a
Just (AnyHpcUsage
False, SrcSpan -> [Located (IE GhcRn)] -> Located [Located (IE GhcRn)]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l [Located (IE GhcRn)]
lies) })
where lies :: [Located (IE GhcRn)]
lies = ((AnyHpcUsage, Located [Located (IE GhcRn)])
-> [Located (IE GhcRn)])
-> [(AnyHpcUsage, Located [Located (IE GhcRn)])]
-> [Located (IE GhcRn)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Located [Located (IE GhcRn)] -> [Located (IE GhcRn)]
forall l e. GenLocated l e -> e
unLoc (Located [Located (IE GhcRn)] -> [Located (IE GhcRn)])
-> ((AnyHpcUsage, Located [Located (IE GhcRn)])
-> Located [Located (IE GhcRn)])
-> (AnyHpcUsage, Located [Located (IE GhcRn)])
-> [Located (IE GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnyHpcUsage, Located [Located (IE GhcRn)])
-> Located [Located (IE GhcRn)]
forall a b. (a, b) -> b
snd) ([(AnyHpcUsage, Located [Located (IE GhcRn)])]
-> [Located (IE GhcRn)])
-> [(AnyHpcUsage, Located [Located (IE GhcRn)])]
-> [Located (IE GhcRn)]
forall a b. (a -> b) -> a -> b
$ (Located (ImportDecl GhcRn)
-> Maybe (AnyHpcUsage, Located [Located (IE GhcRn)]))
-> [Located (ImportDecl GhcRn)]
-> [(AnyHpcUsage, Located [Located (IE GhcRn)])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportDecl GhcRn
-> Maybe (AnyHpcUsage, Located [Located (IE GhcRn)])
forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, XRec pass [LIE pass])
ideclHiding (ImportDecl GhcRn
-> Maybe (AnyHpcUsage, Located [Located (IE GhcRn)]))
-> (Located (ImportDecl GhcRn) -> ImportDecl GhcRn)
-> Located (ImportDecl GhcRn)
-> Maybe (AnyHpcUsage, Located [Located (IE GhcRn)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (ImportDecl GhcRn) -> ImportDecl GhcRn
forall l e. GenLocated l e -> e
unLoc) [Located (ImportDecl GhcRn)]
[LImportDecl GhcRn]
decls
printMinimalImports :: HscSource -> [ImportDeclUsage] -> RnM ()
printMinimalImports :: HscSource -> [ImportDeclUsage] -> IOEnv (Env TcGblEnv TcLclEnv) ()
printMinimalImports HscSource
hsc_src [ImportDeclUsage]
imports_w_usage
= do { [Located (ImportDecl GhcRn)]
imports' <- [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports [ImportDeclUsage]
imports_w_usage
; Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile (DynFlags -> Module -> String
mkFilename DynFlags
dflags Module
this_mod) IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
DynFlags -> Handle -> PrintUnqualified -> Depth -> MsgDoc -> IO ()
printForUser DynFlags
dflags Handle
h PrintUnqualified
neverQualify Depth
AllTheWay ([MsgDoc] -> MsgDoc
vcat ((Located (ImportDecl GhcRn) -> MsgDoc)
-> [Located (ImportDecl GhcRn)] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map Located (ImportDecl GhcRn) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [Located (ImportDecl GhcRn)]
imports'))
}
where
mkFilename :: DynFlags -> Module -> String
mkFilename DynFlags
dflags Module
this_mod
| Just String
d <- DynFlags -> Maybe String
dumpDir DynFlags
dflags = String
d String -> String -> String
</> String
basefn
| AnyHpcUsage
otherwise = String
basefn
where
suffix :: String
suffix = case HscSource
hsc_src of
HscSource
HsBootFile -> String
".imports-boot"
HscSource
HsSrcFile -> String
".imports"
HscSource
HsigFile -> String
".imports"
basefn :: String
basefn = ModuleName -> String
moduleNameString (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix
to_ie_post_rn_var :: (HasOccName name) => Located name -> LIEWrappedName name
to_ie_post_rn_var :: Located name -> LIEWrappedName name
to_ie_post_rn_var (L SrcSpan
l name
n)
| OccName -> AnyHpcUsage
isDataOcc (OccName -> AnyHpcUsage) -> OccName -> AnyHpcUsage
forall a b. (a -> b) -> a -> b
$ name -> OccName
forall name. HasOccName name => name -> OccName
occName name
n = SrcSpan -> IEWrappedName name -> LIEWrappedName name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Located name -> IEWrappedName name
forall name. Located name -> IEWrappedName name
IEPattern (SrcSpan -> name -> Located name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l name
n))
| AnyHpcUsage
otherwise = SrcSpan -> IEWrappedName name -> LIEWrappedName name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Located name -> IEWrappedName name
forall name. Located name -> IEWrappedName name
IEName (SrcSpan -> name -> Located name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l name
n))
to_ie_post_rn :: (HasOccName name) => Located name -> LIEWrappedName name
to_ie_post_rn :: Located name -> LIEWrappedName name
to_ie_post_rn (L SrcSpan
l name
n)
| OccName -> AnyHpcUsage
isTcOcc OccName
occ AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& OccName -> AnyHpcUsage
isSymOcc OccName
occ = SrcSpan -> IEWrappedName name -> LIEWrappedName name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Located name -> IEWrappedName name
forall name. Located name -> IEWrappedName name
IEType (SrcSpan -> name -> Located name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l name
n))
| AnyHpcUsage
otherwise = SrcSpan -> IEWrappedName name -> LIEWrappedName name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Located name -> IEWrappedName name
forall name. Located name -> IEWrappedName name
IEName (SrcSpan -> name -> Located name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l name
n))
where occ :: OccName
occ = name -> OccName
forall name. HasOccName name => name -> OccName
occName name
n
qualImportItemErr :: RdrName -> SDoc
qualImportItemErr :: RdrName -> MsgDoc
qualImportItemErr RdrName
rdr
= MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Illegal qualified name in import item:")
Int
2 (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr)
pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec :: ModIface -> ImpDeclSpec -> MsgDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec =
MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)) MsgDoc -> MsgDoc -> MsgDoc
<+> case ModIface -> IsBootInterface
mi_boot ModIface
iface of
IsBootInterface
IsBoot -> String -> MsgDoc
text String
"(hi-boot interface)"
IsBootInterface
NotBoot -> MsgDoc
Outputable.empty
badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE GhcPs -> SDoc
badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE GhcPs -> MsgDoc
badImportItemErrStd ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
= [MsgDoc] -> MsgDoc
sep [String -> MsgDoc
text String
"Module", ModIface -> ImpDeclSpec -> MsgDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec,
String -> MsgDoc
text String
"does not export", MsgDoc -> MsgDoc
quotes (IE GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr IE GhcPs
ie)]
badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE GhcPs
-> SDoc
badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE GhcPs -> MsgDoc
badImportItemErrDataCon OccName
dataType_occ ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
= [MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"In module"
MsgDoc -> MsgDoc -> MsgDoc
<+> ModIface -> ImpDeclSpec -> MsgDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec
MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
colon
, Int -> MsgDoc -> MsgDoc
nest Int
2 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ MsgDoc -> MsgDoc
quotes MsgDoc
datacon
MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"is a data constructor of"
MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
dataType
, String -> MsgDoc
text String
"To import it use"
, Int -> MsgDoc -> MsgDoc
nest Int
2 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ String -> MsgDoc
text String
"import"
MsgDoc -> MsgDoc -> MsgDoc
<+> ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)
MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens_sp (MsgDoc
dataType MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens_sp MsgDoc
datacon)
, String -> MsgDoc
text String
"or"
, Int -> MsgDoc -> MsgDoc
nest Int
2 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ String -> MsgDoc
text String
"import"
MsgDoc -> MsgDoc -> MsgDoc
<+> ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)
MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens_sp (MsgDoc
dataType MsgDoc -> MsgDoc -> MsgDoc
<> String -> MsgDoc
text String
"(..)")
]
where
datacon_occ :: OccName
datacon_occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
datacon :: MsgDoc
datacon = OccName -> MsgDoc -> MsgDoc
parenSymOcc OccName
datacon_occ (OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
datacon_occ)
dataType :: MsgDoc
dataType = OccName -> MsgDoc -> MsgDoc
parenSymOcc OccName
dataType_occ (OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
dataType_occ)
parens_sp :: MsgDoc -> MsgDoc
parens_sp MsgDoc
d = MsgDoc -> MsgDoc
parens (MsgDoc
space MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
d MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
space)
badImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> SDoc
badImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> MsgDoc
badImportItemErr ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie [AvailInfo]
avails
= case (AvailInfo -> AnyHpcUsage) -> [AvailInfo] -> Maybe AvailInfo
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> Maybe a
find AvailInfo -> AnyHpcUsage
checkIfDataCon [AvailInfo]
avails of
Just AvailInfo
con -> OccName -> ModIface -> ImpDeclSpec -> IE GhcPs -> MsgDoc
badImportItemErrDataCon (AvailInfo -> OccName
availOccName AvailInfo
con) ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
Maybe AvailInfo
Nothing -> ModIface -> ImpDeclSpec -> IE GhcPs -> MsgDoc
badImportItemErrStd ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
where
checkIfDataCon :: AvailInfo -> AnyHpcUsage
checkIfDataCon (AvailTC Name
_ [Name]
ns [FieldLabel]
_) =
case (Name -> AnyHpcUsage) -> [Name] -> Maybe Name
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> Maybe a
find (\Name
n -> FastString
importedFS FastString -> FastString -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Name -> FastString
nameOccNameFS Name
n) [Name]
ns of
Just Name
n -> Name -> AnyHpcUsage
isDataConName Name
n
Maybe Name
Nothing -> AnyHpcUsage
False
checkIfDataCon AvailInfo
_ = AnyHpcUsage
False
availOccName :: AvailInfo -> OccName
availOccName = Name -> OccName
nameOccName (Name -> OccName) -> (AvailInfo -> Name) -> AvailInfo -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvailInfo -> Name
availName
nameOccNameFS :: Name -> FastString
nameOccNameFS = OccName -> FastString
occNameFS (OccName -> FastString) -> (Name -> OccName) -> Name -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName
importedFS :: FastString
importedFS = OccName -> FastString
occNameFS (OccName -> FastString)
-> (RdrName -> OccName) -> RdrName -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> FastString) -> RdrName -> FastString
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
illegalImportItemErr :: SDoc
illegalImportItemErr :: MsgDoc
illegalImportItemErr = String -> MsgDoc
text String
"Illegal import item"
dodgyImportWarn :: RdrName -> SDoc
dodgyImportWarn :: RdrName -> MsgDoc
dodgyImportWarn RdrName
item
= MsgDoc -> RdrName -> IE GhcPs -> MsgDoc
forall a b.
(Outputable a, Outputable b) =>
MsgDoc -> a -> b -> MsgDoc
dodgyMsg (String -> MsgDoc
text String
"import") RdrName
item (IdP GhcPs -> IE GhcPs
forall (p :: Pass). IdP (GhcPass p) -> IE (GhcPass p)
dodgyMsgInsert RdrName
IdP GhcPs
item :: IE GhcPs)
dodgyMsg :: (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgyMsg :: MsgDoc -> a -> b -> MsgDoc
dodgyMsg MsgDoc
kind a
tc b
ie
= [MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text String
"The" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
kind MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"item")
MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (b -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr b
ie)
MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"suggests that",
MsgDoc -> MsgDoc
quotes (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
tc) MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"has (in-scope) constructors or class methods,",
String -> MsgDoc
text String
"but it has none" ]
dodgyMsgInsert :: forall p . IdP (GhcPass p) -> IE (GhcPass p)
dodgyMsgInsert :: IdP (GhcPass p) -> IE (GhcPass p)
dodgyMsgInsert IdP (GhcPass p)
tc = XIEThingAll (GhcPass p)
-> LIEWrappedName (IdP (GhcPass p)) -> IE (GhcPass p)
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll NoExtField
XIEThingAll (GhcPass p)
noExtField LIEWrappedName (IdP (GhcPass p))
ii
where
ii :: LIEWrappedName (IdP (GhcPass p))
ii :: LIEWrappedName (IdP (GhcPass p))
ii = IEWrappedName (IdGhcP p) -> Located (IEWrappedName (IdGhcP p))
forall e. e -> Located e
noLoc (Located (IdGhcP p) -> IEWrappedName (IdGhcP p)
forall name. Located name -> IEWrappedName name
IEName (Located (IdGhcP p) -> IEWrappedName (IdGhcP p))
-> Located (IdGhcP p) -> IEWrappedName (IdGhcP p)
forall a b. (a -> b) -> a -> b
$ IdGhcP p -> Located (IdGhcP p)
forall e. e -> Located e
noLoc IdP (GhcPass p)
IdGhcP p
tc)
addDupDeclErr :: [GlobalRdrElt] -> TcRn ()
addDupDeclErr :: [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDupDeclErr [] = String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. String -> a
panic String
"addDupDeclErr: empty list"
addDupDeclErr gres :: [GlobalRdrElt]
gres@(GlobalRdrElt
gre : [GlobalRdrElt]
_)
= SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan ([Name] -> Name
forall a. [a] -> a
last [Name]
sorted_names)) (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
[MsgDoc] -> MsgDoc
vcat [String -> MsgDoc
text String
"Multiple declarations of" MsgDoc -> MsgDoc -> MsgDoc
<+>
MsgDoc -> MsgDoc
quotes (OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre)),
String -> MsgDoc
text String
"Declared at:" MsgDoc -> MsgDoc -> MsgDoc
<+>
[MsgDoc] -> MsgDoc
vcat ((Name -> MsgDoc) -> [Name] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SrcLoc -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (SrcLoc -> MsgDoc) -> (Name -> SrcLoc) -> Name -> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SrcLoc
nameSrcLoc) [Name]
sorted_names)]
where
sorted_names :: [Name]
sorted_names =
(Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (Name -> SrcSpan) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> SrcSpan
nameSrcSpan)
((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
gre_name [GlobalRdrElt]
gres)
missingImportListWarn :: ModuleName -> SDoc
missingImportListWarn :: ModuleName -> MsgDoc
missingImportListWarn ModuleName
mod
= String -> MsgDoc
text String
"The module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
mod) MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"does not have an explicit import list")
missingImportListItem :: IE GhcPs -> SDoc
missingImportListItem :: IE GhcPs -> MsgDoc
missingImportListItem IE GhcPs
ie
= String -> MsgDoc
text String
"The import item" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (IE GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr IE GhcPs
ie) MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"does not have an explicit import list")
moduleWarn :: ModuleName -> WarningTxt -> SDoc
moduleWarn :: ModuleName -> WarningTxt -> MsgDoc
moduleWarn ModuleName
mod (WarningTxt Located SourceText
_ [Located StringLiteral]
txt)
= [MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text String
"Module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
mod) MsgDoc -> MsgDoc -> MsgDoc
<> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
":"),
Int -> MsgDoc -> MsgDoc
nest Int
2 ([MsgDoc] -> MsgDoc
vcat ((Located StringLiteral -> MsgDoc)
-> [Located StringLiteral] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (FastString -> MsgDoc)
-> (Located StringLiteral -> FastString)
-> Located StringLiteral
-> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> (Located StringLiteral -> StringLiteral)
-> Located StringLiteral
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located StringLiteral -> StringLiteral
forall l e. GenLocated l e -> e
unLoc) [Located StringLiteral]
txt)) ]
moduleWarn ModuleName
mod (DeprecatedTxt Located SourceText
_ [Located StringLiteral]
txt)
= [MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text String
"Module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
mod)
MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"is deprecated:",
Int -> MsgDoc -> MsgDoc
nest Int
2 ([MsgDoc] -> MsgDoc
vcat ((Located StringLiteral -> MsgDoc)
-> [Located StringLiteral] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (FastString -> MsgDoc)
-> (Located StringLiteral -> FastString)
-> Located StringLiteral
-> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> (Located StringLiteral -> StringLiteral)
-> Located StringLiteral
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located StringLiteral -> StringLiteral
forall l e. GenLocated l e -> e
unLoc) [Located StringLiteral]
txt)) ]
packageImportErr :: SDoc
packageImportErr :: MsgDoc
packageImportErr
= String -> MsgDoc
text String
"Package-qualified imports are not enabled; use PackageImports"
checkConName :: RdrName -> TcRn ()
checkConName :: RdrName -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkConName RdrName
name = AnyHpcUsage -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkErr (RdrName -> AnyHpcUsage
isRdrDataCon RdrName
name) (RdrName -> MsgDoc
badDataCon RdrName
name)
badDataCon :: RdrName -> SDoc
badDataCon :: RdrName -> MsgDoc
badDataCon RdrName
name
= [MsgDoc] -> MsgDoc
hsep [String -> MsgDoc
text String
"Illegal data constructor name", MsgDoc -> MsgDoc
quotes (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
name)]