wip

Author: amesgen

ghcide/src/Development/IDE/GHC/Compat/Core.hs

@@ -86,6 +86,7 @@ module Development.IDE.GHC.Compat.Core (
     loadInterface,
     SourceModified(..),
     loadModuleInterface,
+    Warnings(..),
     RecompileRequired(..),
 #if MIN_VERSION_ghc(8,10,0)
     mkPartialIface,
@@ -614,6 +615,7 @@ import           GHC.Unit.Module.ModGuts
 import           GHC.Unit.Module.ModIface     (IfaceExport, ModIface (..),
                                                ModIface_ (..))
 import           GHC.Unit.Module.ModSummary   (ModSummary (..))
+import           GHC.Unit.Module.Warnings     (Warnings (..))
 #endif
 import           GHC.Unit.State               (ModuleOrigin (..))
 import           GHC.Utils.Error              (Severity (..))

ghcide/src/Development/IDE/Types/Exports.hs

@@ -119,7 +119,7 @@ createExportsMap modIface = do
   ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList
   where
     doOne modIFace = do
-      let getModDetails = unpackAvail $ moduleName $ mi_module modIFace
+      let getModDetails = unpackAvail (moduleName $ mi_module modIFace) (mi_warns modIFace)
       concatMap (fmap (second Set.fromList) . getModDetails) (mi_exports modIFace)
 
 createExportsMapMg :: [ModGuts] -> ExportsMap
@@ -129,8 +129,8 @@ createExportsMapMg modGuts = do
   ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList
   where
     doOne mi = do
-      let getModuleName = moduleName $ mg_module mi
-      concatMap (fmap (second Set.fromList) . unpackAvail getModuleName) (mg_exports mi)
+      let getModDetails = unpackAvail (moduleName $ mg_module mi) (mg_warns mi)
+      concatMap (fmap (second Set.fromList) . getModDetails) (mg_exports mi)
 
 updateExportsMapMg :: [ModGuts] -> ExportsMap -> ExportsMap
 updateExportsMapMg modGuts old = old' <> new
@@ -139,15 +139,15 @@ updateExportsMapMg modGuts old = old' <> new
         old' = deleteAll old (Map.keys $ getModuleExportsMap new)
         deleteAll = foldl' (flip deleteEntriesForModule)
 
-nonInternalModules :: ModuleName -> Bool
-nonInternalModules = not . (".Internal" `isSuffixOf`) . moduleNameString
+isInternalModule :: ModuleName -> Bool
+isInternalModule= (".Internal" `isSuffixOf`) . moduleNameString
 
 type WithHieDb = forall a. (HieDb -> IO a) -> IO a
 
 createExportsMapHieDb :: WithHieDb -> IO ExportsMap
 createExportsMapHieDb withHieDb = do
     mods <- withHieDb getAllIndexedMods
-    idents <- forM (filter (nonInternalModules . modInfoName . hieModInfo) mods) $ \m -> do
+    idents <- forM (filter (not . isInternalModule . modInfoName . hieModInfo) mods) $ \m -> do
         let mn = modInfoName $ hieModInfo m
             mText = pack $ moduleNameString mn
         fmap (wrap . unwrap mText) <$> withHieDb (\hieDb -> getExportsForModule hieDb mn)
@@ -161,10 +161,16 @@ createExportsMapHieDb withHieDb = do
           n = pack (occNameString exportName)
           p = pack . occNameString <$> exportParent
 
-unpackAvail :: ModuleName -> IfaceExport -> [(Text, Text, [IdentInfo])]
-unpackAvail mn
-  | nonInternalModules mn = map f . mkIdentInfos mod
-  | otherwise = const []
+unpackAvail :: ModuleName -> Warnings -> IfaceExport -> [(Text, Text, [IdentInfo])]
+unpackAvail mn warnings
+  | isInternalModule mn = const []
+  | otherwise = case warnings of
+      NoWarnings -> map f . mkIdentInfos mod
+      WarnAll {} -> const []
+      WarnSome deprThings -> do
+        let deprNames = Set.fromList $ fst <$> deprThings
+            notDeprecated = not . flip Set.member deprNames
+        map f . filter (notDeprecated . name) . mkIdentInfos mod
   where
     !mod = pack $ moduleNameString mn
     f id@IdentInfo {..} = (printOutputable name, moduleNameText,[id])