Cache NormalizedFilePath in ArtifactLocation (#445)

Previously PathIdMap cached NormalizedFilePath values, but with the addition of
module data those got dropped.

It's probably a good idea to bring those back to avoid the risk of a perf
regression

Author: pepeiborra

src/Development/IDE/Core/Rules.hs

@@ -177,7 +177,8 @@ getLocatedImportsRule =
 -- imports recursively.
 rawDependencyInformation :: NormalizedFilePath -> Action RawDependencyInformation
 rawDependencyInformation f = do
-    let (initialId, initialMap) = getPathId (ArtifactsLocation $ ModLocation (Just $ fromNormalizedFilePath f) "" "") emptyPathIdMap
+    let initialArtifact = ArtifactsLocation f (ModLocation (Just $ fromNormalizedFilePath f) "" "")
+        (initialId, initialMap) = getPathId initialArtifact emptyPathIdMap
     go (IntSet.singleton $ getFilePathId initialId)
        (RawDependencyInformation IntMap.empty initialMap)
   where
@@ -270,7 +271,8 @@ getSpanInfoRule =
         parsedDeps <- mapMaybe (fmap fst) <$> usesWithStale GetParsedModule (transitiveModuleDeps deps)
         (fileImports, _) <- use_ GetLocatedImports file
         packageState <- hscEnv <$> use_ GhcSession file
-        x <- liftIO $ getSrcSpanInfos packageState (fmap (second (fmap modLocationToNormalizedFilePath)) fileImports) tc parsedDeps
+        let imports = second (fmap artifactFilePath) <$> fileImports
+        x <- liftIO $ getSrcSpanInfos packageState imports tc parsedDeps
         return ([], Just x)
 
 -- Typechecks a module.

src/Development/IDE/Import/DependencyInformation.hs

@@ -18,7 +18,6 @@ module Development.IDE.Import.DependencyInformation
   , pathToId
   , idToPath
   , reachableModules
-  , modLocationToNormalizedFilePath
   , processDependencyInformation
   , transitiveDeps
   ) where
@@ -76,27 +75,20 @@ data PathIdMap = PathIdMap
 
 instance NFData PathIdMap
 
-modLocationToNormalizedFilePath :: ArtifactsLocation -> NormalizedFilePath
-modLocationToNormalizedFilePath (ArtifactsLocation loc) =
-    case ml_hs_file loc of
-      Just filePath -> toNormalizedFilePath filePath
-      -- Since we craete all 'ModLocation' values via 'mkHomeModLocation'
-      Nothing -> error "Has something changed in mkHomeModLocation?"
-
 emptyPathIdMap :: PathIdMap
 emptyPathIdMap = PathIdMap IntMap.empty HMS.empty
 
 getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
 getPathId path m@PathIdMap{..} =
-    case HMS.lookup (modLocationToNormalizedFilePath path) pathToIdMap of
+    case HMS.lookup (artifactFilePath path) pathToIdMap of
         Nothing ->
             let !newId = FilePathId $ HMS.size pathToIdMap
             in (newId, insertPathId path newId m)
         Just id -> (id, m)
 
 insertPathId :: ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap
 insertPathId path id PathIdMap{..} =
-    PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (HMS.insert (modLocationToNormalizedFilePath path) id pathToIdMap)
+    PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (HMS.insert (artifactFilePath path) id pathToIdMap)
 
 insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation
 insertImport (FilePathId k) v rawDepInfo = rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) }
@@ -105,7 +97,7 @@ pathToId :: PathIdMap -> NormalizedFilePath -> FilePathId
 pathToId PathIdMap{pathToIdMap} path = pathToIdMap HMS.! path
 
 idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath
-idToPath pathIdMap filePathId = modLocationToNormalizedFilePath $ idToModLocation pathIdMap filePathId
+idToPath pathIdMap filePathId = artifactFilePath $ idToModLocation pathIdMap filePathId
 
 idToModLocation :: PathIdMap -> FilePathId -> ArtifactsLocation
 idToModLocation PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id
@@ -305,9 +297,9 @@ transitiveDeps DependencyInformation{..} file = do
   let transitiveModuleDeps =
         map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds
   let transitiveNamedModuleDeps =
-        [ NamedModuleDep (idToPath depPathIdMap (FilePathId fid)) mn ml
+        [ NamedModuleDep (idToPath depPathIdMap (FilePathId fid)) mn artifactModLocation
         | (fid, ShowableModuleName mn) <- IntMap.toList depModuleNames
-        , let ArtifactsLocation ml = idToPathMap depPathIdMap IntMap.! fid
+        , let ArtifactsLocation{artifactModLocation} = idToPathMap depPathIdMap IntMap.! fid
         ]
   pure TransitiveDependencies {..}
   where

src/Development/IDE/Import/FindImports.hs

@@ -34,11 +34,14 @@ data Import
   | PackageImport !M.InstalledUnitId
   deriving (Show)
 
-newtype ArtifactsLocation =  ArtifactsLocation ModLocation
+data ArtifactsLocation = ArtifactsLocation
+  { artifactFilePath :: !NormalizedFilePath
+  , artifactModLocation :: !ModLocation
+  }
     deriving (Show)
 
 instance NFData ArtifactsLocation where
-  rnf = const ()
+  rnf ArtifactsLocation{..} = rnf artifactFilePath `seq` rwhnf artifactModLocation
 
 instance NFData Import where
   rnf (FileImport x) = rnf x
@@ -94,7 +97,7 @@ locateModule dflags exts doesExist modName mbPkgName isSource = do
   where
     toModLocation file = liftIO $ do
         loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file)
-        return $ Right $ FileImport $ ArtifactsLocation loc
+        return $ Right $ FileImport $ ArtifactsLocation file loc
 
 
     lookupInPackageDB dfs =