Revert "mark the keys dirty before we do async runs to start the database"

This reverts commit 26aac1a.

Author: soulomoon

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

@@ -96,7 +96,7 @@ import           Data.Default
 import           Data.Dynamic
 import           Data.EnumMap.Strict                    (EnumMap)
 import qualified Data.EnumMap.Strict                    as EM
-import           Data.Foldable                          (find, for_, traverse_)
+import           Data.Foldable                          (find, for_)
 import           Data.Functor                           ((<&>))
 import           Data.Functor.Identity
 import           Data.Hashable
@@ -172,7 +172,6 @@ import qualified StmContainers.Map                      as STM
 import           System.FilePath                        hiding (makeRelative)
 import           System.IO.Unsafe                       (unsafePerformIO)
 import           System.Time.Extra
-import Development.IDE.Graph.Database (shakeMarkDirtyKeys)
 -- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
 
 #if !MIN_VERSION_ghc(9,3,0)
@@ -854,15 +853,14 @@ newSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason = do
           whenJust allPendingKeys $ \kk -> setTag otSpan "keys" (BS8.pack $ unlines $ map show $ toListKeySet kk)
           let keysActs = pumpActionThread otSpan : map (run otSpan) (reenqueued ++ acts)
           res <- try @SomeException $
-            restore $ shakeRunDatabaseForKeys shakeDb keysActs
+            restore $ shakeRunDatabaseForKeys (toListKeySet <$> allPendingKeys) shakeDb keysActs
           return $ do
               let exception =
                     case res of
                       Left e -> Just e
                       _      -> Nothing
               logWith recorder Debug $ LogBuildSessionFinish exception
-    -- mark the key as dirty in hls graph
-    traverse_ (shakeMarkDirtyKeys shakeDb) allPendingKeys
+
     -- Do the work in a background thread
     workThread <- asyncWithUnmask workRun
 

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

@@ -8,9 +8,8 @@ module Development.IDE.Graph.Database(
     shakeGetBuildStep,
     shakeGetDatabaseKeys,
     shakeGetDirtySet,
-    shakeGetCleanKeys,
-    shakeMarkDirtyKeys,
-    shakeGetBuildEdges) where
+    shakeGetCleanKeys
+    ,shakeGetBuildEdges) where
 import           Control.Concurrent.STM.Stats            (readTVarIO)
 import           Data.Dynamic
 import           Data.Maybe
@@ -35,7 +34,7 @@ shakeNewDatabase opts rules = do
     pure $ ShakeDatabase (length actions) actions db
 
 shakeRunDatabase :: ShakeDatabase -> [Action a] -> IO [a]
-shakeRunDatabase = shakeRunDatabaseForKeys
+shakeRunDatabase = shakeRunDatabaseForKeys Nothing
 
 -- | Returns the set of dirty keys annotated with their age (in # of builds)
 shakeGetDirtySet :: ShakeDatabase -> IO [(Key, Int)]
@@ -53,19 +52,16 @@ unvoid :: Functor m => m () -> m a
 unvoid = fmap undefined
 
 -- | Assumes that the database is not running a build
--- dirty keys should be marked using `shakeMarkDirtyKeys`
--- before calling this function
 shakeRunDatabaseForKeys
-    ::
-    ShakeDatabase
+    :: Maybe [Key]
+      -- ^ Set of keys changed since last run. 'Nothing' means everything has changed
+    -> ShakeDatabase
     -> [Action a]
     -> IO [a]
-shakeRunDatabaseForKeys (ShakeDatabase lenAs1 as1 db) as2 = do
+shakeRunDatabaseForKeys keysChanged (ShakeDatabase lenAs1 as1 db) as2 = do
+    incDatabase db keysChanged
     fmap (drop lenAs1) $ runActions db $ map unvoid as1 ++ as2
 
-shakeMarkDirtyKeys :: ShakeDatabase -> KeySet -> IO ()
-shakeMarkDirtyKeys (ShakeDatabase _ _ db) keys = incDatabase db $ Just (toListKeySet keys)
-
 -- | Given a 'ShakeDatabase', write an HTML profile to the given file about the latest run.
 shakeProfileDatabase :: ShakeDatabase -> FilePath -> IO ()
 shakeProfileDatabase (ShakeDatabase _ _ s) file = writeProfile file s