compiler/GHC.hs

@@ -1394,7 +1394,7 @@ getPackageModuleInfo hsc_env mdl
             tys    = [ ty | name <- concatMap availNames avails,
                             Just ty <- [lookupTypeEnv pte name] ]
 
-        let !rdr_env = availsToGlobalRdrEnv hsc_env (moduleName mdl) avails
+        let !rdr_env = availsToGlobalRdrEnv hsc_env mdl avails
         -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
 
         return (Just (ModuleInfo {
@@ -1407,7 +1407,7 @@ getPackageModuleInfo hsc_env mdl
                         minf_modBreaks = emptyModBreaks
                 }))
 
-availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> ModuleName -> [AvailInfo] -> IfGlobalRdrEnv
+availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> Module -> [AvailInfo] -> IfGlobalRdrEnv
 availsToGlobalRdrEnv hsc_env mod avails
   = forceGlobalRdrEnv rdr_env
     -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
@@ -1416,7 +1416,7 @@ availsToGlobalRdrEnv hsc_env mod avails
       -- We're building a GlobalRdrEnv as if the user imported
       -- all the specified modules into the global interactive module
     imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
-    decl = ImpDeclSpec { is_mod = mod, is_as = mod,
+    decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod,
                          is_qual = False,
                          is_dloc = srcLocSpan interactiveSrcLoc }
 

compiler/GHC/Driver/Flags.hs

@@ -647,6 +647,7 @@ data WarningFlag =
    | Opt_WarnTermVariableCapture                     -- Since 9.8
    | Opt_WarnMissingRoleAnnotations                  -- Since 9.8
    | Opt_WarnImplicitRhsQuantification               -- Since 9.8
+   | Opt_WarnIncompleteExportWarnings                -- Since 9.8
    deriving (Eq, Ord, Show, Enum)
 
 -- | Return the names of a WarningFlag
@@ -756,6 +757,7 @@ warnFlagNames wflag = case wflag of
   Opt_WarnTypeEqualityRequiresOperators           -> "type-equality-requires-operators" :| []
   Opt_WarnMissingRoleAnnotations                  -> "missing-role-annotations" :| []
   Opt_WarnImplicitRhsQuantification               -> "implicit-rhs-quantification" :| []
+  Opt_WarnIncompleteExportWarnings                -> "incomplete-export-warnings" :| []
 
 -- -----------------------------------------------------------------------------
 -- Standard sets of warning options
@@ -928,7 +930,8 @@ minusWallOpts
         Opt_WarnUnusedRecordWildcards,
         Opt_WarnRedundantRecordWildcards,
         Opt_WarnIncompleteUniPatterns,
-        Opt_WarnIncompletePatternsRecUpd
+        Opt_WarnIncompletePatternsRecUpd,
+        Opt_WarnIncompleteExportWarnings
       ]
 
 -- | Things you get with -Weverything, i.e. *all* known warnings flags

compiler/GHC/Driver/Session.hs

@@ -2271,7 +2271,8 @@ wWarningFlagsDeps = mconcat [
   warnSpec    Opt_WarnTypeEqualityRequiresOperators,
   warnSpec    Opt_WarnTermVariableCapture,
   warnSpec    Opt_WarnMissingRoleAnnotations,
-  warnSpec    Opt_WarnImplicitRhsQuantification
+  warnSpec    Opt_WarnImplicitRhsQuantification,
+  warnSpec    Opt_WarnIncompleteExportWarnings
  ]
 
 warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)]

compiler/GHC/Hs/ImpExp.hs

@@ -38,6 +38,8 @@ import GHC.Hs.Extension
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 
+import GHC.Unit.Module.Warnings (WarningTxt)
+
 import Data.Data
 import Data.Maybe
 
@@ -198,16 +200,39 @@ type instance Anno (IEWrappedName (GhcPass _)) = SrcSpanAnnA
 
 type instance Anno (IE (GhcPass p)) = SrcSpanAnnA
 
-type instance XIEVar             GhcPs = NoExtField
-type instance XIEVar             GhcRn = NoExtField
-type instance XIEVar             GhcTc = NoExtField
-
-type instance XIEThingAbs        (GhcPass _) = EpAnn [AddEpAnn]
-type instance XIEThingAll        (GhcPass _) = EpAnn [AddEpAnn]
-type instance XIEThingWith       (GhcPass _) = EpAnn [AddEpAnn]
-
-type instance XIEModuleContents  GhcPs = EpAnn [AddEpAnn]
-type instance XIEModuleContents  GhcRn = NoExtField
+-- The additional field of type 'Maybe (WarningTxt pass)' holds information
+-- about export deprecation annotations and is thus set to Nothing when `IE`
+-- is used in an import list (since export deprecation can only be used in exports)
+type instance XIEVar       GhcPs = Maybe (LocatedP (WarningTxt GhcPs))
+type instance XIEVar       GhcRn = Maybe (LocatedP (WarningTxt GhcRn))
+type instance XIEVar       GhcTc = NoExtField
+
+-- The additional field of type 'Maybe (WarningTxt pass)' holds information
+-- about export deprecation annotations and is thus set to Nothing when `IE`
+-- is used in an import list (since export deprecation can only be used in exports)
+type instance XIEThingAbs  GhcPs = (Maybe (LocatedP (WarningTxt GhcPs)), EpAnn [AddEpAnn])
+type instance XIEThingAbs  GhcRn = (Maybe (LocatedP (WarningTxt GhcRn)), EpAnn [AddEpAnn])
+type instance XIEThingAbs  GhcTc = EpAnn [AddEpAnn]
+
+-- The additional field of type 'Maybe (WarningTxt pass)' holds information
+-- about export deprecation annotations and is thus set to Nothing when `IE`
+-- is used in an import list (since export deprecation can only be used in exports)
+type instance XIEThingAll  GhcPs = (Maybe (LocatedP (WarningTxt GhcPs)), EpAnn [AddEpAnn])
+type instance XIEThingAll  GhcRn = (Maybe (LocatedP (WarningTxt GhcRn)), EpAnn [AddEpAnn])
+type instance XIEThingAll  GhcTc = EpAnn [AddEpAnn]
+
+-- The additional field of type 'Maybe (WarningTxt pass)' holds information
+-- about export deprecation annotations and is thus set to Nothing when `IE`
+-- is used in an import list (since export deprecation can only be used in exports)
+type instance XIEThingWith GhcPs = (Maybe (LocatedP (WarningTxt GhcPs)), EpAnn [AddEpAnn])
+type instance XIEThingWith GhcRn = (Maybe (LocatedP (WarningTxt GhcRn)), EpAnn [AddEpAnn])
+type instance XIEThingWith GhcTc = EpAnn [AddEpAnn]
+
+-- The additional field of type 'Maybe (WarningTxt pass)' holds information
+-- about export deprecation annotations and is thus set to Nothing when `IE`
+-- is used in an import list (since export deprecation can only be used in exports)
+type instance XIEModuleContents  GhcPs = (Maybe (LocatedP (WarningTxt GhcPs)), EpAnn [AddEpAnn])
+type instance XIEModuleContents  GhcRn = Maybe (LocatedP (WarningTxt GhcRn))
 type instance XIEModuleContents  GhcTc = NoExtField
 
 type instance XIEGroup           (GhcPass _) = NoExtField
@@ -236,6 +261,22 @@ ieNames (IEGroup          {})     = []
 ieNames (IEDoc            {})     = []
 ieNames (IEDocNamed       {})     = []
 
+ieDeprecation :: forall p. IsPass p => IE (GhcPass p) -> Maybe (WarningTxt (GhcPass p))
+ieDeprecation = fmap unLoc . ie_deprecation (ghcPass @p)
+  where
+    ie_deprecation :: GhcPass p -> IE (GhcPass p) -> Maybe (LocatedP (WarningTxt (GhcPass p)))
+    ie_deprecation GhcPs (IEVar xie _) = xie
+    ie_deprecation GhcPs (IEThingAbs (xie, _) _) = xie
+    ie_deprecation GhcPs (IEThingAll (xie, _) _) = xie
+    ie_deprecation GhcPs (IEThingWith (xie, _) _ _ _) = xie
+    ie_deprecation GhcPs (IEModuleContents (xie, _) _) = xie
+    ie_deprecation GhcRn (IEVar xie _) = xie
+    ie_deprecation GhcRn (IEThingAbs (xie, _) _) = xie
+    ie_deprecation GhcRn (IEThingAll (xie, _) _) = xie
+    ie_deprecation GhcRn (IEThingWith (xie, _) _ _ _) = xie
+    ie_deprecation GhcRn (IEModuleContents xie _) = xie
+    ie_deprecation _ _ = Nothing
+
 ieWrappedLName :: IEWrappedName (GhcPass p) -> LIdP (GhcPass p)
 ieWrappedLName (IEName    _ (L l n)) = L l n
 ieWrappedLName (IEPattern _ (L l n)) = L l n
@@ -260,11 +301,11 @@ replaceLWrappedName :: LIEWrappedName GhcPs -> IdP GhcRn -> LIEWrappedName GhcRn
 replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
 
 instance OutputableBndrId p => Outputable (IE (GhcPass p)) where
-    ppr (IEVar       _     var) = ppr (unLoc var)
-    ppr (IEThingAbs  _   thing) = ppr (unLoc thing)
-    ppr (IEThingAll  _   thing) = hcat [ppr (unLoc thing), text "(..)"]
-    ppr (IEThingWith _ thing wc withs)
-        = ppr (unLoc thing) <> parens (fsep (punctuate comma ppWiths))
+    ppr ie@(IEVar       _     var) = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ ppr (unLoc var)]
+    ppr ie@(IEThingAbs  _   thing) = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ ppr (unLoc thing)]
+    ppr ie@(IEThingAll  _   thing) = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ hcat [ppr (unLoc thing), text "(..)"]]
+    ppr ie@(IEThingWith _ thing wc withs)
+        = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ ppr (unLoc thing) <> parens (fsep (punctuate comma ppWiths))]
       where
         ppWiths =
           case wc of
@@ -273,8 +314,8 @@ instance OutputableBndrId p => Outputable (IE (GhcPass p)) where
               IEWildcard pos ->
                 let (bs, as) = splitAt pos (map (ppr . unLoc) withs)
                 in bs ++ [text ".."] ++ as
-    ppr (IEModuleContents _ mod')
-        = text "module" <+> ppr mod'
+    ppr ie@(IEModuleContents _ mod')
+        = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ text "module" <+> ppr mod']
     ppr (IEGroup _ n _)           = text ("<IEGroup: " ++ show n ++ ">")
     ppr (IEDoc _ doc)             = ppr doc
     ppr (IEDocNamed _ string)     = text ("<IEDocNamed: " ++ string ++ ">")

compiler/GHC/Iface/Load.hs

@@ -1210,10 +1210,16 @@ instance Outputable (Warnings pass) where
     ppr = pprWarns
 
 pprWarns :: Warnings pass -> SDoc
-pprWarns NoWarnings         = Outputable.empty
 pprWarns (WarnAll txt)  = text "Warn all" <+> ppr txt
-pprWarns (WarnSome prs) = text "Warnings:"
-                        <+> vcat (map pprWarning prs)
+pprWarns (WarnSome decl_warns export_warns)
+  = vcat $
+    case decl_warns of
+      [] -> []
+      _  -> [text "Declaration warnings:" <+> vcat (map pprWarning decl_warns)]
+    ++
+    case export_warns of
+      [] -> []
+      _  -> [text "Export warnings:" <+> vcat (map pprWarning export_warns)]
     where pprWarning (name, txt) = ppr name <+> ppr txt
 
 pprIfaceAnnotation :: IfaceAnnotation -> SDoc

compiler/GHC/Iface/Recomp.hs

@@ -962,7 +962,8 @@ addFingerprints hsc_env iface0
    eps <- hscEPS hsc_env
    let
        decls = mi_decls iface0
-       warn_fn = mkIfaceWarnCache (mi_warns iface0)
+       decl_warn_fn = mkIfaceDeclWarnCache (mi_warns iface0)
+       export_warn_fn = mkIfaceExportWarnCache (mi_warns iface0)
        fix_fn = mkIfaceFixCache (mi_fixities iface0)
 
         -- The ABI of a declaration represents everything that is made
@@ -1263,22 +1264,23 @@ addFingerprints hsc_env iface0
 
    let
     final_iface_exts = ModIfaceBackend
-      { mi_iface_hash  = iface_hash
-      , mi_mod_hash    = mod_hash
-      , mi_flag_hash   = flag_hash
-      , mi_opt_hash    = opt_hash
-      , mi_hpc_hash    = hpc_hash
-      , mi_plugin_hash = plugin_hash
-      , mi_orphan      = not (   all ifRuleAuto orph_rules
-                                   -- See Note [Orphans and auto-generated rules]
-                              && null orph_insts
-                              && null orph_fis)
-      , mi_finsts      = not (null (mi_fam_insts iface0))
-      , mi_exp_hash    = export_hash
-      , mi_orphan_hash = orphan_hash
-      , mi_warn_fn     = warn_fn
-      , mi_fix_fn      = fix_fn
-      , mi_hash_fn     = lookupOccEnv local_env
+      { mi_iface_hash     = iface_hash
+      , mi_mod_hash       = mod_hash
+      , mi_flag_hash      = flag_hash
+      , mi_opt_hash       = opt_hash
+      , mi_hpc_hash       = hpc_hash
+      , mi_plugin_hash    = plugin_hash
+      , mi_orphan         = not (   all ifRuleAuto orph_rules
+                                      -- See Note [Orphans and auto-generated rules]
+                                 && null orph_insts
+                                 && null orph_fis)
+      , mi_finsts         = not (null (mi_fam_insts iface0))
+      , mi_exp_hash       = export_hash
+      , mi_orphan_hash    = orphan_hash
+      , mi_decl_warn_fn   = decl_warn_fn
+      , mi_export_warn_fn = export_warn_fn
+      , mi_fix_fn         = fix_fn
+      , mi_hash_fn        = lookupOccEnv local_env
       }
     final_iface = iface0 { mi_decls = sorted_decls, mi_extra_decls = sorted_extra_decls, mi_final_exts = final_iface_exts }
    --

compiler/GHC/Parser.y

@@ -1026,11 +1026,24 @@ exportlist1 :: { OrdList (LIE GhcPs) }
    -- No longer allow things like [] and (,,,) to be exported
    -- They are built in syntax, always available
 export  :: { OrdList (LIE GhcPs) }
-        : qcname_ext export_subspec  {% mkModuleImpExp (fst $ unLoc $2) $1 (snd $ unLoc $2)
-                                          >>= \ie -> fmap (unitOL . reLocA) (return (sLL (reLoc $1) $> ie)) }
-        |  'module' modid            {% fmap (unitOL . reLocA) (acs (\cs -> sLL $1 (reLoc $>) (IEModuleContents (EpAnn (glR $1) [mj AnnModule $1] cs) $2))) }
-        |  'pattern' qcon            { unitOL (reLocA (sLL $1 (reLocN $>)
-                                              (IEVar noExtField (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2))))) }
+        : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) (reLoc $2) $> }
+                                                          ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3)
+                                                          ; return $ unitOL $ reLocA $ sL span $ impExp } }
+        | maybeexportwarning 'module' modid            {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>)
+                                                                   ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 (reLoc loc)) $1) $2 }
+                                                          ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3))
+                                                          ; return $ unitOL $ reLocA $ locImpExp } }
+        | maybeexportwarning 'pattern' qcon            { let span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>)
+                                                       in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) }
+
+maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) }
+        : '{-# DEPRECATED' strings '#-}'
+                            {% fmap Just $ amsrp (sLL $1 $> $ DeprecatedTxt (sL1 $1 $ getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))
+                                (AnnPragma (mo $1) (mc $3) (fst $ unLoc $2)) }
+        | '{-# WARNING' warning_category strings '#-}'
+                            {% fmap Just $ amsrp (sLL $1 $> $ WarningTxt $2 (sL1 $1 $ getWARNING_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $3))
+                                (AnnPragma (mo $1) (mc $4) (fst $ unLoc $3))}
+        |  {- empty -}      { Nothing }
 
 export_subspec :: { Located ([AddEpAnn],ImpExpSubSpec) }
         : {- empty -}             { sL0 ([],ImpExpAbs) }
@@ -1166,13 +1179,40 @@ maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedL [LIE GhcPs]
         | {- empty -}              { noLoc Nothing }
 
 impspec :: { Located (ImportListInterpretation, LocatedL [LIE GhcPs]) }
-        :  '(' exportlist ')'               {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $2)
+        :  '(' importlist ')'               {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $2)
                                                                (AnnList Nothing (Just $ mop $1) (Just $ mcp $3) (fst $2) [])
                                                   ; return $ sLL $1 $> (Exactly, es)} }
-        |  'hiding' '(' exportlist ')'      {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $3)
+        |  'hiding' '(' importlist ')'      {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $3)
                                                                (AnnList Nothing (Just $ mop $2) (Just $ mcp $4) (mj AnnHiding $1:fst $3) [])
                                                   ; return $ sLL $1 $> (EverythingBut, es)} }
 
+importlist :: { ([AddEpAnn], OrdList (LIE GhcPs)) }
+        : importlist1     { ([], $1) }
+        | {- empty -}     { ([], nilOL) }
+
+        -- trailing comma:
+        | importlist1 ',' {% case $1 of
+                               SnocOL hs t -> do
+                                 t' <- addTrailingCommaA t (gl $2)
+                                 return ([], snocOL hs t')}
+        | ','             { ([mj AnnComma $1], nilOL) }
+
+importlist1 :: { OrdList (LIE GhcPs) }
+        : importlist1 ',' import
+                          {% let ls = $1
+                             in if isNilOL ls
+                                  then return (ls `appOL` $3)
+                                  else case ls of
+                                         SnocOL hs t -> do
+                                           t' <- addTrailingCommaA t (gl $2)
+                                           return (snocOL hs t' `appOL` $3)}
+        | import          { $1 }
+
+import  :: { OrdList (LIE GhcPs) }
+        : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL (reLoc $1) $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) }
+        | 'module' modid            {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 (reLoc $>) (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) }
+        | 'pattern' qcon            { unitOL $ reLocA $ sLL $1 (reLocN $>) $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) }
+
 -----------------------------------------------------------------------------
 -- Fixity Declarations
 

compiler/GHC/Parser/PostProcess.hs

@@ -153,6 +153,7 @@ import Data.Either
 import Data.List        ( findIndex )
 import Data.Foldable
 import qualified Data.Semigroup as Semi
+import GHC.Unit.Module.Warnings
 import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
 import qualified GHC.Data.Strict as Strict
@@ -2791,18 +2792,20 @@ data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)
                   | ImpExpQcType EpaLocation (LocatedN RdrName)
                   | ImpExpQcWildcard
 
-mkModuleImpExp :: [AddEpAnn] -> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
-mkModuleImpExp anns (L l specname) subs = do
+mkModuleImpExp :: Maybe (LocatedP (WarningTxt GhcPs)) -> [AddEpAnn] -> LocatedA ImpExpQcSpec
+               -> ImpExpSubSpec -> P (IE GhcPs)
+mkModuleImpExp warning anns (L l specname) subs = do
   cs <- getCommentsFor (locA l) -- AZ: IEVar can discard comments
-  let ann = EpAnn (spanAsAnchor $ locA l) anns cs
+  let ann = EpAnn (spanAsAnchor $ maybe (locA l) getLocA warning) anns cs
   case subs of
     ImpExpAbs
       | isVarNameSpace (rdrNameSpace name)
-                       -> return $ IEVar noExtField (L l (ieNameFromSpec specname))
-      | otherwise      -> IEThingAbs ann . L l <$> nameT
-    ImpExpAll          -> IEThingAll ann . L l <$> nameT
+                       -> return $ IEVar warning
+                           (L l (ieNameFromSpec specname))
+      | otherwise      -> IEThingAbs (warning, ann) . L l <$> nameT
+    ImpExpAll          -> IEThingAll (warning, ann) . L l <$> nameT
     ImpExpList xs      ->
-      (\newName -> IEThingWith ann (L l newName)
+      (\newName -> IEThingWith (warning, ann) (L l newName)
         NoIEWildcard (wrapped xs)) <$> nameT
     ImpExpAllWith xs                       ->
       do allowed <- getBit PatternSynonymsBit
@@ -2814,7 +2817,7 @@ mkModuleImpExp anns (L l specname) subs = do
                 ies :: [LocatedA (IEWrappedName GhcPs)]
                 ies   = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs
             in (\newName
-                        -> IEThingWith ann (L l newName) pos ies)
+                        -> IEThingWith (warning, ann) (L l newName) pos ies)
                <$> nameT
           else addFatalError $ mkPlainErrorMsgEnvelope (locA l) $
                  PsErrIllegalPatSynExport

compiler/GHC/Rename/Env.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE GADTs            #-}
 {-# LANGUAGE MultiWayIf       #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE GADTs            #-}
+{-# LANGUAGE TupleSections    #-}
 
 {-
 (c) The GRASP/AQUA Project, Glasgow University, 1992-2006
@@ -79,7 +79,7 @@ import GHC.Parser.PostProcess ( setRdrNameSpace )
 import GHC.Builtin.Types
 import GHC.Types.Name
 import GHC.Types.Name.Set
-import GHC.Types.Name.Env ( lookupNameEnv )
+import GHC.Types.Name.Env
 import GHC.Types.Avail
 import GHC.Types.Hint
 import GHC.Types.Error
@@ -116,6 +116,7 @@ import Control.Monad
 import Data.Either      ( partitionEithers )
 import Data.Function    ( on )
 import Data.List        ( find, partition, groupBy, sortBy )
+import Data.Foldable    ( for_ )
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Semigroup as Semi
 import System.IO.Unsafe ( unsafePerformIO )
@@ -408,7 +409,7 @@ lookupInstDeclBndr cls what rdr
                 -- to use a qualified name for the method
                 -- (Although it'd make perfect sense.)
        ; mb_name <- lookupSubBndrOcc
-                          DisableDeprecationWarnings
+                          NoDeprecationWarnings
                                 -- we don't give deprecated
                                 -- warnings when a deprecated class
                                 -- method is defined. We only warn
@@ -554,7 +555,7 @@ lookupRecFieldOcc mb_con rdr_name
                         , text "rdr_name:" <+> ppr rdr_name
                         , text "flds:" <+> ppr flds
                         , text "mb_gre:" <+> ppr mb_gre ]
-               ; mapM_ (addUsedGRE EnableDeprecationWarnings) mb_gre
+               ; mapM_ (addUsedGRE AllDeprecationWarnings) mb_gre
                ; return $ flSelector . fieldGRELabel <$> mb_gre }
        ; case mb_nm of
           { Nothing  -> do { addErr (badFieldConErr con lbl)
@@ -1415,7 +1416,7 @@ lookupFieldGREs env (L loc rdr)
 lookupGlobalOccRn_overloaded :: RdrName -> RnM (Maybe GlobalRdrElt)
 lookupGlobalOccRn_overloaded rdr_name =
   lookupExactOrOrig_maybe rdr_name id $
-    do { res <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name EnableDeprecationWarnings
+    do { res <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name AllDeprecationWarnings
        ; case res of
            GreNotFound        -> lookupOneQualifiedNameGHCi WantNormal rdr_name
            OneNameMatch gre   -> return $ Just gre
@@ -1635,7 +1636,7 @@ lookupGreRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
 -- Uses addUsedRdrName to record use and deprecations
 lookupGreRn_maybe which_gres rdr_name
   = do
-      res <- lookupGreRn_helper which_gres rdr_name EnableDeprecationWarnings
+      res <- lookupGreRn_helper which_gres rdr_name AllDeprecationWarnings
       case res of
         OneNameMatch gre ->  return $ Just gre
         MultipleNames gres -> do
@@ -1688,7 +1689,7 @@ lookupGreAvailRn :: RdrName -> RnM (Maybe GlobalRdrElt)
 -- Uses addUsedRdrName to record use and deprecations
 lookupGreAvailRn rdr_name
   = do
-      mb_gre <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name DisableDeprecationWarnings
+      mb_gre <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name ExportDeprecationWarnings
       case mb_gre of
         GreNotFound ->
           do
@@ -1713,7 +1714,7 @@ lookupGreAvailRn rdr_name
 Note [Handling of deprecations]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * We report deprecations at each *occurrence* of the deprecated thing
-  (see #5867)
+  (see #5867 and #4879)
 
 * We do not report deprecations for locally-defined names. For a
   start, we may be exporting a deprecated thing. Also we may use a
@@ -1721,6 +1722,10 @@ Note [Handling of deprecations]
   even use a deprecated thing in the defn of a non-deprecated thing,
   when changing a module's interface.
 
+* We also report deprecations at export sites, but only for names
+  deprecated with export deprecations (since those are not transitive as opposed
+  to regular name deprecations and are only reported at the importing module)
+
 * addUsedGREs: we do not report deprecations for sub-binders:
      - the ".." completion for records
      - the ".." in an export item 'T(..)'
@@ -1730,39 +1735,43 @@ Note [Handling of deprecations]
 addUsedDataCons :: GlobalRdrEnv -> TyCon -> RnM ()
 -- Remember use of in-scope data constructors (#7969)
 addUsedDataCons rdr_env tycon
-  = addUsedGREs [ gre
-                | dc <- tyConDataCons tycon
-                , Just gre <- [lookupGRE_Name rdr_env (dataConName dc)] ]
+  = addUsedGREs NoDeprecationWarnings
+      [ gre
+      | dc <- tyConDataCons tycon
+      , Just gre <- [lookupGRE_Name rdr_env (dataConName dc)] ]
 
 -- | Whether to report deprecation warnings when registering a used GRE
+--
+-- There is no option to only emit declaration warnings since everywhere
+-- we emit the declaration warnings we also emit export warnings
+-- (See Note [Handling of deprecations] for details)
 data DeprecationWarnings
-  = DisableDeprecationWarnings
-  | EnableDeprecationWarnings
+  = NoDeprecationWarnings
+  | ExportDeprecationWarnings
+  | AllDeprecationWarnings
 
 addUsedGRE :: DeprecationWarnings -> GlobalRdrElt -> RnM ()
 -- Called for both local and imported things
 -- Add usage *and* warn if deprecated
 addUsedGRE warn_if_deprec gre
-  = do { case warn_if_deprec of
-           EnableDeprecationWarnings  -> warnIfDeprecated gre
-           DisableDeprecationWarnings -> return ()
+  = do { condWarnIfDeprecated warn_if_deprec [gre]
        ; when (isImportedGRE gre) $ -- See Note [Using isImportedGRE in addUsedGRE]
          do { env <- getGblEnv
              -- Do not report the GREInfo (#23424)
             ; traceRn "addUsedGRE" (ppr $ greName gre)
             ; updTcRef (tcg_used_gres env) (gre :) } }
 
-addUsedGREs :: [GlobalRdrElt] -> RnM ()
+addUsedGREs :: DeprecationWarnings -> [GlobalRdrElt] -> RnM ()
 -- Record uses of any *imported* GREs
 -- Used for recording used sub-bndrs
 -- NB: no call to warnIfDeprecated; see Note [Handling of deprecations]
-addUsedGREs gres
-  | null imp_gres = return ()
-  | otherwise     = do { env <- getGblEnv
-                        -- Do not report the GREInfo (#23424)
-                       ; traceRn "addUsedGREs"
-                             (ppr $ map greName imp_gres)
-                       ; updTcRef (tcg_used_gres env) (imp_gres ++) }
+addUsedGREs warn_if_deprec gres
+  = do { condWarnIfDeprecated warn_if_deprec gres
+       ; unless (null imp_gres) $
+         do { env <- getGblEnv
+              -- Do not report the GREInfo (#23424)
+            ; traceRn "addUsedGREs" (ppr $ map greName imp_gres)
+            ; updTcRef (tcg_used_gres env) (imp_gres ++) } }
   where
     imp_gres = filter isImportedGRE gres
     -- See Note [Using isImportedGRE in addUsedGRE]
@@ -1781,22 +1790,32 @@ in which case we have both gre_lcl = False and gre_imp = emptyBag.
 Geting this wrong can lead to panics in e.g. bestImport, see #23240.
 -}
 
-warnIfDeprecated :: GlobalRdrElt -> RnM ()
-warnIfDeprecated gre@(GRE { gre_imp = iss })
+condWarnIfDeprecated :: DeprecationWarnings -> [GlobalRdrElt] -> RnM ()
+condWarnIfDeprecated NoDeprecationWarnings _ = return ()
+condWarnIfDeprecated opt gres = do
+  this_mod <- getModule
+  let external_gres
+        = filterOut (nameIsLocalOrFrom this_mod . greName) gres
+  mapM_ (\gre -> warnIfExportDeprecated gre >> maybeWarnDeclDepr gre) external_gres
+  where
+    maybeWarnDeclDepr = case opt of
+      ExportDeprecationWarnings -> const $ return ()
+      AllDeprecationWarnings    -> warnIfDeclDeprecated
+
+warnIfDeclDeprecated :: GlobalRdrElt -> RnM ()
+warnIfDeclDeprecated gre@(GRE { gre_imp = iss })
   | Just imp_spec <- headMaybe iss
   = do { dflags <- getDynFlags
-       ; this_mod <- getModule
-       ; when (wopt_any_custom dflags &&
-               not (nameIsLocalOrFrom this_mod name)) $
+       ; when (wopt_any_custom dflags) $
                    -- See Note [Handling of deprecations]
          do { iface <- loadInterfaceForName doc name
-            ; case lookupImpDeprec iface gre of
+            ; case lookupImpDeclDeprec iface gre of
                 Just deprText -> addDiagnostic $
                   TcRnPragmaWarning {
                     pragma_warning_occ = occ,
                     pragma_warning_msg = deprText,
                     pragma_warning_import_mod = importSpecModule imp_spec,
-                    pragma_warning_defined_mod = definedMod
+                    pragma_warning_defined_mod = Just definedMod
                   }
                 Nothing  -> return () } }
   | otherwise
@@ -1807,13 +1826,35 @@ warnIfDeprecated gre@(GRE { gre_imp = iss })
     definedMod = moduleName $ assertPpr (isExternalName name) (ppr name) (nameModule name)
     doc = text "The name" <+> quotes (ppr occ) <+> text "is mentioned explicitly"
 
-lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
-lookupImpDeprec iface gre
-  = mi_warn_fn (mi_final_exts iface) (greOccName gre) `mplus`  -- Bleat if the thing,
+lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
+lookupImpDeclDeprec iface gre
+  = mi_decl_warn_fn (mi_final_exts iface) (greOccName gre) `mplus`  -- Bleat if the thing,
     case gre_par gre of                      -- or its parent, is warn'd
-       ParentIs  p              -> mi_warn_fn (mi_final_exts iface) (nameOccName p)
+       ParentIs  p              -> mi_decl_warn_fn (mi_final_exts iface) (nameOccName p)
        NoParent                 -> Nothing
 
+warnIfExportDeprecated :: GlobalRdrElt -> RnM ()
+warnIfExportDeprecated gre@(GRE { gre_imp = iss })
+  = do { mod_warn_mbs <- mapBagM process_import_spec iss
+       ; for_ (sequence mod_warn_mbs) $ mapM
+           $ \(importing_mod, warn_txt) -> addDiagnostic $
+             TcRnPragmaWarning {
+               pragma_warning_occ = occ,
+               pragma_warning_msg = warn_txt,
+               pragma_warning_import_mod = importing_mod,
+               pragma_warning_defined_mod = Nothing
+             } }
+  where
+    occ = greOccName gre
+    name = greName gre
+    doc = text "The name" <+> quotes (ppr occ) <+> text "is mentioned explicitly"
+    process_import_spec :: ImportSpec -> RnM (Maybe (ModuleName, WarningTxt GhcRn))
+    process_import_spec is = do
+      let mod = is_mod $ is_decl is
+      iface <- loadInterfaceForModule doc mod
+      let mb_warn_txt = mi_export_warn_fn (mi_final_exts iface) name
+      return $ (moduleName mod, ) <$> mb_warn_txt
+
 {-
 Note [Used names with interface not loaded]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1902,12 +1943,12 @@ lookupQualifiedNameGHCi fos rdr_name
 
   where
     go_for_it dflags is_ghci
-      | Just (mod,occ) <- isQual_maybe rdr_name
+      | Just (mod_name,occ) <- isQual_maybe rdr_name
       , let ns = occNameSpace occ
       , is_ghci
       , gopt Opt_ImplicitImportQualified dflags   -- Enables this GHCi behaviour
       , not (safeDirectImpsReq dflags)            -- See Note [Safe Haskell and GHCi]
-      = do { res <- loadSrcInterface_maybe doc mod NotBoot NoPkgQual
+      = do { res <- loadSrcInterface_maybe doc mod_name NotBoot NoPkgQual
            ; case res of
                 Succeeded iface
                   -> do { hsc_env <- getTopEnv
@@ -1919,7 +1960,8 @@ lookupQualifiedNameGHCi fos rdr_name
                                       lk_ns  = occNameSpace lk_occ
                                 , occNameFS occ == occNameFS lk_occ
                                 , ns == lk_ns || (ns == varName && isFieldNameSpace lk_ns)
-                                , let gre = lookupGRE_PTE mod hsc_env gname
+                                , let mod = mi_module iface
+                                      gre = lookupGRE_PTE mod hsc_env gname
                                 , allowGRE fos gre
                                   -- Include a field if it has a selector or we are looking for all fields;
                                   -- see Note [NoFieldSelectors].
@@ -1939,7 +1981,7 @@ lookupQualifiedNameGHCi fos rdr_name
 
     -- Lookup a Name for an implicit qualified import in GHCi
     -- in the given PackageTypeEnv.
-    lookupGRE_PTE :: ModuleName -> HscEnv -> Name -> GlobalRdrElt
+    lookupGRE_PTE :: Module -> HscEnv -> Name -> GlobalRdrElt
     lookupGRE_PTE mod hsc_env nm =
       -- Fake a GRE so we can report a sensible name clash error if
       -- -fimplicit-import-qualified is used with a module that exports the same
@@ -1952,7 +1994,7 @@ lookupQualifiedNameGHCi fos rdr_name
           , gre_info = info }
         where
           info = lookupGREInfo hsc_env nm
-          spec = ImpDeclSpec { is_mod = mod, is_as = mod, is_qual = True, is_dloc = noSrcSpan }
+          spec = ImpDeclSpec { is_mod = mod, is_as = moduleName mod, is_qual = True, is_dloc = noSrcSpan }
           is = ImpSpec { is_decl = spec, is_item = ImpAll }
 
 -- | Look up the 'GREInfo' associated with the given 'Name'
@@ -2098,7 +2140,7 @@ lookupBindGroupOcc ctxt what rdr_name
                           else lookup_top (`elemNameSet` ns)
   where
     lookup_cls_op cls
-      = lookupSubBndrOcc EnableDeprecationWarnings cls doc rdr_name
+      = lookupSubBndrOcc AllDeprecationWarnings cls doc rdr_name
       where
         doc = text "method of class" <+> quotes (ppr cls)
 

compiler/GHC/Rename/Module.hs

@@ -194,7 +194,7 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
    -- Rename deprec decls;
    -- check for duplicates and ensure that deprecated things are defined locally
    -- at the moment, we don't keep these around past renaming
-   rn_warns <- rnSrcWarnDecls all_bndrs warn_decls ;
+   rn_decl_warns <- rnSrcWarnDecls all_bndrs warn_decls ;
 
    -- (H) Rename Everything else
 
@@ -236,7 +236,7 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
 
         final_tcg_env = let tcg_env' = (last_tcg_env `addTcgDUs` src_dus)
                         in -- we return the deprecs in the env, not in the HsGroup above
-                        tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
+                        tcg_env' { tcg_warns = insertWarnDecls (tcg_warns tcg_env') rn_decl_warns };
        } ;
    traceRn "finish rnSrc" (ppr rn_group) ;
    traceRn "finish Dus" (ppr src_dus ) ;
@@ -266,9 +266,9 @@ gather them together.
 -}
 
 -- checks that the deprecations are defined locally, and that there are no duplicates
-rnSrcWarnDecls :: NameSet -> [LWarnDecls GhcPs] -> RnM (Warnings GhcRn)
+rnSrcWarnDecls :: NameSet -> [LWarnDecls GhcPs] -> RnM (DeclWarnOccNames GhcRn)
 rnSrcWarnDecls _ []
-  = return NoWarnings
+  = return []
 
 rnSrcWarnDecls bndr_set decls'
   = do { -- check for duplicates
@@ -276,7 +276,7 @@ rnSrcWarnDecls bndr_set decls'
                           in addErrAt (locA loc) (TcRnDuplicateWarningDecls lrdr' rdr))
                warn_rdr_dups
        ; pairs_s <- mapM (addLocMA rn_deprec) decls
-       ; return (WarnSome ((concat pairs_s))) }
+       ; return $ concat pairs_s }
  where
    decls = concatMap (wd_warnings . unLoc) decls'
 

compiler/GHC/Rename/Names.hs

@@ -386,9 +386,9 @@ rnImportDecl this_mod
     when (mod_safe && not (safeImportsOn dflags)) $
         addErr (TcRnSafeImportsDisabled imp_mod_name)
 
-    let
+    let imp_mod = mi_module iface
         qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name
-        imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
+        imp_spec  = ImpDeclSpec { is_mod = imp_mod, is_qual = qual_only,
                                   is_dloc = locA loc, is_as = qual_mod_name }
 
     -- filter the imports according to the import declaration
@@ -620,7 +620,6 @@ warnUnqualifiedImport decl iface =
     -- Modules for which we warn if we see unqualified imports
     qualifiedMods = mkModuleSet [ dATA_LIST ]
 
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1192,6 +1191,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
 
         return (Just (want_hiding, L l (map fst items2)), gres)
   where
+    import_mod = mi_module iface
     all_avails = mi_exports iface
     hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
     imp_occ_env = mkImportOccEnv hsc_env decl_spec all_avails
@@ -1253,6 +1253,13 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
               -- 'badImportItemErr'.
               reason <- badImportItemErr iface decl_spec ie BadImportIsParent all_avails
               pure (TcRnDodgyImports (DodgyImportsHiding reason))
+            warning_msg (DeprecatedExport n w) =
+              pure (TcRnPragmaWarning {
+                      pragma_warning_occ = occName n
+                    , pragma_warning_msg = w
+                    , pragma_warning_import_mod = moduleName import_mod
+                    , pragma_warning_defined_mod = Nothing
+                    })
 
             run_lookup :: IELookupM a -> TcRn (Maybe a)
             run_lookup m = case m of
@@ -1282,15 +1289,20 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
         IEVar _ (L l n) -> do
             -- See Note [Importing DuplicateRecordFields]
             xs <- lookup_names ie (ieWrappedName n)
-            return ( [ (IEVar noExtField (L l (replaceWrappedName n name)), [gre])
-                     | ImpOccItem { imp_item = gre } <- NE.toList xs
+            let gres = map imp_item $ NE.toList xs
+                export_depr_warns
+                  | want_hiding == Exactly
+                      = mapMaybe mk_depr_export_warning gres
+                  | otherwise = []
+            return ( [ (IEVar Nothing (L l (replaceWrappedName n name)), [gre])
+                     | gre <- gres
                      , let name = greName gre ]
-                   , [] )
+                   , export_depr_warns )
 
         IEThingAll _ (L l tc) -> do
             ImpOccItem gre child_gres _ <- lookup_parent ie $ ieWrappedName tc
             let name = greName gre
-                warns
+                imp_list_warn
 
                   | null child_gres
                   -- e.g. f(..) or T(..) where T is a type synonym
@@ -1303,9 +1315,17 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
                   | otherwise
                   = []
 
-                renamed_ie = IEThingAll noAnn (L l (replaceWrappedName tc name))
+                renamed_ie = IEThingAll (Nothing, noAnn) (L l (replaceWrappedName tc name))
+                export_depr_warn
+                  | want_hiding == Exactly
+                      = maybeToList $ mk_depr_export_warning gre
+                        -- We don't want to warn about the children as they
+                        -- are not explicitly mentioned; the warning will
+                        -- be emitted later on if they are used
+                  | otherwise = []
 
-            return ([(renamed_ie, gre:child_gres)], warns)
+            return ( [(renamed_ie, gre:child_gres)]
+                   , imp_list_warn ++ export_depr_warn)
 
 
         IEThingAbs _ (L l tc')
@@ -1318,33 +1338,38 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
                in
                case catIELookupM [ tc_name, dc_name ] of
                  []    -> failLookupWith (BadImport ie BadImportIsParent)
-                 names -> return ([mkIEThingAbs tc' l (imp_item name) | name <- names], [])
+                 names -> return ( [mkIEThingAbs tc' l (imp_item name) | name <- names], [])
             | otherwise
             -> do ImpOccItem { imp_item = gre } <- lookup_parent ie (ieWrappedName tc')
-                  return ([mkIEThingAbs tc' l gre], [])
+                  return ( [mkIEThingAbs tc' l gre]
+                         , maybeToList $ mk_depr_export_warning gre)
 
-        IEThingWith xt ltc@(L l rdr_tc) wc rdr_ns -> do
+        IEThingWith (deprecation, ann) ltc@(L l rdr_tc) wc rdr_ns -> do
            ImpOccItem { imp_item = gre, imp_bundled = subnames }
-               <- lookup_parent (IEThingAbs noAnn ltc) (ieWrappedName rdr_tc)
+               <- lookup_parent (IEThingAbs (Nothing, noAnn) ltc) (ieWrappedName rdr_tc)
            let name = greName gre
 
            -- Look up the children in the sub-names of the parent
            -- See Note [Importing DuplicateRecordFields]
            case lookupChildren subnames rdr_ns of
 
-             Failed rdrs -> failLookupWith (BadImport (IEThingWith xt ltc wc rdrs) BadImportIsSubordinate)
+             Failed rdrs -> failLookupWith (BadImport (IEThingWith (deprecation, ann) ltc wc rdrs ) BadImportIsSubordinate)
                                 -- We are trying to import T( a,b,c,d ), and failed
                                 -- to find 'b' and 'd'.  So we make up an import item
                                 -- to report as failing, namely T( b, d ).
                                 -- c.f. #15412
 
              Succeeded childnames ->
-                return ([ (IEThingWith xt (L l name') wc childnames'
-                          ,gre : map unLoc childnames)]
-                       , [])
+                return ([ (IEThingWith (Nothing, ann) (L l name') wc childnames'
+                          ,gres)]
+                       , export_depr_warns)
 
               where name' = replaceWrappedName rdr_tc name
                     childnames' = map (to_ie_post_rn . fmap greName) childnames
+                    gres = gre : map unLoc childnames
+                    export_depr_warns
+                      | want_hiding == Exactly = mapMaybe mk_depr_export_warning gres
+                      | otherwise              = []
 
         _other -> failLookupWith IllegalImport
         -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed...
@@ -1352,19 +1377,25 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
 
       where
         mkIEThingAbs tc l gre
-          = (IEThingAbs noAnn (L l (replaceWrappedName tc n)), [gre])
+          = (IEThingAbs (Nothing, noAnn) (L l (replaceWrappedName tc n)), [gre])
           where n = greName gre
 
         handle_bad_import m = catchIELookup m $ \err -> case err of
           BadImport ie _ | want_hiding == EverythingBut -> return ([], [BadImportW ie])
           _ -> failLookupWith err
 
+        mk_depr_export_warning gre
+          = DeprecatedExport name <$> mi_export_warn_fn (mi_final_exts iface) name
+          where
+            name = greName gre
+
 type IELookupM = MaybeErr IELookupError
 
 data IELookupWarning
   = BadImportW (IE GhcPs)
   | MissingImportList
   | DodgyImport GlobalRdrElt
+  | DeprecatedExport Name (WarningTxt GhcRn)
 
 data BadImportIsSubordinate = BadImportIsParent | BadImportIsSubordinate
 
@@ -1946,10 +1977,10 @@ getMinimalImports ie_decls
     to_ie rdr_env _ (Avail c)  -- Note [Overloaded field import]
       = do { let
                gre = expectJust "getMinimalImports Avail" $ lookupGRE_Name rdr_env c
-           ; return $ [IEVar noExtField (to_ie_post_rn $ noLocA $ greName gre)] }
+           ; return $ [IEVar Nothing (to_ie_post_rn $ noLocA $ greName gre)] }
     to_ie _ _ avail@(AvailTC n [_])  -- Exporting the main decl and nothing else
       | availExportsDecl avail
-      = return [IEThingAbs noAnn (to_ie_post_rn $ noLocA n)]
+      = return [IEThingAbs (Nothing, noAnn) (to_ie_post_rn $ noLocA n)]
     to_ie rdr_env iface (AvailTC n cs) =
       case [ xs | avail@(AvailTC x xs) <- mi_exports iface
            , x == n
@@ -1957,11 +1988,11 @@ getMinimalImports ie_decls
            ] of
         [xs]
           | all_used xs
-          -> return [IEThingAll noAnn (to_ie_post_rn $ noLocA n)]
+          -> return [IEThingAll (Nothing, noAnn) (to_ie_post_rn $ noLocA n)]
           | otherwise
           -> do { let ns_gres = map (expectJust "getMinimalImports AvailTC" . lookupGRE_Name rdr_env) cs
                       ns = map greName ns_gres
-                ; return [IEThingWith noAnn (to_ie_post_rn $ noLocA n) NoIEWildcard
+                ; return [IEThingWith (Nothing, noAnn) (to_ie_post_rn $ noLocA n) NoIEWildcard
                                  (map (to_ie_post_rn . noLocA) (filter (/= n) ns))] }
                                        -- Note [Overloaded field import]
         _other
@@ -1971,8 +2002,8 @@ getMinimalImports ie_decls
                       fs = map fieldGREInfo fs_gres
                 ; return $
                   if all_non_overloaded fs
-                  then map (IEVar noExtField . to_ie_post_rn_var . noLocA) ns
-                  else [IEThingWith noAnn (to_ie_post_rn $ noLocA n) NoIEWildcard
+                  then map (IEVar Nothing . to_ie_post_rn_var . noLocA) ns
+                  else [IEThingWith (Nothing, noAnn) (to_ie_post_rn $ noLocA n) NoIEWildcard
                          (map (to_ie_post_rn . noLocA) (filter (/= n) ns))] }
         where
 

compiler/GHC/Rename/Pat.hs

@@ -830,7 +830,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                              HsRecFieldCon {} -> arg_in_scope lbl
                              _other           -> True ]
 
-           ; addUsedGREs dot_dot_gres
+           ; addUsedGREs NoDeprecationWarnings dot_dot_gres
            ; let locn = noAnnSrcSpan loc
            ; return [ L (noAnnSrcSpan loc) (HsFieldBind
                         { hfbAnn = noAnn

compiler/GHC/Runtime/Loader.hs

@@ -357,7 +357,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
             case mb_iface of
                 Just iface -> do
                     -- Try and find the required name in the exports
-                    let decl_spec = ImpDeclSpec { is_mod = mod_name, is_as = mod_name
+                    let decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod_name
                                                 , is_qual = False, is_dloc = noSrcSpan }
                         imp_spec = ImpSpec decl_spec ImpAll
                         env = mkGlobalRdrEnv

compiler/GHC/Tc/Errors/Ppr.hs

@@ -1095,8 +1095,14 @@ instance Diagnostic TcRnMessage where
           , pprWarningTxtForMsg pragma_warning_msg ]
           where
             impMsg  = text "imported from" <+> ppr pragma_warning_import_mod <> extra
-            extra | pragma_warning_import_mod == pragma_warning_defined_mod = empty
+            extra | maybe True (pragma_warning_import_mod ==) pragma_warning_defined_mod = empty
                   | otherwise = text ", but defined in" <+> ppr pragma_warning_defined_mod
+    TcRnDifferentExportWarnings name locs
+      -> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "exported with different error messages",
+                                   text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)]
+    TcRnIncompleteExportWarnings name locs
+      -> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "will not have its export warned about",
+                                   text "missing export warning at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)]
     TcRnIllegalHsigDefaultMethods name meths
       -> mkSimpleDecorated $
         text "Illegal default method" <> plural (NE.toList meths) <+> text "in class definition of" <+> ppr name <+> text "in hsig file"
@@ -2180,6 +2186,10 @@ instance Diagnostic TcRnMessage where
       -> WarningWithoutFlag
     TcRnPragmaWarning{pragma_warning_msg}
       -> WarningWithCategory (warningTxtCategory pragma_warning_msg)
+    TcRnDifferentExportWarnings _ _
+      -> ErrorWithoutFlag
+    TcRnIncompleteExportWarnings _ _
+      -> WarningWithFlag Opt_WarnIncompleteExportWarnings
     TcRnIllegalHsigDefaultMethods{}
       -> ErrorWithoutFlag
     TcRnHsigFixityMismatch{}
@@ -2818,6 +2828,10 @@ instance Diagnostic TcRnMessage where
       -> [SuggestSpecialiseVisibilityHints name]
     TcRnPragmaWarning{}
       -> noHints
+    TcRnDifferentExportWarnings _ _
+      -> noHints
+    TcRnIncompleteExportWarnings _ _
+      -> noHints
     TcRnIllegalHsigDefaultMethods{}
       -> noHints
     TcRnIllegalQuasiQuotes{}
@@ -3074,13 +3088,13 @@ instance Diagnostic TcRnMessage where
     TcRnRedundantSourceImport{}
       -> noHints
     TcRnImportLookup (ImportLookupBad k _ is ie patsyns_enabled) ->
-      let mod = is_mod is
+      let mod_name = moduleName $ is_mod is
           occ = rdrNameOcc $ ieName ie
       in case k of
-        BadImportAvailVar         -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod]
+        BadImportAvailVar         -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name]
         BadImportNotExported      -> noHints
-        BadImportAvailTyCon       -> [ImportSuggestion occ $ CouldAddTypeKeyword (is_mod is)]
-        BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (is_mod is, patsyns_enabled)) par]
+        BadImportAvailTyCon       -> [ImportSuggestion occ $ CouldAddTypeKeyword mod_name]
+        BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par]
         BadImportNotExportedSubordinates{} -> noHints
     TcRnImportLookup{}
       -> noHints
@@ -3272,7 +3286,7 @@ dodgy_msg kind tc ie
              , text "but it is not a type constructor or a class" ]
 
 dodgy_msg_insert :: GlobalRdrElt -> IE GhcRn
-dodgy_msg_insert tc_gre = IEThingAll noAnn ii
+dodgy_msg_insert tc_gre = IEThingAll (Nothing, noAnn) ii
   where
     ii = noLocA (IEName noExtField $ noLocA $ greName tc_gre)
 
@@ -5322,7 +5336,7 @@ pprImportLookup = \case
     let
       pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc
       pprImpDeclSpec iface decl_spec =
-        quotes (ppr (is_mod decl_spec)) <+> case mi_boot iface of
+        quotes (ppr (moduleName $ is_mod decl_spec)) <+> case mi_boot iface of
             IsBoot  -> text "(hi-boot interface)"
             NotBoot -> empty
       withContext msgs =

compiler/GHC/Tc/Errors/Types.hs

@@ -2528,9 +2528,31 @@ data TcRnMessage where
     pragma_warning_occ :: OccName,
     pragma_warning_msg :: WarningTxt GhcRn,
     pragma_warning_import_mod :: ModuleName,
-    pragma_warning_defined_mod :: ModuleName
+    pragma_warning_defined_mod :: Maybe ModuleName
   } -> TcRnMessage
 
+  {-| TcRnDifferentExportWarnings is an error that occurs when the
+     warning messages for exports of a name differ between several export items.
+
+     Test case:
+      DifferentExportWarnings
+  -}
+  TcRnDifferentExportWarnings :: !Name -- ^ The name with different export warnings
+                              -> NE.NonEmpty SrcSpan -- ^ The locations of export list items that differ
+                                            --   from the one at which the error is reported
+                              -> TcRnMessage
+
+  {-| TcRnIncompleteExportWarnings is a warning (controlled by -Wincomplete-export-warnings) that
+     occurs when some of the exports of a name do not have an export warning and some do
+
+     Test case:
+      ExportWarnings6
+  -}
+  TcRnIncompleteExportWarnings :: !Name -- ^ The name that is exported
+                               -> NE.NonEmpty SrcSpan -- ^ The locations of export list items that are
+                                             --   missing the export warning
+                               -> TcRnMessage
+
   {-| TcRnIllegalHsigDefaultMethods is an error that occurs when a binding for
      a class default method is provided in a Backpack signature file.
 

compiler/GHC/Tc/Gen/Export.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE TupleSections     #-}
 
 module GHC.Tc.Gen.Export (rnExports, exports_from_avail, classifyGREs) where
 
@@ -15,12 +16,14 @@ 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.Outputable
 import GHC.Utils.Panic
@@ -33,7 +36,7 @@ import GHC.Driver.DynFlags
 import GHC.Parser.PostProcess ( setRdrNameSpace )
 import qualified GHC.LanguageExtensions as LangExt
 
-import GHC.Types.Unique.Set
+import GHC.Types.Unique.Map
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Name
 import GHC.Types.Name.Env
@@ -48,6 +51,7 @@ import Control.Arrow ( first )
 import Control.Monad ( when )
 import qualified Data.List.NonEmpty as NE
 import Data.Traversable   ( for )
+import Data.List ( sortBy )
 
 {-
 ************************************************************************
@@ -133,22 +137,34 @@ into @[C{C, T;}, T{T, D;}]@ (which satisfies the AvailTC invariant).
 
 data ExportAccum        -- The type of the accumulating parameter of
                         -- the main worker function in rnExports
-     = ExportAccum
-        ExportOccMap           --  Tracks exported occurrence names
-        (UniqSet ModuleName)   --  Tracks (re-)exported module names
+     = ExportAccum {
+         expacc_exp_occs :: ExportOccMap,
+           -- ^ Tracks exported occurrence names
+         expacc_mods :: UniqMap ModuleName [Name],
+           -- ^ Tracks (re-)exported module names
+           --   and the names they re-export
+         expacc_warn_spans :: ExportWarnSpanNames,
+           -- ^ Information about warnings for names
+         expacc_dont_warn :: DontWarnExportNames
+           -- ^ What names not to export warnings for
+           --   (because they are exported without a warning)
+     }
+
 
 emptyExportAccum :: ExportAccum
-emptyExportAccum = ExportAccum emptyOccEnv emptyUniqSet
+emptyExportAccum = ExportAccum emptyOccEnv emptyUniqMap [] emptyNameEnv
 
-accumExports :: (ExportAccum -> x -> TcRn (Maybe (ExportAccum, y)))
+accumExports :: (ExportAccum -> x -> TcRn (ExportAccum, Maybe y))
              -> [x]
-             -> TcRn [y]
-accumExports f = fmap (catMaybes . snd) . mapAccumLM f' emptyExportAccum
-  where f' acc x = do
-          m <- attemptM (f acc x)
-          pure $ case m of
-            Just (Just (acc', y)) -> (acc', Just y)
-            _                     -> (acc, Nothing)
+             -> TcRn ([y], ExportWarnSpanNames, DontWarnExportNames)
+accumExports f xs = do
+  (ExportAccum _ _ export_warn_spans dont_warn_export, ys)
+    <- mapAccumLM f' emptyExportAccum xs
+  return ( catMaybes ys
+         , export_warn_spans
+         , dont_warn_export )
+  where f' acc x
+          = fromMaybe (acc, Nothing) <$> attemptM (f acc x)
 
 type ExportOccMap = OccEnv (Name, IE GhcPs)
         -- Tracks what a particular exported OccName
@@ -173,6 +189,7 @@ rnExports explicit_mod exports
               TcGblEnv { tcg_mod     = this_mod
                        , tcg_rdr_env = rdr_env
                        , tcg_imports = imports
+                       , tcg_warns   = warns
                        , tcg_src     = hsc_src } = tcg_env
               default_main | mainModIs (hsc_HUE hsc_env) == this_mod
                            , Just main_fun <- mainFunIs dflags
@@ -188,7 +205,7 @@ rnExports explicit_mod exports
         ; let real_exports
                  | explicit_mod = exports
                  | has_main
-                          = Just (noLocA [noLocA (IEVar noExtField
+                          = Just (noLocA [noLocA (IEVar Nothing
                                      (noLocA (IEName noExtField $ noLocA default_main)))])
                         -- ToDo: the 'noLoc' here is unhelpful if 'main'
                         --       turns out to be out of scope
@@ -196,7 +213,7 @@ rnExports explicit_mod exports
 
         -- Rename the export list
         ; let do_it = exports_from_avail real_exports rdr_env imports this_mod
-        ; (rn_exports, final_avails)
+        ; (rn_exports, final_avails, new_export_warns)
             <- if hsc_src == HsigFile
                 then do (mb_r, msgs) <- tryTc do_it
                         case mb_r of
@@ -214,7 +231,17 @@ rnExports explicit_mod exports
                                                 Nothing -> Nothing
                                                 Just _  -> rn_exports
                           , tcg_dus = tcg_dus tcg_env `plusDU`
-                                      usesOnly final_ns }) }
+                                      usesOnly final_ns
+                          , tcg_warns = insertWarnExports
+                                        warns new_export_warns}) }
+
+-- | List of names and the information about their warnings
+--   (warning, export list item span)
+type ExportWarnSpanNames = [(Name, WarningTxt GhcRn, SrcSpan)]
+
+-- | Map from names that should not have export warnings to
+--   the spans of export list items that are missing those warnings
+type DontWarnExportNames = NameEnv (NE.NonEmpty SrcSpan)
 
 exports_from_avail :: Maybe (LocatedL [LIE GhcPs])
                          -- ^ 'Nothing' means no explicit export list
@@ -224,8 +251,8 @@ exports_from_avail :: Maybe (LocatedL [LIE GhcPs])
                          -- @module Foo@ export is valid (it's not valid
                          -- if we didn't import @Foo@!)
                    -> Module
-                   -> RnM (Maybe [(LIE GhcRn, Avails)], Avails)
-                         -- (Nothing, _) <=> no explicit export list
+                   -> RnM (Maybe [(LIE GhcRn, Avails)], Avails, ExportWarnNames GhcRn)
+                         -- (Nothing, _, _) <=> no explicit export list
                          -- if explicit export list is present it contains
                          -- each renamed export item together with its exported
                          -- names.
@@ -240,7 +267,7 @@ exports_from_avail Nothing rdr_env _imports _this_mod
     ; let avails =
             map fix_faminst . gresToAvailInfo
               . filter isLocalGRE . globalRdrEnvElts $ rdr_env
-    ; return (Nothing, avails) }
+    ; return (Nothing, avails, []) }
   where
     -- #11164: when we define a data instance
     -- but not data family, re-export the family
@@ -256,12 +283,14 @@ exports_from_avail Nothing rdr_env _imports _this_mod
 
 
 exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
-  = do ie_avails <- accumExports do_litem rdr_items
+  = do (ie_avails, export_warn_spans, dont_warn_export)
+         <- accumExports do_litem rdr_items
        let final_exports = nubAvails (concatMap snd ie_avails) -- Combine families
-       return (Just ie_avails, final_exports)
+       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 (Maybe (ExportAccum, (LIE GhcRn, Avails)))
+             -> RnM (ExportAccum, Maybe (LIE GhcRn, Avails))
     do_litem acc lie = setSrcSpan (getLocA lie) (exports_from_item acc lie)
 
     -- Maps a parent to its in-scope children
@@ -282,30 +311,45 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
                        , imv <- importedByUser xs ]
 
     exports_from_item :: ExportAccum -> LIE GhcPs
-                      -> RnM (Maybe (ExportAccum, (LIE GhcRn, Avails)))
-    exports_from_item (ExportAccum occs earlier_mods)
-                      (L loc ie@(IEModuleContents _ lmod@(L _ mod)))
-      | mod `elementOfUniqSet` earlier_mods    -- Duplicate export of M
+                      -> RnM (ExportAccum, Maybe (LIE GhcRn, Avails))
+    exports_from_item expacc@ExportAccum{
+                        expacc_exp_occs   = occs,
+                        expacc_mods       = earlier_mods,
+                        expacc_warn_spans = export_warn_spans,
+                        expacc_dont_warn  = dont_warn_export
+                      } (L loc ie@(IEModuleContents (warn_txt_ps, _) lmod@(L _ mod)))
+      | Just exported_names <- lookupUniqMap earlier_mods mod  -- Duplicate export of M
       = do { addDiagnostic (TcRnDupeModuleExport mod)
-           ; return Nothing}
+           ; (export_warn_spans', dont_warn_export', _) <-
+                process_warning export_warn_spans
+                                dont_warn_export
+                                exported_names
+                                warn_txt_ps
+                                (locA loc)
+                   -- Checks if all the names are exported with the same warning message
+                   -- or if they should not be warned about
+           ; return ( expacc{ expacc_warn_spans = export_warn_spans'
+                            , expacc_dont_warn  = dont_warn_export' }
+                    , Nothing ) }
 
       | otherwise
-      = do { let { exportValid = (mod `elem` imported_modules)
-                               || (moduleName this_mod == mod)
-                 ; gre_prs     = pickGREsModExp mod (globalRdrEnvElts rdr_env)
-                 ; new_gres    = [ gre'
-                                 | (gre, _) <- gre_prs
-                                 , gre' <- expand_tyty_gre gre ]
-                 ; new_exports = map availFromGRE new_gres
-                 ; all_gres    = foldr (\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs
-                 ; mods        = addOneToUniqSet earlier_mods mod
+      = do { let { exportValid    = (mod `elem` imported_modules)
+                                  || (moduleName this_mod == mod)
+                 ; gre_prs        = pickGREsModExp mod (globalRdrEnvElts rdr_env)
+                 ; new_gres       = [ gre'
+                                    | (gre, _) <- gre_prs
+                                    , gre' <- expand_tyty_gre gre ]
+                 ; new_exports    = map availFromGRE new_gres
+                 ; all_gres       = foldr (\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs
+                 ; exported_names = map greName new_gres
+                 ; mods           = addToUniqMap earlier_mods mod exported_names
                  }
 
             ; checkErr exportValid (TcRnExportedModNotImported mod)
             ; warnIf (exportValid && null gre_prs) (TcRnNullExportedModule mod)
 
             ; traceRn "efa" (ppr mod $$ ppr all_gres)
-            ; addUsedGREs all_gres
+            ; addUsedGREs ExportDeprecationWarnings all_gres
 
             ; occs' <- check_occs occs ie new_gres
                           -- This check_occs not only finds conflicts
@@ -314,54 +358,114 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
                           -- 'M.x' is in scope in several ways, we'll have
                           -- several members of mod_avails with the same
                           -- OccName.
+            ; (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 $ Just $
-                ( ExportAccum occs' mods
-                , ( L loc (IEModuleContents noExtField lmod)
-                , new_exports) ) }
-
-    exports_from_item acc@(ExportAccum occs mods) (L loc ie) = do
-        m_new_ie <- lookup_doc_ie ie
-        case m_new_ie of
-          Just new_ie -> return $ Just (acc, (L loc new_ie, []))
+            ; 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), new_exports) ) }
+
+    exports_from_item acc lie = do
+        m_doc_ie <- lookup_doc_ie lie
+        case m_doc_ie of
+          Just new_ie -> return (acc, Just (new_ie, []))
           Nothing -> do
-            let finish (occs', new_ie, avail) = (ExportAccum occs' mods, (L loc new_ie, [avail]))
-            fmap finish <$> lookup_ie occs ie
+            m_ie <- lookup_ie acc lie
+            case m_ie of
+              Nothing -> return (acc, Nothing)
+              Just (acc', new_ie, avail)
+                -> return (acc', Just (new_ie, [avail]))
 
     -------------
-    lookup_ie :: ExportOccMap -> IE GhcPs -> RnM (Maybe (ExportOccMap, IE GhcRn, AvailInfo))
-    lookup_ie occs ie@(IEVar ann l)
+    lookup_ie :: ExportAccum -> LIE GhcPs -> RnM (Maybe (ExportAccum, LIE GhcRn, AvailInfo))
+    lookup_ie expacc@ExportAccum{
+            expacc_exp_occs   = occs,
+            expacc_warn_spans = export_warn_spans,
+            expacc_dont_warn  = dont_warn_export
+          } (L loc ie@(IEVar warn_txt_ps l))
         = do mb_gre <- lookupGreAvailRn $ lieWrappedName l
              for mb_gre $ \ gre -> do
                let avail = availFromGRE gre
                    name = greName gre
-               occs' <- check_occs occs ie [gre]
-               return (occs', IEVar ann (replaceLWrappedName l name), avail)
 
-    lookup_ie occs ie@(IEThingAbs ann l)
+               occs' <- check_occs occs ie [gre]
+               (export_warn_spans', dont_warn_export', warn_txt_rn)
+                 <- process_warning export_warn_spans
+                                    dont_warn_export
+                                    [name]
+                                    warn_txt_ps
+                                    (locA loc)
+
+               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))
+                      , avail )
+
+    lookup_ie expacc@ExportAccum{
+            expacc_exp_occs   = occs,
+            expacc_warn_spans = export_warn_spans,
+            expacc_dont_warn  = dont_warn_export
+          } (L loc ie@(IEThingAbs (warn_txt_ps, ann) l))
         = do mb_gre <- lookupGreAvailRn $ lieWrappedName l
              for mb_gre $ \ gre -> do
                let avail = availFromGRE gre
                    name = greName gre
-               occs' <- check_occs occs ie [gre]
-               return ( occs'
-                      , IEThingAbs ann (replaceLWrappedName l name)
-                      , avail)
 
-    lookup_ie occs ie@(IEThingAll ann l)
+               occs' <- check_occs occs ie [gre]
+               (export_warn_spans', dont_warn_export', warn_txt_rn)
+                 <- process_warning export_warn_spans
+                                    dont_warn_export
+                                    [name]
+                                    warn_txt_ps
+                                    (locA loc)
+
+               return ( expacc{ expacc_exp_occs   = occs'
+                              , expacc_warn_spans = export_warn_spans'
+                              , expacc_dont_warn  = dont_warn_export' }
+                      , L loc (IEThingAbs (warn_txt_rn, ann) (replaceLWrappedName l name))
+                      , avail )
+
+    lookup_ie expacc@ExportAccum{
+            expacc_exp_occs   = occs,
+            expacc_warn_spans = export_warn_spans,
+            expacc_dont_warn  = dont_warn_export
+          } (L loc ie@(IEThingAll (warn_txt_ps, ann) l))
         = do mb_gre <- lookupGreAvailRn $ lieWrappedName l
              for mb_gre $ \ par -> do
                all_kids <- lookup_ie_kids_all ie l par
                let name = greName par
-                   kids_avails = map greName all_kids
-               occs' <- check_occs occs ie (par:all_kids)
-               return ( occs'
-                       , IEThingAll ann (replaceLWrappedName l name)
-                       , AvailTC name (name:kids_avails))
-
-    lookup_ie occs ie@(IEThingWith ann l wc sub_rdrs)
+                   all_gres = par : all_kids
+                   all_names = map greName 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)
+
+               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))
+                      , AvailTC name all_names )
+
+    lookup_ie expacc@ExportAccum{
+            expacc_exp_occs   = occs,
+            expacc_warn_spans = export_warn_spans,
+            expacc_dont_warn  = dont_warn_export
+          } (L loc ie@(IEThingWith (warn_txt_ps, ann) l wc sub_rdrs))
         = do mb_gre <- addExportErrCtxt ie
                      $ lookupGreAvailRn $ lieWrappedName l
              for mb_gre $ \ par -> do
@@ -376,11 +480,22 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
 
                let name = greName par
                    all_kids = with_kids ++ wc_kids
-                   kids_avails = map greName all_kids
-               occs' <- check_occs occs ie (par:all_kids)
-               return ( occs'
-                       , IEThingWith ann (replaceLWrappedName l name) wc subs
-                       , AvailTC name (name:kids_avails))
+                   all_gres = par : all_kids
+                   all_names = map greName 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)
+
+               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)
+                      , AvailTC name all_names )
 
     lookup_ie _ _ = panic "lookup_ie"    -- Other cases covered earlier
 
@@ -407,21 +522,102 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
          ; return gres }
 
     -------------
-    lookup_doc_ie :: IE GhcPs -> RnM (Maybe (IE GhcRn))
-    lookup_doc_ie (IEGroup _ lev doc) = do
+
+    rn_warning_txt_loc :: LocatedP (WarningTxt GhcPs) -> RnM (LocatedP (WarningTxt GhcRn))
+    rn_warning_txt_loc (L loc warn_txt) = L loc <$> rnWarningTxt warn_txt
+
+    -- Runs for every Name
+    -- - If there is no new warning, flags that the old warning should not be
+    --     included (since a warning should only be emitted if all
+    --     of the export statements have a warning)
+    -- - If the Name already has a warning, adds it
+    process_warning :: ExportWarnSpanNames       -- Old aggregate data about warnins
+                    -> DontWarnExportNames       -- Old names not to warn about
+                    -> [Name]                              -- Names to warn about
+                    -> Maybe (LocatedP (WarningTxt GhcPs)) -- Warning
+                    -> SrcSpan                             -- Span of the export list item
+                    -> RnM (ExportWarnSpanNames, -- Aggregate data about the warnings
+                            DontWarnExportNames, -- Names not to warn about in the end
+                                                 -- (when there was a non-warned export)
+                            Maybe (LocatedP (WarningTxt GhcRn))) -- Renamed warning
+    process_warning export_warn_spans
+                    dont_warn_export
+                    names Nothing loc
+      = return ( export_warn_spans
+               , foldr update_dont_warn_export
+                       dont_warn_export names
+               , Nothing )
+      where
+        update_dont_warn_export :: Name -> DontWarnExportNames -> DontWarnExportNames
+        update_dont_warn_export name dont_warn_export'
+          = extendNameEnv_Acc (NE.<|)
+                              NE.singleton
+                              dont_warn_export'
+                              name
+                              loc
+
+    process_warning export_warn_spans
+                    dont_warn_export
+                    names (Just warn_txt_ps) loc
+      = do
+          warn_txt_rn <- rn_warning_txt_loc warn_txt_ps
+          let new_export_warn_spans = map (, unLoc warn_txt_rn, loc) names
+          return ( new_export_warn_spans ++ export_warn_spans
+                 , dont_warn_export
+                 , Just warn_txt_rn )
+
+    -- For each name exported with any warnings throws an error
+    --   if there are any exports of that name with a different warning
+    aggregate_warnings :: ExportWarnSpanNames
+                       -> DontWarnExportNames
+                       -> RnM (ExportWarnNames GhcRn)
+    aggregate_warnings export_warn_spans dont_warn_export
+      = fmap catMaybes
+      $ mapM (aggregate_single . extract_name)
+      $ NE.groupBy (\(n1, _, _) (n2, _, _) -> n1 == n2)
+      $ sortBy (\(n1, _, _) (n2, _, _) -> n1 `compare` n2) export_warn_spans
+      where
+        extract_name :: NE.NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
+                     -> (Name, NE.NonEmpty (WarningTxt GhcRn, SrcSpan))
+        extract_name l@((name, _, _) NE.:| _)
+          = (name, NE.map (\(_, warn_txt, span) -> (warn_txt, span)) l)
+
+        aggregate_single :: (Name, NE.NonEmpty (WarningTxt GhcRn, SrcSpan))
+                         -> RnM (Maybe (Name, WarningTxt GhcRn))
+        aggregate_single (name, (warn_txt_rn, loc) NE.:| warn_spans)
+          = do
+              -- Emit an error if the warnings differ
+              case NE.nonEmpty spans_different of
+                Nothing -> return ()
+                Just spans_different
+                  -> addErrAt loc (TcRnDifferentExportWarnings name spans_different)
+              -- Emit a warning if some export list items do not have a warning
+              case lookupNameEnv dont_warn_export name of
+                Nothing -> return $ Just (name, warn_txt_rn)
+                Just not_warned_spans -> do
+                  addDiagnosticAt loc (TcRnIncompleteExportWarnings name not_warned_spans)
+                  return Nothing
+          where
+            spans_different = map snd $ filter (not . warningTxtSame warn_txt_rn . fst) warn_spans
+
+    -------------
+    lookup_doc_ie :: LIE GhcPs -> RnM (Maybe (LIE GhcRn))
+    lookup_doc_ie (L loc (IEGroup _ lev doc)) = do
       doc' <- rnLHsDoc doc
-      pure $ Just (IEGroup noExtField lev doc')
-    lookup_doc_ie (IEDoc _ doc)       = do
+      pure $ Just (L loc (IEGroup noExtField lev doc'))
+    lookup_doc_ie (L loc (IEDoc _ doc))       = do
       doc' <- rnLHsDoc doc
-      pure $ Just (IEDoc noExtField doc')
-    lookup_doc_ie (IEDocNamed _ str)  = pure $ Just (IEDocNamed noExtField str)
+      pure $ Just (L loc (IEDoc noExtField doc'))
+    lookup_doc_ie (L loc (IEDocNamed _ str))
+      = pure $ Just (L loc (IEDocNamed noExtField str))
     lookup_doc_ie _ = pure Nothing
 
     -- In an export item M.T(A,B,C), we want to treat the uses of
     -- A,B,C as if they were M.A, M.B, M.C
     -- Happily pickGREs does just the right thing
     addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM ()
-    addUsedKids parent_rdr kid_gres = addUsedGREs (pickGREs parent_rdr kid_gres)
+    addUsedKids parent_rdr kid_gres
+      = addUsedGREs ExportDeprecationWarnings (pickGREs parent_rdr kid_gres)
 
 -- Renaming and typechecking of exports happens after everything else has
 -- been typechecked.
@@ -503,7 +699,8 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items
         doOne n = do
 
           let bareName = (ieWrappedName . unLoc) n
-              lkup v = lookupSubBndrOcc_helper False DisableDeprecationWarnings -- Do not report export list deprecations
+                -- Do not report export list declaration deprecations
+              lkup v = lookupSubBndrOcc_helper False ExportDeprecationWarnings
                         spec_parent (setRdrNameSpace bareName v)
 
           name <-  combineChildLookupResult $ map lkup $

compiler/GHC/Tc/Gen/Expr.hs

@@ -54,7 +54,7 @@ import GHC.Tc.Gen.Bind        ( tcLocalBinds )
 import GHC.Tc.Instance.Family ( tcGetFamInstEnvs )
 import GHC.Core.FamInstEnv    ( FamInstEnvs )
 import GHC.Rename.Expr        ( mkExpandedExpr )
-import GHC.Rename.Env         ( addUsedGRE, getUpdFieldLbls, DeprecationWarnings(EnableDeprecationWarnings) )
+import GHC.Rename.Env         ( addUsedGRE, getUpdFieldLbls, DeprecationWarnings(..) )
 import GHC.Tc.Utils.Env
 import GHC.Tc.Gen.Arrow
 import GHC.Tc.Gen.Match
@@ -1423,7 +1423,7 @@ disambiguateRecordBinds record_expr record_rho possible_parents rbnds res_ty
              -- Mark the record fields as used, now that we have disambiguated.
              -- There is no risk of duplicate deprecation warnings, as we have
              -- not marked the GREs as used previously.
-           ; setSrcSpanA loc $ mapM_ (addUsedGRE EnableDeprecationWarnings) mb_gre
+           ; setSrcSpanA loc $ mapM_ (addUsedGRE AllDeprecationWarnings) mb_gre
            ; sel <- tcLookupId (greName fld_gre)
            ; return $ L l HsFieldBind
                { hfbAnn = hfbAnn upd

compiler/GHC/Tc/Instance/Class.hs

@@ -23,7 +23,7 @@ import GHC.Tc.Utils.TcMType
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.Origin (InstanceWhat (..), SafeOverlapping)
 import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst )
-import GHC.Rename.Env( addUsedGRE, DeprecationWarnings(EnableDeprecationWarnings) )
+import GHC.Rename.Env( addUsedGRE, DeprecationWarnings (..) )
 
 import GHC.Builtin.Types
 import GHC.Builtin.Types.Prim
@@ -942,7 +942,7 @@ matchHasField dflags short_cut clas tys
                      -- it must not be higher-rank.
                    ; if not (isNaughtyRecordSelector sel_id) && isTauTy sel_ty
                      then do { -- See Note [Unused name reporting and HasField]
-                               addUsedGRE EnableDeprecationWarnings gre
+                               addUsedGRE AllDeprecationWarnings gre
                              ; keepAlive (greName gre)
                              ; return OneInst { cir_new_theta   = theta
                                               , cir_mk_ev       = mk_ev

compiler/GHC/Tc/Module.hs

@@ -1691,7 +1691,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
                                  -- tcg_dus: see Note [Newtype constructor usage in foreign declarations]
 
         -- See Note [Newtype constructor usage in foreign declarations]
-        addUsedGREs (bagToList fo_gres) ;
+        addUsedGREs NoDeprecationWarnings (bagToList fo_gres) ;
 
         return (tcg_env', tcl_env)
     }}}}}}

compiler/GHC/Tc/Solver/Monad.hs

@@ -198,6 +198,7 @@ import Data.List ( mapAccumL )
 import Data.Foldable
 import qualified Data.Semigroup as S
 import GHC.Types.SrcLoc
+import GHC.Rename.Env
 
 #if defined(DEBUG)
 import GHC.Types.Unique.Set (nonDetEltsUniqSet)
@@ -1372,7 +1373,7 @@ tcLookupTyCon n = wrapTcS $ TcM.tcLookupTyCon n
 -- might), so it's not worth losing sleep over.
 recordUsedGREs :: Bag GlobalRdrElt -> TcS ()
 recordUsedGREs gres
-  = do { wrapTcS $ TcM.addUsedGREs gre_list
+  = do { wrapTcS $ TcM.addUsedGREs NoDeprecationWarnings gre_list
          -- If a newtype constructor was imported, don't warn about not
          -- importing it...
        ; wrapTcS $ traverse_ (TcM.keepAlive . greName) gre_list }