Compute Partial module graph fingerprints

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

@@ -264,7 +264,7 @@ typecheckParents recorder state nfp = void $ shakeEnqueue (shakeExtras state) pa
 
 typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action ()
 typecheckParentsAction recorder nfp = do
-    revs <- transitiveReverseDependencies nfp <$> useNoFile_ GetModuleGraph
+    revs <- transitiveReverseDependencies nfp <$> use_ GetFileModuleGraph nfp
     case revs of
       Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp
       Just rs -> do

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

@@ -74,6 +74,9 @@ type instance RuleResult GetParsedModuleWithComments = ParsedModule
 
 type instance RuleResult GetModuleGraph = DependencyInformation
 
+-- same as GetModuleGraph but only rebuilds if the target file deps changes
+type instance RuleResult GetFileModuleGraph = DependencyInformation
+
 data GetKnownTargets = GetKnownTargets
   deriving (Show, Generic, Eq, Ord)
 instance Hashable GetKnownTargets
@@ -417,6 +420,11 @@ data GetModuleGraph = GetModuleGraph
 instance Hashable GetModuleGraph
 instance NFData   GetModuleGraph
 
+data GetFileModuleGraph = GetFileModuleGraph
+    deriving (Eq, Show, Generic)
+instance Hashable GetFileModuleGraph
+instance NFData   GetFileModuleGraph
+
 data ReportImportCycles = ReportImportCycles
     deriving (Eq, Show, Generic)
 instance Hashable ReportImportCycles

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

@@ -472,7 +472,7 @@
 reportImportCyclesRule :: Recorder (WithPriority Log) -> Rules ()
 reportImportCyclesRule recorder =
     defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \ReportImportCycles file -> fmap (\errs -> if null errs then (Just "1",([], Just ())) else (Nothing, (errs, Nothing))) $ do
-        DependencyInformation{..} <- useNoFile_ GetModuleGraph
+        DependencyInformation{..} <- use_ GetFileModuleGraph file
         case pathToId depPathIdMap file of
           -- The header of the file does not parse, so it can't be part of any import cycles.
           Nothing -> pure []
@@ -608,7 +608,7 @@
     -- very expensive.
     when (foi == NotFOI) $
       logWith recorder Logger.Warning $ LogTypecheckedFOI file
-    typeCheckRuleDefinition hsc pm
+    typeCheckRuleDefinition hsc pm file
 
 knownFilesRule :: Recorder (WithPriority Log) -> Rules ()
 knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetKnownTargets -> do
@@ -628,6 +628,12 @@
   fs <- toKnownFiles <$> useNoFile_ GetKnownTargets
   dependencyInfoForFiles (HashSet.toList fs)
 
+getModuleGraphSingleFileRule :: Recorder (WithPriority Log) -> Rules ()
+getModuleGraphSingleFileRule recorder =
+    defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetFileModuleGraph file -> do
+        di <- useNoFile_ GetModuleGraph
+        return (fingerprintToBS <$> lookupFingerprint file di, ([], Just di))
+
 dependencyInfoForFiles :: [NormalizedFilePath] -> Action (BS.ByteString, DependencyInformation)
 dependencyInfoForFiles fs = do
   (rawDepInfo, bm) <- rawDependencyInformation fs
@@ -643,7 +649,10 @@
       go (Just ms) _ = Just $ ModuleNode [] ms
       go _ _ = Nothing
       mg = mkModuleGraph mns
-  pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg)
+  let shallowFingers = IntMap.fromList $ foldr' (\(i, m) acc -> case m of
+                                        Just x -> (getFilePathId i,msrFingerprint x):acc
+                                        Nothing -> acc) [] $ zip _all_ids msrs
+  pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg shallowFingers)
 
 -- This is factored out so it can be directly called from the GetModIface
 -- rule. Directly calling this rule means that on the initial load we can
@@ -652,14 +661,15 @@
 typeCheckRuleDefinition
     :: HscEnv
     -> ParsedModule
+    -> NormalizedFilePath
     -> Action (IdeResult TcModuleResult)
-typeCheckRuleDefinition hsc pm = do
+typeCheckRuleDefinition hsc pm fp = do
   IdeOptions { optDefer = defer } <- getIdeOptions
 
   unlift <- askUnliftIO
   let dets = TypecheckHelpers
            { getLinkables = unliftIO unlift . uses_ GetLinkable
-           , getModuleGraph = unliftIO unlift $ useNoFile_ GetModuleGraph
+           , getModuleGraph = unliftIO unlift $ use_ GetFileModuleGraph fp
            }
   addUsageDependencies $ liftIO $
     typecheckModule defer hsc dets pm
@@ -758,7 +768,7 @@
             let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces
             mg <- do
               if fullModuleGraph
-              then depModuleGraph <$> useNoFile_ GetModuleGraph
+              then depModuleGraph <$> use_ GetFileModuleGraph file
               else do
                 let mgs = map hsc_mod_graph depSessions
                 -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph
@@ -771,7 +781,7 @@
                       nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs)
                 liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes
                 return $ mkModuleGraph module_graph_nodes
-            de <- useNoFile_ GetModuleGraph
+            de <- use_ GetFileModuleGraph file
             session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions
 
             -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new
@@ -800,8 +810,8 @@
             { source_version = ver
             , old_value = m_old
             , get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
             , get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs
-            , get_module_graph = useNoFile_ GetModuleGraph
+            , get_module_graph = use_ GetFileModuleGraph f
             , regenerate = regenerateHiFile session f ms
             }
       hsc_env' <- setFileCacheHook (hscEnv session)
@@ -977,7 +987,7 @@
         Just pm -> do
             -- Invoke typechecking directly to update it without incurring a dependency
             -- on the parsed module and the typecheck rules
-            (diags', mtmr) <- typeCheckRuleDefinition hsc pm
+            (diags', mtmr) <- typeCheckRuleDefinition hsc pm f
             case mtmr of
               Nothing -> pure (diags', Nothing)
               Just tmr -> do
@@ -1093,7 +1103,7 @@
             -- thus bump its modification time, forcing this rule to be rerun every time.
             exists <- liftIO $ doesFileExist obj_file
             mobj_time <- liftIO $
               if exists
               then Just <$> getModTime obj_file
               else pure Nothing
             case mobj_time of
@@ -1135,7 +1145,7 @@
   | "boot" `isSuffixOf` fromNormalizedFilePath file =
     pure (Just $ encodeLinkableType Nothing, Just Nothing)
 needsCompilationRule file = do
-  graph <- useNoFile GetModuleGraph
+  graph <- use GetFileModuleGraph file
   res <- case graph of
     -- Treat as False if some reverse dependency header fails to parse
     Nothing -> pure Nothing
@@ -1226,6 +1236,7 @@
     getModIfaceRule recorder
     getModSummaryRule templateHaskellWarning recorder
     getModuleGraphRule recorder
+    getModuleGraphSingleFileRule recorder
     getFileHashRule recorder
     knownFilesRule recorder
     getClientSettingsRule recorder

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

@@ -29,6 +29,7 @@ module Development.IDE.Import.DependencyInformation
   , lookupModuleFile
   , BootIdMap
   , insertBootId
+  , lookupFingerprint
   ) where
 
 import           Control.DeepSeq
@@ -49,6 +50,8 @@ import qualified Data.List.NonEmpty                 as NonEmpty
 import           Data.Maybe
 import           Data.Tuple.Extra                   hiding (first, second)
 import           Development.IDE.GHC.Compat
+import           Development.IDE.GHC.Compat.Util    (Fingerprint)
+import qualified Development.IDE.GHC.Compat.Util    as Util
 import           Development.IDE.GHC.Orphans        ()
 import           Development.IDE.Import.FindImports (ArtifactsLocation (..))
 import           Development.IDE.Types.Diagnostics
@@ -136,23 +139,31 @@ data RawDependencyInformation = RawDependencyInformation
 
 data DependencyInformation =
   DependencyInformation
-    { depErrorNodes        :: !(FilePathIdMap (NonEmpty NodeError))
+    { depErrorNodes         :: !(FilePathIdMap (NonEmpty NodeError))
     -- ^ Nodes that cannot be processed correctly.
-    , depModules           :: !(FilePathIdMap ShowableModule)
-    , depModuleDeps        :: !(FilePathIdMap FilePathIdSet)
+    , depModules            :: !(FilePathIdMap ShowableModule)
+    , depModuleDeps         :: !(FilePathIdMap FilePathIdSet)
     -- ^ For a non-error node, this contains the set of module immediate dependencies
     -- in the same package.
-    , depReverseModuleDeps :: !(IntMap IntSet)
+    , depReverseModuleDeps  :: !(IntMap IntSet)
     -- ^ Contains a reverse mapping from a module to all those that immediately depend on it.
-    , depPathIdMap         :: !PathIdMap
+    , depPathIdMap          :: !PathIdMap
     -- ^ Map from FilePath to FilePathId
-    , depBootMap           :: !BootIdMap
+    , depBootMap            :: !BootIdMap
     -- ^ Map from hs-boot file to the corresponding hs file
-    , depModuleFiles       :: !(ShowableModuleEnv FilePathId)
+    , depModuleFiles        :: !(ShowableModuleEnv FilePathId)
     -- ^ Map from Module to the corresponding non-boot hs file
-    , depModuleGraph       :: !ModuleGraph
+    , depModuleGraph        :: !ModuleGraph
+    -- ^ Map from Module to the
+    , depModuleFingerprints :: !(FilePathIdMap Fingerprint)
     } deriving (Show, Generic)
 
+lookupFingerprint :: NormalizedFilePath -> DependencyInformation -> Maybe Fingerprint
+lookupFingerprint fileId DependencyInformation {..} =
+  do
+    FilePathId cur_id <- lookupPathToId depPathIdMap fileId
+    IntMap.lookup cur_id depModuleFingerprints
+
 newtype ShowableModule =
   ShowableModule {showableModule :: Module}
   deriving NFData
@@ -228,8 +239,8 @@ instance Semigroup NodeResult where
    SuccessNode _ <> ErrorNode errs   = ErrorNode errs
    SuccessNode a <> SuccessNode _    = SuccessNode a
 
-processDependencyInformation :: RawDependencyInformation -> BootIdMap -> ModuleGraph -> DependencyInformation
-processDependencyInformation RawDependencyInformation{..} rawBootMap mg =
+processDependencyInformation :: RawDependencyInformation -> BootIdMap -> ModuleGraph -> FilePathIdMap Fingerprint -> DependencyInformation
+processDependencyInformation RawDependencyInformation{..} rawBootMap mg shallowFingerMap =
   DependencyInformation
     { depErrorNodes = IntMap.fromList errorNodes
     , depModuleDeps = moduleDeps
@@ -239,6 +250,7 @@ processDependencyInformation RawDependencyInformation{..} rawBootMap mg =
     , depBootMap = rawBootMap
     , depModuleFiles = ShowableModuleEnv reverseModuleMap
     , depModuleGraph = mg
+    , depModuleFingerprints = buildAccFingerFilePathIdMap moduleDeps shallowFingerMap
     }
   where resultGraph = buildResultGraph rawImports
         (errorNodes, successNodes) = partitionNodeResults $ IntMap.toList resultGraph
@@ -398,3 +410,29 @@ instance NFData NamedModuleDep where
 
 instance Show NamedModuleDep where
   show NamedModuleDep{..} = show nmdFilePath
+
+-- | Build a map from file path to its full fingerprint.
+-- The fingerprint is depend on both the fingerprints of the file and all its dependencies.
+-- This is used to determine if a file has changed and needs to be reloaded.
+buildAccFingerFilePathIdMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint
+buildAccFingerFilePathIdMap modulesDeps shallowFingers = go keys IntMap.empty
+  where
+    keys = IntMap.keys shallowFingers
+    go :: [IntSet.Key] -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint
+    go keys acc =
+      case keys of
+        [] -> acc
+        k : ks ->
+          if IntMap.member k acc
+            -- already in the map, so we can skip
+            then go ks acc
+            -- not in the map, so we need to add it
+            else
+              let -- get the dependencies of the current key
+                  deps = IntSet.toList $ IntMap.findWithDefault IntSet.empty k modulesDeps
+                  -- add fingerprints of the dependencies to the accumulator
+                  depFingerprints = go deps acc
+                  -- combine the fingerprints of the dependencies with the current key
+                  combinedFingerprints = Util.fingerprintFingerprints $ shallowFingers IntMap.! k : map (depFingerprints IntMap.!) deps
+               in -- add the combined fingerprints to the accumulator
+                  go ks (IntMap.insert k combinedFingerprints depFingerprints)

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs

@@ -46,7 +46,7 @@ import           Development.IDE.Core.Rules                   (IdeState,
                                                                runAction)
 import           Development.IDE.Core.RuleTypes               (LinkableResult (linkableHomeMod),
                                                                TypeCheck (..),
-                                                               tmrTypechecked)
+                                                               tmrTypechecked, GetFileModuleGraph(..))
 import           Development.IDE.Core.Shake                   (useNoFile_, use_,
                                                                uses_)
 import           Development.IDE.GHC.Compat                   hiding (typeKind,
@@ -256,7 +256,7 @@ initialiseSessionForEval needs_quickcheck st nfp = do
     ms <- msrModSummary <$> use_ GetModSummary nfp
     deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp
 
-    linkables_needed <- transitiveDeps <$> useNoFile_ GetModuleGraph <*> pure nfp
+    linkables_needed <- transitiveDeps <$> use_ GetFileModuleGraph nfp <*> pure nfp
     linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)
     -- We unset the global rdr env in mi_globals when we generate interfaces
     -- See Note [Clearing mi_globals after generating an iface]