Clean dependency data structures and speed up GetDependencies

ghcide/ghcide.cabal

@@ -164,6 +164,7 @@ library
         Development.IDE.GHC.Orphans
         Development.IDE.GHC.Util
         Development.IDE.Import.DependencyInformation
+        Development.IDE.Import.FindImports
         Development.IDE.LSP.HoverDefinition
         Development.IDE.LSP.LanguageServer
         Development.IDE.LSP.Outline
@@ -207,7 +208,6 @@ library
         Development.IDE.Core.FileExists
         Development.IDE.GHC.CPP
         Development.IDE.GHC.Warnings
-        Development.IDE.Import.FindImports
         Development.IDE.LSP.Notifications
         Development.IDE.Plugin.CodeAction.PositionIndexed
         Development.IDE.Plugin.Completions.Logic

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

@@ -26,12 +26,10 @@ import Development.IDE.Types.HscEnvEq (HscEnvEq)
 import Development.IDE.Types.KnownTargets
 import           Data.Hashable
 import           Data.Typeable
-import qualified Data.Set as S
 import qualified Data.Map as M
 import           Development.Shake
 import           GHC.Generics                             (Generic)
 
-import Module (InstalledUnitId)
 import HscTypes (ModGuts, hm_iface, HomeModInfo, hm_linkable)
 
 import           Development.IDE.Spans.Common
@@ -223,9 +221,8 @@ type instance RuleResult GhcSession = HscEnvEq
 -- | A GHC session preloaded with all the dependencies
 type instance RuleResult GhcSessionDeps = HscEnvEq
 
--- | 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 ArtifactsLocation)], S.Set InstalledUnitId)
+-- | Resolve the imports in a module to the file path of a module in the same package
+type instance RuleResult GetLocatedImports = [(Located ModuleName, Maybe ArtifactsLocation)]
 
 -- | This rule is used to report import cycles. It depends on GetDependencyInformation.
 -- We cannot report the cycles directly from GetDependencyInformation since

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

@@ -82,7 +82,6 @@ import Development.IDE.Types.Location
 import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule, writeHieFile, TargetModule, TargetFile)
 import Development.IDE.GHC.ExactPrint
 import Development.IDE.GHC.Util
-import Data.Either.Extra
 import qualified Development.IDE.Types.Logger as L
 import Data.Maybe
 import           Data.Foldable
@@ -402,17 +401,11 @@ getLocatedImportsRule =
         (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do
             diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetExists modName mbPkgName isSource
             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))
+                Left diags -> pure (diags, Just (modName, Nothing))
+                Right (FileImport path) -> pure ([], Just (modName, Just path))
+                Right PackageImport -> pure ([], Nothing)
+        let moduleImports = catMaybes imports'
+        pure (concat diags, Just moduleImports)
 
 type RawDepM a = StateT (RawDependencyInformation, IntMap ArtifactsLocation) Action a
 
@@ -427,19 +420,23 @@ execRawDepM act =
 -- imports recursively.
 rawDependencyInformation :: [NormalizedFilePath] -> Action RawDependencyInformation
 rawDependencyInformation fs = do
-    (rdi, ss) <- execRawDepM (mapM_ go fs)
+    (rdi, ss) <- execRawDepM (goPlural fs)
     let bm = IntMap.foldrWithKey (updateBootMap rdi) IntMap.empty ss
     return (rdi { rawBootMap = bm })
   where
+    goPlural ff = do
+        mss <- lift $ (fmap.fmap) fst <$> uses GetModSummaryWithoutTimestamps ff
+        zipWithM go ff mss
+
     go :: NormalizedFilePath -- ^ Current module being processed
+       -> Maybe ModSummary   -- ^ ModSummary of the module
        -> StateT (RawDependencyInformation, IntMap ArtifactsLocation) Action FilePathId
-    go f = do
+    go f msum = do
       -- First check to see if we have already processed the FilePath
       -- If we have, just return its Id but don't update any of the state.
       -- Otherwise, we need to process its imports.
       checkAlreadyProcessed f $ do
-          msum <- lift $ fmap fst <$> use GetModSummaryWithoutTimestamps f
-          let al =  modSummaryToArtifactsLocation f msum
+          let al = modSummaryToArtifactsLocation f msum
           -- Get a fresh FilePathId for the new file
           fId <- getFreshFid al
           -- Adding an edge to the bootmap so we can make sure to
@@ -454,19 +451,19 @@ rawDependencyInformation fs = do
             -- elements in the queue
               modifyRawDepInfo (insertImport fId (Left ModuleParseError))
               return fId
-            Just (modImports, pkgImports) -> do
+            Just modImports -> do
               -- Get NFPs of the imports which have corresponding files
               -- Imports either come locally from a file or from a package.
               let (no_file, with_file) = splitImports modImports
                   (mns, ls) = unzip with_file
               -- Recursively process all the imports we just learnt about
               -- and get back a list of their FilePathIds
-              fids <- mapM (go . artifactFilePath) ls
+              fids <- goPlural $ map artifactFilePath ls
               -- Associate together the ModuleName with the FilePathId
               let moduleImports' = map (,Nothing) no_file ++ zip mns (map Just fids)
               -- Insert into the map the information about this modules
               -- imports.
-              modifyRawDepInfo $ insertImport fId (Right $ ModuleImports moduleImports' pkgImports)
+              modifyRawDepInfo $ insertImport fId (Right $ ModuleImports moduleImports')
               return fId
 
 
@@ -612,7 +609,7 @@ getHieAstRuleDefinition f hsc tmr = do
 getImportMapRule :: Rules ()
 getImportMapRule = define $ \GetImportMap f -> do
   im <- use GetLocatedImports f
-  let mkImports (fileImports, _) = M.fromList $ mapMaybe (\(m, mfp) -> (unLoc m,) . artifactFilePath <$> mfp) fileImports
+  let mkImports fileImports = M.fromList $ mapMaybe (\(m, mfp) -> (unLoc m,) . artifactFilePath <$> mfp) fileImports
   pure ([], ImportMap . mkImports <$> im)
 
 -- | Ensure that go to definition doesn't block on startup
@@ -857,7 +854,7 @@ isHiFileStableRule = defineEarlyCutoff $ \IsHiFileStable f -> do
             if modificationTime x < modificationTime modVersion
                 then pure SourceModified
                 else do
-                    (fileImports, _) <- use_ GetLocatedImports f
+                    fileImports <- use_ GetLocatedImports f
                     let imports = fmap artifactFilePath . snd <$> fileImports
                     deps <- uses_ IsHiFileStable (catMaybes imports)
                     pure $ if all (== SourceUnmodifiedAndStable) deps

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

@@ -46,24 +46,19 @@ import qualified Data.IntMap.Lazy as IntMapLazy
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as IntSet
 import Data.Maybe
-import Data.Set (Set)
-import qualified Data.Set as Set
 import GHC.Generics (Generic)
 
 import Development.IDE.Types.Diagnostics
 import Development.IDE.Types.Location
 import Development.IDE.Import.FindImports (ArtifactsLocation(..))
 
 import GHC
-import Module
 
 -- | The imports for a given module.
-data ModuleImports = ModuleImports
-    { moduleImports :: ![(Located ModuleName, Maybe FilePathId)]
+newtype ModuleImports = ModuleImports
+    { moduleImports :: [(Located ModuleName, Maybe FilePathId)]
     -- ^ Imports of a module in the current package and the file path of
     -- that module on disk (if we found it)
-    , packageImports :: !(Set InstalledUnitId)
-    -- ^ Transitive package dependencies unioned for all imports.
     } deriving Show
 
 -- | For processing dependency information, we need lots of maps and sets of
@@ -132,10 +127,6 @@ data RawDependencyInformation = RawDependencyInformation
     , rawBootMap :: !BootIdMap
     } deriving Show
 
-pkgDependencies :: RawDependencyInformation -> FilePathIdMap (Set InstalledUnitId)
-pkgDependencies RawDependencyInformation{..} =
-    IntMap.map (either (const Set.empty) packageImports) rawImports
-
 data DependencyInformation =
   DependencyInformation
     { depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError))
@@ -146,8 +137,6 @@ data DependencyInformation =
     -- in the same package.
     , depReverseModuleDeps :: !(IntMap IntSet)
     -- ^ Contains a reverse mapping from a module to all those that immediately depend on it.
-    , depPkgDeps :: !(FilePathIdMap (Set InstalledUnitId))
-    -- ^ For a non-error node, this contains the set of immediate pkg deps.
     , depPathIdMap :: !PathIdMap
     -- ^ Map from FilePath to FilePathId
     , depBootMap :: !BootIdMap
@@ -222,13 +211,12 @@ instance Semigroup NodeResult where
    SuccessNode a <> SuccessNode _ = SuccessNode a
 
 processDependencyInformation :: RawDependencyInformation -> DependencyInformation
-processDependencyInformation rawDepInfo@RawDependencyInformation{..} =
+processDependencyInformation RawDependencyInformation{..} =
   DependencyInformation
     { depErrorNodes = IntMap.fromList errorNodes
     , depModuleDeps = moduleDeps
     , depReverseModuleDeps = reverseModuleDeps
     , depModuleNames = IntMap.fromList $ coerce moduleNames
-    , depPkgDeps = pkgDependencies rawDepInfo
     , depPathIdMap = rawPathIdMap
     , depBootMap = rawBootMap
     }
@@ -248,8 +236,8 @@ processDependencyInformation rawDepInfo@RawDependencyInformation{..} =
             successEdges
         reverseModuleDeps =
           foldr (\(p, cs) res ->
-                                  let new = IntMap.fromList (map (, IntSet.singleton (coerce p)) (coerce cs))
-                                  in IntMap.unionWith IntSet.union new res ) IntMap.empty successEdges
+            let new = IntMap.fromList (map (, IntSet.singleton (coerce p)) (coerce cs))
+            in IntMap.unionWith IntSet.union new res ) IntMap.empty successEdges
 
 
 -- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows:
@@ -345,17 +333,8 @@ transitiveDeps DependencyInformation{..} file = do
       reachable g <$> toVertex (getFilePathId fileId)
   let transitiveModuleDepIds =
         filter (\v -> v `IntSet.member` reachableVs) $ map (fst3 . fromVertex) vs
-  let transitivePkgDeps =
-          Set.toList $ Set.unions $
-          map (\f -> IntMap.findWithDefault Set.empty f depPkgDeps) $
-          getFilePathId fileId : transitiveModuleDepIds
   let transitiveModuleDeps =
         map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds
-  let transitiveNamedModuleDeps =
-        [ NamedModuleDep (idToPath depPathIdMap (FilePathId fid)) mn artifactModLocation
-        | (fid, ShowableModuleName mn) <- IntMap.toList depModuleNames
-        , let ArtifactsLocation{artifactModLocation} = idToPathMap depPathIdMap IntMap.! fid
-        ]
   pure TransitiveDependencies {..}
   where
     (g, fromVertex, toVertex) = graphFromEdges edges
@@ -369,15 +348,10 @@ transitiveDeps DependencyInformation{..} file = do
 
     vs = topSort g
 
-data TransitiveDependencies = TransitiveDependencies
+newtype TransitiveDependencies = TransitiveDependencies
   { transitiveModuleDeps :: [NormalizedFilePath]
   -- ^ Transitive module dependencies in topological order.
   -- The module itself is not included.
-  , transitiveNamedModuleDeps :: [NamedModuleDep]
-  -- ^ Transitive module dependencies in topological order.
-  -- The module itself is not included.
-  , transitivePkgDeps :: [InstalledUnitId]
-  -- ^ Transitive pkg dependencies in unspecified order.
   } deriving (Eq, Show, Generic)
 
 instance NFData TransitiveDependencies

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

@@ -37,7 +37,7 @@ import Data.List (isSuffixOf)
 
 data Import
   = FileImport !ArtifactsLocation
-  | PackageImport !M.InstalledUnitId
+  | PackageImport
   deriving (Show)
 
 data ArtifactsLocation = ArtifactsLocation
@@ -55,7 +55,7 @@ isBootLocation = not . artifactIsSource
 
 instance NFData Import where
   rnf (FileImport x) = rnf x
-  rnf (PackageImport x) = rnf x
+  rnf PackageImport = ()
 
 modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation
 modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location <$> ms) source
@@ -137,7 +137,7 @@ locateModule dflags comp_info exts doesExist modName mbPkgName isSource = do
 
     lookupInPackageDB dfs =
       case lookupModuleWithSuggestions dfs (unLoc modName) mbPkgName of
-        LookupFound _m pkgConfig -> return $ Right $ PackageImport $ unitId pkgConfig
+        LookupFound _m _pkgConfig -> return $ Right PackageImport
         reason -> return $ Left $ notFoundErr dfs modName reason
 
 -- | Don't call this on a found module.