GC fixes

Author: pepeiborra

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

@@ -743,19 +743,22 @@ getHiddenDiagnostics IdeState{shakeExtras = ShakeExtras{hiddenDiagnostics}} = do
 garbageCollectDirtyKeys :: Action ()
 garbageCollectDirtyKeys = do
     start <- liftIO offsetTime
-    dirtyKeys <- fromMaybe [] <$> getDirtySet
+    dirtySet <- fromMaybe [] <$> getDirtySet
     extras <- getShakeExtras
-    n <- liftIO $ modifyVar (state extras) $ \vmap ->
-        evaluate $ foldl' removeDirtyKey (vmap, 0) dirtyKeys
+    (n::Int, garbage) <- liftIO $ modifyVar (state extras) $ \vmap ->
+        evaluate $ foldl' removeDirtyKey (vmap, (0,[])) dirtySet
+    liftIO $ atomicModifyIORef_ (dirtyKeys extras) $ \x ->
+        foldl' (flip HSet.insert) x garbage
     t <- liftIO start
-    liftIO $ logDebug (logger extras) $ T.pack $
+    when (n>0) $ liftIO $ logDebug (logger extras) $ T.pack $
         "Garbage collected " <> show n <> " keys (took " <> showDuration t <> ")"
     where
-        removeDirtyKey :: (Values, Int) -> (Key, Int) -> (Values, Int)
-        removeDirtyKey (vmap,counter) (k, age)
+        -- removeDirtyKey :: (Values, Int) -> (Key, Int) -> (Values, [Key], Int)
+        removeDirtyKey (vmap,(counter, keys)) (k, age)
             | age > garbageAge
-            = let !c' = counter +1 in (HMap.delete k vmap, c')
-            | otherwise = (vmap,counter)
+            , (True, vmap') <- HMap.alterF (\prev -> (isJust prev, Nothing)) k vmap
+            = let !c' = counter+1 in (vmap', (c', k:keys))
+            | otherwise = (vmap, (counter, keys))
 
 -- | Define a new Rule without early cutoff
 define