Preserve dirty set and add dirtiness assertion (#2279)

* do not throw away the previous dirty set * assertion
haskell · Oct 17, 2021 · 6c647d1 · 6c647d1
1 parent 37370f4
commit 6c647d1
Show file tree

Hide file tree

Showing 5 changed files with 19 additions and 8 deletions.
diff --git a/ghcide/ghcide.cabal b/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

diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/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

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/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)

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs b/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
 

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/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)),