consider only dirty deps

Author: pepeiborra

hls-graph/src/Development/IDE/Graph/Internal/Database.hs

@@ -125,16 +125,19 @@ builder db@Database{..} keys = do
 cleanupAsync :: IORef [Async a] -> IO ()
 cleanupAsync ref = mapConcurrently_ uninterruptibleCancel =<< readIORef ref
 
-
 -- | Check if we need to run the database.
 check :: Database -> Key -> Id -> Maybe Result -> IO Result
 check db key id result@(Just me@Result{resultDeps=Just deps}) = do
-    amDirty <- isDirty db id
-    mode <- if amDirty
+    dirtySet <- getDirtySet db
+    let allDirty = reverseDepsAllDirty (databaseReverseDeps db)
+    let isDirty id = allDirty
+                   || HSet.member id dirtySet
+    mode <- if isDirty id
         -- Event if I am dirty, it is still possible that all my dependencies are unchanged
         -- thanks to early cutoff, and therefore we must check to avoid redundant work
         then do
-            res <- builder db $ map Left deps
+            let dirtyDeps = if allDirty then deps else filter isDirty deps
+            res <- builder db $ map Left dirtyDeps
             let dirty = any (\(_,dep) -> resultBuilt me < resultChanged dep) res
             return $ if dirty then Shake.RunDependenciesChanged else Shake.RunDependenciesSame
         -- If I am not dirty then none of my dependencies are, so they must be unchanged
@@ -205,12 +208,6 @@ flushDirty Database{databaseReverseDeps} = do
     cleanIds <- atomicModifyIORef' (reverseDepsClean databaseReverseDeps) (mempty,)
     atomicModifyIORef'_ (reverseDepsDirty databaseReverseDeps) (`HSet.difference` cleanIds)
 
-isDirty :: Database -> Id -> IO Bool
-isDirty db@Database{databaseReverseDeps} id
-  | reverseDepsAllDirty databaseReverseDeps = pure True
-  | otherwise =
-    HSet.member id <$> getDirtySet db
-
 getDirtySet :: Database -> IO (HSet.HashSet Id)
 getDirtySet db = readIORef (reverseDepsDirty $ databaseReverseDeps db)