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

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_)
+import           Data.Foldable                          (find, for_, traverse_)
 import           Data.Functor                           ((<&>))
 import           Data.Functor.Identity
 import           Data.Hashable
@@ -172,6 +172,7 @@ 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)
@@ -853,14 +854,15 @@ 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 (toListKeySet <$> allPendingKeys) shakeDb keysActs
+            restore $ shakeRunDatabaseForKeys 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,8 +8,9 @@ module Development.IDE.Graph.Database(
     shakeGetBuildStep,
     shakeGetDatabaseKeys,
     shakeGetDirtySet,
-    shakeGetCleanKeys
-    ,shakeGetBuildEdges) where
+    shakeGetCleanKeys,
+    shakeMarkDirtyKeys,
+    shakeGetBuildEdges) where
 import           Control.Concurrent.STM.Stats            (readTVarIO)
 import           Data.Dynamic
 import           Data.Maybe
@@ -34,7 +35,7 @@ shakeNewDatabase opts rules = do
     pure $ ShakeDatabase (length actions) actions db
 
 shakeRunDatabase :: ShakeDatabase -> [Action a] -> IO [a]
-shakeRunDatabase = shakeRunDatabaseForKeys Nothing
+shakeRunDatabase = shakeRunDatabaseForKeys
 
 -- | Returns the set of dirty keys annotated with their age (in # of builds)
 shakeGetDirtySet :: ShakeDatabase -> IO [(Key, Int)]
@@ -52,16 +53,19 @@ 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
-    :: Maybe [Key]
-      -- ^ Set of keys changed since last run. 'Nothing' means everything has changed
-    -> ShakeDatabase
+    ::
+    ShakeDatabase
     -> [Action a]
     -> IO [a]
-shakeRunDatabaseForKeys keysChanged (ShakeDatabase lenAs1 as1 db) as2 = do
-    incDatabase db keysChanged
+shakeRunDatabaseForKeys (ShakeDatabase lenAs1 as1 db) as2 = do
     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