Initialize ExportsMap using hiedb exports

Author: pepeiborra

cabal.project

@@ -22,7 +22,7 @@ packages:
          ./plugins/hls-pragmas-plugin
          ./plugins/hls-module-name-plugin
          ./plugins/hls-ormolu-plugin
-tests: true
+         ../HieDb
 
 package *
   ghc-options: -haddock
@@ -34,6 +34,12 @@ source-repository-package
   location: https://github.com/hsyl20/ghc-api-compat
   tag: 8fee87eac97a538dbe81ff1ab18cff10f2f9fa15
 
+source-repository-package
+  type: git
+  location: https://github.com/pepeiborra/HieDb
+  tag: d983a61a0ff97b4e01e13d3da8e9023fcdff7f64
+
+
 write-ghc-environment-files: never
 
 index-state: 2021-06-21T19:57:32Z

ghcide/ghcide.cabal

@@ -59,7 +59,7 @@ library
         hie-compat ^>= 0.2.0.0,
         hls-plugin-api ^>= 1.1.0.0,
         lens,
-        hiedb == 0.3.0.*,
+        hiedb == 0.4.0.*,
         lsp-types == 1.2.*,
         lsp == 1.2.*,
         mtl,

ghcide/session-loader/Development/IDE/Session.hs

@@ -398,7 +398,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
           restartShakeSession []
 
           -- Typecheck all files in the project on startup
-          checkProject <- getCheckProject
+          checkProject <- pure False -- getCheckProject
           unless (null cs || not checkProject) $ do
                 cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations cs)
                 void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do

ghcide/src/Development/IDE/Core/OfInterest.hs

@@ -19,24 +19,19 @@ module Development.IDE.Core.OfInterest(
 import           Control.Concurrent.Strict
 import           Control.Monad
 import           Control.Monad.IO.Class
-import           Data.HashMap.Strict                          (HashMap)
-import qualified Data.HashMap.Strict                          as HashMap
-import qualified Data.Text                                    as T
+import           Data.HashMap.Strict                    (HashMap)
+import qualified Data.HashMap.Strict                    as HashMap
+import qualified Data.Text                              as T
 import           Development.IDE.Graph
 
-import           Control.Monad.Trans.Class
-import           Control.Monad.Trans.Maybe
-import qualified Data.ByteString                              as BS
-import           Data.List.Extra                              (nubOrd)
-import           Data.Maybe                                   (catMaybes)
+import qualified Data.ByteString                        as BS
+import           Data.Maybe                             (catMaybes)
 import           Development.IDE.Core.ProgressReporting
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake
-import           Development.IDE.Import.DependencyInformation
 import           Development.IDE.Types.Exports
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Logger
-import           Development.IDE.Types.Options
 
 newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
 instance IsIdeGlobal OfInterestVar
@@ -98,25 +93,13 @@ deleteFileOfInterest state f = do
 kick :: Action ()
 kick = do
     files <- HashMap.keys <$> getFilesOfInterestUntracked
-    ShakeExtras{progress} <- getShakeExtras
+    ShakeExtras{exportsMap, progress} <- getShakeExtras
     liftIO $ progressUpdate progress KickStarted
 
-    -- Update the exports map for FOIs
+    -- Update the exports map
     results <- uses GenerateCore files <* uses GetHieAst files
-
-    -- Update the exports map for non FOIs
-    -- We can skip this if checkProject is True, assuming they never change under our feet.
-    IdeOptions{ optCheckProject = doCheckProject } <- getIdeOptions
-    checkProject <- liftIO doCheckProject
-    ifaces <- if checkProject then return Nothing else runMaybeT $ do
-        deps <- MaybeT $ sequence <$> uses GetDependencies files
-        hiResults <- lift $ uses GetModIface (nubOrd $ foldMap transitiveModuleDeps deps)
-        return $ map hirModIface $ catMaybes hiResults
-
-    ShakeExtras{exportsMap} <- getShakeExtras
     let mguts = catMaybes results
         !exportsMap' = createExportsMapMg mguts
-        !exportsMap'' = maybe mempty createExportsMap ifaces
-    void $ liftIO $ modifyVar' exportsMap $ (exportsMap'' <>) . (exportsMap' <>)
+    void $ liftIO $ modifyVar' exportsMap (exportsMap' <>)
 
     liftIO $ progressUpdate progress KickCompleted

ghcide/src/Development/IDE/Core/Shake.hs

@@ -152,6 +152,8 @@ import           Data.HashSet                           (HashSet)
 import qualified Data.HashSet                           as HSet
 import           Data.IORef.Extra                       (atomicModifyIORef'_,
                                                          atomicModifyIORef_)
+import           Data.Text                              (pack)
+import qualified Development.IDE.Types.Exports          as ExportsMap
 import           HieDb.Types
 import           Ide.Plugin.Config
 import qualified Ide.PluginUtils                        as HLS
@@ -507,6 +509,12 @@ shakeOpen lspEnv defaultConfig logger debouncer
         indexProgressToken <- newVar Nothing
         let hiedbWriter = HieDbWriter{..}
         exportsMap <- newVar mempty
+        -- lazily initialize the exports map with the contents of the hiedb
+        _ <- async $ do
+            logDebug logger "Initializing exports map from hiedb"
+            em <- createExportsMapHieDb hiedb
+            modifyVar' exportsMap (<> em)
+            logDebug logger $ "Done initializing exports map from hiedb (" <> pack(show (ExportsMap.size em)) <> ")"
 
         progress <- do
             let (before, after) = if testing then (0,0.1) else (0.1,0.1)

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

@@ -7,12 +7,13 @@ module Development.IDE.Types.Exports
     createExportsMap,
     createExportsMapMg,
     createExportsMapTc
-) where
+,createExportsMapHieDb,size) where
 
 import           Avail                      (AvailInfo (..))
 import           Control.DeepSeq            (NFData (..))
+import           Control.Monad
 import           Data.Bifunctor             (Bifunctor (second))
-import           Data.HashMap.Strict        (HashMap)
+import           Data.HashMap.Strict        (HashMap, elems)
 import qualified Data.HashMap.Strict        as Map
 import           Data.HashSet               (HashSet)
 import qualified Data.HashSet               as Set
@@ -23,13 +24,17 @@ import           Development.IDE.GHC.Util
 import           FieldLabel                 (flSelector)
 import           GHC.Generics               (Generic)
 import           GhcPlugins                 (IfaceExport, ModGuts (..))
+import           HieDb
 import           Name
 import           TcRnTypes                  (TcGblEnv (..))
 
 newtype ExportsMap = ExportsMap
     {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)}
     deriving newtype (Monoid, NFData, Show)
 
+size :: ExportsMap -> Int
+size = sum . map length . elems . getExportsMap
+
 instance Semigroup ExportsMap where
     ExportsMap a <> ExportsMap b = ExportsMap $ Map.unionWith (<>) a b
 
@@ -104,6 +109,22 @@ createExportsMapTc = ExportsMap . Map.fromListWith (<>) . concatMap doOne
       where
         mn = moduleName $ tcg_mod mi
 
+createExportsMapHieDb :: HieDb -> IO ExportsMap
+createExportsMapHieDb hiedb = do
+    mods <- getAllIndexedMods hiedb
+    idents <- forM mods $ \m -> do
+        let mn = modInfoName $ hieModInfo m
+            mText = pack $ moduleNameString mn
+        fmap (wrap . unwrap mText) <$> getExportsForModule hiedb mn
+    return $ ExportsMap $ Map.fromListWith (<>) (concat idents)
+  where
+    wrap identInfo = (name identInfo, Set.fromList [identInfo])
+    -- unwrap :: ExportRow -> IdentInfo
+    unwrap m ExportRow{..} = IdentInfo n n p exportIsDatacon m
+      where
+          n = pack (occNameString exportName)
+          p = pack . occNameString <$> exportParent
+
 unpackAvail :: ModuleName -> IfaceExport -> [(Text, [IdentInfo])]
 unpackAvail !(pack . moduleNameString -> mod) = map f . mkIdentInfos mod
   where