Only integrate known target in the cache once

Author: guibou

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

@@ -91,7 +91,7 @@ import           Control.Applicative                 (Alternative ((<|>)))
 import           Data.Void
 
 import           Control.Concurrent.STM.Stats        (atomically, modifyTVar',
-                                                      readTVar, writeTVar)
+                                                      readTVar, writeTVar, readTVarIO)
 import           Control.Concurrent.STM.TQueue
 import           Control.DeepSeq
 import           Control.Exception                   (evaluate)
@@ -124,6 +124,7 @@ import           GHC.Driver.Errors.Types
 import           GHC.Types.Error                     (errMsgDiagnostic,
                                                       singleMessage)
 import           GHC.Unit.State
+import Development.IDE (HscEnvEq(..))
 
 #if MIN_VERSION_ghc(9,13,0)
 import           GHC.Driver.Make                     (checkHomeUnitsClosed)
@@ -443,7 +444,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
 
   return $ do
     clientConfig <- getClientConfigAction
-    extras@ShakeExtras{restartShakeSession, ideNc, knownTargetsVar, lspEnv
+    extras@ShakeExtras{restartShakeSession, ideNc, knownTargetsVar, lspEnv, moduleToPathCache
                       } <- getShakeExtras
     let invalidateShakeCache = do
             void $ modifyVar' version succ
@@ -490,6 +491,22 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
             pure hasUpdate
           for_ hasUpdate $ \x ->
             logWith recorder Debug $ LogKnownFilesUpdated (targetMap x)
+
+
+          -- Clean the module map cache
+          -- TODO: the clean is total: it refresh the complete module to
+          -- filename cache. We can imagine something smarter in the future,
+          -- but anyway, the scan is actually really fast (It lists recursively
+          -- the content of all your include path, but once. It could only be
+          -- as slow as the number of files in your include paths, which is,
+          -- most of the time, the same as the number of module in your
+          -- project. If there are a lot of not required files inside your
+          -- include path, this will be an issue) and right now
+          -- what's expensive is the association of Known target to module,
+          -- which is still fast considering that it does not do any IO.
+          atomically $ do
+            writeTVar moduleToPathCache mempty
+
           return $ toNoFileKey GetKnownTargets
 
     -- Create a new HscEnv from a hieYaml root and a set of options

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

@@ -330,7 +330,7 @@ getLocatedImportsRule recorder =
         let dflags = hsc_dflags env
         opt <- getIdeOptions
 
-        moduleMaps <- extendModuleMapWithKnownTargets file
+        moduleMaps <- use_ GetModulesPaths file
 
         (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do
 
@@ -661,23 +661,29 @@ getModulesPathsRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder
         pure (fmap (u,) $ mconcat a, fmap (u, ) $ mconcat b)
 
       let res = (mconcat a, mconcat b)
-      liftIO $ atomically $ modifyTVar' moduleToPathCache (Map.insert (envUnique env_eq) res)
+      -- Extend the current module map with all the known targets
+      resExtended <- extendModuleMapWithKnownTargets file res
+
+      liftIO $ atomically $ modifyTVar' moduleToPathCache (Map.insert (envUnique env_eq) resExtended)
+
+      pure (mempty, ([], Just resExtended))
 
-      pure (mempty, ([], Just res))
 
 -- | Extend the map from module name to filepath (exiting on the drive) with
 -- the list of known targets provided by HLS
 --
 -- These known targets are files which were recently created and not yet saved
 -- to the filesystem.
 --
--- TODO: for now the implementation is O(number_of_known_files *
--- number_of_include_path) which is inacceptable and should be addressed.
+-- This code is not really efficient (O(import_dirs * known_targets)), which
+-- can quickly represents millions of tests. It could be improved, but
+-- everything only happen once everytime known_targets is updated (which only
+-- happen when the project start or when a file is added) and the code is not
+-- doing any IO.
 extendModuleMapWithKnownTargets
-    :: NormalizedFilePath
-       -> Action (Map.Map ModuleName (UnitId, NormalizedFilePath), Map.Map ModuleName (UnitId, NormalizedFilePath))
-extendModuleMapWithKnownTargets file = do
-  (notSourceModules, sourceModules) <- use_ GetModulesPaths file
+    :: NormalizedFilePath -> (Map.Map ModuleName (UnitId, NormalizedFilePath), Map.Map ModuleName (UnitId, NormalizedFilePath)) ->
+       Action (Map.Map ModuleName (UnitId, NormalizedFilePath), Map.Map ModuleName (UnitId, NormalizedFilePath))
+extendModuleMapWithKnownTargets file (notSourceModules, sourceModules) = do
   KnownTargets targetsMap <- useNoFile_ GetKnownTargets
 
   env_eq <- use_ GhcSession file
@@ -717,7 +723,6 @@ extendModuleMapWithKnownTargets file = do
         else
            pure (Just (modName, (u, path)), Nothing)
 
-
   pure $ (Map.fromList a <> notSourceModules, Map.fromList b <> sourceModules)