Maximize sharing of NormalizedFilePath values in getLocatedImports

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

@@ -151,6 +151,7 @@ import Ide.Plugin.Properties (HasProperty,
 import Ide.PluginUtils (configForPlugin)
 import Ide.Types (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser),
  PluginId)
+import qualified Data.HashSet as HS
 
 -- | This is useful for rules to convert rules that can only produce errors or
 -- a result into the more general IdeResult type that supports producing
@@ -311,6 +312,7 @@ getLocatedImportsRule =
  define $ \GetLocatedImports file -> do
  ModSummaryResult{msrModSummary = ms} <- use_ GetModSummaryWithoutTimestamps file
  targets <- useNoFile_ GetKnownTargets
+ let targetsMap = HM.mapWithKey const targets
  let imports = [(False, imp) | imp <- ms_textual_imps ms] ++ [(True, imp) | imp <- ms_srcimps ms]
  env_eq <- use_ GhcSession file
  let env = hscEnvWithImportPaths env_eq
@@ -321,14 +323,24 @@ getLocatedImportsRule =
  then addRelativeImport file (moduleName $ ms_mod ms) dflags
  else dflags
  opt <- getIdeOptions
- let getTargetExists modName nfp
- | isImplicitCradle = getFileExists nfp
- | HM.member (TargetModule modName) targets
- || HM.member (TargetFile nfp) targets
- = getFileExists nfp
- | otherwise = return False
+ let getTargetFor modName nfp
+ | isImplicitCradle = do
+ itExists <- getFileExists nfp
+ return $ if itExists then Just nfp else Nothing
+ | Just (TargetFile nfp') <- HM.lookup (TargetFile nfp) targetsMap = do
+ -- reuse the existing NormalizedFilePath in order to maximize sharing
+ itExists <- getFileExists nfp'
+ return $ if itExists then Just nfp' else Nothing
+ | Just tt <- HM.lookup (TargetModule modName) targets = do
+ -- reuse the existing NormalizedFilePath in order to maximize sharing
+ let ttmap = HM.mapWithKey const (HS.toMap tt)
+ nfp' = HM.lookupDefault nfp nfp ttmap
+ itExists <- getFileExists nfp'
+ return $ if itExists then Just nfp' else Nothing
+ | otherwise
+ = return Nothing
  (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do
- diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetExists modName mbPkgName isSource
+ diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource
  case diagOrImp of
  Left diags -> pure (diags, Just (modName, Nothing))
  Right (FileImport path) -> pure ([], Just (modName, Just path))

ghcide/src/Development/IDE/Import/FindImports.hs

@@ -69,15 +69,15 @@ modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location <$> ms
 locateModuleFile :: MonadIO m
  => [[FilePath]]
  -> [String]
- -> (ModuleName -> NormalizedFilePath -> m Bool)
+ -> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
  -> Bool
  -> ModuleName
  -> m (Maybe NormalizedFilePath)
-locateModuleFile import_dirss exts doesExist isSource modName = do
+locateModuleFile import_dirss exts targetFor isSource modName = do
  let candidates import_dirs =
  [ toNormalizedFilePath' (prefix </> M.moduleNameSlashes modName <.> maybeBoot ext)
  | prefix <- import_dirs , ext <- exts]
- findM (doesExist modName) (concatMap candidates import_dirss)
+ firstJustM (targetFor modName) (concatMap candidates import_dirss)
  where
  maybeBoot ext
  | isSource = ext ++ "-boot"
@@ -97,12 +97,12 @@ locateModule
  => DynFlags
  -> [(Compat.InstalledUnitId, DynFlags)] -- ^ Import directories
  -> [String] -- ^ File extensions
- -> (ModuleName -> NormalizedFilePath -> m Bool) -- ^ does file exist predicate
+ -> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)) -- ^ does file exist predicate
  -> Located ModuleName -- ^ Module name
  -> Maybe FastString -- ^ Package name
  -> Bool -- ^ Is boot module
  -> m (Either [FileDiagnostic] Import)
-locateModule dflags comp_info exts doesExist modName mbPkgName isSource = do
+locateModule dflags comp_info exts targetFor modName mbPkgName isSource = do
  case mbPkgName of
  -- "this" means that we should only look in the current package
  Just "this" -> do
@@ -118,7 +118,7 @@ locateModule dflags comp_info exts doesExist modName mbPkgName isSource = do
  -- Here the importPaths for the current modules are added to the front of the import paths from the other components.
  -- This is particularly important for Paths_* modules which get generated for every component but unless you use it in
  -- each component will end up being found in the wrong place and cause a multi-cradle match failure.
- mbFile <- locateModuleFile (importPaths dflags : map snd import_paths) exts doesExist isSource $ unLoc modName
+ mbFile <- locateModuleFile (importPaths dflags : map snd import_paths) exts targetFor isSource $ unLoc modName
  case mbFile of
  Nothing -> lookupInPackageDB dflags
  Just file -> toModLocation file
@@ -129,7 +129,7 @@ locateModule dflags comp_info exts doesExist modName mbPkgName isSource = do
  return $ Right $ FileImport $ ArtifactsLocation file (Just loc) (not isSource)
 
  lookupLocal dirs = do
- mbFile <- locateModuleFile dirs exts doesExist isSource $ unLoc modName
+ mbFile <- locateModuleFile dirs exts targetFor isSource $ unLoc modName
  case mbFile of
  Nothing -> return $ Left $ notFoundErr dflags modName $ LookupNotFound []
  Just file -> toModLocation file