Speed up dependency chasing (#2383)

This PR moves as much work as possible to GetLocatedImports which
contracry to GetDependencyInformation is shared between rules.

It’s still slower than it should be and somewhat messy but at least
it’s slightly faster and imho cleaner than before.

src/Development/IDE/Core/RuleTypes.hs

@@ -12,14 +12,16 @@ module Development.IDE.Core.RuleTypes(
     ) where
 
 import           Control.DeepSeq
-import           Development.IDE.Import.FindImports         (Import(..))
 import           Development.IDE.Import.DependencyInformation
+import Development.IDE.Types.Location
 import           Data.Hashable
 import           Data.Typeable
+import qualified Data.Set as S
 import           Development.Shake                        hiding (Env, newCache)
 import           GHC.Generics                             (Generic)
 
 import           GHC
+import Module (InstalledUnitId)
 import HscTypes (HomeModInfo)
 import Development.IDE.GHC.Compat
 
@@ -66,9 +68,9 @@ type instance RuleResult GenerateCore = CoreModule
 -- | A GHC session that we reuse.
 type instance RuleResult GhcSession = HscEnv
 
--- | Resolve the imports in a module to the list of either external packages or absolute file paths
--- for modules in the same package.
-type instance RuleResult GetLocatedImports = [(Located ModuleName, Maybe Import)]
+-- | Resolve the imports in a module to the file path of a module
+-- in the same package or the package id of another package.
+type instance RuleResult GetLocatedImports = ([(Located ModuleName, Maybe NormalizedFilePath)], S.Set InstalledUnitId)
 
 -- | This rule is used to report import cycles. It depends on GetDependencyInformation.
 -- We cannot report the cycles directly from GetDependencyInformation since

src/Development/IDE/Core/Rules.hs

@@ -36,7 +36,6 @@ import Development.IDE.Import.FindImports
 import           Development.IDE.Core.FileStore
 import           Development.IDE.Types.Diagnostics
 import Development.IDE.Types.Location
-import Data.Bifunctor
 import Data.Either.Extra
 import Data.Maybe
 import           Data.Foldable
@@ -186,9 +185,20 @@ getLocatedImportsRule =
         env <- useNoFile_ GhcSession
         let dflags = addRelativeImport pm $ hsc_dflags env
         opt <- getIdeOptions
-        xs <- forM imports $ \(mbPkgName, modName) ->
-            (modName, ) <$> locateModule dflags (optExtensions opt) getFileExists modName mbPkgName
-        return (concat $ lefts $ map snd xs, Just $ map (second eitherToMaybe) xs)
+        (diags, imports') <- fmap unzip $ forM imports $ \(mbPkgName, modName) -> do
+            diagOrImp <- locateModule dflags (optExtensions opt) getFileExists modName mbPkgName
+            case diagOrImp of
+                Left diags -> pure (diags, Left (modName, Nothing))
+                Right (FileImport path) -> pure ([], Left (modName, Just path))
+                Right (PackageImport pkgId) -> liftIO $ do
+                    diagsOrPkgDeps <- computePackageDeps env pkgId
+                    case diagsOrPkgDeps of
+                        Left diags -> pure (diags, Right Nothing)
+                        Right pkgIds -> pure ([], Right $ Just $ pkgId : pkgIds)
+        let (moduleImports, pkgImports) = partitionEithers imports'
+        case sequence pkgImports of
+            Nothing -> pure (concat diags, Nothing)
+            Just pkgImports -> pure (concat diags, Just (moduleImports, Set.fromList $ concat pkgImports))
 
 
 -- | Given a target file path, construct the raw dependency results by following
@@ -204,19 +214,10 @@ rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty
                 Nothing ->
                   let modGraph' = Map.insert f (Left ModuleParseError) modGraph
                   in go fs modGraph' pkgs
-                Just imports -> do
-                  packageState <- lift $ useNoFile_ GhcSession
-                  modOrPkgImports <- forM imports $ \imp -> do
-                    case imp of
-                      (_modName, Just (PackageImport pkg)) -> do
-                          pkgs <- ExceptT $ liftIO $ computePackageDeps packageState pkg
-                          pure $ Right $ pkg:pkgs
-                      (modName, Just (FileImport absFile)) -> pure $ Left (modName, Just absFile)
-                      (modName, Nothing) -> pure $ Left (modName, Nothing)
-                  let (modImports, pkgImports) = partitionEithers modOrPkgImports
+                Just (modImports, pkgImports) -> do
                   let newFiles = Set.fromList (mapMaybe snd modImports) Set.\\ Map.keysSet modGraph
                       modGraph' = Map.insert f (Right modImports) modGraph
-                      pkgs' = Map.insert f (Set.fromList $ concat pkgImports) pkgs
+                      pkgs' = Map.insert f pkgImports pkgs
                   go (fs `Set.union` newFiles) modGraph' pkgs'
 
 getDependencyInformationRule :: Rules ()
@@ -270,9 +271,9 @@ getSpanInfoRule :: Rules ()
 getSpanInfoRule =
     define $ \GetSpanInfo file -> do
         tc <- use_ TypeCheck file
-        imports <- use_ GetLocatedImports file
+        (fileImports, _) <- use_ GetLocatedImports file
         packageState <- useNoFile_ GhcSession
-        x <- liftIO $ getSrcSpanInfos packageState (fileImports imports) tc
+        x <- liftIO $ getSrcSpanInfos packageState fileImports tc
         return ([], Just x)
 
 -- Typechecks a module.
@@ -328,11 +329,3 @@ mainRule = do
 
 fileFromParsedModule :: ParsedModule -> NormalizedFilePath
 fileFromParsedModule = toNormalizedFilePath . ms_hspp_file . pm_mod_summary
-
-fileImports ::
-     [(Located ModuleName, Maybe Import)]
-  -> [(Located ModuleName, Maybe NormalizedFilePath)]
-fileImports = mapMaybe $ \case
-    (modName, Nothing) -> Just (modName, Nothing)
-    (modName, Just (FileImport absFile)) -> Just (modName, Just absFile)
-    (_modName, Just (PackageImport _pkg)) -> Nothing

src/Development/IDE/Import/DependencyInformation.hs

@@ -13,9 +13,9 @@ module Development.IDE.Import.DependencyInformation
 
 import Control.DeepSeq
 import Data.Bifunctor
+import Data.List
 import Development.IDE.GHC.Orphans()
 import Data.Either
-import Data.Foldable
 import Data.Graph
 import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
 import qualified Data.List.NonEmpty as NonEmpty
@@ -113,20 +113,17 @@ instance Semigroup NodeResult where
 processDependencyInformation :: RawDependencyInformation -> DependencyInformation
 processDependencyInformation rawResults =
   DependencyInformation
-    { depErrorNodes = MS.mapMaybe errorNode resultGraph
+    { depErrorNodes = MS.fromList errorNodes
     , depModuleDeps = moduleDeps
     , depPkgDeps = pkgDependencies rawResults
     }
   where resultGraph = buildResultGraph rawResults
+        (errorNodes, successNodes) = partitionNodeResults $ MS.toList resultGraph
         successEdges :: [(NormalizedFilePath, NormalizedFilePath, [NormalizedFilePath])]
-        successEdges = map (\(k,ks) -> (k,k,ks)) $ MS.toList $
-          MS.map (map snd) $ MS.mapMaybe successNode resultGraph
+        successEdges =
+            map (\(file, imports) -> (file, file, map snd imports)) successNodes
         moduleDeps =
           MS.fromList $ map (\(_, v, vs) -> (v, Set.fromList vs)) successEdges
-        errorNode (ErrorNode errs) = Just errs
-        errorNode _ = Nothing
-        successNode (SuccessNode fs) = Just fs
-        successNode _ = Nothing
 
 -- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows:
 -- 1. Mark each node that is part of an import cycle as an error node.