compute deps fingerprint only

Refactor comments for clarity and update rule usage in needsCompilationRule

Refactor imports in Handlers.hs for clarity and organization

maximize sharing by creating a finger print rule and query result from GetModuleGraph

avoid fingerprint nothing to fail in useWithSeparateFingerprintRule

add fingerprints rules for module graph:
GetModuleGraphTransDepsFingerprints,GetModuleGraphTransReverseDepsFingerprints,GetModuleGraphImmediateReverseDepsFingerprints.

fix comment

small refactor

optimize buildImmediateDepsFingerprintMap

use customize finger

implement restriction to transitive deps for module graph

Author: soulomoon

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

@@ -262,9 +262,12 @@ typecheckParents :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePat
 typecheckParents recorder state nfp = void $ shakeEnqueue (shakeExtras state) parents
   where parents = mkDelayedAction "ParentTC" L.Debug (typecheckParentsAction recorder nfp)
 
+
+useReverseTransDeps :: NormalizedFilePath -> Action (Maybe [NormalizedFilePath])
+useReverseTransDeps file = transitiveReverseDependencies file <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file
 typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action ()
 typecheckParentsAction recorder nfp = do
-    revs <- transitiveReverseDependencies nfp <$> useNoFile_ GetModuleGraph
+    revs <- useReverseTransDeps 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

@@ -12,6 +12,7 @@ module Development.IDE.Core.Rules(
     -- * Types
     IdeState, GetParsedModule(..), TransitiveDependencies(..),
     GhcSessionIO(..), GetClientSettings(..),
+    useTransDepModuleGraph,
     -- * Functions
     runAction,
     toIdeResult,
@@ -472,7 +473,7 @@ rawDependencyInformation fs = do
 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 {depErrorNodes, depPathIdMap} <- useTransDepModuleGraph 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 +609,7 @@ typeCheckRule recorder = define (cmapWithPrio LogShake recorder) $ \TypeCheck fi
     -- 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
@@ -633,17 +634,20 @@ dependencyInfoForFiles fs = do
   (rawDepInfo, bm) <- rawDependencyInformation fs
   let (all_fs, _all_ids) = unzip $ HM.toList $ pathToIdMap $ rawPathIdMap rawDepInfo
   msrs <- uses GetModSummaryWithoutTimestamps all_fs
-  let mss = map (fmap msrModSummary) msrs
+  let mss = zip _all_ids $ map (fmap msrModSummary) msrs
   let deps = map (\i -> IM.lookup (getFilePathId i) (rawImports rawDepInfo)) _all_ids
-      nodeKeys = IM.fromList $ catMaybes $ zipWith (\fi mms -> (getFilePathId fi,) . NodeKey_Module . msKey <$> mms) _all_ids mss
+      nodeKeys = IM.fromList $ catMaybes $ zipWith (\fi (_, mms) -> (getFilePathId fi,) . NodeKey_Module . msKey <$> mms) _all_ids mss
       mns = catMaybes $ zipWith go mss deps
-      go (Just ms) (Just (Right (ModuleImports xs))) = Just $ ModuleNode this_dep_keys ms
+      go (pid,Just ms) (Just (Right (ModuleImports xs))) = Just $ (pid, ModuleNode this_dep_keys ms)
         where this_dep_ids = mapMaybe snd xs
               this_dep_keys = mapMaybe (\fi -> IM.lookup (getFilePathId fi) nodeKeys) this_dep_ids
-      go (Just ms) _ = Just $ ModuleNode [] ms
+      go (pid, Just ms) _ = Just $ (pid, ModuleNode [] ms)
       go _ _ = Nothing
-      mg = mkModuleGraph mns
-  pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg)
+      mg = IntMap.fromList $ map (first getFilePathId) mns
+  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 +656,15 @@ dependencyInfoForFiles fs = do
 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 $ useTransDepModuleGraph fp
            }
   addUsageDependencies $ liftIO $
     typecheckModule defer hsc dets pm
@@ -731,6 +736,11 @@ instance Default GhcSessionDepsConfig where
     { fullModuleGraph = True
     }
 
+useTransDepModuleGraph :: NormalizedFilePath -> Action DependencyInformation
+useTransDepModuleGraph file = filterDependencyInformationReachable file <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file
+useImmediateDepsModuleGraph :: NormalizedFilePath -> Action (Maybe DependencyInformation)
+useImmediateDepsModuleGraph file = useWithSeparateFingerprintRule GetModuleGraphTransDepsFingerprints GetModuleGraph file
+
 -- | Note [GhcSessionDeps]
 --   ~~~~~~~~~~~~~~~~~~~~~
 -- For a file 'Foo', GhcSessionDeps "Foo.hs" results in an HscEnv which includes
@@ -756,9 +766,10 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
             depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps
             ifaces <- uses_ GetModIface deps
             let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces
-            mg <- do
+            de <- useTransDepModuleGraph file
+            mg <- mkModuleGraph <$> do
               if fullModuleGraph
-              then depModuleGraph <$> useNoFile_ GetModuleGraph
+              then return $ IntMap.elems $ 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
@@ -770,8 +781,7 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
                 let module_graph_nodes =
                       nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs)
                 liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes
-                return $ mkModuleGraph module_graph_nodes
-            de <- useNoFile_ GetModuleGraph
+                return module_graph_nodes
             session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions
 
             -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new
@@ -801,7 +811,7 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco
             , 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 = useTransDepModuleGraph f
             , regenerate = regenerateHiFile session f ms
             }
       hsc_env' <- setFileCacheHook (hscEnv session)
@@ -977,7 +987,7 @@ regenerateHiFile sess f ms compNeeded = do
         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
@@ -1135,7 +1145,7 @@ needsCompilationRule file
   | "boot" `isSuffixOf` fromNormalizedFilePath file =
     pure (Just $ encodeLinkableType Nothing, Just Nothing)
 needsCompilationRule file = do
-  graph <- useNoFile GetModuleGraph
+  graph <- useImmediateDepsModuleGraph file
   res <- case graph of
     -- Treat as False if some reverse dependency header fails to parse
     Nothing -> pure Nothing
@@ -1247,6 +1257,19 @@ mainRule recorder RulesConfig{..} = do
     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 =