From 684a85042f6ca209d6c8f3b18e41b6d1d774da66 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 23 Apr 2024 04:59:55 +0800 Subject: [PATCH 01/44] passing keys need to be update directly to restartShakeSession --- ghcide/session-loader/Development/IDE/Session.hs | 2 +- ghcide/src/Development/IDE/Core/FileStore.hs | 4 ++-- ghcide/src/Development/IDE/Core/Shake.hs | 6 ++++-- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 2 +- 4 files changed, 8 insertions(+), 6 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index a0d870d590..4b4294cd8a 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -623,7 +623,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do invalidateShakeCache -- The VFS doesn't change on cradle edits, re-use the old one. - restartShakeSession VFSUnmodified "new component" [] + restartShakeSession VFSUnmodified "new component" [] [] -- Typecheck all files in the project on startup checkProject <- getCheckProject diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 7be4c71827..49e9ad3b5c 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -224,7 +224,7 @@ setFileModified recorder vfs state saved nfp = do CheckOnSave -> saved _ -> False join $ atomically $ recordDirtyKeys (shakeExtras state) GetModificationTime [nfp] - restartShakeSession (shakeExtras state) vfs (fromNormalizedFilePath nfp ++ " (modified)") [] + restartShakeSession (shakeExtras state) vfs (fromNormalizedFilePath nfp ++ " (modified)") [] [] when checkParents $ typecheckParents recorder state nfp @@ -251,7 +251,7 @@ setSomethingModified vfs state keys reason = do writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles) modifyTVar' (dirtyKeys $ shakeExtras state) $ \x -> foldl' (flip insertKeySet) x keys - void $ restartShakeSession (shakeExtras state) vfs reason [] + void $ restartShakeSession (shakeExtras state) vfs reason [] keys registerFileWatches :: [String] -> LSP.LspT Config IO Bool registerFileWatches globs = do diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index a215ee42ef..d5ed2bc579 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -300,6 +300,7 @@ data ShakeExtras = ShakeExtras :: VFSModified -> String -> [DelayedAction ()] + -> [Key] -> IO () #if MIN_VERSION_ghc(9,3,0) ,ideNc :: NameCache @@ -759,13 +760,14 @@ delayedAction a = do -- | Restart the current 'ShakeSession' with the given system actions. -- Any actions running in the current session will be aborted, -- but actions added via 'shakeEnqueue' will be requeued. -shakeRestart :: Recorder (WithPriority Log) -> IdeState -> VFSModified -> String -> [DelayedAction ()] -> IO () -shakeRestart recorder IdeState{..} vfs reason acts = +shakeRestart :: Recorder (WithPriority Log) -> IdeState -> VFSModified -> String -> [DelayedAction ()] -> [Key] -> IO () +shakeRestart recorder IdeState{..} vfs reason acts keys = withMVar' shakeSession (\runner -> do (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner res <- shakeDatabaseProfile shakeDb + atomically $ modifyTVar' (dirtyKeys shakeExtras) $ \x -> foldl' (flip insertKeySet) x keys backlog <- readTVarIO $ dirtyKeys shakeExtras queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 7126dc14b1..2e305b2e45 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -133,7 +133,7 @@ Then we restart the shake session, so that changes to our virtual files are actu restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO () restartCabalShakeSession shakeExtras vfs file actionMsg = do join $ atomically $ Shake.recordDirtyKeys shakeExtras GetModificationTime [file] - restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] + restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] [] -- ---------------------------------------------------------------- -- Plugin Rules From 5d098374c0129b545721cd433d74bbe8988c8be5 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 25 Apr 2024 00:42:02 +0800 Subject: [PATCH 02/44] send actions to run between restart --- .../session-loader/Development/IDE/Session.hs | 20 ++++++-------- ghcide/src/Development/IDE/Core/FileStore.hs | 23 +++++++++------- ghcide/src/Development/IDE/Core/Shake.hs | 8 +++--- .../src/Development/IDE/LSP/Notifications.hs | 26 +++++++++---------- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 20 +++++++------- 5 files changed, 48 insertions(+), 49 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 4b4294cd8a..e862261480 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -611,19 +611,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do [ "No cradle target found. Is this file listed in the targets of your cradle?" , "If you are using a .cabal file, please ensure that this module is listed in either the exposed-modules or other-modules section" ] - - void $ modifyVar' fileToFlags $ - Map.insert hieYaml this_flags_map - void $ modifyVar' filesMap $ - flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) - - void $ extendKnownTargets all_targets - - -- Invalidate all the existing GhcSession build nodes by restarting the Shake session - invalidateShakeCache - -- The VFS doesn't change on cradle edits, re-use the old one. - restartShakeSession VFSUnmodified "new component" [] [] + restartShakeSession VFSUnmodified "new component" [] $ do + void $ modifyVar' fileToFlags $ + Map.insert hieYaml this_flags_map + void $ modifyVar' filesMap $ + flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) + void $ extendKnownTargets all_targets + -- Invalidate all the existing GhcSession build nodes by restarting the Shake session + invalidateShakeCache -- Typecheck all files in the project on startup checkProject <- getCheckProject diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 49e9ad3b5c..d0e5d69876 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -216,15 +216,17 @@ setFileModified :: Recorder (WithPriority Log) -> Bool -- ^ Was the file saved? -> NormalizedFilePath -> IO () -setFileModified recorder vfs state saved nfp = do + -> IO () +setFileModified recorder vfs state saved nfp actionBefore = do ideOptions <- getIdeOptionsIO $ shakeExtras state doCheckParents <- optCheckParents ideOptions let checkParents = case doCheckParents of AlwaysCheck -> True CheckOnSave -> saved _ -> False - join $ atomically $ recordDirtyKeys (shakeExtras state) GetModificationTime [nfp] - restartShakeSession (shakeExtras state) vfs (fromNormalizedFilePath nfp ++ " (modified)") [] [] + restartShakeSession (shakeExtras state) vfs (fromNormalizedFilePath nfp ++ " (modified)") [] $ do + actionBefore + join $ atomically $ recordDirtyKeys (shakeExtras state) GetModificationTime [nfp] when checkParents $ typecheckParents recorder state nfp @@ -244,14 +246,15 @@ typecheckParentsAction recorder nfp = do -- | Note that some keys have been modified and restart the session -- Only valid if the virtual file system was initialised by LSP, as that -- independently tracks which files are modified. -setSomethingModified :: VFSModified -> IdeState -> [Key] -> String -> IO () -setSomethingModified vfs state keys reason = do +setSomethingModified :: VFSModified -> IdeState -> [Key] -> String -> IO () -> IO () +setSomethingModified vfs state keys reason actionBetweenSession = do -- Update database to remove any files that might have been renamed/deleted - atomically $ do - writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles) - modifyTVar' (dirtyKeys $ shakeExtras state) $ \x -> - foldl' (flip insertKeySet) x keys - void $ restartShakeSession (shakeExtras state) vfs reason [] keys + void $ restartShakeSession (shakeExtras state) vfs reason [] $ do + actionBetweenSession + atomically $ do + writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles) + modifyTVar' (dirtyKeys $ shakeExtras state) $ \x -> + foldl' (flip insertKeySet) x keys registerFileWatches :: [String] -> LSP.LspT Config IO Bool registerFileWatches globs = do diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index d5ed2bc579..9003917f0c 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -300,7 +300,7 @@ data ShakeExtras = ShakeExtras :: VFSModified -> String -> [DelayedAction ()] - -> [Key] + -> IO () -> IO () #if MIN_VERSION_ghc(9,3,0) ,ideNc :: NameCache @@ -760,14 +760,14 @@ delayedAction a = do -- | Restart the current 'ShakeSession' with the given system actions. -- Any actions running in the current session will be aborted, -- but actions added via 'shakeEnqueue' will be requeued. -shakeRestart :: Recorder (WithPriority Log) -> IdeState -> VFSModified -> String -> [DelayedAction ()] -> [Key] -> IO () -shakeRestart recorder IdeState{..} vfs reason acts keys = +shakeRestart :: Recorder (WithPriority Log) -> IdeState -> VFSModified -> String -> [DelayedAction ()] -> IO () -> IO () +shakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession = withMVar' shakeSession (\runner -> do (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner res <- shakeDatabaseProfile shakeDb - atomically $ modifyTVar' (dirtyKeys shakeExtras) $ \x -> foldl' (flip insertKeySet) x keys + ioActionBetweenShakeSession backlog <- readTVarIO $ dirtyKeys shakeExtras queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index 1772612e2d..f468c55e55 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -72,32 +72,32 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat whenUriFile _uri $ \file -> do -- We don't know if the file actually exists, or if the contents match those on disk -- For example, vscode restores previously unsaved contents on open - addFileOfInterest ide file Modified{firstOpen=True} - setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file - logWith recorder Debug $ LogOpenedTextDocument _uri + setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file $ + addFileOfInterest ide file Modified{firstOpen=True} + logWith recorder Debug $ LogOpenedTextDocument _uri , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $ \ide vfs _ (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do atomically $ updatePositionMapping ide identifier changes whenUriFile _uri $ \file -> do - addFileOfInterest ide file Modified{firstOpen=False} - setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file + setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file $ + addFileOfInterest ide file Modified{firstOpen=False} logWith recorder Debug $ LogModifiedTextDocument _uri , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $ \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do - addFileOfInterest ide file OnDisk - setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide True file + setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide True file $ + addFileOfInterest ide file OnDisk logWith recorder Debug $ LogSavedTextDocument _uri , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $ \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do whenUriFile _uri $ \file -> do - deleteFileOfInterest ide file let msg = "Closed text document: " <> getUri _uri - scheduleGarbageCollection ide - setSomethingModified (VFSModified vfs) ide [] $ Text.unpack msg + setSomethingModified (VFSModified vfs) ide [] (Text.unpack msg) $ do + deleteFileOfInterest ide file + scheduleGarbageCollection ide logWith recorder Debug $ LogClosedTextDocument _uri , mkPluginNotificationHandler LSP.SMethod_WorkspaceDidChangeWatchedFiles $ @@ -116,9 +116,9 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat unless (null fileEvents') $ do let msg = show fileEvents' logWith recorder Debug $ LogWatchedFileEvents (Text.pack msg) - modifyFileExists ide fileEvents' - resetFileStore ide fileEvents' - setSomethingModified (VFSModified vfs) ide [] msg + setSomethingModified (VFSModified vfs) ide [] msg $ do + modifyFileExists ide fileEvents' + resetFileStore ide fileEvents' , mkPluginNotificationHandler LSP.SMethod_WorkspaceDidChangeWorkspaceFolders $ \ide _ _ (DidChangeWorkspaceFoldersParams events) -> liftIO $ do diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 2e305b2e45..34f0095f64 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -90,26 +90,26 @@ descriptor recorder plId = \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocOpened _uri - addFileOfInterest recorder ide file Modified{firstOpen = True} - restartCabalShakeSession (shakeExtras ide) vfs file "(opened)" + restartCabalShakeSession (shakeExtras ide) vfs file "(opened)" $ + addFileOfInterest recorder ide file Modified{firstOpen = True} , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $ \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocModified _uri - addFileOfInterest recorder ide file Modified{firstOpen = False} - restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" + restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $ + addFileOfInterest recorder ide file Modified{firstOpen = False} , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $ \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocSaved _uri - addFileOfInterest recorder ide file OnDisk - restartCabalShakeSession (shakeExtras ide) vfs file "(saved)" + restartCabalShakeSession (shakeExtras ide) vfs file "(saved)" $ + addFileOfInterest recorder ide file OnDisk , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $ \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocClosed _uri - deleteFileOfInterest recorder ide file - restartCabalShakeSession (shakeExtras ide) vfs file "(closed)" + restartCabalShakeSession (shakeExtras ide) vfs file "(closed)" $ + deleteFileOfInterest recorder ide file ] , pluginConfigDescriptor = defaultConfigDescriptor { configHasDiagnostics = True @@ -132,8 +132,8 @@ Then we restart the shake session, so that changes to our virtual files are actu -} restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO () restartCabalShakeSession shakeExtras vfs file actionMsg = do - join $ atomically $ Shake.recordDirtyKeys shakeExtras GetModificationTime [file] - restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] [] + restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ + join $ atomically $ Shake.recordDirtyKeys shakeExtras GetModificationTime [file] -- ---------------------------------------------------------------- -- Plugin Rules From 13528d7d4b5aba5e33fbdf970fc2eeabe9e87191 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 25 Apr 2024 00:44:58 +0800 Subject: [PATCH 03/44] fix --- ghcide/src/Development/IDE/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 0c7581f75d..1d8f064709 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -364,7 +364,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re let msg = T.pack $ show cfg logWith recorder Debug $ LogConfigurationChange msg modifyClientSettings ide (const $ Just cfgObj) - setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change" + setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change" $ return () runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup dumpSTMStats From fdbb7aaca816cdbf23d7904148969b41350d76c8 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 25 Apr 2024 00:49:24 +0800 Subject: [PATCH 04/44] fix --- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 7 ++++--- plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs | 6 ++---- 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 9003917f0c..f49bfe56b8 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -766,8 +766,8 @@ shakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession = shakeSession (\runner -> do (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner - res <- shakeDatabaseProfile shakeDb ioActionBetweenShakeSession + res <- shakeDatabaseProfile shakeDb backlog <- readTVarIO $ dirtyKeys shakeExtras queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 34f0095f64..404ba71ba2 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -130,9 +130,10 @@ needs to be re-parsed. That's what we do when we record the dirty key that our p rule depends on. Then we restart the shake session, so that changes to our virtual files are actually picked up. -} -restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO () -restartCabalShakeSession shakeExtras vfs file actionMsg = do - restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ +restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO () -> IO () +restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = do + restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do + actionBetweenSession join $ atomically $ Shake.recordDirtyKeys shakeExtras GetModificationTime [file] -- ---------------------------------------------------------------- diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index bb7c51be59..4d9aec1ad2 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -211,10 +211,8 @@ runEvalCmd recorder plId st mtoken EvalParams{..} = -- enable codegen for the module which we need to evaluate. final_hscEnv <- liftIO $ bracket_ - (do queueForEvaluation st nfp - setSomethingModified VFSUnmodified st [toKey IsEvaluating nfp] "Eval") - (do unqueueForEvaluation st nfp - setSomethingModified VFSUnmodified st [toKey IsEvaluating nfp] "Eval") + (setSomethingModified VFSUnmodified st [toKey IsEvaluating nfp] "Eval" $ queueForEvaluation st nfp) + (setSomethingModified VFSUnmodified st [toKey IsEvaluating nfp] "Eval" $ unqueueForEvaluation st nfp) (initialiseSessionForEval (needsQuickCheck tests) st nfp) evalCfg <- liftIO $ runAction "eval: config" st $ getEvalConfig plId From 6fc3646741af3d62b9729f173ddcc903f443a4ef Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 25 Apr 2024 01:08:01 +0800 Subject: [PATCH 05/44] some more fix up --- ghcide/src/Development/IDE/Core/FileStore.hs | 6 ++---- ghcide/src/Development/IDE/Core/Shake.hs | 11 +++++++++- .../src/Development/IDE/LSP/Notifications.hs | 4 ++-- ghcide/src/Development/IDE/Main.hs | 15 +++++++------ .../src/Ide/Plugin/Eval/CodeLens.hs | 21 +++++++++++++------ 5 files changed, 38 insertions(+), 19 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index d0e5d69876..762f761dbe 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -246,15 +246,13 @@ typecheckParentsAction recorder nfp = do -- | Note that some keys have been modified and restart the session -- Only valid if the virtual file system was initialised by LSP, as that -- independently tracks which files are modified. -setSomethingModified :: VFSModified -> IdeState -> [Key] -> String -> IO () -> IO () -setSomethingModified vfs state keys reason actionBetweenSession = do +setSomethingModified :: VFSModified -> IdeState -> String -> IO () -> IO () +setSomethingModified vfs state reason actionBetweenSession = do -- Update database to remove any files that might have been renamed/deleted void $ restartShakeSession (shakeExtras state) vfs reason [] $ do actionBetweenSession atomically $ do writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles) - modifyTVar' (dirtyKeys $ shakeExtras state) $ \x -> - foldl' (flip insertKeySet) x keys registerFileWatches :: [String] -> LSP.LspT Config IO Bool registerFileWatches globs = do diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index f49bfe56b8..9348dd692e 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -57,7 +57,7 @@ module Development.IDE.Core.Shake( FileVersion(..), updatePositionMapping, updatePositionMappingHelper, - deleteValue, recordDirtyKeys, + deleteValue, recordDirtyKeys, recordDirtyKeySet, WithProgressFunc, WithIndefiniteProgressFunc, ProgressEvent(..), DelayedAction, mkDelayedAction, @@ -579,6 +579,15 @@ recordDirtyKeys ShakeExtras{dirtyKeys} key file = do return $ withEventTrace "recordDirtyKeys" $ \addEvent -> do addEvent (fromString $ unlines $ "dirty " <> show key : map fromNormalizedFilePath file) +recordDirtyKeySet + :: ShakeExtras + -> [Key] + -> STM (IO ()) +recordDirtyKeySet ShakeExtras{dirtyKeys} keys = do + modifyTVar' dirtyKeys $ \x -> foldl' (flip insertKeySet) x keys + return $ withEventTrace "recordDirtyKeys" $ \addEvent -> do + addEvent (fromString $ unlines $ "dirty " : map show keys) + -- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value. getValues :: forall k v. diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index f468c55e55..cbfa92380d 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -95,7 +95,7 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do whenUriFile _uri $ \file -> do let msg = "Closed text document: " <> getUri _uri - setSomethingModified (VFSModified vfs) ide [] (Text.unpack msg) $ do + setSomethingModified (VFSModified vfs) ide (Text.unpack msg) $ do deleteFileOfInterest ide file scheduleGarbageCollection ide logWith recorder Debug $ LogClosedTextDocument _uri @@ -116,7 +116,7 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat unless (null fileEvents') $ do let msg = show fileEvents' logWith recorder Debug $ LogWatchedFileEvents (Text.pack msg) - setSomethingModified (VFSModified vfs) ide [] msg $ do + setSomethingModified (VFSModified vfs) ide msg $ do modifyFileExists ide fileEvents' resetFileStore ide fileEvents' diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 1d8f064709..fc2e7be561 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -18,8 +18,8 @@ import Control.Concurrent.STM.Stats (dumpSTMStats) import Control.Exception.Safe (SomeException, catchAny, displayException) -import Control.Monad.Extra (concatMapM, unless, - when) +import Control.Monad.Extra (concatMapM, join, + unless, when) import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as J import Data.Coerce (coerce) @@ -56,6 +56,7 @@ import Development.IDE.Core.Service (initialise, import qualified Development.IDE.Core.Service as Service import Development.IDE.Core.Shake (IdeState (shakeExtras), IndexQueue, + recordDirtyKeys, shakeSessionInit, uses) import qualified Development.IDE.Core.Shake as Shake @@ -89,7 +90,8 @@ import Development.IDE.Types.Options (IdeGhcSession, optModifyDynFlags, optTesting) import Development.IDE.Types.Shake (WithHieDb, toKey) -import GHC.Conc (getNumProcessors) +import GHC.Conc (atomically, + getNumProcessors) import GHC.IO.Encoding (setLocaleEncoding) import GHC.IO.Handle (hDuplicate) import HIE.Bios.Cradle (findCradle) @@ -362,9 +364,10 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re Nothing -> pure () Just ide -> liftIO $ do let msg = T.pack $ show cfg - logWith recorder Debug $ LogConfigurationChange msg - modifyClientSettings ide (const $ Just cfgObj) - setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change" $ return () + setSomethingModified Shake.VFSUnmodified ide "config change" $ do + logWith recorder Debug $ LogConfigurationChange msg + modifyClientSettings ide (const $ Just cfgObj) + join $ atomically $ recordDirtyKeys (shakeExtras ide) Rules.GetClientSettings [emptyFilePath] runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup dumpSTMStats diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 4d9aec1ad2..be9d0472c8 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -23,8 +23,8 @@ import Control.Exception (bracket_, try) import qualified Control.Exception as E import Control.Lens (_1, _3, ix, (%~), (<&>), (^.)) -import Control.Monad (guard, void, - when) +import Control.Monad (guard, join, + void, when) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) @@ -47,7 +47,8 @@ import Development.IDE.Core.RuleTypes (LinkableResult (l NeedsCompilation (NeedsCompilation), TypeCheck (..), tmrTypechecked) -import Development.IDE.Core.Shake (useNoFile_, +import Development.IDE.Core.Shake (shakeExtras, + useNoFile_, useWithStale_, use_, uses_) import Development.IDE.GHC.Compat hiding (typeKind, @@ -84,15 +85,18 @@ import Development.IDE.Core.RuleTypes (GetLinkable (GetL GetModuleGraph (GetModuleGraph), GhcSessionDeps (GhcSessionDeps), ModSummaryResult (msrModSummary)) -import Development.IDE.Core.Shake (VFSModified (VFSUnmodified)) +import Development.IDE.Core.Shake (VFSModified (VFSUnmodified), + recordDirtyKeys) import qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule)) import qualified Development.IDE.GHC.Compat.Core as SrcLoc (HasSrcSpan (getLoc), unLoc) import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) +import Control.Concurrent.STM.Stats (atomically) import Development.IDE.Core.FileStore (setSomethingModified) import Development.IDE.Core.PluginUtils +import Development.IDE.Graph (ShakeOptions (shakeExtra)) import Development.IDE.Types.Shake (toKey) import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) import Ide.Logger (Priority (..), @@ -211,8 +215,13 @@ runEvalCmd recorder plId st mtoken EvalParams{..} = -- enable codegen for the module which we need to evaluate. final_hscEnv <- liftIO $ bracket_ - (setSomethingModified VFSUnmodified st [toKey IsEvaluating nfp] "Eval" $ queueForEvaluation st nfp) - (setSomethingModified VFSUnmodified st [toKey IsEvaluating nfp] "Eval" $ unqueueForEvaluation st nfp) + (setSomethingModified VFSUnmodified st "Eval" $ do + join $ atomically $ recordDirtyKeys (shakeExtras st) IsEvaluating [nfp] + queueForEvaluation st nfp + ) + (setSomethingModified VFSUnmodified st "Eval" $ do + join $ atomically $ recordDirtyKeys (shakeExtras st) IsEvaluating [nfp] + unqueueForEvaluation st nfp) (initialiseSessionForEval (needsQuickCheck tests) st nfp) evalCfg <- liftIO $ runAction "eval: config" st $ getEvalConfig plId From e247ae13e780a0475040a6285c1c976585528f29 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 25 Apr 2024 01:46:11 +0800 Subject: [PATCH 06/44] use IO [Key] --- .../session-loader/Development/IDE/Session.hs | 16 ++++++------- ghcide/src/Development/IDE/Core/FileExists.hs | 12 ++++++---- ghcide/src/Development/IDE/Core/FileStore.hs | 15 ++++++------ ghcide/src/Development/IDE/Core/OfInterest.hs | 13 +++++++---- ghcide/src/Development/IDE/Core/Shake.hs | 22 +++++------------- .../src/Development/IDE/LSP/Notifications.hs | 4 ++-- ghcide/src/Development/IDE/Main.hs | 3 +-- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 23 +++++++++++-------- .../src/Ide/Plugin/Eval/CodeLens.hs | 10 ++++---- 9 files changed, 58 insertions(+), 60 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index e862261480..84e8a9011f 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -106,7 +106,7 @@ import qualified Data.HashSet as Set import Database.SQLite.Simple import Development.IDE.Core.Tracing (withTrace) import Development.IDE.Session.Diagnostics (renderCradleError) -import Development.IDE.Types.Shake (WithHieDb) +import Development.IDE.Types.Shake (WithHieDb, toKey) import HieDb.Create import HieDb.Types import HieDb.Utils @@ -474,10 +474,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do clientConfig <- getClientConfigAction extras@ShakeExtras{restartShakeSession, ideNc, knownTargetsVar, lspEnv } <- getShakeExtras - let invalidateShakeCache :: IO () - invalidateShakeCache = do + let invalidateShakeCache = do void $ modifyVar' version succ - join $ atomically $ recordDirtyKeys extras GhcSessionIO [emptyFilePath] + return $ toKey GhcSessionIO emptyFilePath IdeOptions{ optTesting = IdeTesting optTesting , optCheckProject = getCheckProject @@ -516,10 +515,10 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do HM.unionWith (<>) k $ HM.fromList knownTargets hasUpdate = if known /= known' then Just (unhashed known') else Nothing writeTVar knownTargetsVar known' - logDirtyKeys <- recordDirtyKeys extras GetKnownTargets [emptyFilePath] - return (logDirtyKeys >> pure hasUpdate) + return (pure hasUpdate) for_ hasUpdate $ \x -> logWith recorder Debug $ LogKnownFilesUpdated x + return $ toKey GetKnownTargets emptyFilePath -- Create a new HscEnv from a hieYaml root and a set of options let packageSetup :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath) @@ -617,9 +616,10 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do Map.insert hieYaml this_flags_map void $ modifyVar' filesMap $ flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) - void $ extendKnownTargets all_targets + key1 <- extendKnownTargets all_targets + key2 <- invalidateShakeCache + return [key1, key2] -- Invalidate all the existing GhcSession build nodes by restarting the Shake session - invalidateShakeCache -- Typecheck all files in the project on startup checkProject <- getCheckProject diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index 4ca55a8d24..eb87051812 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -28,6 +28,7 @@ import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Graph import Development.IDE.Types.Location import Development.IDE.Types.Options +import Development.IDE.Types.Shake (toKey) import qualified Focus import Ide.Logger (Pretty (pretty), Recorder, WithPriority, @@ -106,11 +107,11 @@ getFileExistsMapUntracked = do return v -- | Modify the global store of file exists. -modifyFileExists :: IdeState -> [(NormalizedFilePath, FileChangeType)] -> IO () +modifyFileExists :: IdeState -> [(NormalizedFilePath, FileChangeType)] -> IO [Key] modifyFileExists state changes = do FileExistsMapVar var <- getIdeGlobalState state -- Masked to ensure that the previous values are flushed together with the map update - join $ mask_ $ atomicallyNamed "modifyFileExists" $ do + keys <- join $ mask_ $ atomicallyNamed "modifyFileExists" $ do forM_ changes $ \(f,c) -> case fromChange c of Just c' -> STM.focus (Focus.insert c') f var @@ -120,9 +121,10 @@ modifyFileExists state changes = do let (fileModifChanges, fileExistChanges) = partition ((== FileChangeType_Changed) . snd) changes mapM_ (deleteValue (shakeExtras state) GetFileExists . fst) fileExistChanges - io1 <- recordDirtyKeys (shakeExtras state) GetFileExists $ map fst fileExistChanges - io2 <- recordDirtyKeys (shakeExtras state) GetModificationTime $ map fst fileModifChanges - return (io1 <> io2) + let keys1 = map (toKey GetFileExists . fst) fileExistChanges + let keys2 = map (toKey GetModificationTime . fst) fileModifChanges + return $ return (keys1 <> keys2) + return keys fromChange :: FileChangeType -> Maybe Bool fromChange FileChangeType_Created = Just True diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 762f761dbe..31d110c466 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -49,6 +49,7 @@ import Development.IDE.Import.DependencyInformation import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Options +import Development.IDE.Types.Shake (toKey) import HieDb.Create (deleteMissingRealFiles) import Ide.Logger (Pretty (pretty), Priority (Info), @@ -215,7 +216,7 @@ setFileModified :: Recorder (WithPriority Log) -> IdeState -> Bool -- ^ Was the file saved? -> NormalizedFilePath - -> IO () + -> IO [Key] -> IO () setFileModified recorder vfs state saved nfp actionBefore = do ideOptions <- getIdeOptionsIO $ shakeExtras state @@ -225,8 +226,8 @@ setFileModified recorder vfs state saved nfp actionBefore = do CheckOnSave -> saved _ -> False restartShakeSession (shakeExtras state) vfs (fromNormalizedFilePath nfp ++ " (modified)") [] $ do - actionBefore - join $ atomically $ recordDirtyKeys (shakeExtras state) GetModificationTime [nfp] + keys<-actionBefore + return (toKey GetModificationTime nfp:keys) when checkParents $ typecheckParents recorder state nfp @@ -246,13 +247,13 @@ typecheckParentsAction recorder nfp = do -- | Note that some keys have been modified and restart the session -- Only valid if the virtual file system was initialised by LSP, as that -- independently tracks which files are modified. -setSomethingModified :: VFSModified -> IdeState -> String -> IO () -> IO () +setSomethingModified :: VFSModified -> IdeState -> String -> IO [Key] -> IO () setSomethingModified vfs state reason actionBetweenSession = do -- Update database to remove any files that might have been renamed/deleted void $ restartShakeSession (shakeExtras state) vfs reason [] $ do - actionBetweenSession - atomically $ do - writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles) + keys <- actionBetweenSession + atomically $ writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles) + return keys registerFileWatches :: [String] -> LSP.LspT Config IO Bool registerFileWatches globs = do diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index 0be869b45a..098b2dedaa 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/ghcide/src/Development/IDE/Core/OfInterest.hs @@ -40,6 +40,7 @@ import Development.IDE.Plugin.Completions.Types import Development.IDE.Types.Exports import Development.IDE.Types.Location import Development.IDE.Types.Options (IdeTesting (..)) +import Development.IDE.Types.Shake (toKey) import GHC.TypeLits (KnownSymbol) import Ide.Logger (Pretty (pretty), Priority (..), @@ -103,24 +104,26 @@ getFilesOfInterestUntracked = do OfInterestVar var <- getIdeGlobalAction liftIO $ readVar var -addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO () +addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key] addFileOfInterest state f v = do OfInterestVar var <- getIdeGlobalState state (prev, files) <- modifyVar var $ \dict -> do let (prev, new) = HashMap.alterF (, Just v) f dict pure (new, (prev, new)) - when (prev /= Just v) $ do - join $ atomically $ recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] + if prev /= Just v + then do logWith (ideLogger state) Debug $ LogSetFilesOfInterest (HashMap.toList files) + return [toKey IsFileOfInterest f] + else return [] -deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO () +deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO [Key] deleteFileOfInterest state f = do OfInterestVar var <- getIdeGlobalState state files <- modifyVar' var $ HashMap.delete f - join $ atomically $ recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] logWith (ideLogger state) Debug $ LogSetFilesOfInterest (HashMap.toList files) + return [toKey IsFileOfInterest f] scheduleGarbageCollection :: IdeState -> IO () scheduleGarbageCollection state = do GarbageCollectVar var <- getIdeGlobalState state diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 9348dd692e..f6c23a8405 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -57,7 +57,7 @@ module Development.IDE.Core.Shake( FileVersion(..), updatePositionMapping, updatePositionMappingHelper, - deleteValue, recordDirtyKeys, recordDirtyKeySet, + deleteValue, recordDirtyKeys, WithProgressFunc, WithIndefiniteProgressFunc, ProgressEvent(..), DelayedAction, mkDelayedAction, @@ -300,7 +300,7 @@ data ShakeExtras = ShakeExtras :: VFSModified -> String -> [DelayedAction ()] - -> IO () + -> IO [Key] -> IO () #if MIN_VERSION_ghc(9,3,0) ,ideNc :: NameCache @@ -569,21 +569,10 @@ deleteValue ShakeExtras{dirtyKeys, state} key file = do modifyTVar' dirtyKeys $ insertKeySet (toKey key file) recordDirtyKeys - :: Shake.ShakeValue k - => ShakeExtras - -> k - -> [NormalizedFilePath] - -> STM (IO ()) -recordDirtyKeys ShakeExtras{dirtyKeys} key file = do - modifyTVar' dirtyKeys $ \x -> foldl' (flip insertKeySet) x (toKey key <$> file) - return $ withEventTrace "recordDirtyKeys" $ \addEvent -> do - addEvent (fromString $ unlines $ "dirty " <> show key : map fromNormalizedFilePath file) - -recordDirtyKeySet :: ShakeExtras -> [Key] -> STM (IO ()) -recordDirtyKeySet ShakeExtras{dirtyKeys} keys = do +recordDirtyKeys ShakeExtras{dirtyKeys} keys = do modifyTVar' dirtyKeys $ \x -> foldl' (flip insertKeySet) x keys return $ withEventTrace "recordDirtyKeys" $ \addEvent -> do addEvent (fromString $ unlines $ "dirty " : map show keys) @@ -769,13 +758,14 @@ delayedAction a = do -- | Restart the current 'ShakeSession' with the given system actions. -- Any actions running in the current session will be aborted, -- but actions added via 'shakeEnqueue' will be requeued. -shakeRestart :: Recorder (WithPriority Log) -> IdeState -> VFSModified -> String -> [DelayedAction ()] -> IO () -> IO () +shakeRestart :: Recorder (WithPriority Log) -> IdeState -> VFSModified -> String -> [DelayedAction ()] -> IO [Key] -> IO () shakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession = withMVar' shakeSession (\runner -> do (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner - ioActionBetweenShakeSession + keys <- ioActionBetweenShakeSession + join $ atomically $ recordDirtyKeys shakeExtras keys res <- shakeDatabaseProfile shakeDb backlog <- readTVarIO $ dirtyKeys shakeExtras queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index cbfa92380d..7b5fe7adeb 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -96,8 +96,8 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat whenUriFile _uri $ \file -> do let msg = "Closed text document: " <> getUri _uri setSomethingModified (VFSModified vfs) ide (Text.unpack msg) $ do - deleteFileOfInterest ide file scheduleGarbageCollection ide + deleteFileOfInterest ide file logWith recorder Debug $ LogClosedTextDocument _uri , mkPluginNotificationHandler LSP.SMethod_WorkspaceDidChangeWatchedFiles $ @@ -117,8 +117,8 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat let msg = show fileEvents' logWith recorder Debug $ LogWatchedFileEvents (Text.pack msg) setSomethingModified (VFSModified vfs) ide msg $ do - modifyFileExists ide fileEvents' resetFileStore ide fileEvents' + modifyFileExists ide fileEvents' , mkPluginNotificationHandler LSP.SMethod_WorkspaceDidChangeWorkspaceFolders $ \ide _ _ (DidChangeWorkspaceFoldersParams events) -> liftIO $ do diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index fc2e7be561..b9c977e08e 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -56,7 +56,6 @@ import Development.IDE.Core.Service (initialise, import qualified Development.IDE.Core.Service as Service import Development.IDE.Core.Shake (IdeState (shakeExtras), IndexQueue, - recordDirtyKeys, shakeSessionInit, uses) import qualified Development.IDE.Core.Shake as Shake @@ -367,7 +366,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re setSomethingModified Shake.VFSUnmodified ide "config change" $ do logWith recorder Debug $ LogConfigurationChange msg modifyClientSettings ide (const $ Just cfgObj) - join $ atomically $ recordDirtyKeys (shakeExtras ide) Rules.GetClientSettings [emptyFilePath] + return [toKey Rules.GetClientSettings emptyFilePath] runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup dumpSTMStats diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 404ba71ba2..b9db5f816f 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -24,9 +24,10 @@ import Data.Typeable import Development.IDE as D import Development.IDE.Core.Shake (restartShakeSession) import qualified Development.IDE.Core.Shake as Shake -import Development.IDE.Graph (alwaysRerun) +import Development.IDE.Graph (Key, alwaysRerun) import qualified Development.IDE.Plugin.Completions.Logic as Ghcide import qualified Development.IDE.Plugin.Completions.Types as Ghcide +import Development.IDE.Types.Shake (toKey) import GHC.Generics import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes import qualified Ide.Plugin.Cabal.Completion.Completions as Completions @@ -130,11 +131,11 @@ needs to be re-parsed. That's what we do when we record the dirty key that our p rule depends on. Then we restart the shake session, so that changes to our virtual files are actually picked up. -} -restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO () -> IO () +restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO () restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = do restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do - actionBetweenSession - join $ atomically $ Shake.recordDirtyKeys shakeExtras GetModificationTime [file] + keys <- actionBetweenSession + return (toKey GetModificationTime file:keys) -- ---------------------------------------------------------------- -- Plugin Rules @@ -250,24 +251,26 @@ getCabalFilesOfInterestUntracked = do OfInterestCabalVar var <- Shake.getIdeGlobalAction liftIO $ readVar var -addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO () +addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key] addFileOfInterest recorder state f v = do OfInterestCabalVar var <- Shake.getIdeGlobalState state (prev, files) <- modifyVar var $ \dict -> do let (prev, new) = HashMap.alterF (,Just v) f dict pure (new, (prev, new)) - when (prev /= Just v) $ do - join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] - log' Debug $ LogFOI files + if prev /= Just v + then do + log' Debug $ LogFOI files + return [toKey IsCabalFileOfInterest f] + else return [] where log' = logWith recorder -deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO () +deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO [Key] deleteFileOfInterest recorder state f = do OfInterestCabalVar var <- Shake.getIdeGlobalState state files <- modifyVar' var $ HashMap.delete f - join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] log' Debug $ LogFOI files + return [toKey IsFileOfInterest f] where log' = logWith recorder diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index be9d0472c8..8701526b65 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -85,8 +85,7 @@ import Development.IDE.Core.RuleTypes (GetLinkable (GetL GetModuleGraph (GetModuleGraph), GhcSessionDeps (GhcSessionDeps), ModSummaryResult (msrModSummary)) -import Development.IDE.Core.Shake (VFSModified (VFSUnmodified), - recordDirtyKeys) +import Development.IDE.Core.Shake (VFSModified (VFSUnmodified)) import qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule)) import qualified Development.IDE.GHC.Compat.Core as SrcLoc (HasSrcSpan (getLoc), unLoc) @@ -216,12 +215,13 @@ runEvalCmd recorder plId st mtoken EvalParams{..} = -- enable codegen for the module which we need to evaluate. final_hscEnv <- liftIO $ bracket_ (setSomethingModified VFSUnmodified st "Eval" $ do - join $ atomically $ recordDirtyKeys (shakeExtras st) IsEvaluating [nfp] queueForEvaluation st nfp + return [toKey IsEvaluating nfp] ) (setSomethingModified VFSUnmodified st "Eval" $ do - join $ atomically $ recordDirtyKeys (shakeExtras st) IsEvaluating [nfp] - unqueueForEvaluation st nfp) + unqueueForEvaluation st nfp + return [toKey IsEvaluating nfp] + ) (initialiseSessionForEval (needsQuickCheck tests) st nfp) evalCfg <- liftIO $ runAction "eval: config" st $ getEvalConfig plId From 7b7ea4d726a09d45cbeff28a92e807dd8b383d1b Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 25 Apr 2024 02:56:23 +0800 Subject: [PATCH 07/44] remove double return --- ghcide/src/Development/IDE/Core/FileExists.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index eb87051812..deeee49c33 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -111,7 +111,7 @@ modifyFileExists :: IdeState -> [(NormalizedFilePath, FileChangeType)] -> IO [Ke modifyFileExists state changes = do FileExistsMapVar var <- getIdeGlobalState state -- Masked to ensure that the previous values are flushed together with the map update - keys <- join $ mask_ $ atomicallyNamed "modifyFileExists" $ do + keys <- mask_ $ atomicallyNamed "modifyFileExists" $ do forM_ changes $ \(f,c) -> case fromChange c of Just c' -> STM.focus (Focus.insert c') f var @@ -123,7 +123,7 @@ modifyFileExists state changes = do mapM_ (deleteValue (shakeExtras state) GetFileExists . fst) fileExistChanges let keys1 = map (toKey GetFileExists . fst) fileExistChanges let keys2 = map (toKey GetModificationTime . fst) fileModifChanges - return $ return (keys1 <> keys2) + return (keys1 <> keys2) return keys fromChange :: FileChangeType -> Maybe Bool From c31a3756ed3e428d6b5b6246922318453e6147b6 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Fri, 26 Apr 2024 20:54:46 +0800 Subject: [PATCH 08/44] Update ghcide/src/Development/IDE/Core/FileExists.hs Co-authored-by: wz1000 --- ghcide/src/Development/IDE/Core/FileExists.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index deeee49c33..af1fd45559 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -111,7 +111,7 @@ modifyFileExists :: IdeState -> [(NormalizedFilePath, FileChangeType)] -> IO [Ke modifyFileExists state changes = do FileExistsMapVar var <- getIdeGlobalState state -- Masked to ensure that the previous values are flushed together with the map update - keys <- mask_ $ atomicallyNamed "modifyFileExists" $ do + mask_ $ atomicallyNamed "modifyFileExists" $ do forM_ changes $ \(f,c) -> case fromChange c of Just c' -> STM.focus (Focus.insert c') f var From bfb06a3565d4d6188b357061cc7f9c18aa1d7dd7 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 26 Apr 2024 20:59:01 +0800 Subject: [PATCH 09/44] minor fix --- ghcide/session-loader/Development/IDE/Session.hs | 7 +++---- ghcide/src/Development/IDE/Core/FileExists.hs | 1 - ghcide/src/Development/IDE/Core/FileStore.hs | 6 ++---- 3 files changed, 5 insertions(+), 9 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 84e8a9011f..d93f654e21 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -610,12 +610,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do [ "No cradle target found. Is this file listed in the targets of your cradle?" , "If you are using a .cabal file, please ensure that this module is listed in either the exposed-modules or other-modules section" ] + + void $ modifyVar' fileToFlags $ Map.insert hieYaml this_flags_map + void $ modifyVar' filesMap $ flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) -- The VFS doesn't change on cradle edits, re-use the old one. restartShakeSession VFSUnmodified "new component" [] $ do - void $ modifyVar' fileToFlags $ - Map.insert hieYaml this_flags_map - void $ modifyVar' filesMap $ - flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) key1 <- extendKnownTargets all_targets key2 <- invalidateShakeCache return [key1, key2] diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index af1fd45559..f1840b9ffd 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -124,7 +124,6 @@ modifyFileExists state changes = do let keys1 = map (toKey GetFileExists . fst) fileExistChanges let keys2 = map (toKey GetModificationTime . fst) fileModifChanges return (keys1 <> keys2) - return keys fromChange :: FileChangeType -> Maybe Bool fromChange FileChangeType_Created = Just True diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 31d110c466..145e9dc905 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -250,10 +250,8 @@ typecheckParentsAction recorder nfp = do setSomethingModified :: VFSModified -> IdeState -> String -> IO [Key] -> IO () setSomethingModified vfs state reason actionBetweenSession = do -- Update database to remove any files that might have been renamed/deleted - void $ restartShakeSession (shakeExtras state) vfs reason [] $ do - keys <- actionBetweenSession - atomically $ writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles) - return keys + atomically $ writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles) + void $ restartShakeSession (shakeExtras state) vfs reason [] actionBetweenSession registerFileWatches :: [String] -> LSP.LspT Config IO Bool registerFileWatches globs = do From bbc5c9507ae6aa7b66a78342de0265efbf7f6f46 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 28 Apr 2024 03:52:43 +0800 Subject: [PATCH 10/44] capture more dirty keys to between sessions --- ghcide/src/Development/IDE/Core/FileExists.hs | 4 ++-- ghcide/src/Development/IDE/Core/FileStore.hs | 18 +++++++++--------- ghcide/src/Development/IDE/Core/Shake.hs | 5 +++-- .../src/Development/IDE/LSP/Notifications.hs | 5 +++-- 4 files changed, 17 insertions(+), 15 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index f1840b9ffd..28c633f93d 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -120,10 +120,10 @@ modifyFileExists state changes = do -- flush previous values let (fileModifChanges, fileExistChanges) = partition ((== FileChangeType_Changed) . snd) changes - mapM_ (deleteValue (shakeExtras state) GetFileExists . fst) fileExistChanges + keys0 <- concat <$> mapM (deleteValue (shakeExtras state) GetFileExists . fst) fileExistChanges let keys1 = map (toKey GetFileExists . fst) fileExistChanges let keys2 = map (toKey GetModificationTime . fst) fileModifChanges - return (keys1 <> keys2) + return (keys0 <> keys1 <> keys2) fromChange :: FileChangeType -> Maybe Bool fromChange FileChangeType_Created = Just True diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 145e9dc905..e96a3984cf 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -149,24 +149,24 @@ isInterface :: NormalizedFilePath -> Bool isInterface f = takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot", ".hie", ".hie-boot", ".core"] -- | Reset the GetModificationTime state of interface files -resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> STM () +resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> STM [Key] resetInterfaceStore state f = do deleteValue state GetModificationTime f -- | Reset the GetModificationTime state of watched files -- Assumes the list does not include any FOIs -resetFileStore :: IdeState -> [(NormalizedFilePath, LSP.FileChangeType)] -> IO () +resetFileStore :: IdeState -> [(NormalizedFilePath, LSP.FileChangeType)] -> IO [Key] resetFileStore ideState changes = mask $ \_ -> do -- we record FOIs document versions in all the stored values -- so NEVER reset FOIs to avoid losing their versions -- FOI filtering is done by the caller (LSP Notification handler) - forM_ changes $ \(nfp, c) -> do - case c of - LSP.FileChangeType_Changed - -- already checked elsewhere | not $ HM.member nfp fois - -> atomically $ - deleteValue (shakeExtras ideState) GetModificationTime nfp - _ -> pure () + fmap concat <$> + forM changes $ \(nfp, c) -> do + case c of + LSP.FileChangeType_Changed + -- already checked elsewhere | not $ HM.member nfp fois + -> atomically $ deleteValue (shakeExtras ideState) GetModificationTime nfp + _ -> pure [] modificationTime :: FileVersion -> Maybe UTCTime diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index f6c23a8405..04381b65fa 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -563,10 +563,11 @@ deleteValue => ShakeExtras -> k -> NormalizedFilePath - -> STM () + -> STM [Key] deleteValue ShakeExtras{dirtyKeys, state} key file = do STM.delete (toKey key file) state - modifyTVar' dirtyKeys $ insertKeySet (toKey key file) + return [toKey key file] + recordDirtyKeys :: ShakeExtras diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index 7b5fe7adeb..f5cc4abc96 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -117,8 +117,9 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat let msg = show fileEvents' logWith recorder Debug $ LogWatchedFileEvents (Text.pack msg) setSomethingModified (VFSModified vfs) ide msg $ do - resetFileStore ide fileEvents' - modifyFileExists ide fileEvents' + ks1 <- resetFileStore ide fileEvents' + ks2 <- modifyFileExists ide fileEvents' + return (ks1 <> ks2) , mkPluginNotificationHandler LSP.SMethod_WorkspaceDidChangeWorkspaceFolders $ \ide _ _ (DidChangeWorkspaceFoldersParams events) -> liftIO $ do From 48d5644a527682eba22432ec56576c00f76450fc Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 28 Apr 2024 06:06:47 +0800 Subject: [PATCH 11/44] cleanup --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index b9db5f816f..c13ce9fe4a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -6,7 +6,6 @@ module Ide.Plugin.Cabal (descriptor, Log (..)) where -import Control.Concurrent.STM import Control.Concurrent.Strict import Control.DeepSeq import Control.Lens ((^.)) From e967dde93bc66f6b692b3f5f2067e2b98c28644d Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 28 Apr 2024 22:25:42 +0800 Subject: [PATCH 12/44] fix the race between cache value updated but not updated hls-database --- ghcide/src/Development/IDE/Core/Shake.hs | 9 ++++----- ghcide/src/Development/IDE/Core/Tracing.hs | 2 +- hls-graph/src/Development/IDE/Graph/Internal/Database.hs | 4 +++- hls-graph/src/Development/IDE/Graph/Internal/Types.hs | 6 +++--- 4 files changed, 11 insertions(+), 10 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 04381b65fa..0f2d376cb3 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1200,7 +1200,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do Just (v@(Succeeded _ x), diags) -> do ver <- estimateFileVersionUnsafely key (Just x) file doDiagnostics (vfsVersion =<< ver) $ Vector.toList diags - return $ Just $ RunResult ChangedNothing old $ A v + return $ Just $ RunResult ChangedNothing old (A v) mempty _ -> return Nothing _ -> -- assert that a "clean" rule is never a cache miss @@ -1224,7 +1224,6 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do Nothing -> do pure (toShakeValue ShakeStale mbBs, staleV) Just v -> pure (maybe ShakeNoCutoff ShakeResult mbBs, Succeeded ver v) - liftIO $ atomicallyNamed "define - write" $ setValues state key file res (Vector.fromList diags) doDiagnostics (vfsVersion =<< ver) diags let eq = case (bs, fmap decodeShakeValue mbOld) of (ShakeResult a, Just (ShakeResult b)) -> cmp a b @@ -1234,9 +1233,9 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do _ -> False return $ RunResult (if eq then ChangedRecomputeSame else ChangedRecomputeDiff) - (encodeShakeValue bs) $ - A res - liftIO $ atomicallyNamed "define - dirtyKeys" $ modifyTVar' dirtyKeys (deleteKeySet $ toKey key file) + (encodeShakeValue bs) + (A res) + (setValues state key file res (Vector.fromList diags) >> modifyTVar' dirtyKeys (deleteKeySet $ toKey key file)) return res where -- Highly unsafe helper to compute the version of a file diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 86212f0e83..b55dcc7af5 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -112,7 +112,7 @@ otTracedAction key file mode result act ExitCaseSuccess res -> do setTag sp "result" (pack $ result $ runValue res) setTag sp "changed" $ case res of - RunResult x _ _ -> fromString $ show x + RunResult x _ _ _ -> fromString $ show x endSpan sp) (\sp -> act (liftIO . setTag sp "diagnostics" . encodeUtf8 . showDiagnostics )) | otherwise = act (\_ -> return ()) diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs index 63e874c87d..8d956e74c9 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs @@ -200,7 +200,9 @@ compute db@Database{..} stack key mode result = do (getResultDepsDefault mempty previousDeps) deps _ -> pure () - atomicallyNamed "compute" $ SMap.focus (updateStatus $ Clean res) key databaseValues + atomicallyNamed "compute and run hook" $ do + runHook + SMap.focus (updateStatus $ Clean res) key databaseValues pure res updateStatus :: Monad m => Status -> Focus.Focus KeyDetails m () diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs index 02b5ccd4b0..227eb6ab4b 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs @@ -27,6 +27,7 @@ import qualified StmContainers.Map as SMap import StmContainers.Map (Map) import System.Time.Extra (Seconds) import UnliftIO (MonadUnliftIO) +import Control.Concurrent.STM (STM) #if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2) @@ -202,11 +203,10 @@ data RunResult value = RunResult -- ^ The value to store in the Shake database. ,runValue :: value -- ^ The value to return from 'Development.Shake.Rule.apply'. + ,runHook :: STM () + -- ^ The value to return from 'Development.Shake.Rule.apply'. } deriving Functor -instance NFData value => NFData (RunResult value) where - rnf (RunResult x1 x2 x3) = rnf x1 `seq` x2 `seq` rnf x3 - --------------------------------------------------------------------- -- EXCEPTIONS From 69c93964c547893d346bddc7adb70e3e152d9b2d Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 28 Apr 2024 22:38:45 +0800 Subject: [PATCH 13/44] fix build --- hls-graph/test/DatabaseSpec.hs | 2 +- hls-graph/test/Example.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/hls-graph/test/DatabaseSpec.hs b/hls-graph/test/DatabaseSpec.hs index 4f15e77639..489b50fc7e 100644 --- a/hls-graph/test/DatabaseSpec.hs +++ b/hls-graph/test/DatabaseSpec.hs @@ -20,6 +20,6 @@ spec = do ruleBool addRule $ \Rule _old _mode -> do True <- apply1 (Rule @Bool) - return $ RunResult ChangedRecomputeDiff "" () + return $ RunResult ChangedRecomputeDiff "" () mempty let res = shakeRunDatabase db $ pure $ apply1 (Rule @()) timeout 1 res `shouldThrow` \StackException{} -> True diff --git a/hls-graph/test/Example.hs b/hls-graph/test/Example.hs index 2845b60e6c..2b12b3dcec 100644 --- a/hls-graph/test/Example.hs +++ b/hls-graph/test/Example.hs @@ -22,13 +22,13 @@ type instance RuleResult (Rule a) = a ruleUnit :: Rules () ruleUnit = addRule $ \(Rule :: Rule ()) _old _mode -> do - return $ RunResult ChangedRecomputeDiff "" () + return $ RunResult ChangedRecomputeDiff "" () mempty -- | Depends on Rule @() ruleBool :: Rules () ruleBool = addRule $ \Rule _old _mode -> do () <- apply1 Rule - return $ RunResult ChangedRecomputeDiff "" True + return $ RunResult ChangedRecomputeDiff "" True mempty data CondRule = CondRule From 02f0d41f18d5c05c0722d5535735f2e01ba3073c Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 28 Apr 2024 23:01:40 +0800 Subject: [PATCH 14/44] fix hls-graph --- hls-graph/test/ActionSpec.hs | 2 +- hls-graph/test/Example.hs | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/hls-graph/test/ActionSpec.hs b/hls-graph/test/ActionSpec.hs index ffb319c614..0f4dd2627d 100644 --- a/hls-graph/test/ActionSpec.hs +++ b/hls-graph/test/ActionSpec.hs @@ -87,7 +87,7 @@ spec = do ruleUnit addRule $ \Rule _old _mode -> do [()] <- applyWithoutDependency [Rule] - return $ RunResult ChangedRecomputeDiff "" True + return $ RunResult ChangedRecomputeDiff "" True mempty let theKey = Rule @Bool res <- shakeRunDatabase db $ diff --git a/hls-graph/test/Example.hs b/hls-graph/test/Example.hs index 2b12b3dcec..6c0d546684 100644 --- a/hls-graph/test/Example.hs +++ b/hls-graph/test/Example.hs @@ -39,7 +39,7 @@ type instance RuleResult CondRule = Bool ruleCond :: C.MVar Bool -> Rules () ruleCond mv = addRule $ \CondRule _old _mode -> do r <- liftIO $ C.modifyMVar mv $ \x -> return (not x, x) - return $ RunResult ChangedRecomputeDiff "" r + return $ RunResult ChangedRecomputeDiff "" r mempty data BranchedRule = BranchedRule deriving (Eq, Generic, Hashable, NFData, Show, Typeable) @@ -50,9 +50,9 @@ ruleWithCond = addRule $ \BranchedRule _old _mode -> do r <- apply1 CondRule if r then do _ <- apply1 SubBranchRule - return $ RunResult ChangedRecomputeDiff "" (1 :: Int) + return $ RunResult ChangedRecomputeDiff "" (1 :: Int) mempty else - return $ RunResult ChangedRecomputeDiff "" (2 :: Int) + return $ RunResult ChangedRecomputeDiff "" (2 :: Int) mempty data SubBranchRule = SubBranchRule deriving (Eq, Generic, Hashable, NFData, Show, Typeable) @@ -61,4 +61,4 @@ type instance RuleResult SubBranchRule = Int ruleSubBranch :: C.MVar Int -> Rules () ruleSubBranch mv = addRule $ \SubBranchRule _old _mode -> do r <- liftIO $ C.modifyMVar mv $ \x -> return (x+1, x) - return $ RunResult ChangedRecomputeDiff "" r + return $ RunResult ChangedRecomputeDiff "" r mempty From c983727d29ec00132c50116a4bc0b455fe4d6a29 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 29 Apr 2024 05:24:15 +0800 Subject: [PATCH 15/44] fix 9.2.8 --- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- .../src/Development/IDE/Graph/Internal/Types.hs | 2 +- hls-graph/test/ActionSpec.hs | 2 +- hls-graph/test/DatabaseSpec.hs | 2 +- hls-graph/test/Example.hs | 12 ++++++------ 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 0f2d376cb3..0d1eb3ea60 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1200,7 +1200,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do Just (v@(Succeeded _ x), diags) -> do ver <- estimateFileVersionUnsafely key (Just x) file doDiagnostics (vfsVersion =<< ver) $ Vector.toList diags - return $ Just $ RunResult ChangedNothing old (A v) mempty + return $ Just $ RunResult ChangedNothing old (A v) $ return () _ -> return Nothing _ -> -- assert that a "clean" rule is never a cache miss diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs index 227eb6ab4b..e8d09359c8 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs @@ -204,7 +204,7 @@ data RunResult value = RunResult ,runValue :: value -- ^ The value to return from 'Development.Shake.Rule.apply'. ,runHook :: STM () - -- ^ The value to return from 'Development.Shake.Rule.apply'. + -- ^ The hook to run after the rule completes. } deriving Functor --------------------------------------------------------------------- diff --git a/hls-graph/test/ActionSpec.hs b/hls-graph/test/ActionSpec.hs index 0f4dd2627d..eece9b03ca 100644 --- a/hls-graph/test/ActionSpec.hs +++ b/hls-graph/test/ActionSpec.hs @@ -87,7 +87,7 @@ spec = do ruleUnit addRule $ \Rule _old _mode -> do [()] <- applyWithoutDependency [Rule] - return $ RunResult ChangedRecomputeDiff "" True mempty + return $ RunResult ChangedRecomputeDiff "" True $ return () let theKey = Rule @Bool res <- shakeRunDatabase db $ diff --git a/hls-graph/test/DatabaseSpec.hs b/hls-graph/test/DatabaseSpec.hs index 489b50fc7e..97a04d3007 100644 --- a/hls-graph/test/DatabaseSpec.hs +++ b/hls-graph/test/DatabaseSpec.hs @@ -20,6 +20,6 @@ spec = do ruleBool addRule $ \Rule _old _mode -> do True <- apply1 (Rule @Bool) - return $ RunResult ChangedRecomputeDiff "" () mempty + return $ RunResult ChangedRecomputeDiff "" () (return ()) let res = shakeRunDatabase db $ pure $ apply1 (Rule @()) timeout 1 res `shouldThrow` \StackException{} -> True diff --git a/hls-graph/test/Example.hs b/hls-graph/test/Example.hs index 6c0d546684..a15cb5487f 100644 --- a/hls-graph/test/Example.hs +++ b/hls-graph/test/Example.hs @@ -22,13 +22,13 @@ type instance RuleResult (Rule a) = a ruleUnit :: Rules () ruleUnit = addRule $ \(Rule :: Rule ()) _old _mode -> do - return $ RunResult ChangedRecomputeDiff "" () mempty + return $ RunResult ChangedRecomputeDiff "" () (return ()) -- | Depends on Rule @() ruleBool :: Rules () ruleBool = addRule $ \Rule _old _mode -> do () <- apply1 Rule - return $ RunResult ChangedRecomputeDiff "" True mempty + return $ RunResult ChangedRecomputeDiff "" True (return ()) data CondRule = CondRule @@ -39,7 +39,7 @@ type instance RuleResult CondRule = Bool ruleCond :: C.MVar Bool -> Rules () ruleCond mv = addRule $ \CondRule _old _mode -> do r <- liftIO $ C.modifyMVar mv $ \x -> return (not x, x) - return $ RunResult ChangedRecomputeDiff "" r mempty + return $ RunResult ChangedRecomputeDiff "" r (return ()) data BranchedRule = BranchedRule deriving (Eq, Generic, Hashable, NFData, Show, Typeable) @@ -50,9 +50,9 @@ ruleWithCond = addRule $ \BranchedRule _old _mode -> do r <- apply1 CondRule if r then do _ <- apply1 SubBranchRule - return $ RunResult ChangedRecomputeDiff "" (1 :: Int) mempty + return $ RunResult ChangedRecomputeDiff "" (1 :: Int) (return ()) else - return $ RunResult ChangedRecomputeDiff "" (2 :: Int) mempty + return $ RunResult ChangedRecomputeDiff "" (2 :: Int) (return ()) data SubBranchRule = SubBranchRule deriving (Eq, Generic, Hashable, NFData, Show, Typeable) @@ -61,4 +61,4 @@ type instance RuleResult SubBranchRule = Int ruleSubBranch :: C.MVar Int -> Rules () ruleSubBranch mv = addRule $ \SubBranchRule _old _mode -> do r <- liftIO $ C.modifyMVar mv $ \x -> return (x+1, x) - return $ RunResult ChangedRecomputeDiff "" r mempty + return $ RunResult ChangedRecomputeDiff "" r (return ()) From 3748fc2f0e0f5ebb9cd8af30740a45754186f166 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 29 Apr 2024 08:36:30 +0800 Subject: [PATCH 16/44] format --- hls-graph/src/Development/IDE/Graph/Internal/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs index e8d09359c8..3474289b42 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs @@ -5,6 +5,7 @@ module Development.IDE.Graph.Internal.Types where +import Control.Concurrent.STM (STM) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Trans.Reader @@ -27,7 +28,6 @@ import qualified StmContainers.Map as SMap import StmContainers.Map (Map) import System.Time.Extra (Seconds) import UnliftIO (MonadUnliftIO) -import Control.Concurrent.STM (STM) #if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2) From a65ac5c15fc8d6d5a2456b805a61ccd464b862f7 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 1 May 2024 18:19:22 +0800 Subject: [PATCH 17/44] run refreshDeps in a single asyncWithCleanUp --- .../Development/IDE/Graph/Internal/Database.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs index 8d956e74c9..7f2cee0a8c 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs @@ -143,31 +143,31 @@ isDirty me = any (\(_,dep) -> resultBuilt me < resultChanged dep) -- * If no dirty dependencies and we have evaluated the key previously, then we refresh it in the current thread. -- This assumes that the implementation will be a lookup -- * Otherwise, we spawn a new thread to refresh the dirty deps (if any) and the key itself -refreshDeps :: KeySet -> Database -> Stack -> Key -> Result -> [KeySet] -> AIO (IO Result) +refreshDeps :: KeySet -> Database -> Stack -> Key -> Result -> [KeySet] -> AIO Result refreshDeps visited db stack key result = \case -- no more deps to refresh - [] -> pure $ compute db stack key RunDependenciesSame (Just result) + [] -> liftIO $ compute db stack key RunDependenciesSame (Just result) (dep:deps) -> do let newVisited = dep <> visited res <- builder db stack (toListKeySet (dep `differenceKeySet` visited)) case res of Left res -> if isDirty result res -- restart the computation if any of the deps are dirty - then asyncWithCleanUp $ liftIO $ compute db stack key RunDependenciesChanged (Just result) + then liftIO $ compute db stack key RunDependenciesChanged (Just result) -- else kick the rest of the deps else refreshDeps newVisited db stack key result deps - Right iores -> asyncWithCleanUp $ liftIO $ do - res <- iores + Right iores -> do + res <- liftIO iores if isDirty result res - then compute db stack key RunDependenciesChanged (Just result) - else join $ runAIO $ refreshDeps newVisited db stack key result deps + then liftIO $ compute db stack key RunDependenciesChanged (Just result) + else refreshDeps newVisited db stack key result deps -- | Refresh a key: refresh :: Database -> Stack -> Key -> Maybe Result -> AIO (IO Result) -- refresh _ st k _ | traceShow ("refresh", st, k) False = undefined refresh db stack key result = case (addStack key stack, result) of (Left e, _) -> throw e - (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> refreshDeps mempty db stack key me (reverse deps) + (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> asyncWithCleanUp $ refreshDeps mempty db stack key me (reverse deps) (Right stack, _) -> asyncWithCleanUp $ liftIO $ compute db stack key RunDependenciesChanged result From f4690c577cea0a31d3a956aa080c5bb9c5b4da52 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 1 May 2024 23:35:21 +0800 Subject: [PATCH 18/44] shut the session before shut the reactor --- ghcide/src/Development/IDE/LSP/LanguageServer.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index e4493436cb..19f2d93b16 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -262,10 +262,10 @@ shutdownHandler :: Recorder (WithPriority Log) -> IO () -> LSP.Handlers (ServerM shutdownHandler recorder stopReactor = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do (_, ide) <- ask liftIO $ logWith recorder Debug LogServerShutdownMessage - -- stop the reactor to free up the hiedb connection - liftIO stopReactor -- flush out the Shake session to record a Shake profile if applicable liftIO $ shakeShut ide + -- stop the reactor to free up the hiedb connection + liftIO stopReactor resp $ Right Null exitHandler :: IO () -> LSP.Handlers (ServerM c) From 610355cb00ed350ff510d0010ac67fcfd2d2a7e4 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 3 May 2024 05:02:48 +0800 Subject: [PATCH 19/44] Revert "shut the session before shut the reactor" This reverts commit f4690c577cea0a31d3a956aa080c5bb9c5b4da52. --- ghcide/src/Development/IDE/LSP/LanguageServer.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 19f2d93b16..e4493436cb 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -262,10 +262,10 @@ shutdownHandler :: Recorder (WithPriority Log) -> IO () -> LSP.Handlers (ServerM shutdownHandler recorder stopReactor = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do (_, ide) <- ask liftIO $ logWith recorder Debug LogServerShutdownMessage - -- flush out the Shake session to record a Shake profile if applicable - liftIO $ shakeShut ide -- stop the reactor to free up the hiedb connection liftIO stopReactor + -- flush out the Shake session to record a Shake profile if applicable + liftIO $ shakeShut ide resp $ Right Null exitHandler :: IO () -> LSP.Handlers (ServerM c) From 63b1956d34e3f8c64695f663ae6276f22aa60f0b Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 3 May 2024 06:25:10 +0800 Subject: [PATCH 20/44] remove record dirty key recordDirtyKeys --- ghcide/session-loader/Development/IDE/Session.hs | 4 ++-- ghcide/src/Development/IDE/Core/Shake.hs | 13 ++----------- 2 files changed, 4 insertions(+), 13 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index d93f654e21..2d12125b7b 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -613,10 +613,10 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do void $ modifyVar' fileToFlags $ Map.insert hieYaml this_flags_map void $ modifyVar' filesMap $ flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) + key1 <- extendKnownTargets all_targets + key2 <- invalidateShakeCache -- The VFS doesn't change on cradle edits, re-use the old one. restartShakeSession VFSUnmodified "new component" [] $ do - key1 <- extendKnownTargets all_targets - key2 <- invalidateShakeCache return [key1, key2] -- Invalidate all the existing GhcSession build nodes by restarting the Shake session diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 0d1eb3ea60..3973a8a3e8 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -57,7 +57,7 @@ module Development.IDE.Core.Shake( FileVersion(..), updatePositionMapping, updatePositionMappingHelper, - deleteValue, recordDirtyKeys, + deleteValue, WithProgressFunc, WithIndefiniteProgressFunc, ProgressEvent(..), DelayedAction, mkDelayedAction, @@ -569,15 +569,6 @@ deleteValue ShakeExtras{dirtyKeys, state} key file = do return [toKey key file] -recordDirtyKeys - :: ShakeExtras - -> [Key] - -> STM (IO ()) -recordDirtyKeys ShakeExtras{dirtyKeys} keys = do - modifyTVar' dirtyKeys $ \x -> foldl' (flip insertKeySet) x keys - return $ withEventTrace "recordDirtyKeys" $ \addEvent -> do - addEvent (fromString $ unlines $ "dirty " : map show keys) - -- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value. getValues :: forall k v. @@ -766,7 +757,7 @@ shakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession = (\runner -> do (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner keys <- ioActionBetweenShakeSession - join $ atomically $ recordDirtyKeys shakeExtras keys + atomically $ modifyTVar' (dirtyKeys shakeExtras) $ \x -> foldl' (flip insertKeySet) x keys res <- shakeDatabaseProfile shakeDb backlog <- readTVarIO $ dirtyKeys shakeExtras queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras From 742369525cacf1b09054ad8ee6d6366f7b772495 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Mon, 6 May 2024 20:36:49 +0800 Subject: [PATCH 21/44] Update ghcide/src/Development/IDE/Core/Shake.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 3973a8a3e8..16e96af6eb 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -564,7 +564,7 @@ deleteValue -> k -> NormalizedFilePath -> STM [Key] -deleteValue ShakeExtras{dirtyKeys, state} key file = do +deleteValue ShakeExtras{state} key file = do STM.delete (toKey key file) state return [toKey key file] From 0c4a2f574a859d30471cbd816ccf1965cce4131a Mon Sep 17 00:00:00 2001 From: soulomoon Date: Mon, 6 May 2024 20:37:15 +0800 Subject: [PATCH 22/44] Update ghcide/src/Development/IDE/Core/FileExists.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/src/Development/IDE/Core/FileExists.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index 28c633f93d..a0d5b2ac84 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -120,7 +120,7 @@ modifyFileExists state changes = do -- flush previous values let (fileModifChanges, fileExistChanges) = partition ((== FileChangeType_Changed) . snd) changes - keys0 <- concat <$> mapM (deleteValue (shakeExtras state) GetFileExists . fst) fileExistChanges + keys0 <- foldMap (deleteValue (shakeExtras state) GetFileExists . fst) fileExistChanges let keys1 = map (toKey GetFileExists . fst) fileExistChanges let keys2 = map (toKey GetModificationTime . fst) fileModifChanges return (keys0 <> keys1 <> keys2) From bea88b51aee5a4d7f9b7a4dcba7246754e9a693d Mon Sep 17 00:00:00 2001 From: soulomoon Date: Mon, 6 May 2024 20:37:33 +0800 Subject: [PATCH 23/44] Update ghcide/session-loader/Development/IDE/Session.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/session-loader/Development/IDE/Session.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 2d12125b7b..4d6de699a1 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -518,7 +518,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do return (pure hasUpdate) for_ hasUpdate $ \x -> logWith recorder Debug $ LogKnownFilesUpdated x - return $ toKey GetKnownTargets emptyFilePath + return $ toNoFileKey GetKnownTargets -- Create a new HscEnv from a hieYaml root and a set of options let packageSetup :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath) From c9219f0b18189b56f63b14a82715bdfecd62214a Mon Sep 17 00:00:00 2001 From: soulomoon Date: Mon, 6 May 2024 20:37:55 +0800 Subject: [PATCH 24/44] Update ghcide/session-loader/Development/IDE/Session.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/session-loader/Development/IDE/Session.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 4d6de699a1..ea2eecb088 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -476,7 +476,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do } <- getShakeExtras let invalidateShakeCache = do void $ modifyVar' version succ - return $ toKey GhcSessionIO emptyFilePath + return $ toNoFileKey GhcSessionIO IdeOptions{ optTesting = IdeTesting optTesting , optCheckProject = getCheckProject From 7a08b0332810268057b98d843cd087e80019387f Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 6 May 2024 20:45:14 +0800 Subject: [PATCH 25/44] cleanup --- ghcide/session-loader/Development/IDE/Session.hs | 4 ++-- ghcide/src/Development/IDE/Core/FileExists.hs | 2 +- ghcide/src/Development/IDE/Core/Shake.hs | 5 +++-- ghcide/src/Development/IDE/Main.hs | 3 +-- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index ea2eecb088..bbead3219e 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -509,13 +509,13 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do TargetModule _ -> do found <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations return [(targetTarget, Set.fromList found)] - hasUpdate <- join $ atomically $ do + hasUpdate <- atomically $ do known <- readTVar knownTargetsVar let known' = flip mapHashed known $ \k -> HM.unionWith (<>) k $ HM.fromList knownTargets hasUpdate = if known /= known' then Just (unhashed known') else Nothing writeTVar knownTargetsVar known' - return (pure hasUpdate) + pure hasUpdate for_ hasUpdate $ \x -> logWith recorder Debug $ LogKnownFilesUpdated x return $ toNoFileKey GetKnownTargets diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index a0d5b2ac84..52527622d2 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -106,7 +106,7 @@ getFileExistsMapUntracked = do FileExistsMapVar v <- getIdeGlobalAction return v --- | Modify the global store of file exists. +-- | Modify the global store of file exists and return the keys that need to be mark as dirty modifyFileExists :: IdeState -> [(NormalizedFilePath, FileChangeType)] -> IO [Key] modifyFileExists state changes = do FileExistsMapVar var <- getIdeGlobalState state diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 16e96af6eb..bd9b9e887d 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1225,8 +1225,9 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do return $ RunResult (if eq then ChangedRecomputeSame else ChangedRecomputeDiff) (encodeShakeValue bs) - (A res) - (setValues state key file res (Vector.fromList diags) >> modifyTVar' dirtyKeys (deleteKeySet $ toKey key file)) + (A res) $ do + setValues state key file res (Vector.fromList diags) + modifyTVar' dirtyKeys (deleteKeySet $ toKey key file) return res where -- Highly unsafe helper to compute the version of a file diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index b9c977e08e..1eb3cbe73b 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -18,8 +18,7 @@ import Control.Concurrent.STM.Stats (dumpSTMStats) import Control.Exception.Safe (SomeException, catchAny, displayException) -import Control.Monad.Extra (concatMapM, join, - unless, when) +import Control.Monad.Extra (concatMapM, unless, when) import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as J import Data.Coerce (coerce) From dc18b7479467b0d39c6253757504c27a7b82541c Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 6 May 2024 20:49:23 +0800 Subject: [PATCH 26/44] fix --- ghcide/session-loader/Development/IDE/Session.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index bbead3219e..5e0b1924e1 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -106,7 +106,7 @@ import qualified Data.HashSet as Set import Database.SQLite.Simple import Development.IDE.Core.Tracing (withTrace) import Development.IDE.Session.Diagnostics (renderCradleError) -import Development.IDE.Types.Shake (WithHieDb, toKey) +import Development.IDE.Types.Shake (WithHieDb, toNoFileKey) import HieDb.Create import HieDb.Types import HieDb.Utils From dc71a4074fe215a6111bedc8bbb0338e72675012 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 6 May 2024 20:53:49 +0800 Subject: [PATCH 27/44] cleanup --- ghcide/session-loader/Development/IDE/Session.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 5e0b1924e1..0a2126f43f 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -614,11 +614,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do void $ modifyVar' fileToFlags $ Map.insert hieYaml this_flags_map void $ modifyVar' filesMap $ flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) key1 <- extendKnownTargets all_targets - key2 <- invalidateShakeCache -- The VFS doesn't change on cradle edits, re-use the old one. + -- Invalidate all the existing GhcSession build nodes by restarting the Shake session restartShakeSession VFSUnmodified "new component" [] $ do + key2 <- invalidateShakeCache return [key1, key2] - -- Invalidate all the existing GhcSession build nodes by restarting the Shake session -- Typecheck all files in the project on startup checkProject <- getCheckProject From 342f52fb955d479f64511ced3c766e7648ac8ffd Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 6 May 2024 21:34:42 +0800 Subject: [PATCH 28/44] fix ghc 9.2 --- ghcide/src/Development/IDE/Core/FileExists.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index 52527622d2..39c663cd8e 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -120,7 +120,7 @@ modifyFileExists state changes = do -- flush previous values let (fileModifChanges, fileExistChanges) = partition ((== FileChangeType_Changed) . snd) changes - keys0 <- foldMap (deleteValue (shakeExtras state) GetFileExists . fst) fileExistChanges + keys0 <- concat <$> mapM (deleteValue (shakeExtras state) GetFileExists . fst) fileExistChanges let keys1 = map (toKey GetFileExists . fst) fileExistChanges let keys2 = map (toKey GetModificationTime . fst) fileModifChanges return (keys0 <> keys1 <> keys2) From 240254e9cdaf4f392b08b7b30ddd9e1eab19d369 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 6 May 2024 21:55:09 +0800 Subject: [PATCH 29/44] stylish --- ghcide/src/Development/IDE/Main.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 1eb3cbe73b..014aec8d71 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -18,7 +18,8 @@ import Control.Concurrent.STM.Stats (dumpSTMStats) import Control.Exception.Safe (SomeException, catchAny, displayException) -import Control.Monad.Extra (concatMapM, unless, when) +import Control.Monad.Extra (concatMapM, unless, + when) import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as J import Data.Coerce (coerce) From 797d9e939fb53f9247b2e378c7c4f95c7f3f747d Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 7 May 2024 05:47:23 +0800 Subject: [PATCH 30/44] push back extendKnownTargets to shake restart --- ghcide/session-loader/Development/IDE/Session.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 0a2126f43f..842bddf91a 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -613,10 +613,10 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do void $ modifyVar' fileToFlags $ Map.insert hieYaml this_flags_map void $ modifyVar' filesMap $ flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) - key1 <- extendKnownTargets all_targets -- The VFS doesn't change on cradle edits, re-use the old one. -- Invalidate all the existing GhcSession build nodes by restarting the Shake session restartShakeSession VFSUnmodified "new component" [] $ do + key1 <- extendKnownTargets all_targets key2 <- invalidateShakeCache return [key1, key2] From 7704d6a43bc35c8832c1f0abefe216f038add10e Mon Sep 17 00:00:00 2001 From: soulomoon Date: Wed, 8 May 2024 09:13:30 +0800 Subject: [PATCH 31/44] Update FileExists.hs Co-authored-by: Michael Peyton Jones --- ghcide/src/Development/IDE/Core/FileExists.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index 39c663cd8e..280cd14028 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -106,7 +106,7 @@ getFileExistsMapUntracked = do FileExistsMapVar v <- getIdeGlobalAction return v --- | Modify the global store of file exists and return the keys that need to be mark as dirty +-- | Modify the global store of file exists and return the keys that need to be marked as dirty modifyFileExists :: IdeState -> [(NormalizedFilePath, FileChangeType)] -> IO [Key] modifyFileExists state changes = do FileExistsMapVar var <- getIdeGlobalState state From ee1c334ab4645ab18c3c0daa0d247005b3a0b7a0 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 9 May 2024 02:39:05 +0800 Subject: [PATCH 32/44] update doc --- .../session-loader/Development/IDE/Session.hs | 2 +- ghcide/src/Development/IDE/Core/Shake.hs | 30 +++++++++++++++++++ .../Development/IDE/Graph/Internal/Types.hs | 3 +- 3 files changed, 33 insertions(+), 2 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 842bddf91a..d09f5d3334 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -615,9 +615,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do void $ modifyVar' filesMap $ flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) -- The VFS doesn't change on cradle edits, re-use the old one. -- Invalidate all the existing GhcSession build nodes by restarting the Shake session + key2 <- invalidateShakeCache restartShakeSession VFSUnmodified "new component" [] $ do key1 <- extendKnownTargets all_targets - key2 <- invalidateShakeCache return [key1, key2] -- Typecheck all files in the project on startup diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index bd9b9e887d..144980bf65 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -757,6 +757,8 @@ shakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession = (\runner -> do (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner keys <- ioActionBetweenShakeSession + -- it is every important to update the dirty keys after we enter the critical section + -- see Note [Housekeeping rule cache and dirty key out side of hls-graph] atomically $ modifyTVar' (dirtyKeys shakeExtras) $ \x -> foldl' (flip insertKeySet) x keys res <- shakeDatabaseProfile shakeDb backlog <- readTVarIO $ dirtyKeys shakeExtras @@ -1226,6 +1228,8 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do (if eq then ChangedRecomputeSame else ChangedRecomputeDiff) (encodeShakeValue bs) (A res) $ do + -- this hook need to be run in the same transaction as the key is marked clean + -- see Note [Housekeeping rule cache and dirty key out side of hls-graph] setValues state key file res (Vector.fromList diags) modifyTVar' dirtyKeys (deleteKeySet $ toKey key file) return res @@ -1251,6 +1255,32 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do -- * creating bogus "file does not exists" diagnostics | otherwise = useWithoutDependency (GetModificationTime_ False) fp +-- Note [Housekeeping rule cache and dirty key out side of hls-graph] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Hls-graph contains its own internal running state for each key in the shakeDatabase. +-- Rule result cache and dirty key are in ShakeExtras that is not visible to the hls-graph +-- Essentially, we need to keep the rule cache and dirty key and hls-graph's internal state +-- in sync. + +-- 1. A dirty key collect in a session should not be clean out in the same session. +-- Since if we clean out the dirty key in the same session, +-- 1.1. we will lose the chance to dirty it's reverse dependencies. Since it only happened during session restart. +-- 1.2. a key might marked as dirty at the same time it's already being run to a point that it should not be clean, +-- then invalidly clean it out. +-- See issue https://github.com/haskell/haskell-language-server/issues/4093 for more details. + +-- 2. When a key is marked clean in the hls-graph's internal running +-- state, the rule cache and dirty key are updated in the same transaction. +-- otherwise, some situations like the following can happen: +-- thread 1: hls-graph session run a key +-- thread 1: defineEarlyCutoff' run the action for the key +-- thread 1: the action is done, rule cache and dirty key are updated +-- thread 2: we restart the hls-graph session, thread 1 is killed, the +-- hls-graph's internal state is not updated. +-- This is problematic with early cut off because we are having a new rule cache matching the +-- old hls-graph's internal state, which might case it's reverse dependency to skip the recomputation. +-- See https://github.com/haskell/haskell-language-server/issues/4194 for more details. + traceA :: A v -> String traceA (A Failed{}) = "Failed" traceA (A Stale{}) = "Stale" diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs index 3474289b42..2283e3acde 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs @@ -204,7 +204,8 @@ data RunResult value = RunResult ,runValue :: value -- ^ The value to return from 'Development.Shake.Rule.apply'. ,runHook :: STM () - -- ^ The hook to run after the rule completes. + -- ^ The hook to run at the end of the build in the same transaction + -- when the key is marked as clean. } deriving Functor --------------------------------------------------------------------- From e7d380bb28038f1c13da83fdd97f57e12128f041 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 9 May 2024 03:16:09 +0800 Subject: [PATCH 33/44] add comment --- ghcide/src/Development/IDE/Core/Shake.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 144980bf65..5fdf40f735 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -558,6 +558,7 @@ setValues state key file val diags = -- | Delete the value stored for a given ide build key +-- and return the key that was deleted. deleteValue :: Shake.ShakeValue k => ShakeExtras From e0a7ff735a884dd81d9a1f09cd62fe09e7dea8ed Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 9 May 2024 21:29:18 +0800 Subject: [PATCH 34/44] Update Shake.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 5fdf40f735..dd50d5f224 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1256,7 +1256,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do -- * creating bogus "file does not exists" diagnostics | otherwise = useWithoutDependency (GetModificationTime_ False) fp --- Note [Housekeeping rule cache and dirty key out side of hls-graph] +-- Note [Housekeeping rule cache and dirty key outside of hls-graph] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Hls-graph contains its own internal running state for each key in the shakeDatabase. -- Rule result cache and dirty key are in ShakeExtras that is not visible to the hls-graph From a410dd92ddc10dfb3206e100643fd7a7b92d240b Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 9 May 2024 21:29:40 +0800 Subject: [PATCH 35/44] Update Shake.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index dd50d5f224..7c1157c03d 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1263,7 +1263,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do -- Essentially, we need to keep the rule cache and dirty key and hls-graph's internal state -- in sync. --- 1. A dirty key collect in a session should not be clean out in the same session. +-- 1. A dirty key collected in a session should not be removed from dirty keys in the same session. -- Since if we clean out the dirty key in the same session, -- 1.1. we will lose the chance to dirty it's reverse dependencies. Since it only happened during session restart. -- 1.2. a key might marked as dirty at the same time it's already being run to a point that it should not be clean, From cc1fa283c8780738adcc97bfe2d8a8856731f551 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 9 May 2024 21:30:26 +0800 Subject: [PATCH 36/44] Update Shake.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/src/Development/IDE/Core/Shake.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 7c1157c03d..a07ebfa2d6 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1266,8 +1266,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do -- 1. A dirty key collected in a session should not be removed from dirty keys in the same session. -- Since if we clean out the dirty key in the same session, -- 1.1. we will lose the chance to dirty it's reverse dependencies. Since it only happened during session restart. --- 1.2. a key might marked as dirty at the same time it's already being run to a point that it should not be clean, --- then invalidly clean it out. +-- 1.2. a key might be marked as dirty in ShakeExtras while it's being recomputed by hls-graph which could lead to it's premature removal from dirtyKeys. -- See issue https://github.com/haskell/haskell-language-server/issues/4093 for more details. -- 2. When a key is marked clean in the hls-graph's internal running From ebce5eb0d33ac433a773df714b64774f1f3439c7 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 9 May 2024 21:30:33 +0800 Subject: [PATCH 37/44] Update Shake.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index a07ebfa2d6..511ef2868e 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1270,7 +1270,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do -- See issue https://github.com/haskell/haskell-language-server/issues/4093 for more details. -- 2. When a key is marked clean in the hls-graph's internal running --- state, the rule cache and dirty key are updated in the same transaction. +-- state, the rule cache and dirty keys are updated in the same transaction. -- otherwise, some situations like the following can happen: -- thread 1: hls-graph session run a key -- thread 1: defineEarlyCutoff' run the action for the key From 24ec73fc6d67c75996e95d589f05e7ff54da0a22 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 9 May 2024 21:30:45 +0800 Subject: [PATCH 38/44] Update Session.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/session-loader/Development/IDE/Session.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index d09f5d3334..a0a5e9596e 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -615,10 +615,10 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do void $ modifyVar' filesMap $ flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) -- The VFS doesn't change on cradle edits, re-use the old one. -- Invalidate all the existing GhcSession build nodes by restarting the Shake session - key2 <- invalidateShakeCache + keys2 <- invalidateShakeCache restartShakeSession VFSUnmodified "new component" [] $ do - key1 <- extendKnownTargets all_targets - return [key1, key2] + keys1 <- extendKnownTargets all_targets + return [keys1, keys2] -- Typecheck all files in the project on startup checkProject <- getCheckProject From d609b344210ed724c826d3ad5ea6d178ba37e15a Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 9 May 2024 21:30:52 +0800 Subject: [PATCH 39/44] Update Shake.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 511ef2868e..8e5e44c947 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1229,7 +1229,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do (if eq then ChangedRecomputeSame else ChangedRecomputeDiff) (encodeShakeValue bs) (A res) $ do - -- this hook need to be run in the same transaction as the key is marked clean + -- this hook needs to be run in the same transaction as the key is marked clean -- see Note [Housekeeping rule cache and dirty key out side of hls-graph] setValues state key file res (Vector.fromList diags) modifyTVar' dirtyKeys (deleteKeySet $ toKey key file) From 91f88b3d2060c38edd5eada645303ea1efeffa36 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 9 May 2024 21:31:13 +0800 Subject: [PATCH 40/44] Update Shake.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 8e5e44c947..3f23534a38 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1265,7 +1265,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do -- 1. A dirty key collected in a session should not be removed from dirty keys in the same session. -- Since if we clean out the dirty key in the same session, --- 1.1. we will lose the chance to dirty it's reverse dependencies. Since it only happened during session restart. +-- 1.1. we will lose the chance to dirty its reverse dependencies. Since it only happens during session restart. -- 1.2. a key might be marked as dirty in ShakeExtras while it's being recomputed by hls-graph which could lead to it's premature removal from dirtyKeys. -- See issue https://github.com/haskell/haskell-language-server/issues/4093 for more details. From db969c87d119de62eb27e4439d4926fa9382b72a Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 9 May 2024 21:31:31 +0800 Subject: [PATCH 41/44] Update Main.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- ghcide/src/Development/IDE/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 014aec8d71..e355634c1c 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -366,7 +366,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re setSomethingModified Shake.VFSUnmodified ide "config change" $ do logWith recorder Debug $ LogConfigurationChange msg modifyClientSettings ide (const $ Just cfgObj) - return [toKey Rules.GetClientSettings emptyFilePath] + return [toNoFileKey Rules.GetClientSettings] runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup dumpSTMStats From 2eb20d2754e04c97dfc40789ae3c184825270663 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 10 May 2024 02:44:25 +0800 Subject: [PATCH 42/44] fix comment --- ghcide/src/Development/IDE/Core/Shake.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 3f23534a38..b1745918f2 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1259,7 +1259,8 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do -- Note [Housekeeping rule cache and dirty key outside of hls-graph] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Hls-graph contains its own internal running state for each key in the shakeDatabase. --- Rule result cache and dirty key are in ShakeExtras that is not visible to the hls-graph +-- ShakeExtras contains `state` field (rule result cache) and `dirtyKeys` (keys that became +-- dirty in between build sessions) that is not visible to the hls-graph -- Essentially, we need to keep the rule cache and dirty key and hls-graph's internal state -- in sync. From 035a71c8ce33cac21e3673c33674c5550c75050b Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 10 May 2024 02:46:43 +0800 Subject: [PATCH 43/44] fix import --- ghcide/src/Development/IDE/Main.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index e355634c1c..d3fb7dd852 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -88,7 +88,8 @@ import Development.IDE.Types.Options (IdeGhcSession, defaultIdeOptions, optModifyDynFlags, optTesting) -import Development.IDE.Types.Shake (WithHieDb, toKey) +import Development.IDE.Types.Shake (WithHieDb, toKey, + toNoFileKey) import GHC.Conc (atomically, getNumProcessors) import GHC.IO.Encoding (setLocaleEncoding) From f4f80f791dff90a011cf8ba9056985545542b39e Mon Sep 17 00:00:00 2001 From: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> Date: Fri, 10 May 2024 05:53:50 +0200 Subject: [PATCH 44/44] Fix note references --- ghcide/src/Development/IDE/Core/Shake.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index b1745918f2..28e22a6b48 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -759,7 +759,7 @@ shakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession = (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner keys <- ioActionBetweenShakeSession -- it is every important to update the dirty keys after we enter the critical section - -- see Note [Housekeeping rule cache and dirty key out side of hls-graph] + -- see Note [Housekeeping rule cache and dirty key outside of hls-graph] atomically $ modifyTVar' (dirtyKeys shakeExtras) $ \x -> foldl' (flip insertKeySet) x keys res <- shakeDatabaseProfile shakeDb backlog <- readTVarIO $ dirtyKeys shakeExtras @@ -1230,7 +1230,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do (encodeShakeValue bs) (A res) $ do -- this hook needs to be run in the same transaction as the key is marked clean - -- see Note [Housekeeping rule cache and dirty key out side of hls-graph] + -- see Note [Housekeeping rule cache and dirty key outside of hls-graph] setValues state key file res (Vector.fromList diags) modifyTVar' dirtyKeys (deleteKeySet $ toKey key file) return res