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 <$> useWithSeparateFingerprintRule_ GetModuleGraphTransReverseDepsFingerprints GetModuleGraph nfp
     case revs of
       Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp
       Just rs -> do

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

@@ -74,6 +74,12 @@ type instance RuleResult GetParsedModuleWithComments = ParsedModule
 
 type instance RuleResult GetModuleGraph = DependencyInformation
 
+-- | it only compute the fingerprint of the module graph for a file and its dependencies
+-- we need this to trigger recompilation when the sub module graph for a file changes
+type instance RuleResult GetModuleGraphTransDepsFingerprints = Fingerprint
+type instance RuleResult GetModuleGraphTransReverseDepsFingerprints = Fingerprint
+type instance RuleResult GetModuleGraphImmediateReverseDepsFingerprints = Fingerprint
+
 data GetKnownTargets = GetKnownTargets
   deriving (Show, Generic, Eq, Ord)
 instance Hashable GetKnownTargets
@@ -417,6 +423,21 @@ data GetModuleGraph = GetModuleGraph
 instance Hashable GetModuleGraph
 instance NFData   GetModuleGraph
 
+data GetModuleGraphTransDepsFingerprints = GetModuleGraphTransDepsFingerprints
+    deriving (Eq, Show, Generic)
+instance Hashable GetModuleGraphTransDepsFingerprints
+instance NFData   GetModuleGraphTransDepsFingerprints
+
+data GetModuleGraphTransReverseDepsFingerprints = GetModuleGraphTransReverseDepsFingerprints
+    deriving (Eq, Show, Generic)
+instance Hashable GetModuleGraphTransReverseDepsFingerprints
+instance NFData   GetModuleGraphTransReverseDepsFingerprints
+
+data GetModuleGraphImmediateReverseDepsFingerprints = GetModuleGraphImmediateReverseDepsFingerprints
+    deriving (Eq, Show, Generic)
+instance Hashable GetModuleGraphImmediateReverseDepsFingerprints
+instance NFData   GetModuleGraphImmediateReverseDepsFingerprints
+
 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{..} <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph 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
@@ -643,7 +643,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 +655,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 $ useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph fp
            }
   addUsageDependencies $ liftIO $
     typecheckModule defer hsc dets pm
@@ -756,9 +760,10 @@
             depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps
             ifaces <- uses_ GetModIface deps
             let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces
+            de <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file
             mg <- do
               if fullModuleGraph
-              then depModuleGraph <$> useNoFile_ GetModuleGraph
+              then return $ depModuleGraph de
               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 +776,6 @@
                       nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs)
                 liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes
                 return $ mkModuleGraph module_graph_nodes
-            de <- useNoFile_ GetModuleGraph
             session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions
 
             -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new
@@ -800,8 +804,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 = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f
             , regenerate = regenerateHiFile session f ms
             }
       hsc_env' <- setFileCacheHook (hscEnv session)
@@ -977,7 +981,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 +1097,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 +1139,7 @@
   | "boot" `isSuffixOf` fromNormalizedFilePath file =
     pure (Just $ encodeLinkableType Nothing, Just Nothing)
 needsCompilationRule file = do
-  graph <- useNoFile GetModuleGraph
+  graph <- useWithSeparateFingerprintRule GetModuleGraphImmediateReverseDepsFingerprints GetModuleGraph file
   res <- case graph of
     -- Treat as False if some reverse dependency header fails to parse
     Nothing -> pure Nothing
@@ -1247,6 +1251,19 @@
     persistentDocMapRule
     persistentImportMapRule
     getLinkableRule recorder
+    defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransDepsFingerprints file -> do
+        di <- useNoFile_ GetModuleGraph
+        let finger = lookupFingerprint file di (depTransDepsFingerprints di)
+        return (fingerprintToBS <$> finger, ([], finger))
+    defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransReverseDepsFingerprints file -> do
+        di <- useNoFile_ GetModuleGraph
+        let finger = lookupFingerprint file di (depTransReverseDepsFingerprints di)
+        return (fingerprintToBS <$> finger, ([], finger))
+    defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphImmediateReverseDepsFingerprints file -> do
+        di <- useNoFile_ GetModuleGraph
+        let finger = lookupFingerprint file di (depImmediateReverseDepsFingerprints di)
+        return (fingerprintToBS <$> finger, ([], finger))
+
 
 -- | Get HieFile for haskell file on NormalizedFilePath
 getHieFile :: NormalizedFilePath -> Action (Maybe HieFile)

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

@@ -31,6 +31,8 @@ module Development.IDE.Core.Shake(
     shakeEnqueue,
     newSession,
     use, useNoFile, uses, useWithStaleFast, useWithStaleFast', delayedAction,
+    useWithSeparateFingerprintRule,
+    useWithSeparateFingerprintRule_,
     FastResult(..),
     use_, useNoFile_, uses_,
     useWithStale, usesWithStale,
@@ -1148,6 +1150,23 @@ usesWithStale key files = do
     -- whether the rule succeeded or not.
     traverse (lastValue key) files
 
+-- we use separate fingerprint rules to trigger the rebuild of the rule
+useWithSeparateFingerprintRule
+    :: (IdeRule k v, IdeRule k1 Fingerprint)
+    => k1 -> k -> NormalizedFilePath -> Action (Maybe v)
+useWithSeparateFingerprintRule fingerKey key file = do
+    _ <- use fingerKey file
+    useWithoutDependency key emptyFilePath
+
+-- we use separate fingerprint rules to trigger the rebuild of the rule
+useWithSeparateFingerprintRule_
+    :: (IdeRule k v, IdeRule k1 Fingerprint)
+    => k1 -> k -> NormalizedFilePath -> Action v
+useWithSeparateFingerprintRule_ fingerKey key file = do
+    useWithSeparateFingerprintRule fingerKey key file >>= \case
+        Just v -> return v
+        Nothing -> liftIO $ throwIO $ BadDependency (show key)
+
 useWithoutDependency :: IdeRule k v
     => k -> NormalizedFilePath -> Action (Maybe v)
 useWithoutDependency key file =

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,35 @@ 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
+    , depTransDepsFingerprints :: !(FilePathIdMap Fingerprint)
+    -- ^ Map from Module to fingerprint of the transitive dependencies of the module.
+    , depTransReverseDepsFingerprints :: !(FilePathIdMap Fingerprint)
+    -- ^ Map from FilePathId to the fingerprint of the transitive reverse dependencies of the module.
+    , depImmediateReverseDepsFingerprints :: !(FilePathIdMap Fingerprint)
+    -- ^ Map from FilePathId to the fingerprint of the immediate reverse dependencies of the module.
     } deriving (Show, Generic)
 
+lookupFingerprint :: NormalizedFilePath -> DependencyInformation -> FilePathIdMap Fingerprint -> Maybe Fingerprint
+lookupFingerprint fileId DependencyInformation {..} depFingerprintMap =
+  do
+    FilePathId cur_id <- lookupPathToId depPathIdMap fileId
+    IntMap.lookup cur_id depFingerprintMap
+
 newtype ShowableModule =
   ShowableModule {showableModule :: Module}
   deriving NFData
@@ -228,8 +243,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 +254,9 @@ processDependencyInformation RawDependencyInformation{..} rawBootMap mg =
     , depBootMap = rawBootMap
     , depModuleFiles = ShowableModuleEnv reverseModuleMap
     , depModuleGraph = mg
+    , depTransDepsFingerprints = buildTransDepsFingerprintMap moduleDeps shallowFingerMap
+    , depTransReverseDepsFingerprints = buildTransDepsFingerprintMap reverseModuleDeps shallowFingerMap
+    , depImmediateReverseDepsFingerprints = buildImmediateDepsFingerprintMap reverseModuleDeps shallowFingerMap
     }
   where resultGraph = buildResultGraph rawImports
         (errorNodes, successNodes) = partitionNodeResults $ IntMap.toList resultGraph
@@ -398,3 +416,44 @@ instance NFData NamedModuleDep where
 
 instance Show NamedModuleDep where
   show NamedModuleDep{..} = show nmdFilePath
+
+
+buildImmediateDepsFingerprintMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint
+buildImmediateDepsFingerprintMap modulesDeps shallowFingers =
+  IntMap.fromList
+    $ map
+      ( \k ->
+          ( k,
+            Util.fingerprintFingerprints $
+              map
+                (shallowFingers IntMap.!)
+                (k : IntSet.toList (IntMap.findWithDefault IntSet.empty k modulesDeps))
+          )
+      )
+    $ IntMap.keys shallowFingers
+
+-- | 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.
+buildTransDepsFingerprintMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint
+buildTransDepsFingerprintMap 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)