schedule a GC on file close

Author: pepeiborra

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

@@ -256,9 +256,9 @@ setFileModified state saved nfp = do
     ideOptions <- getIdeOptionsIO $ shakeExtras state
     doCheckParents <- optCheckParents ideOptions
     let checkParents = case doCheckParents of
-          AlwaysCheck         -> True
-          CheckOnSaveAndClose -> saved
-          _                   -> False
+          AlwaysCheck -> True
+          CheckOnSave -> saved
+          _           -> False
     VFSHandle{..} <- getIdeGlobalState state
     when (isJust setVirtualFileContents) $
         fail "setFileModified can't be called on this type of VFSHandle"

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

@@ -15,7 +15,7 @@ module Development.IDE.Core.OfInterest(
     setFilesOfInterest,
     kick, FileOfInterestStatus(..),
     OfInterestVar(..)
-    ) where
+    ,scheduleGarbageCollection) where
 
 import           Control.Concurrent.Strict
 import           Control.Monad
@@ -42,6 +42,7 @@ instance IsIdeGlobal OfInterestVar
 ofInterestRules :: Rules ()
 ofInterestRules = do
     addIdeGlobal . OfInterestVar =<< liftIO (newVar HashMap.empty)
+    addIdeGlobal . GarbageCollectVar =<< liftIO (newVar False)
     defineEarlyCutoff $ RuleNoDiagnostics $ \IsFileOfInterest f -> do
         alwaysRerun
         filesOfInterest <- getFilesOfInterestUntracked
@@ -55,6 +56,9 @@ ofInterestRules = do
     summarize (IsFOI (Modified False)) = BS.singleton 2
     summarize (IsFOI (Modified True))  = BS.singleton 3
 
+------------------------------------------------------------
+newtype GarbageCollectVar = GarbageCollectVar (Var Bool)
+instance IsIdeGlobal GarbageCollectVar
 
 ------------------------------------------------------------
 -- Exposed API
@@ -94,6 +98,10 @@ deleteFileOfInterest state f = do
     recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]
     logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show files)
 
+scheduleGarbageCollection :: IdeState -> IO ()
+scheduleGarbageCollection state = do
+    GarbageCollectVar var <- getIdeGlobalState state
+    writeVar var True
 
 -- | Typecheck all the files of interest.
 --   Could be improved
@@ -111,6 +119,8 @@ kick = do
 
     liftIO $ progressUpdate progress KickCompleted
 
-    -- if idle, perform garbage collection of dirty keys
-    liftIO $ sleep 5
-    void garbageCollectDirtyKeys
+    GarbageCollectVar var <- getIdeGlobalAction
+    garbageCollectionScheduled <- liftIO $ readVar var
+    when garbageCollectionScheduled $ do
+        void $ garbageCollectDirtyKeys
+        liftIO $ writeVar var False

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

@@ -761,9 +761,9 @@ getHiddenDiagnostics IdeState{shakeExtras = ShakeExtras{hiddenDiagnostics}} = do
 --     * exports map
 garbageCollectDirtyKeys :: Action [Key]
 garbageCollectDirtyKeys = do
-    IdeOptions{optCheckParents, optMaxDirtyAge} <- getIdeOptions
+    IdeOptions{optCheckParents} <- getIdeOptions
     checkParents <- liftIO optCheckParents
-    garbageCollectDirtyKeysOlderThan optMaxDirtyAge checkParents
+    garbageCollectDirtyKeysOlderThan 1 checkParents
 
 garbageCollectDirtyKeysOlderThan :: Int -> CheckParents -> Action [Key]
 garbageCollectDirtyKeysOlderThan maxAge checkParents = otTracedGarbageCollection "dirty GC" $ do

ghcide/src/Development/IDE/LSP/Notifications.hs

@@ -14,30 +14,25 @@ module Development.IDE.LSP.Notifications
 import           Language.LSP.Types
 import qualified Language.LSP.Types                    as LSP
 
-import           Development.IDE.Core.IdeConfiguration
-import           Development.IDE.Core.Service
-import           Development.IDE.Core.Shake
-import           Development.IDE.Types.Location
-import           Development.IDE.Types.Logger
-import           Development.IDE.Types.Options
-
 import           Control.Monad.Extra
-import qualified Data.HashSet                          as S
-import qualified Data.Text                             as Text
-
 import           Control.Monad.IO.Class
 import qualified Data.HashMap.Strict                   as HM
+import qualified Data.HashSet                          as S
+import qualified Data.Text                             as Text
 import           Development.IDE.Core.FileExists       (modifyFileExists,
                                                         watchedGlobs)
 import           Development.IDE.Core.FileStore        (registerFileWatches,
                                                         resetFileStore,
                                                         setFileModified,
-                                                        setSomethingModified,
-                                                        typecheckParents)
+                                                        setSomethingModified)
+import           Development.IDE.Core.IdeConfiguration
 import           Development.IDE.Core.OfInterest
 import           Development.IDE.Core.RuleTypes        (GetClientSettings (..))
+import           Development.IDE.Core.Service
+import           Development.IDE.Core.Shake
+import           Development.IDE.Types.Location
+import           Development.IDE.Types.Logger
 import           Development.IDE.Types.Shake           (toKey)
-import           Ide.Plugin.Config                     (CheckParents (CheckOnClose))
 import           Ide.Types
 
 whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
@@ -74,10 +69,10 @@ descriptor plId = (defaultPluginDescriptor plId) { pluginNotificationHandlers =
         \ide _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
           whenUriFile _uri $ \file -> do
               deleteFileOfInterest ide file
-              -- Refresh all the files that depended on this
-              checkParents <- optCheckParents =<< getIdeOptionsIO (shakeExtras ide)
-              when (checkParents >= CheckOnClose) $ typecheckParents ide file
-              logDebug (ideLogger ide) $ "Closed text document: " <> getUri _uri
+              let msg = "Closed text document: " <> getUri _uri
+              scheduleGarbageCollection ide
+              setSomethingModified ide [] $ Text.unpack msg
+              logDebug (ideLogger ide) msg
 
   , mkPluginNotificationHandler LSP.SWorkspaceDidChangeWatchedFiles $
       \ide _ (DidChangeWatchedFilesParams (List fileEvents)) -> liftIO $ do

ghcide/src/Development/IDE/Types/Options.hs

@@ -139,7 +139,7 @@ defaultIdeOptions session = IdeOptions
     ,optDefer = IdeDefer True
     ,optTesting = IdeTesting False
     ,optCheckProject = pure True
-    ,optCheckParents = pure CheckOnSaveAndClose
+    ,optCheckParents = pure CheckOnSave
     ,optHaddockParse = HaddockParse
     ,optModifyDynFlags = mempty
     ,optSkipProgress = defaultSkipProgress

hls-plugin-api/src/Ide/Plugin/Config.hs

@@ -37,8 +37,7 @@ data CheckParents
     -- Note that ordering of constructors is meaningful and must be monotonically
     -- increasing in the scenarios where parents are checked
     = NeverCheck
-    | CheckOnClose
-    | CheckOnSaveAndClose
+    | CheckOnSave
     | AlwaysCheck
   deriving stock (Eq, Ord, Show, Generic)
   deriving anyclass (FromJSON, ToJSON)
@@ -61,7 +60,7 @@ data Config =
 
 instance Default Config where
   def = Config
-    { checkParents                = CheckOnSaveAndClose
+    { checkParents                = CheckOnSave
     , checkProject                = True
     , hlintOn                     = True
     , diagnosticsOnChange         = True