{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TupleSections #-}
module GHC.Tc.Gen.Export (rnExports, exports_from_avail, classifyGREs) where
import GHC.Prelude
import GHC.Hs
import GHC.Builtin.Names
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.Env
( TyThing(AConLike, AnId), tcLookupGlobal, tcLookupTyCon )
import GHC.Tc.Utils.TcType
import GHC.Rename.Doc
import GHC.Rename.Module
import GHC.Rename.Names
import GHC.Rename.Env
import GHC.Rename.Unbound ( reportUnboundName )
import GHC.Utils.Error
import GHC.Unit.Module
import GHC.Unit.Module.Imported
import GHC.Unit.Module.Warnings
import GHC.Core.TyCon
import GHC.Utils.Misc (sndOf3, thdOf3)
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Core.ConLike
import GHC.Core.PatSyn
import GHC.Data.Maybe
import GHC.Data.FastString (fsLit)
import GHC.Driver.Env
import GHC.Driver.DynFlags
import GHC.Parser.PostProcess ( setRdrNameSpace )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Types.Unique.Map
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.DefaultEnv (ClassDefaults (cd_class), DefaultEnv,
emptyDefaultEnv, filterDefaultEnv, isEmptyDefaultEnv)
import GHC.Types.Avail
import GHC.Types.SourceFile
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Name.Reader
import Control.Arrow ( first )
import Control.Monad ( when )
import qualified Data.List.NonEmpty as NE
import Data.Traversable ( for )
import Data.List ( sortBy )
import qualified Data.Map as Map
data ExportAccum
= ExportAccum {
ExportAccum -> ExportOccMap
expacc_exp_occs :: ExportOccMap,
ExportAccum -> UniqMap ModuleName [Name]
expacc_mods :: UniqMap ModuleName [Name],
ExportAccum -> ExportWarnSpanNames
expacc_warn_spans :: ExportWarnSpanNames,
ExportAccum -> DontWarnExportNames
expacc_dont_warn :: DontWarnExportNames
}
emptyExportAccum :: ExportAccum
emptyExportAccum :: ExportAccum
emptyExportAccum = ExportOccMap
-> UniqMap ModuleName [Name]
-> ExportWarnSpanNames
-> DontWarnExportNames
-> ExportAccum
ExportAccum ExportOccMap
forall a. OccEnv a
emptyOccEnv UniqMap ModuleName [Name]
forall k a. UniqMap k a
emptyUniqMap [] DontWarnExportNames
forall a. NameEnv a
emptyNameEnv
accumExports :: (ExportAccum -> x -> TcRn (ExportAccum, Maybe y))
-> [x]
-> TcRn ([y], ExportWarnSpanNames, DontWarnExportNames)
accumExports :: forall x y.
(ExportAccum -> x -> TcRn (ExportAccum, Maybe y))
-> [x] -> TcRn ([y], ExportWarnSpanNames, DontWarnExportNames)
accumExports ExportAccum -> x -> TcRn (ExportAccum, Maybe y)
f [x]
xs = do
(ExportAccum _ _ export_warn_spans dont_warn_export, ys)
<- (ExportAccum -> x -> TcRn (ExportAccum, Maybe y))
-> ExportAccum
-> [x]
-> IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, [Maybe y])
forall (m :: * -> *) (t :: * -> *) acc x y.
(Monad m, Traversable t) =>
(acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
mapAccumLM ExportAccum -> x -> TcRn (ExportAccum, Maybe y)
f' ExportAccum
emptyExportAccum [x]
xs
return ( catMaybes ys
, export_warn_spans
, dont_warn_export )
where f' :: ExportAccum -> x -> TcRn (ExportAccum, Maybe y)
f' ExportAccum
acc x
x
= (ExportAccum, Maybe y)
-> Maybe (ExportAccum, Maybe y) -> (ExportAccum, Maybe y)
forall a. a -> Maybe a -> a
fromMaybe (ExportAccum
acc, Maybe y
forall a. Maybe a
Nothing) (Maybe (ExportAccum, Maybe y) -> (ExportAccum, Maybe y))
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (ExportAccum, Maybe y))
-> TcRn (ExportAccum, Maybe y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TcRn (ExportAccum, Maybe y)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (ExportAccum, Maybe y))
forall r. TcRn r -> TcRn (Maybe r)
attemptM (ExportAccum -> x -> TcRn (ExportAccum, Maybe y)
f ExportAccum
acc x
x)
type ExportOccMap = OccEnv (Name, IE GhcPs)
rnExports :: Bool
-> Maybe (LocatedLI [LIE GhcPs])
-> RnM TcGblEnv
rnExports :: Bool -> Maybe (LocatedLI [LIE GhcPs]) -> RnM TcGblEnv
rnExports Bool
explicit_mod Maybe (LocatedLI [LIE GhcPs])
exports
= RnM TcGblEnv -> RnM TcGblEnv
forall r. TcM r -> TcM r
checkNoErrs (RnM TcGblEnv -> RnM TcGblEnv) -> RnM TcGblEnv -> RnM TcGblEnv
forall a b. (a -> b) -> a -> b
$
do { hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; tcg_env <- getGblEnv
; let dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
TcGblEnv { tcg_mod = this_mod
, tcg_rdr_env = rdr_env
, tcg_imports = imports
, tcg_warns = warns
, tcg_src = hsc_src } = tcg_env
default_main | HomeUnitEnv -> Module
mainModIs (HscEnv -> HomeUnitEnv
hsc_HUE HscEnv
hsc_env) Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
this_mod
, Just String
main_fun <- DynFlags -> Maybe String
mainFunIs DynFlags
dflags
= NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
main_fun)
| Bool
otherwise
= RdrName
main_RDR_Unqual
; has_main <- (not . null) <$> lookupInfoOccRn default_main
; let real_exports
| Bool
explicit_mod = Maybe (LocatedLI [LIE GhcPs])
exports
| Bool
has_main
= GenLocated SrcSpanAnnLI [GenLocated SrcSpanAnnA (IE GhcPs)]
-> Maybe
(GenLocated SrcSpanAnnLI [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. a -> Maybe a
Just ([GenLocated SrcSpanAnnA (IE GhcPs)]
-> GenLocated SrcSpanAnnLI [GenLocated SrcSpanAnnA (IE GhcPs)]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA [IE GhcPs -> GenLocated SrcSpanAnnA (IE GhcPs)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XIEVar GhcPs
-> LIEWrappedName GhcPs -> Maybe (ExportDoc GhcPs) -> IE GhcPs
forall pass.
XIEVar pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEVar Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
XIEVar GhcPs
forall a. Maybe a
Nothing
(IEWrappedName GhcPs -> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XIEName GhcPs -> LIdP GhcPs -> IEWrappedName GhcPs
forall p. XIEName p -> LIdP p -> IEWrappedName p
IEName XIEName GhcPs
NoExtField
noExtField (LIdP GhcPs -> IEWrappedName GhcPs)
-> LIdP GhcPs -> IEWrappedName GhcPs
forall a b. (a -> b) -> a -> b
$ RdrName -> GenLocated SrcSpanAnnN RdrName
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA RdrName
default_main)) Maybe (ExportDoc GhcPs)
forall a. Maybe a
Nothing)])
| Bool
otherwise = Maybe (LocatedLI [LIE GhcPs])
Maybe (GenLocated SrcSpanAnnLI [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. Maybe a
Nothing
; let do_it = Maybe (LocatedLI [LIE GhcPs])
-> GlobalRdrEnv
-> ImportAvails
-> Module
-> RnM
(Maybe [(LIE GhcRn, DefaultEnv, [AvailInfo])], [AvailInfo],
ExportWarnNames GhcRn)
exports_from_avail Maybe (LocatedLI [LIE GhcPs])
real_exports GlobalRdrEnv
rdr_env ImportAvails
imports Module
this_mod
; (rn_exports, final_avails, new_export_warns)
<- if hsc_src == HsigFile
then do (mb_r, msgs) <- tryTc do_it
case mb_r of
Just (Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
[AvailInfo], ExportWarnNames GhcRn)
r -> (Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
[AvailInfo], ExportWarnNames GhcRn)
-> TcRn
(Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
[AvailInfo], ExportWarnNames GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
[AvailInfo], ExportWarnNames GhcRn)
r
Maybe
(Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
[AvailInfo], ExportWarnNames GhcRn)
Nothing -> Messages TcRnMessage -> TcRn ()
addMessages Messages TcRnMessage
msgs TcRn ()
-> TcRn
(Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
[AvailInfo], ExportWarnNames GhcRn)
-> TcRn
(Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
[AvailInfo], ExportWarnNames GhcRn)
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TcRn
(Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
[AvailInfo], ExportWarnNames GhcRn)
forall env a. IOEnv env a
failM
else checkNoErrs do_it
; let final_ns = [AvailInfo] -> NameSet
availsToNameSet [AvailInfo]
final_avails
drop_defaults (a
spans, b
_defaults, b
avails) = (a
spans, b
avails)
; traceRn "rnExports: Exports:" (ppr final_avails)
; return (tcg_env { tcg_exports = final_avails
, tcg_rn_exports = case tcg_rn_exports tcg_env of
Maybe [(LIE GhcRn, [AvailInfo])]
Nothing -> Maybe [(LIE GhcRn, [AvailInfo])]
Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
forall a. Maybe a
Nothing
Just [(LIE GhcRn, [AvailInfo])]
_ -> ((GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
-> (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
-> [(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
-> [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
-> (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])
forall {a} {b} {b}. (a, b, b) -> (a, b)
drop_defaults ([(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
-> [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])])
-> Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
-> Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
rn_exports
, tcg_default_exports = case exports of
Maybe (LocatedLI [LIE GhcPs])
Nothing -> DefaultEnv
emptyDefaultEnv
Maybe (LocatedLI [LIE GhcPs])
_ -> ([(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
-> DefaultEnv)
-> Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
-> DefaultEnv
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (((GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
-> DefaultEnv)
-> [(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
-> DefaultEnv
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
-> DefaultEnv
forall a b c. (a, b, c) -> b
sndOf3) Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
rn_exports
, tcg_dus = tcg_dus tcg_env `plusDU`
usesOnly final_ns
, tcg_warns = insertWarnExports
warns new_export_warns}) }
type ExportWarnSpanNames = [(Name, WarningTxt GhcRn, SrcSpan)]
type DontWarnExportNames = NameEnv (NE.NonEmpty SrcSpan)
exports_from_avail :: Maybe (LocatedLI [LIE GhcPs])
-> GlobalRdrEnv
-> ImportAvails
-> Module
-> RnM (Maybe [(LIE GhcRn, DefaultEnv, Avails)], Avails, ExportWarnNames GhcRn)
exports_from_avail :: Maybe (LocatedLI [LIE GhcPs])
-> GlobalRdrEnv
-> ImportAvails
-> Module
-> RnM
(Maybe [(LIE GhcRn, DefaultEnv, [AvailInfo])], [AvailInfo],
ExportWarnNames GhcRn)
exports_from_avail Maybe (LocatedLI [LIE GhcPs])
Nothing GlobalRdrEnv
rdr_env ImportAvails
_imports Module
_this_mod
= do {
; TcRnMessage -> TcRn ()
addDiagnostic
(ModuleName -> TcRnMessage
TcRnMissingExportList (ModuleName -> TcRnMessage) -> ModuleName -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
_this_mod)
; let avails :: [AvailInfo]
avails =
(AvailInfo -> AvailInfo) -> [AvailInfo] -> [AvailInfo]
forall a b. (a -> b) -> [a] -> [b]
map AvailInfo -> AvailInfo
fix_faminst ([AvailInfo] -> [AvailInfo])
-> (GlobalRdrEnv -> [AvailInfo]) -> GlobalRdrEnv -> [AvailInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GlobalRdrEltX GREInfo] -> [AvailInfo]
forall info. [GlobalRdrEltX info] -> [AvailInfo]
gresToAvailInfo
([GlobalRdrEltX GREInfo] -> [AvailInfo])
-> (GlobalRdrEnv -> [GlobalRdrEltX GREInfo])
-> GlobalRdrEnv
-> [AvailInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalRdrEltX GREInfo -> Bool)
-> [GlobalRdrEltX GREInfo] -> [GlobalRdrEltX GREInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrEltX GREInfo -> Bool
forall info. GlobalRdrEltX info -> Bool
isLocalGRE ([GlobalRdrEltX GREInfo] -> [GlobalRdrEltX GREInfo])
-> (GlobalRdrEnv -> [GlobalRdrEltX GREInfo])
-> GlobalRdrEnv
-> [GlobalRdrEltX GREInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrEnv -> [GlobalRdrEltX GREInfo]
forall info. GlobalRdrEnvX info -> [GlobalRdrEltX info]
globalRdrEnvElts (GlobalRdrEnv -> [AvailInfo]) -> GlobalRdrEnv -> [AvailInfo]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv
rdr_env
; (Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
[AvailInfo], ExportWarnNames GhcRn)
-> TcRn
(Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
[AvailInfo], ExportWarnNames GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
[(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
forall a. Maybe a
Nothing, [AvailInfo]
avails, []) }
where
fix_faminst :: AvailInfo -> AvailInfo
fix_faminst avail :: AvailInfo
avail@(AvailTC Name
n [Name]
ns)
| AvailInfo -> Bool
availExportsDecl AvailInfo
avail
= AvailInfo
avail
| Bool
otherwise
= Name -> [Name] -> AvailInfo
AvailTC Name
n (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ns)
fix_faminst AvailInfo
avail = AvailInfo
avail
exports_from_avail (Just (L SrcSpanAnnLI
_ [LIE GhcPs]
rdr_items)) GlobalRdrEnv
rdr_env ImportAvails
imports Module
this_mod
= do (ie_avails, export_warn_spans, dont_warn_export)
<- (ExportAccum
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> TcRn
(ExportAccum,
Maybe
(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> TcRn
([(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])],
ExportWarnSpanNames, DontWarnExportNames)
forall x y.
(ExportAccum -> x -> TcRn (ExportAccum, Maybe y))
-> [x] -> TcRn ([y], ExportWarnSpanNames, DontWarnExportNames)
accumExports ExportAccum
-> LIE GhcPs
-> RnM (ExportAccum, Maybe (LIE GhcRn, DefaultEnv, [AvailInfo]))
ExportAccum
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> TcRn
(ExportAccum,
Maybe (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo]))
do_litem [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
rdr_items
let final_exports = [AvailInfo] -> [AvailInfo]
nubAvails (((GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
-> [AvailInfo])
-> [(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
-> [AvailInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
-> [AvailInfo]
forall a b c. (a, b, c) -> c
thdOf3 [(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])]
ie_avails)
export_warn_names <- aggregate_warnings export_warn_spans dont_warn_export
return (Just ie_avails, final_exports, export_warn_names)
where
do_litem :: ExportAccum -> LIE GhcPs
-> RnM (ExportAccum, Maybe (LIE GhcRn, DefaultEnv, Avails))
do_litem :: ExportAccum
-> LIE GhcPs
-> RnM (ExportAccum, Maybe (LIE GhcRn, DefaultEnv, [AvailInfo]))
do_litem ExportAccum
acc LIE GhcPs
lie = SrcSpan
-> TcRn
(ExportAccum,
Maybe (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo]))
-> TcRn
(ExportAccum,
Maybe (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo]))
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (GenLocated SrcSpanAnnA (IE GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LIE GhcPs
GenLocated SrcSpanAnnA (IE GhcPs)
lie) (ExportAccum
-> LIE GhcPs
-> RnM (ExportAccum, Maybe (LIE GhcRn, DefaultEnv, [AvailInfo]))
exports_from_item ExportAccum
acc LIE GhcPs
lie)
kids_env :: NameEnv [GlobalRdrElt]
kids_env :: NameEnv [GlobalRdrEltX GREInfo]
kids_env = [GlobalRdrEltX GREInfo] -> NameEnv [GlobalRdrEltX GREInfo]
mkChildEnv (GlobalRdrEnv -> [GlobalRdrEltX GREInfo]
forall info. GlobalRdrEnvX info -> [GlobalRdrEltX info]
globalRdrEnvElts GlobalRdrEnv
rdr_env)
expand_tyty_gre :: GlobalRdrElt -> [GlobalRdrElt]
expand_tyty_gre :: GlobalRdrEltX GREInfo -> [GlobalRdrEltX GREInfo]
expand_tyty_gre (gre :: GlobalRdrEltX GREInfo
gre@GRE { gre_par :: forall info. GlobalRdrEltX info -> Parent
gre_par = ParentIs Name
p })
| Name -> Bool
isTyConName Name
p
, Name -> Bool
isTyConName (GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
gre)
= [GlobalRdrEltX GREInfo
gre, GlobalRdrEltX GREInfo
gre{ gre_par = NoParent }]
expand_tyty_gre GlobalRdrEltX GREInfo
gre
= [GlobalRdrEltX GREInfo
gre]
imported_modules :: [ModuleName]
imported_modules = [ ImportedModsVal -> ModuleName
imv_name ImportedModsVal
imv
| [ImportedBy]
xs <- Map Module [ImportedBy] -> [[ImportedBy]]
forall k a. Map k a -> [a]
Map.elems (Map Module [ImportedBy] -> [[ImportedBy]])
-> Map Module [ImportedBy] -> [[ImportedBy]]
forall a b. (a -> b) -> a -> b
$ ImportAvails -> Map Module [ImportedBy]
imp_mods ImportAvails
imports
, ImportedModsVal
imv <- [ImportedBy] -> [ImportedModsVal]
importedByUser [ImportedBy]
xs ]
exports_from_item :: ExportAccum -> LIE GhcPs
-> RnM (ExportAccum, Maybe (LIE GhcRn, DefaultEnv, Avails))
exports_from_item :: ExportAccum
-> LIE GhcPs
-> RnM (ExportAccum, Maybe (LIE GhcRn, DefaultEnv, [AvailInfo]))
exports_from_item expacc :: ExportAccum
expacc@ExportAccum{
expacc_exp_occs :: ExportAccum -> ExportOccMap
expacc_exp_occs = ExportOccMap
occs,
expacc_mods :: ExportAccum -> UniqMap ModuleName [Name]
expacc_mods = UniqMap ModuleName [Name]
earlier_mods,
expacc_warn_spans :: ExportAccum -> ExportWarnSpanNames
expacc_warn_spans = ExportWarnSpanNames
export_warn_spans,
expacc_dont_warn :: ExportAccum -> DontWarnExportNames
expacc_dont_warn = DontWarnExportNames
dont_warn_export
} (L SrcSpanAnnA
loc ie :: IE GhcPs
ie@(IEModuleContents (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warn_txt_ps, EpToken "module"
_) lmod :: XRec GhcPs ModuleName
lmod@(L SrcSpanAnnA
_ ModuleName
mod)))
| Just [Name]
exported_names <- UniqMap ModuleName [Name] -> ModuleName -> Maybe [Name]
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
lookupUniqMap UniqMap ModuleName [Name]
earlier_mods ModuleName
mod
= do { TcRnMessage -> TcRn ()
addDiagnostic (ModuleName -> TcRnMessage
TcRnDupeModuleExport ModuleName
mod)
; (export_warn_spans', dont_warn_export', _) <-
ExportWarnSpanNames
-> DontWarnExportNames
-> [Name]
-> Maybe (LWarningTxt GhcPs)
-> SrcSpan
-> RnM
(ExportWarnSpanNames, DontWarnExportNames,
Maybe (LWarningTxt GhcRn))
process_warning ExportWarnSpanNames
export_warn_spans
DontWarnExportNames
dont_warn_export
[Name]
exported_names
Maybe (LWarningTxt GhcPs)
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warn_txt_ps
(SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc)
; return ( expacc{ expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, Nothing ) }
| Bool
otherwise
= do { let { exportValid :: Bool
exportValid = (ModuleName
mod ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
imported_modules)
Bool -> Bool -> Bool
|| (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
mod)
; gre_prs :: [(GlobalRdrEltX GREInfo, GlobalRdrEltX GREInfo)]
gre_prs = ModuleName
-> [GlobalRdrEltX GREInfo]
-> [(GlobalRdrEltX GREInfo, GlobalRdrEltX GREInfo)]
forall info.
ModuleName
-> [GlobalRdrEltX info]
-> [(GlobalRdrEltX info, GlobalRdrEltX info)]
pickGREsModExp ModuleName
mod (GlobalRdrEnv -> [GlobalRdrEltX GREInfo]
forall info. GlobalRdrEnvX info -> [GlobalRdrEltX info]
globalRdrEnvElts GlobalRdrEnv
rdr_env)
; new_gres :: [GlobalRdrEltX GREInfo]
new_gres = [ GlobalRdrEltX GREInfo
gre'
| (GlobalRdrEltX GREInfo
gre, GlobalRdrEltX GREInfo
_) <- [(GlobalRdrEltX GREInfo, GlobalRdrEltX GREInfo)]
gre_prs
, GlobalRdrEltX GREInfo
gre' <- GlobalRdrEltX GREInfo -> [GlobalRdrEltX GREInfo]
expand_tyty_gre GlobalRdrEltX GREInfo
gre ]
; new_exports :: [AvailInfo]
new_exports = (GlobalRdrEltX GREInfo -> AvailInfo)
-> [GlobalRdrEltX GREInfo] -> [AvailInfo]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrEltX GREInfo -> AvailInfo
forall info. GlobalRdrEltX info -> AvailInfo
availFromGRE [GlobalRdrEltX GREInfo]
new_gres
; all_gres :: [GlobalRdrEltX GREInfo]
all_gres = ((GlobalRdrEltX GREInfo, GlobalRdrEltX GREInfo)
-> [GlobalRdrEltX GREInfo] -> [GlobalRdrEltX GREInfo])
-> [GlobalRdrEltX GREInfo]
-> [(GlobalRdrEltX GREInfo, GlobalRdrEltX GREInfo)]
-> [GlobalRdrEltX GREInfo]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(GlobalRdrEltX GREInfo
gre1,GlobalRdrEltX GREInfo
gre2) [GlobalRdrEltX GREInfo]
gres -> GlobalRdrEltX GREInfo
gre1 GlobalRdrEltX GREInfo
-> [GlobalRdrEltX GREInfo] -> [GlobalRdrEltX GREInfo]
forall a. a -> [a] -> [a]
: GlobalRdrEltX GREInfo
gre2 GlobalRdrEltX GREInfo
-> [GlobalRdrEltX GREInfo] -> [GlobalRdrEltX GREInfo]
forall a. a -> [a] -> [a]
: [GlobalRdrEltX GREInfo]
gres) [] [(GlobalRdrEltX GREInfo, GlobalRdrEltX GREInfo)]
gre_prs
; exported_names :: [Name]
exported_names = (GlobalRdrEltX GREInfo -> Name)
-> [GlobalRdrEltX GREInfo] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName [GlobalRdrEltX GREInfo]
new_gres
; mods :: UniqMap ModuleName [Name]
mods = UniqMap ModuleName [Name]
-> ModuleName -> [Name] -> UniqMap ModuleName [Name]
forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap UniqMap ModuleName [Name]
earlier_mods ModuleName
mod [Name]
exported_names
}
; Bool -> TcRnMessage -> TcRn ()
checkErr Bool
exportValid (ModuleName -> TcRnMessage
TcRnExportedModNotImported ModuleName
mod)
; Bool -> TcRnMessage -> TcRn ()
warnIf (Bool
exportValid Bool -> Bool -> Bool
&& [(GlobalRdrEltX GREInfo, GlobalRdrEltX GREInfo)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(GlobalRdrEltX GREInfo, GlobalRdrEltX GREInfo)]
gre_prs) (ModuleName -> TcRnMessage
TcRnNullExportedModule ModuleName
mod)
; String -> SDoc -> TcRn ()
traceRn String
"efa" (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [GlobalRdrEltX GREInfo] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrEltX GREInfo]
all_gres)
; DeprecationWarnings -> [GlobalRdrEltX GREInfo] -> TcRn ()
addUsedGREs DeprecationWarnings
ExportDeprecationWarnings [GlobalRdrEltX GREInfo]
all_gres
; occs' <- ExportOccMap
-> IE GhcPs -> [GlobalRdrEltX GREInfo] -> RnM ExportOccMap
check_occs ExportOccMap
occs IE GhcPs
ie [GlobalRdrEltX GREInfo]
new_gres
; (export_warn_spans', dont_warn_export', warn_txt_rn) <-
process_warning export_warn_spans
dont_warn_export
exported_names
warn_txt_ps
(locA loc)
; traceRn "export_mod"
(vcat [ ppr mod
, ppr new_exports ])
; return ( ExportAccum { expacc_exp_occs = occs'
, expacc_mods = mods
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, Just (L loc (IEModuleContents warn_txt_rn lmod), emptyDefaultEnv, new_exports) ) }
exports_from_item ExportAccum
acc LIE GhcPs
lie = do
m_doc_ie <- LIE GhcPs -> RnM (Maybe (LIE GhcRn))
lookup_doc_ie LIE GhcPs
lie
case m_doc_ie of
Just GenLocated SrcSpanAnnA (IE GhcRn)
new_ie -> (ExportAccum,
Maybe (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo]))
-> TcRn
(ExportAccum,
Maybe (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo]))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportAccum
acc, (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
-> Maybe
(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (IE GhcRn)
new_ie, DefaultEnv
emptyDefaultEnv, []))
Maybe (GenLocated SrcSpanAnnA (IE GhcRn))
Nothing -> do
m_ie <- ExportAccum
-> LIE GhcPs
-> RnM (Maybe (ExportAccum, LIE GhcRn, Either OccName AvailInfo))
lookup_ie ExportAccum
acc LIE GhcPs
lie
case m_ie of
Maybe
(ExportAccum, GenLocated SrcSpanAnnA (IE GhcRn),
Either OccName AvailInfo)
Nothing -> (ExportAccum,
Maybe (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo]))
-> TcRn
(ExportAccum,
Maybe (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo]))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportAccum
acc, Maybe (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
forall a. Maybe a
Nothing)
Just (ExportAccum
acc', GenLocated SrcSpanAnnA (IE GhcRn)
new_ie, Left OccName
cls) -> do
defaults <- TcGblEnv -> DefaultEnv
tcg_default (TcGblEnv -> DefaultEnv)
-> RnM TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) DefaultEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RnM TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
let exported_default = (ClassDefaults -> Bool) -> DefaultEnv -> DefaultEnv
filterDefaultEnv ((OccName
cls OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
==) (OccName -> Bool)
-> (ClassDefaults -> OccName) -> ClassDefaults -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName (Name -> OccName)
-> (ClassDefaults -> Name) -> ClassDefaults -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Name
tyConName (TyCon -> Name)
-> (ClassDefaults -> TyCon) -> ClassDefaults -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassDefaults -> TyCon
cd_class) DefaultEnv
defaults
return (acc', Just (new_ie, exported_default, []))
Just (ExportAccum
acc', GenLocated SrcSpanAnnA (IE GhcRn)
new_ie, Right AvailInfo
avail)
-> (ExportAccum,
Maybe (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo]))
-> TcRn
(ExportAccum,
Maybe (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo]))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportAccum
acc', (GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
-> Maybe
(GenLocated SrcSpanAnnA (IE GhcRn), DefaultEnv, [AvailInfo])
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (IE GhcRn)
new_ie, DefaultEnv
emptyDefaultEnv, [AvailInfo
avail]))
lookup_ie :: ExportAccum -> LIE GhcPs -> RnM (Maybe (ExportAccum, LIE GhcRn, Either OccName AvailInfo))
lookup_ie :: ExportAccum
-> LIE GhcPs
-> RnM (Maybe (ExportAccum, LIE GhcRn, Either OccName AvailInfo))
lookup_ie expacc :: ExportAccum
expacc@ExportAccum{
expacc_exp_occs :: ExportAccum -> ExportOccMap
expacc_exp_occs = ExportOccMap
occs,
expacc_warn_spans :: ExportAccum -> ExportWarnSpanNames
expacc_warn_spans = ExportWarnSpanNames
export_warn_spans,
expacc_dont_warn :: ExportAccum -> DontWarnExportNames
expacc_dont_warn = DontWarnExportNames
dont_warn_export
} (L SrcSpanAnnA
loc ie :: IE GhcPs
ie@(IEVar XIEVar GhcPs
warn_txt_ps LIEWrappedName GhcPs
l Maybe (ExportDoc GhcPs)
doc))
= do mb_gre <- RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo))
lookupGreAvailRn (RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo)))
-> RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo))
forall a b. (a -> b) -> a -> b
$ LIEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
lieWrappedName LIEWrappedName GhcPs
l
for mb_gre $ \ GlobalRdrEltX GREInfo
gre -> do
let avail :: AvailInfo
avail = GlobalRdrEltX GREInfo -> AvailInfo
forall info. GlobalRdrEltX info -> AvailInfo
availFromGRE GlobalRdrEltX GREInfo
gre
name :: Name
name = GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
gre
occs' <- ExportOccMap
-> IE GhcPs -> [GlobalRdrEltX GREInfo] -> RnM ExportOccMap
check_occs ExportOccMap
occs IE GhcPs
ie [GlobalRdrEltX GREInfo
gre]
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
[name]
warn_txt_ps
(locA loc)
doc' <- traverse rnLHsDoc doc
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, L loc (IEVar warn_txt_rn (replaceLWrappedName l name) doc')
, Right avail )
lookup_ie expacc :: ExportAccum
expacc@ExportAccum{
expacc_exp_occs :: ExportAccum -> ExportOccMap
expacc_exp_occs = ExportOccMap
occs,
expacc_warn_spans :: ExportAccum -> ExportWarnSpanNames
expacc_warn_spans = ExportWarnSpanNames
export_warn_spans,
expacc_dont_warn :: ExportAccum -> DontWarnExportNames
expacc_dont_warn = DontWarnExportNames
dont_warn_export
} (L SrcSpanAnnA
loc ie :: IE GhcPs
ie@(IEThingAbs XIEThingAbs GhcPs
warn_txt_ps LIEWrappedName GhcPs
l Maybe (ExportDoc GhcPs)
doc))
= do mb_gre <- RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo))
lookupGreAvailRn (RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo)))
-> RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo))
forall a b. (a -> b) -> a -> b
$ LIEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
lieWrappedName LIEWrappedName GhcPs
l
for mb_gre $ \ GlobalRdrEltX GREInfo
gre -> do
let avail :: AvailInfo
avail = GlobalRdrEltX GREInfo -> AvailInfo
forall info. GlobalRdrEltX info -> AvailInfo
availFromGRE GlobalRdrEltX GREInfo
gre
name :: Name
name = GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
gre
occs' <- ExportOccMap
-> IE GhcPs -> [GlobalRdrEltX GREInfo] -> RnM ExportOccMap
check_occs ExportOccMap
occs IE GhcPs
ie [GlobalRdrEltX GREInfo
gre]
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
[name]
warn_txt_ps
(locA loc)
doc' <- traverse rnLHsDoc doc
avail' <- case unLoc l of
IEDefault XIEDefault GhcPs
_ LIdP GhcPs
cls -> do
let defaultOccName :: ClassDefaults -> OccName
defaultOccName = Name -> OccName
nameOccName (Name -> OccName)
-> (ClassDefaults -> Name) -> ClassDefaults -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Name
tyConName (TyCon -> Name)
-> (ClassDefaults -> TyCon) -> ClassDefaults -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassDefaults -> TyCon
cd_class
occName :: OccName
occName = RdrName -> OccName
rdrNameOcc (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
cls)
defaults <- TcGblEnv -> DefaultEnv
tcg_default (TcGblEnv -> DefaultEnv)
-> RnM TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) DefaultEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RnM TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
when (isEmptyDefaultEnv $ filterDefaultEnv ((occName ==) . defaultOccName) defaults)
(addErr $ TcRnExportHiddenDefault ie)
pure (Left occName)
IEWrappedName GhcPs
_ -> Either OccName AvailInfo
-> IOEnv (Env TcGblEnv TcLclEnv) (Either OccName AvailInfo)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AvailInfo -> Either OccName AvailInfo
forall a b. b -> Either a b
Right AvailInfo
avail)
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, L loc (IEThingAbs warn_txt_rn (replaceLWrappedName l name) doc')
, avail' )
lookup_ie expacc :: ExportAccum
expacc@ExportAccum{
expacc_exp_occs :: ExportAccum -> ExportOccMap
expacc_exp_occs = ExportOccMap
occs,
expacc_warn_spans :: ExportAccum -> ExportWarnSpanNames
expacc_warn_spans = ExportWarnSpanNames
export_warn_spans,
expacc_dont_warn :: ExportAccum -> DontWarnExportNames
expacc_dont_warn = DontWarnExportNames
dont_warn_export
} (L SrcSpanAnnA
loc ie :: IE GhcPs
ie@(IEThingAll (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warn_txt_ps, (EpToken "(", EpToken "..", EpToken ")")
ann) LIEWrappedName GhcPs
l Maybe (ExportDoc GhcPs)
doc))
= do mb_gre <- RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo))
lookupGreAvailRn (RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo)))
-> RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo))
forall a b. (a -> b) -> a -> b
$ LIEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
lieWrappedName LIEWrappedName GhcPs
l
for mb_gre $ \ GlobalRdrEltX GREInfo
par -> do
all_kids <- IE GhcPs
-> LIEWrappedName GhcPs
-> GlobalRdrEltX GREInfo
-> RnM [GlobalRdrEltX GREInfo]
lookup_ie_kids_all IE GhcPs
ie LIEWrappedName GhcPs
l GlobalRdrEltX GREInfo
par
let name = GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
par
all_gres = GlobalRdrEltX GREInfo
par GlobalRdrEltX GREInfo
-> [GlobalRdrEltX GREInfo] -> [GlobalRdrEltX GREInfo]
forall a. a -> [a] -> [a]
: [GlobalRdrEltX GREInfo]
all_kids
all_names = (GlobalRdrEltX GREInfo -> Name)
-> [GlobalRdrEltX GREInfo] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName [GlobalRdrEltX GREInfo]
all_gres
occs' <- check_occs occs ie all_gres
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
all_names
warn_txt_ps
(locA loc)
doc' <- traverse rnLHsDoc doc
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, L loc (IEThingAll (warn_txt_rn, ann) (replaceLWrappedName l name) doc')
, Right (AvailTC name all_names) )
lookup_ie expacc :: ExportAccum
expacc@ExportAccum{
expacc_exp_occs :: ExportAccum -> ExportOccMap
expacc_exp_occs = ExportOccMap
occs,
expacc_warn_spans :: ExportAccum -> ExportWarnSpanNames
expacc_warn_spans = ExportWarnSpanNames
export_warn_spans,
expacc_dont_warn :: ExportAccum -> DontWarnExportNames
expacc_dont_warn = DontWarnExportNames
dont_warn_export
} (L SrcSpanAnnA
loc ie :: IE GhcPs
ie@(IEThingWith (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
warn_txt_ps, IEThingWithAnns
ann) LIEWrappedName GhcPs
l IEWildcard
wc [LIEWrappedName GhcPs]
sub_rdrs Maybe (ExportDoc GhcPs)
doc))
= do mb_gre <- IE GhcPs
-> RnM (Maybe (GlobalRdrEltX GREInfo))
-> RnM (Maybe (GlobalRdrEltX GREInfo))
forall (p :: Pass) a.
OutputableBndrId p =>
IE (GhcPass p) -> TcM a -> TcM a
addExportErrCtxt IE GhcPs
ie
(RnM (Maybe (GlobalRdrEltX GREInfo))
-> RnM (Maybe (GlobalRdrEltX GREInfo)))
-> RnM (Maybe (GlobalRdrEltX GREInfo))
-> RnM (Maybe (GlobalRdrEltX GREInfo))
forall a b. (a -> b) -> a -> b
$ RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo))
lookupGreAvailRn (RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo)))
-> RdrName -> RnM (Maybe (GlobalRdrEltX GREInfo))
forall a b. (a -> b) -> a -> b
$ LIEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
lieWrappedName LIEWrappedName GhcPs
l
for mb_gre $ \ GlobalRdrEltX GREInfo
par -> do
(subs, with_kids)
<- IE GhcPs
-> TcM ([LIEWrappedName GhcRn], [GlobalRdrEltX GREInfo])
-> TcM ([LIEWrappedName GhcRn], [GlobalRdrEltX GREInfo])
forall (p :: Pass) a.
OutputableBndrId p =>
IE (GhcPass p) -> TcM a -> TcM a
addExportErrCtxt IE GhcPs
ie
(TcM ([LIEWrappedName GhcRn], [GlobalRdrEltX GREInfo])
-> TcM ([LIEWrappedName GhcRn], [GlobalRdrEltX GREInfo]))
-> TcM ([LIEWrappedName GhcRn], [GlobalRdrEltX GREInfo])
-> TcM ([LIEWrappedName GhcRn], [GlobalRdrEltX GREInfo])
forall a b. (a -> b) -> a -> b
$ GlobalRdrEltX GREInfo
-> [LIEWrappedName GhcPs]
-> TcM ([LIEWrappedName GhcRn], [GlobalRdrEltX GREInfo])
lookup_ie_kids_with GlobalRdrEltX GREInfo
par [LIEWrappedName GhcPs]
sub_rdrs
wc_kids <-
case wc of
IEWildcard
NoIEWildcard -> [GlobalRdrEltX GREInfo] -> RnM [GlobalRdrEltX GREInfo]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
IEWildcard Int
_ -> IE GhcPs
-> LIEWrappedName GhcPs
-> GlobalRdrEltX GREInfo
-> RnM [GlobalRdrEltX GREInfo]
lookup_ie_kids_all IE GhcPs
ie LIEWrappedName GhcPs
l GlobalRdrEltX GREInfo
par
let name = GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
par
all_kids = [GlobalRdrEltX GREInfo]
with_kids [GlobalRdrEltX GREInfo]
-> [GlobalRdrEltX GREInfo] -> [GlobalRdrEltX GREInfo]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrEltX GREInfo]
wc_kids
all_gres = GlobalRdrEltX GREInfo
par GlobalRdrEltX GREInfo
-> [GlobalRdrEltX GREInfo] -> [GlobalRdrEltX GREInfo]
forall a. a -> [a] -> [a]
: [GlobalRdrEltX GREInfo]
all_kids
all_names = (GlobalRdrEltX GREInfo -> Name)
-> [GlobalRdrEltX GREInfo] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName [GlobalRdrEltX GREInfo]
all_gres
occs' <- check_occs occs ie all_gres
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
all_names
warn_txt_ps
(locA loc)
doc' <- traverse rnLHsDoc doc
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, L loc (IEThingWith (warn_txt_rn, ann) (replaceLWrappedName l name) wc subs doc')
, Right (AvailTC name all_names) )
lookup_ie ExportAccum
_ LIE GhcPs
_ = String
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe
(ExportAccum, GenLocated SrcSpanAnnA (IE GhcRn),
Either OccName AvailInfo))
forall a. HasCallStack => String -> a
panic String
"lookup_ie"
lookup_ie_kids_with :: GlobalRdrElt -> [LIEWrappedName GhcPs]
-> RnM ([LIEWrappedName GhcRn], [GlobalRdrElt])
lookup_ie_kids_with :: GlobalRdrEltX GREInfo
-> [LIEWrappedName GhcPs]
-> TcM ([LIEWrappedName GhcRn], [GlobalRdrEltX GREInfo])
lookup_ie_kids_with GlobalRdrEltX GREInfo
gre [LIEWrappedName GhcPs]
sub_rdrs =
do { let name :: Name
name = GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
gre
; kids <- Name
-> [LIEWrappedName GhcPs]
-> RnM [(LIEWrappedName GhcRn, GlobalRdrEltX GREInfo)]
lookupChildrenExport Name
name [LIEWrappedName GhcPs]
sub_rdrs
; return (map fst kids, map snd kids) }
lookup_ie_kids_all :: IE GhcPs -> LIEWrappedName GhcPs -> GlobalRdrElt
-> RnM [GlobalRdrElt]
lookup_ie_kids_all :: IE GhcPs
-> LIEWrappedName GhcPs
-> GlobalRdrEltX GREInfo
-> RnM [GlobalRdrEltX GREInfo]
lookup_ie_kids_all IE GhcPs
ie (L SrcSpanAnnA
_ IEWrappedName GhcPs
rdr) GlobalRdrEltX GREInfo
gre =
do { let name :: Name
name = GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
gre
gres :: [GlobalRdrEltX GREInfo]
gres = NameEnv [GlobalRdrEltX GREInfo] -> Name -> [GlobalRdrEltX GREInfo]
forall a. NameEnv [a] -> Name -> [a]
findChildren NameEnv [GlobalRdrEltX GREInfo]
kids_env Name
name
; RdrName -> [GlobalRdrEltX GREInfo] -> TcRn ()
addUsedKids (IEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName IEWrappedName GhcPs
rdr) [GlobalRdrEltX GREInfo]
gres
; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([GlobalRdrEltX GREInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrEltX GREInfo]
gres) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
if Name -> Bool
isTyConName Name
name
then TcRnMessage -> TcRn ()
addTcRnDiagnostic (GlobalRdrEltX GREInfo -> TcRnMessage
TcRnDodgyExports GlobalRdrEltX GREInfo
gre)
else
TcRnMessage -> TcRn ()
addErr (IE GhcPs -> TcRnMessage
TcRnExportHiddenComponents IE GhcPs
ie)
; [GlobalRdrEltX GREInfo] -> RnM [GlobalRdrEltX GREInfo]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [GlobalRdrEltX GREInfo]
gres }
process_warning :: ExportWarnSpanNames
-> DontWarnExportNames
-> [Name]
-> Maybe (LWarningTxt GhcPs)
-> SrcSpan
-> RnM (ExportWarnSpanNames,
DontWarnExportNames,
Maybe (LWarningTxt GhcRn))
process_warning :: ExportWarnSpanNames
-> DontWarnExportNames
-> [Name]
-> Maybe (LWarningTxt GhcPs)
-> SrcSpan
-> RnM
(ExportWarnSpanNames, DontWarnExportNames,
Maybe (LWarningTxt GhcRn))
process_warning ExportWarnSpanNames
export_warn_spans
DontWarnExportNames
dont_warn_export
[Name]
names Maybe (LWarningTxt GhcPs)
Nothing SrcSpan
loc
= (ExportWarnSpanNames, DontWarnExportNames,
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ExportWarnSpanNames, DontWarnExportNames,
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ExportWarnSpanNames
export_warn_spans
, (Name -> DontWarnExportNames -> DontWarnExportNames)
-> DontWarnExportNames -> [Name] -> DontWarnExportNames
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Name -> DontWarnExportNames -> DontWarnExportNames
update_dont_warn_export
DontWarnExportNames
dont_warn_export [Name]
names
, Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
forall a. Maybe a
Nothing )
where
update_dont_warn_export :: Name -> DontWarnExportNames -> DontWarnExportNames
update_dont_warn_export :: Name -> DontWarnExportNames -> DontWarnExportNames
update_dont_warn_export Name
name DontWarnExportNames
dont_warn_export'
= (SrcSpan -> NonEmpty SrcSpan -> NonEmpty SrcSpan)
-> (SrcSpan -> NonEmpty SrcSpan)
-> DontWarnExportNames
-> Name
-> SrcSpan
-> DontWarnExportNames
forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc SrcSpan -> NonEmpty SrcSpan -> NonEmpty SrcSpan
forall a. a -> NonEmpty a -> NonEmpty a
(NE.<|)
SrcSpan -> NonEmpty SrcSpan
forall a. a -> NonEmpty a
NE.singleton
DontWarnExportNames
dont_warn_export'
Name
name
SrcSpan
loc
process_warning ExportWarnSpanNames
export_warn_spans
DontWarnExportNames
dont_warn_export
[Name]
names (Just LWarningTxt GhcPs
warn_txt_ps) SrcSpan
loc
= do
warn_txt_rn <- LWarningTxt GhcPs -> RnM (LWarningTxt GhcRn)
rnLWarningTxt LWarningTxt GhcPs
warn_txt_ps
let new_export_warn_spans = (Name -> (Name, WarningTxt GhcRn, SrcSpan))
-> [Name] -> ExportWarnSpanNames
forall a b. (a -> b) -> [a] -> [b]
map (, GenLocated SrcSpanAnnP (WarningTxt GhcRn) -> WarningTxt GhcRn
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnP (WarningTxt GhcRn)
warn_txt_rn, SrcSpan
loc) [Name]
names
return ( new_export_warn_spans ++ export_warn_spans
, dont_warn_export
, Just warn_txt_rn )
aggregate_warnings :: ExportWarnSpanNames
-> DontWarnExportNames
-> RnM (ExportWarnNames GhcRn)
aggregate_warnings :: ExportWarnSpanNames
-> DontWarnExportNames -> RnM (ExportWarnNames GhcRn)
aggregate_warnings ExportWarnSpanNames
export_warn_spans DontWarnExportNames
dont_warn_export
= ([Maybe (Name, WarningTxt GhcRn)] -> ExportWarnNames GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) [Maybe (Name, WarningTxt GhcRn)]
-> RnM (ExportWarnNames GhcRn)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (Name, WarningTxt GhcRn)] -> ExportWarnNames GhcRn
forall a. [Maybe a] -> [a]
catMaybes
(IOEnv (Env TcGblEnv TcLclEnv) [Maybe (Name, WarningTxt GhcRn)]
-> RnM (ExportWarnNames GhcRn))
-> IOEnv (Env TcGblEnv TcLclEnv) [Maybe (Name, WarningTxt GhcRn)]
-> RnM (ExportWarnNames GhcRn)
forall a b. (a -> b) -> a -> b
$ (NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Name, WarningTxt GhcRn)))
-> [NonEmpty (Name, WarningTxt GhcRn, SrcSpan)]
-> IOEnv (Env TcGblEnv TcLclEnv) [Maybe (Name, WarningTxt GhcRn)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Name, NonEmpty (WarningTxt GhcRn, SrcSpan))
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Name, WarningTxt GhcRn))
aggregate_single ((Name, NonEmpty (WarningTxt GhcRn, SrcSpan))
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Name, WarningTxt GhcRn)))
-> (NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
-> (Name, NonEmpty (WarningTxt GhcRn, SrcSpan)))
-> NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Name, WarningTxt GhcRn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
-> (Name, NonEmpty (WarningTxt GhcRn, SrcSpan))
extract_name)
([NonEmpty (Name, WarningTxt GhcRn, SrcSpan)]
-> IOEnv (Env TcGblEnv TcLclEnv) [Maybe (Name, WarningTxt GhcRn)])
-> [NonEmpty (Name, WarningTxt GhcRn, SrcSpan)]
-> IOEnv (Env TcGblEnv TcLclEnv) [Maybe (Name, WarningTxt GhcRn)]
forall a b. (a -> b) -> a -> b
$ ((Name, WarningTxt GhcRn, SrcSpan)
-> (Name, WarningTxt GhcRn, SrcSpan) -> Bool)
-> ExportWarnSpanNames
-> [NonEmpty (Name, WarningTxt GhcRn, SrcSpan)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (\(Name
n1, WarningTxt GhcRn
_, SrcSpan
_) (Name
n2, WarningTxt GhcRn
_, SrcSpan
_) -> Name
n1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n2)
(ExportWarnSpanNames
-> [NonEmpty (Name, WarningTxt GhcRn, SrcSpan)])
-> ExportWarnSpanNames
-> [NonEmpty (Name, WarningTxt GhcRn, SrcSpan)]
forall a b. (a -> b) -> a -> b
$ ((Name, WarningTxt GhcRn, SrcSpan)
-> (Name, WarningTxt GhcRn, SrcSpan) -> Ordering)
-> ExportWarnSpanNames -> ExportWarnSpanNames
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Name
n1, WarningTxt GhcRn
_, SrcSpan
_) (Name
n2, WarningTxt GhcRn
_, SrcSpan
_) -> Name
n1 Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Name
n2) ExportWarnSpanNames
export_warn_spans
where
extract_name :: NE.NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
-> (Name, NE.NonEmpty (WarningTxt GhcRn, SrcSpan))
extract_name :: NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
-> (Name, NonEmpty (WarningTxt GhcRn, SrcSpan))
extract_name l :: NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
l@((Name
name, WarningTxt GhcRn
_, SrcSpan
_) NE.:| ExportWarnSpanNames
_)
= (Name
name, ((Name, WarningTxt GhcRn, SrcSpan) -> (WarningTxt GhcRn, SrcSpan))
-> NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
-> NonEmpty (WarningTxt GhcRn, SrcSpan)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Name
_, WarningTxt GhcRn
warn_txt, SrcSpan
span) -> (WarningTxt GhcRn
warn_txt, SrcSpan
span)) NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
l)
aggregate_single :: (Name, NE.NonEmpty (WarningTxt GhcRn, SrcSpan))
-> RnM (Maybe (Name, WarningTxt GhcRn))
aggregate_single :: (Name, NonEmpty (WarningTxt GhcRn, SrcSpan))
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Name, WarningTxt GhcRn))
aggregate_single (Name
name, (WarningTxt GhcRn
warn_txt_rn, SrcSpan
loc) NE.:| [(WarningTxt GhcRn, SrcSpan)]
warn_spans)
= do
case [SrcSpan] -> Maybe (NonEmpty SrcSpan)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [SrcSpan]
spans_different of
Maybe (NonEmpty SrcSpan)
Nothing -> () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just NonEmpty SrcSpan
spans_different
-> SrcSpan -> TcRnMessage -> TcRn ()
addErrAt SrcSpan
loc (Name -> NonEmpty SrcSpan -> TcRnMessage
TcRnDifferentExportWarnings Name
name NonEmpty SrcSpan
spans_different)
case DontWarnExportNames -> Name -> Maybe (NonEmpty SrcSpan)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv DontWarnExportNames
dont_warn_export Name
name of
Maybe (NonEmpty SrcSpan)
Nothing -> Maybe (Name, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Name, WarningTxt GhcRn))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Name, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Name, WarningTxt GhcRn)))
-> Maybe (Name, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Name, WarningTxt GhcRn))
forall a b. (a -> b) -> a -> b
$ (Name, WarningTxt GhcRn) -> Maybe (Name, WarningTxt GhcRn)
forall a. a -> Maybe a
Just (Name
name, WarningTxt GhcRn
warn_txt_rn)
Just NonEmpty SrcSpan
not_warned_spans -> do
SrcSpan -> TcRnMessage -> TcRn ()
addDiagnosticAt SrcSpan
loc (Name -> NonEmpty SrcSpan -> TcRnMessage
TcRnIncompleteExportWarnings Name
name NonEmpty SrcSpan
not_warned_spans)
Maybe (Name, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Name, WarningTxt GhcRn))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Name, WarningTxt GhcRn)
forall a. Maybe a
Nothing
where
spans_different :: [SrcSpan]
spans_different = ((WarningTxt GhcRn, SrcSpan) -> SrcSpan)
-> [(WarningTxt GhcRn, SrcSpan)] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map (WarningTxt GhcRn, SrcSpan) -> SrcSpan
forall a b. (a, b) -> b
snd ([(WarningTxt GhcRn, SrcSpan)] -> [SrcSpan])
-> [(WarningTxt GhcRn, SrcSpan)] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ ((WarningTxt GhcRn, SrcSpan) -> Bool)
-> [(WarningTxt GhcRn, SrcSpan)] -> [(WarningTxt GhcRn, SrcSpan)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((WarningTxt GhcRn, SrcSpan) -> Bool)
-> (WarningTxt GhcRn, SrcSpan)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WarningTxt GhcRn -> WarningTxt GhcRn -> Bool
forall p1 p2. WarningTxt p1 -> WarningTxt p2 -> Bool
warningTxtSame WarningTxt GhcRn
warn_txt_rn (WarningTxt GhcRn -> Bool)
-> ((WarningTxt GhcRn, SrcSpan) -> WarningTxt GhcRn)
-> (WarningTxt GhcRn, SrcSpan)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WarningTxt GhcRn, SrcSpan) -> WarningTxt GhcRn
forall a b. (a, b) -> a
fst) [(WarningTxt GhcRn, SrcSpan)]
warn_spans
lookup_doc_ie :: LIE GhcPs -> RnM (Maybe (LIE GhcRn))
lookup_doc_ie :: LIE GhcPs -> RnM (Maybe (LIE GhcRn))
lookup_doc_ie (L SrcSpanAnnA
loc (IEGroup XIEGroup GhcPs
_ Int
lev ExportDoc GhcPs
doc)) = do
doc' <- ExportDoc GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) (LHsDoc GhcRn)
rnLHsDoc ExportDoc GhcPs
doc
pure $ Just (L loc (IEGroup noExtField lev doc'))
lookup_doc_ie (L SrcSpanAnnA
loc (IEDoc XIEDoc GhcPs
_ ExportDoc GhcPs
doc)) = do
doc' <- ExportDoc GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) (LHsDoc GhcRn)
rnLHsDoc ExportDoc GhcPs
doc
pure $ Just (L loc (IEDoc noExtField doc'))
lookup_doc_ie (L SrcSpanAnnA
loc (IEDocNamed XIEDocNamed GhcPs
_ String
str))
= Maybe (LIE GhcRn) -> RnM (Maybe (LIE GhcRn))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (LIE GhcRn) -> RnM (Maybe (LIE GhcRn)))
-> Maybe (LIE GhcRn) -> RnM (Maybe (LIE GhcRn))
forall a b. (a -> b) -> a -> b
$ LIE GhcRn -> Maybe (LIE GhcRn)
forall a. a -> Maybe a
Just (SrcSpanAnnA -> IE GhcRn -> GenLocated SrcSpanAnnA (IE GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XIEDocNamed GhcRn -> String -> IE GhcRn
forall pass. XIEDocNamed pass -> String -> IE pass
IEDocNamed XIEDocNamed GhcRn
NoExtField
noExtField String
str))
lookup_doc_ie LIE GhcPs
_ = Maybe (GenLocated SrcSpanAnnA (IE GhcRn))
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpanAnnA (IE GhcRn)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (GenLocated SrcSpanAnnA (IE GhcRn))
forall a. Maybe a
Nothing
addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM ()
addUsedKids :: RdrName -> [GlobalRdrEltX GREInfo] -> TcRn ()
addUsedKids RdrName
parent_rdr [GlobalRdrEltX GREInfo]
kid_gres
= DeprecationWarnings -> [GlobalRdrEltX GREInfo] -> TcRn ()
addUsedGREs DeprecationWarnings
ExportDeprecationWarnings (RdrName -> [GlobalRdrEltX GREInfo] -> [GlobalRdrEltX GREInfo]
forall info.
RdrName -> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
pickGREs RdrName
parent_rdr [GlobalRdrEltX GREInfo]
kid_gres)
lookupChildrenExport :: Name -> [LIEWrappedName GhcPs]
-> RnM ([(LIEWrappedName GhcRn, GlobalRdrElt)])
lookupChildrenExport :: Name
-> [LIEWrappedName GhcPs]
-> RnM [(LIEWrappedName GhcRn, GlobalRdrEltX GREInfo)]
lookupChildrenExport Name
spec_parent [LIEWrappedName GhcPs]
rdr_items = (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> TcRn
(GenLocated SrcSpanAnnA (IEWrappedName GhcRn),
GlobalRdrEltX GREInfo))
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpanAnnA (IEWrappedName GhcRn),
GlobalRdrEltX GREInfo)]
forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
mapAndReportM LIEWrappedName GhcPs
-> RnM (LIEWrappedName GhcRn, GlobalRdrEltX GREInfo)
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> TcRn
(GenLocated SrcSpanAnnA (IEWrappedName GhcRn),
GlobalRdrEltX GREInfo)
doOne [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
rdr_items
where
doOne :: LIEWrappedName GhcPs
-> RnM (LIEWrappedName GhcRn, GlobalRdrElt)
doOne :: LIEWrappedName GhcPs
-> RnM (LIEWrappedName GhcRn, GlobalRdrEltX GREInfo)
doOne LIEWrappedName GhcPs
n = do
let bareName :: RdrName
bareName = (IEWrappedName GhcPs -> IdP GhcPs
IEWrappedName GhcPs -> RdrName
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName (IEWrappedName GhcPs -> RdrName)
-> (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> IEWrappedName GhcPs)
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> IEWrappedName GhcPs
forall l e. GenLocated l e -> e
unLoc) LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
n
what_lkup :: LookupChild
what_lkup :: LookupChild
what_lkup =
LookupChild
{ wantedParent :: Name
wantedParent = Name
spec_parent
, lookupDataConFirst :: Bool
lookupDataConFirst = Bool
True
, prioritiseParent :: Bool
prioritiseParent = Bool
False
}
name <- Bool
-> DeprecationWarnings
-> Name
-> RdrName
-> LookupChild
-> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
False DeprecationWarnings
ExportDeprecationWarnings
Name
spec_parent RdrName
bareName LookupChild
what_lkup
traceRn "lookupChildrenExport" (ppr name)
let unboundName :: RdrName
unboundName = if RdrName -> NameSpace
rdrNameSpace RdrName
bareName NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
varName
then RdrName
bareName
else RdrName -> NameSpace -> RdrName
setRdrNameSpace RdrName
bareName NameSpace
dataName
case name of
ChildLookupResult
NameNotFound ->
do { ub <- RdrName -> RnM Name
reportUnboundName RdrName
unboundName
; let l = GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
n
gre = GREInfo -> Parent -> Name -> GlobalRdrEltX GREInfo
mkLocalGRE GREInfo
UnboundGRE Parent
NoParent Name
ub
; return (L l (IEName noExtField (L (l2l l) ub)), gre)}
FoundChild child :: GlobalRdrEltX GREInfo
child@(GRE { gre_name :: forall info. GlobalRdrEltX info -> Name
gre_name = Name
child_nm, gre_par :: forall info. GlobalRdrEltX info -> Parent
gre_par = Parent
par }) ->
do { Name -> Parent -> Name -> TcRn ()
checkPatSynParent Name
spec_parent Parent
par Name
child_nm
; (GenLocated SrcSpanAnnA (IEWrappedName GhcRn),
GlobalRdrEltX GREInfo)
-> TcRn
(GenLocated SrcSpanAnnA (IEWrappedName GhcRn),
GlobalRdrEltX GREInfo)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (LIEWrappedName GhcPs -> IdP GhcRn -> LIEWrappedName GhcRn
replaceLWrappedName LIEWrappedName GhcPs
n IdP GhcRn
Name
child_nm, GlobalRdrEltX GREInfo
child)
}
IncorrectParent Name
p GlobalRdrEltX GREInfo
c [Name]
gs -> Name
-> Name
-> [Name]
-> TcRn
(GenLocated SrcSpanAnnA (IEWrappedName GhcRn),
GlobalRdrEltX GREInfo)
forall a. Name -> Name -> [Name] -> TcM a
failWithDcErr Name
p (GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
c) [Name]
gs
checkPatSynParent :: Name
-> Parent
-> Name
-> TcM ()
checkPatSynParent :: Name -> Parent -> Name -> TcRn ()
checkPatSynParent Name
_ (ParentIs {}) Name
_
= () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPatSynParent Name
parent Parent
NoParent Name
nm
| Name -> Bool
isUnboundName Name
parent
= () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= do { parent_ty_con <- Name -> TcM TyCon
tcLookupTyCon Name
parent
; mpat_syn_thing <- tcLookupGlobal nm
; case mpat_syn_thing of
AnId Id
i | Id -> Bool
isId Id
i
, RecSelId { sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelPatSyn PatSyn
p } <- Id -> IdDetails
idDetails Id
i
-> SDoc -> TyCon -> PatSyn -> TcRn ()
handle_pat_syn (Name -> SDoc
selErr Name
nm) TyCon
parent_ty_con PatSyn
p
AConLike (PatSynCon PatSyn
p) -> SDoc -> TyCon -> PatSyn -> TcRn ()
handle_pat_syn (PatSyn -> SDoc
psErr PatSyn
p) TyCon
parent_ty_con PatSyn
p
TyThing
_ -> Name -> Name -> [Name] -> TcRn ()
forall a. Name -> Name -> [Name] -> TcM a
failWithDcErr Name
parent Name
nm [] }
where
psErr :: PatSyn -> SDoc
psErr = String -> PatSyn -> SDoc
forall o. Outputable o => String -> o -> SDoc
exportErrCtxt String
"pattern synonym"
selErr :: Name -> SDoc
selErr = String -> Name -> SDoc
forall o. Outputable o => String -> o -> SDoc
exportErrCtxt String
"pattern synonym record selector"
handle_pat_syn :: SDoc
-> TyCon
-> PatSyn
-> TcM ()
handle_pat_syn :: SDoc -> TyCon -> PatSyn -> TcRn ()
handle_pat_syn SDoc
doc TyCon
ty_con PatSyn
pat_syn
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TyCon -> Bool
isTyConWithSrcDataCons TyCon
ty_con
= SDoc -> TcRn () -> TcRn ()
forall a. SDoc -> TcM a -> TcM a
addErrCtxt SDoc
doc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ TcRnMessage -> TcRn ()
forall a. TcRnMessage -> TcM a
failWithTc TcRnMessage
TcRnPatSynBundledWithNonDataCon
| Maybe TyCon
Nothing <- Maybe TyCon
mtycon
= () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just TyCon
p_ty_con <- Maybe TyCon
mtycon, TyCon
p_ty_con TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
/= TyCon
ty_con
= SDoc -> TcRn () -> TcRn ()
forall a. SDoc -> TcM a -> TcM a
addErrCtxt SDoc
doc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ TcRnMessage -> TcRn ()
forall a. TcRnMessage -> TcM a
failWithTc
(Type -> Type -> TcRnMessage
TcRnPatSynBundledWithWrongType Type
expected_res_ty Type
res_ty)
| Bool
otherwise
= () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
expected_res_ty :: Type
expected_res_ty = TyCon -> [Type] -> Type
mkTyConApp TyCon
ty_con ([Id] -> [Type]
mkTyVarTys (TyCon -> [Id]
tyConTyVars TyCon
ty_con))
([Id]
_, [Type]
_, [Id]
_, [Type]
_, [Scaled Type]
_, Type
res_ty) = PatSyn -> ([Id], [Type], [Id], [Type], [Scaled Type], Type)
patSynSig PatSyn
pat_syn
mtycon :: Maybe TyCon
mtycon = (TyCon, [Type]) -> TyCon
forall a b. (a, b) -> a
fst ((TyCon, [Type]) -> TyCon) -> Maybe (TyCon, [Type]) -> Maybe TyCon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasDebugCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
res_ty
check_occs :: ExportOccMap -> IE GhcPs -> [GlobalRdrElt] -> RnM ExportOccMap
check_occs :: ExportOccMap
-> IE GhcPs -> [GlobalRdrEltX GREInfo] -> RnM ExportOccMap
check_occs ExportOccMap
occs IE GhcPs
ie [GlobalRdrEltX GREInfo]
gres
= do { drf <- Extension -> IOEnv (Env TcGblEnv TcLclEnv) Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DuplicateRecordFields
; foldlM (check drf) occs gres }
where
check :: Bool -> ExportOccMap -> GlobalRdrElt -> RnM ExportOccMap
check :: Bool -> ExportOccMap -> GlobalRdrEltX GREInfo -> RnM ExportOccMap
check Bool
drf_enabled ExportOccMap
occs GlobalRdrEltX GREInfo
gre
= case ExportOccMap
-> GlobalRdrEltX GREInfo -> Either (Name, IE GhcPs) ExportOccMap
try_insert ExportOccMap
occs GlobalRdrEltX GREInfo
gre of
Right ExportOccMap
occs'
| Bool
drf_enabled Bool -> Bool -> Bool
|| Bool -> Bool
not (OccName -> Bool
isFieldOcc OccName
child_occ)
-> ExportOccMap -> RnM ExportOccMap
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ExportOccMap
occs'
| Bool
otherwise
-> do { let flds :: [(Name, IE GhcPs)]
flds = ((Name, IE GhcPs) -> Bool)
-> [(Name, IE GhcPs)] -> [(Name, IE GhcPs)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
_,IE GhcPs
ie') -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IE GhcPs -> Bool
dupFieldExport_ok IE GhcPs
ie IE GhcPs
ie')
([(Name, IE GhcPs)] -> [(Name, IE GhcPs)])
-> [(Name, IE GhcPs)] -> [(Name, IE GhcPs)]
forall a b. (a -> b) -> a -> b
$ ExportOccMap -> FastString -> [(Name, IE GhcPs)]
forall a. OccEnv a -> FastString -> [a]
lookupFieldsOccEnv ExportOccMap
occs (OccName -> FastString
occNameFS OccName
child_occ)
; case [(Name, IE GhcPs)]
flds of { [] -> ExportOccMap -> RnM ExportOccMap
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ExportOccMap
occs'; (Name, IE GhcPs)
clash1:[(Name, IE GhcPs)]
clashes ->
do { (GlobalRdrEltX GREInfo, IE GhcPs)
-> NonEmpty (Name, IE GhcPs) -> TcRn ()
addDuplicateFieldExportErr (GlobalRdrEltX GREInfo
gre,IE GhcPs
ie) ((Name, IE GhcPs)
clash1 (Name, IE GhcPs) -> [(Name, IE GhcPs)] -> NonEmpty (Name, IE GhcPs)
forall a. a -> [a] -> NonEmpty a
NE.:| [(Name, IE GhcPs)]
clashes)
; ExportOccMap -> RnM ExportOccMap
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ExportOccMap
occs } } }
Left (Name
child', IE GhcPs
ie')
| Name
child Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
child'
-> do { Bool -> TcRnMessage -> TcRn ()
warnIf (Bool -> Bool
not (Name -> IE GhcPs -> IE GhcPs -> Bool
dupExport_ok Name
child IE GhcPs
ie IE GhcPs
ie')) (GlobalRdrEltX GREInfo -> IE GhcPs -> IE GhcPs -> TcRnMessage
TcRnDuplicateExport GlobalRdrEltX GREInfo
gre IE GhcPs
ie IE GhcPs
ie')
; ExportOccMap -> RnM ExportOccMap
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ExportOccMap
occs }
| Bool
otherwise
-> do { global_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; addErr (exportClashErr global_env child' child ie' ie)
; return occs }
where
child :: Name
child = GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
gre
child_occ :: OccName
child_occ = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
child
try_insert :: ExportOccMap -> GlobalRdrElt -> Either (Name, IE GhcPs) ExportOccMap
try_insert :: ExportOccMap
-> GlobalRdrEltX GREInfo -> Either (Name, IE GhcPs) ExportOccMap
try_insert ExportOccMap
occs GlobalRdrEltX GREInfo
child
= case ExportOccMap -> OccName -> Maybe (Name, IE GhcPs)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv ExportOccMap
occs OccName
occ of
Maybe (Name, IE GhcPs)
Nothing -> ExportOccMap -> Either (Name, IE GhcPs) ExportOccMap
forall a b. b -> Either a b
Right (ExportOccMap -> OccName -> (Name, IE GhcPs) -> ExportOccMap
forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv ExportOccMap
occs OccName
occ (GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
child, IE GhcPs
ie))
Just (Name, IE GhcPs)
x -> (Name, IE GhcPs) -> Either (Name, IE GhcPs) ExportOccMap
forall a b. a -> Either a b
Left (Name, IE GhcPs)
x
where
occ :: OccName
occ = GlobalRdrEltX GREInfo -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrEltX GREInfo
child
dupExport_ok :: Name -> IE GhcPs -> IE GhcPs -> Bool
dupExport_ok :: Name -> IE GhcPs -> IE GhcPs -> Bool
dupExport_ok Name
child IE GhcPs
ie1 IE GhcPs
ie2
= Bool -> Bool
not ( IE GhcPs -> Bool
forall {pass}. IE pass -> Bool
single IE GhcPs
ie1 Bool -> Bool -> Bool
|| IE GhcPs -> Bool
forall {pass}. IE pass -> Bool
single IE GhcPs
ie2
Bool -> Bool -> Bool
|| (IE GhcPs -> Bool
explicit_in IE GhcPs
ie1 Bool -> Bool -> Bool
&& IE GhcPs -> Bool
explicit_in IE GhcPs
ie2) )
where
explicit_in :: IE GhcPs -> Bool
explicit_in (IEModuleContents {}) = Bool
False
explicit_in (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
r Maybe (ExportDoc GhcPs)
_)
= Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
child OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> OccName
rdrNameOcc (IEWrappedName GhcPs -> IdP GhcPs
forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName (IEWrappedName GhcPs -> IdP GhcPs)
-> IEWrappedName GhcPs -> IdP GhcPs
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> IEWrappedName GhcPs
forall l e. GenLocated l e -> e
unLoc LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
r)
explicit_in IE GhcPs
_ = Bool
True
single :: IE pass -> Bool
single IEVar {} = Bool
True
single IEThingAbs {} = Bool
True
single IE pass
_ = Bool
False
exportErrCtxt :: Outputable o => String -> o -> SDoc
exportErrCtxt :: forall o. Outputable o => String -> o -> SDoc
exportErrCtxt String
herald o
exp =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (String
herald String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> o -> SDoc
forall a. Outputable a => a -> SDoc
ppr o
exp
addExportErrCtxt :: (OutputableBndrId p)
=> IE (GhcPass p) -> TcM a -> TcM a
addExportErrCtxt :: forall (p :: Pass) a.
OutputableBndrId p =>
IE (GhcPass p) -> TcM a -> TcM a
addExportErrCtxt IE (GhcPass p)
ie = SDoc -> TcM a -> TcM a
forall a. SDoc -> TcM a -> TcM a
addErrCtxt SDoc
exportCtxt
where
exportCtxt :: SDoc
exportCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In the export:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IE (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE (GhcPass p)
ie
failWithDcErr :: Name -> Name -> [Name] -> TcM a
failWithDcErr :: forall a. Name -> Name -> [Name] -> TcM a
failWithDcErr Name
parent Name
child [Name]
parents = do
ty_thing <- Name -> TcM TyThing
tcLookupGlobal Name
child
failWithTc $ TcRnExportedParentChildMismatch parent ty_thing child parents
exportClashErr :: GlobalRdrEnv
-> Name -> Name
-> IE GhcPs -> IE GhcPs
-> TcRnMessage
exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE GhcPs -> IE GhcPs -> TcRnMessage
exportClashErr GlobalRdrEnv
global_env Name
child1 Name
child2 IE GhcPs
ie1 IE GhcPs
ie2
= OccName
-> GlobalRdrEltX GREInfo
-> IE GhcPs
-> GlobalRdrEltX GREInfo
-> IE GhcPs
-> TcRnMessage
TcRnConflictingExports OccName
occ GlobalRdrEltX GREInfo
gre1' IE GhcPs
ie1' GlobalRdrEltX GREInfo
gre2' IE GhcPs
ie2'
where
occ :: OccName
occ = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
child1
gre1 :: GlobalRdrEltX GREInfo
gre1 = Name -> GlobalRdrEltX GREInfo
get_gre Name
child1
gre2 :: GlobalRdrEltX GREInfo
gre2 = Name -> GlobalRdrEltX GREInfo
get_gre Name
child2
get_gre :: Name -> GlobalRdrEltX GREInfo
get_gre Name
child
= GlobalRdrEltX GREInfo
-> Maybe (GlobalRdrEltX GREInfo) -> GlobalRdrEltX GREInfo
forall a. a -> Maybe a -> a
fromMaybe (String -> SDoc -> GlobalRdrEltX GREInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"exportClashErr" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
child))
(GlobalRdrEnv -> Name -> Maybe (GlobalRdrEltX GREInfo)
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
global_env Name
child)
(GlobalRdrEltX GREInfo
gre1', IE GhcPs
ie1', GlobalRdrEltX GREInfo
gre2', IE GhcPs
ie2') =
case SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest (GlobalRdrEltX GREInfo -> SrcSpan
forall info. Outputable info => GlobalRdrEltX info -> SrcSpan
greSrcSpan GlobalRdrEltX GREInfo
gre1) (GlobalRdrEltX GREInfo -> SrcSpan
forall info. Outputable info => GlobalRdrEltX info -> SrcSpan
greSrcSpan GlobalRdrEltX GREInfo
gre2) of
Ordering
LT -> (GlobalRdrEltX GREInfo
gre1, IE GhcPs
ie1, GlobalRdrEltX GREInfo
gre2, IE GhcPs
ie2)
Ordering
GT -> (GlobalRdrEltX GREInfo
gre2, IE GhcPs
ie2, GlobalRdrEltX GREInfo
gre1, IE GhcPs
ie1)
Ordering
EQ -> String
-> (GlobalRdrEltX GREInfo, IE GhcPs, GlobalRdrEltX GREInfo,
IE GhcPs)
forall a. HasCallStack => String -> a
panic String
"exportClashErr: clashing exports have identical location"
addDuplicateFieldExportErr :: (GlobalRdrElt, IE GhcPs)
-> NE.NonEmpty (Name, IE GhcPs)
-> RnM ()
addDuplicateFieldExportErr :: (GlobalRdrEltX GREInfo, IE GhcPs)
-> NonEmpty (Name, IE GhcPs) -> TcRn ()
addDuplicateFieldExportErr (GlobalRdrEltX GREInfo, IE GhcPs)
gre NonEmpty (Name, IE GhcPs)
others
= do { rdr_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let lkup = String -> Maybe (GlobalRdrEltX GREInfo) -> GlobalRdrEltX GREInfo
forall a. HasDebugCallStack => String -> Maybe a -> a
expectJust String
"addDuplicateFieldExportErr" (Maybe (GlobalRdrEltX GREInfo) -> GlobalRdrEltX GREInfo)
-> (Name -> Maybe (GlobalRdrEltX GREInfo))
-> Name
-> GlobalRdrEltX GREInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrEnv -> Name -> Maybe (GlobalRdrEltX GREInfo)
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env
other_gres = ((Name, IE GhcPs) -> (GlobalRdrEltX GREInfo, IE GhcPs))
-> NonEmpty (Name, IE GhcPs)
-> NonEmpty (GlobalRdrEltX GREInfo, IE GhcPs)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> GlobalRdrEltX GREInfo)
-> (Name, IE GhcPs) -> (GlobalRdrEltX GREInfo, IE GhcPs)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Name -> GlobalRdrEltX GREInfo
lkup) NonEmpty (Name, IE GhcPs)
others
; addErr (TcRnDuplicateFieldExport gre other_gres) }
dupFieldExport_ok :: IE GhcPs -> IE GhcPs -> Bool
dupFieldExport_ok :: IE GhcPs -> IE GhcPs -> Bool
dupFieldExport_ok IE GhcPs
ie1 IE GhcPs
ie2
| IEModuleContents {} <- IE GhcPs
ie1
, IE GhcPs
ie2 IE GhcPs -> IE GhcPs -> Bool
forall a. Eq a => a -> a -> Bool
== IE GhcPs
ie1
= Bool
True
| Bool
otherwise
= Bool
False