Preserve dirty set and add dirtiness assertion

ghcide/ghcide.cabal

@@ -213,7 +213,12 @@ library
         Development.IDE.Types.Action
         Text.Fuzzy.Parallel
 
-    ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns -Wno-unticked-promoted-constructors
+    ghc-options:
+                -Wall
+                -Wno-name-shadowing
+                -Wincomplete-uni-patterns
+                -Wno-unticked-promoted-constructors
+                -fno-ignore-asserts
 
     if flag(ghc-patched-unboxed-bytecode)
       cpp-options: -DGHC_PATCHED_UNBOXED_BYTECODE

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

@@ -109,11 +109,12 @@ import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.ProgressReporting
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Tracing
-import           Development.IDE.GHC.Compat             (NameCacheUpdater (..),
-                                                         upNameCache, NameCache,
+import           Development.IDE.GHC.Compat             (NameCache,
+                                                         NameCacheUpdater (..),
                                                          initNameCache,
+                                                         knownKeyNames,
                                                          mkSplitUniqSupply,
-                                                         knownKeyNames)
+                                                         upNameCache)
 import           Development.IDE.GHC.Orphans            ()
 import           Development.IDE.Graph                  hiding (ShakeValue)
 import qualified Development.IDE.Graph                  as Shake
@@ -914,7 +915,10 @@ defineEarlyCutoff' doDiagnostics key file old mode action = do
                             updateFileDiagnostics file (Key key) extras $ map (\(_,y,z) -> (y,z)) $ Vector.toList diags
                         return $ Just $ RunResult ChangedNothing old $ A v
                     _ -> return Nothing
-            _ -> return Nothing
+            _ ->
+                -- assert that a "clean" rule is never a cache miss
+                -- as this is likely a bug in the dirty key tracking
+                assert (mode /= RunDependenciesSame) $ return Nothing
         res <- case val of
             Just res -> return res
             Nothing -> do

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

@@ -66,7 +66,7 @@ incDatabase db (Just kk) = do
     intern <- readIORef (databaseIds db)
     let dirtyIds = mapMaybe (`Intern.lookup` intern) kk
     transitiveDirtyIds <- transitiveDirtySet db dirtyIds
-    writeIORef (databaseDirtySet db) (Just $ Set.toList transitiveDirtyIds)
+    modifyIORef (databaseDirtySet db) (\dd -> Just $ fromMaybe mempty dd <> transitiveDirtyIds)
     withLock (databaseLock db) $
         Ids.forMutate (databaseValues db) $ \i -> \case
             (k, Running _ _ x) -> (k, Dirty x)

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

@@ -14,6 +14,7 @@ import qualified Data.HashMap.Strict                  as Map
 import           Data.IORef
 import           Data.IntMap                          (IntMap)
 import qualified Data.IntMap                          as IntMap
+import qualified Data.IntSet                          as Set
 import           Data.List                            (dropWhileEnd, foldl',
                                                        intercalate, partition,
                                                        sort, sortBy)
@@ -45,7 +46,7 @@ writeProfile :: FilePath -> Database -> IO ()
 writeProfile out db = do
     dirtyKeys <- readIORef (databaseDirtySet db)
     (report, mapping) <- toReport db
-    let dirtyKeysMapped = mapMaybe (`IntMap.lookup` mapping) <$> dirtyKeys
+    let dirtyKeysMapped = mapMaybe (`IntMap.lookup` mapping) . Set.toList <$> dirtyKeys
     rpt <- generateHTML (sort <$> dirtyKeysMapped) report
     LBS.writeFile out rpt
 

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

@@ -81,7 +81,8 @@ data Database = Database {
     databaseExtra           :: Dynamic,
     databaseRules           :: TheRules,
     databaseStep            :: !(IORef Step),
-    databaseDirtySet        :: IORef (Maybe [Id]),
+    -- | Nothing means that everything is dirty
+    databaseDirtySet        :: IORef (Maybe IntSet),
     -- Hold the lock while mutating Ids/Values
     databaseLock            :: !Lock,
     databaseIds             :: !(IORef (Intern Key)),