Check if dependency HIE files already indexed

Author: nlander

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

@@ -21,6 +21,7 @@ module Development.IDE.Core.Compile
   , generateByteCode
   , generateHieAsts
   , writeAndIndexHieFile
+  , HieDbModuleQuery(..)
   , indexHieFile
   , writeHiFile
   , getModSummaryFromImports
@@ -859,6 +860,10 @@ spliceExpressions Splices{..} =
         , DL.fromList $ map fst awSplices
         ]
 
+data HieDbModuleQuery
+  = HieDbModuleQuery ModuleName Unit
+  | DontCheckForModule
+
 -- | In addition to indexing the `.hie` file, this function is responsible for
 -- maintaining the 'IndexQueue' state and notifying the user about indexing
 -- progress.
@@ -887,16 +892,14 @@ spliceExpressions Splices{..} =
 -- TVar to 0 in order to set it up for a fresh indexing session. Otherwise, we
 -- can just increment the 'indexCompleted' TVar and exit.
 --
-indexHieFile :: ShakeExtras -> NormalizedFilePath -> HieDb.SourceFile -> Util.Fingerprint -> Compat.HieFile -> IO ()
-indexHieFile se hiePath sourceFile !hash hf = do
+indexHieFile :: ShakeExtras -> HieDbModuleQuery -> NormalizedFilePath -> HieDb.SourceFile -> Util.Fingerprint -> Compat.HieFile -> IO ()
+indexHieFile se query hiePath sourceFile !hash hf = do
  IdeOptions{optProgressStyle} <- getIdeOptionsIO se
  atomically $ do
   pending <- readTVar indexPending
   case HashMap.lookup hiePath pending of
     Just pendingHash | pendingHash == hash -> pure () -- An index is already scheduled
     _ -> do
-      -- hiedb doesn't use the Haskell src, so we clear it to avoid unnecessarily keeping it around
-      let !hf' = hf{hie_hs_src = mempty}
       modifyTVar' indexPending $ HashMap.insert hiePath hash
       writeTQueue indexQueue $ \withHieDb -> do
         -- We are now in the worker thread
@@ -911,8 +914,24 @@ indexHieFile se hiePath sourceFile !hash hf = do
           -- Using bracket, so even if an exception happen during withHieDb call,
           -- the `post` (which clean the progress indicator) will still be called.
           bracket_ (pre optProgressStyle) post $
-            withHieDb (\db -> HieDb.addRefsFromLoaded db (fromNormalizedFilePath hiePath) sourceFile hash hf')
+            withHieDb indexIfNotAlready
   where
+    -- hiedb doesn't use the Haskell src, so we clear it to avoid unnecessarily keeping it around
+    hf' :: Compat.HieFile
+    !hf' = hf{hie_hs_src = mempty}
+    indexIfNotAlready :: HieDb -> IO ()
+    indexIfNotAlready db = case query of
+      DontCheckForModule -> doIndexing
+      HieDbModuleQuery moduleName unit -> do
+        mRow <- HieDb.lookupHieFile db moduleName unit
+        case mRow of
+          Nothing -> doIndexing
+          Just _row -> return ()
+      where
+        doIndexing :: IO ()
+        doIndexing =
+          HieDb.addRefsFromLoaded db (fromNormalizedFilePath hiePath) sourceFile hash hf'
+
     HieDbWriter{..} = hiedbWriter se
 
     -- Get a progress token to report progress and update it for the current file
@@ -1005,7 +1024,7 @@ writeAndIndexHieFile hscEnv se mod_summary srcPath exports ast source =
       GHC.mkHieFile' mod_summary exports ast source
     atomicFileWrite se targetPath $ flip GHC.writeHieFile hf
     hash <- Util.getFileHash targetPath
-    indexHieFile se (toNormalizedFilePath' targetPath) (HieDb.RealFile $ fromNormalizedFilePath srcPath) hash hf
+    indexHieFile se DontCheckForModule (toNormalizedFilePath' targetPath) (HieDb.RealFile $ fromNormalizedFilePath srcPath) hash hf
   where
     dflags       = hsc_dflags hscEnv
     mod_location = ms_location mod_summary

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

@@ -876,7 +876,7 @@ getModIfaceFromDiskAndIndexRule recorder =
         -- can just re-index the file we read from disk
         Right hf -> liftIO $ do
           logWith recorder Logger.Debug $ LogReindexingHieFile f
-          indexHieFile se (toNormalizedFilePath' hie_loc) (HieDb.RealFile $ fromNormalizedFilePath f) hash hf
+          indexHieFile se DontCheckForModule (toNormalizedFilePath' hie_loc) (HieDb.RealFile $ fromNormalizedFilePath f) hash hf
 
   return (Just x)
 

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

@@ -27,6 +27,7 @@ module Development.IDE.GHC.Compat.Units (
     unitHiddenModules,
     unitLibraryDirs,
     UnitInfo.unitId,
+    UnitInfo.mkUnit,
     unitDepends,
     unitHaddockInterfaces,
     unitInfoId,
@@ -125,7 +126,6 @@ type PreloadUnitClosure = ()
 type Unit = UnitId
 #endif
 
-
 #if !MIN_VERSION_ghc(9,0,0)
 unitString :: Unit -> String
 unitString = Module.unitIdString

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

@@ -26,7 +26,7 @@ import qualified Data.Set                        as Set
 import qualified Data.Text                       as T
 import           Data.Unique                     (Unique)
 import qualified Data.Unique                     as Unique
-import           Development.IDE.Core.Compile    (indexHieFile, loadHieFile)
+import           Development.IDE.Core.Compile    (HieDbModuleQuery(HieDbModuleQuery), indexHieFile, loadHieFile)
 import           Development.IDE.Core.Shake      (ShakeExtras(ideNc, logger), mkUpdater)
 import           Development.IDE.GHC.Compat
 import qualified Development.IDE.GHC.Compat.Util as Maybes
@@ -127,19 +127,25 @@ newHscEnvEqWithImportPaths envImportPaths se hscEnv deps = do
                   (libraryDir : _) -> libraryDir
                 hieDir :: FilePath
                 hieDir = pkgLibDir </> "extra-compilation-artifacts"
+                packageUnit :: Unit
+                packageUnit = mkUnit package
             modIfaces <- mapMaybeM loadModIface modules
-            traverse_ (indexModuleHieFile hieDir) modIfaces
-        indexModuleHieFile :: FilePath -> ModIface -> IO ()
-        indexModuleHieFile hieDir modIface = do
-            let hiePath :: FilePath
-                hiePath = hieDir </> toFilePath (moduleName $ mi_module modIface) ++ ".hie"
+            traverse_ (indexModuleHieFile hieDir packageUnit) modIfaces
+        indexModuleHieFile :: FilePath -> Unit -> ModIface -> IO ()
+        indexModuleHieFile hieDir packageUnit modIface = do
+            let modName :: ModuleName
+                modName = moduleName $ mi_module modIface
+                hiePath :: FilePath
+                hiePath = hieDir </> toFilePath modName ++ ".hie"
+                query :: HieDbModuleQuery
+                query = HieDbModuleQuery modName packageUnit
             hieResults <- tryAny $ loadHieFile (mkUpdater $ ideNc se) hiePath
             case hieResults of
               Left e -> Logger.logDebug (logger se) $
                   "Failed to index dependency HIE file:\n"
                   <> T.pack (show e)
               Right hie ->
-                  indexHieFile se (toNormalizedFilePath' hiePath) (FakeFile Nothing) (mi_src_hash modIface) hie
+                  indexHieFile se query (toNormalizedFilePath' hiePath) (FakeFile Nothing) (mi_src_hash modIface) hie
         toFilePath :: ModuleName -> FilePath
         toFilePath = separateDirectories . prettyModuleName
             where