Only integrate known target in the cache once and clean path comparison

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
@@ -459,6 +460,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
         -- files in the project so that `knownFiles` can learn about them and
         -- we can generate a complete module graph
     let extendKnownTargets newTargets = do
+          print "extendKnownTargets"
           knownTargets <- concatForM  newTargets $ \TargetDetails{..} ->
             case targetTarget of
               TargetFile f -> do
@@ -490,6 +492,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

@@ -178,7 +178,7 @@ import           System.Info.Extra                            (isWindows)
 import qualified Data.IntMap                                  as IM
 import           GHC.Fingerprint
 import qualified Data.Map.Strict as Map
-import System.FilePath (takeExtension, takeFileName, normalise, dropExtension, splitDirectories)
+import System.FilePath (takeExtension, takeFileName, normalise, dropExtension, splitDirectories, equalFilePath)
 import Data.Char (isUpper)
 import System.Directory.Extra (listFilesInside)
 
@@ -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
 
@@ -643,7 +643,7 @@ getModulesPathsRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder
       (unzip -> (a, b)) <- flip mapM import_dirs $ \(u, dyn) -> do
         (unzip -> (a, b)) <- flip mapM (importPaths dyn) $ \dir' -> do
           let dir = normalise dir'
-          let predicate path = pure (normalise path == dir || case takeFileName path of
+          let predicate path = pure (equalFilePath path dir || case takeFileName path of
                [] -> False
                (x:_) -> isUpper x)
           let dir_number_directories = length (splitDirectories dir)
@@ -663,21 +663,21 @@ getModulesPathsRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder
       let res = (mconcat a, mconcat b)
       liftIO $ atomically $ modifyTVar' moduleToPathCache (Map.insert (envUnique env_eq) res)
 
-      pure (mempty, ([], Just res))
+      -- Extend the current module map with all the known targets
+      resExtended <- extendModuleMapWithKnownTargets file res
+
+      pure (mempty, ([], Just resExtended))
+
 
 -- | 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.
 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 +717,6 @@ extendModuleMapWithKnownTargets file = do
         else
            pure (Just (modName, (u, path)), Nothing)
 
-
   pure $ (Map.fromList a <> notSourceModules, Map.fromList b <> sourceModules)