From da658456c1c1ec82ba2374d628232c395bf4d63a Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 26 Mar 2024 07:35:32 +0800 Subject: [PATCH 01/14] surface the problem --- ghcide/src/Development/IDE/Core/FileStore.hs | 6 ++++++ plugins/hls-refactor-plugin/test/Main.hs | 10 ++++++---- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 7be4c71827..7046ff1661 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 GHC.Conc.Sync (unsafeIOToSTM) import HieDb.Create (deleteMissingRealFiles) import Ide.Logger (Pretty (pretty), Priority (Info), @@ -246,11 +247,16 @@ typecheckParentsAction recorder nfp = do -- independently tracks which files are modified. setSomethingModified :: VFSModified -> IdeState -> [Key] -> String -> IO () setSomethingModified vfs state keys reason = do + L.logDebug (Shake.ideLogger state) "begin restartShakeSession" -- Update database to remove any files that might have been renamed/deleted atomically $ do + unsafeIOToSTM $ L.logDebug (Shake.ideLogger state) "begin writing indexQueue" writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles) + unsafeIOToSTM $ L.logDebug (Shake.ideLogger state) "begin writing dirtyKeys" modifyTVar' (dirtyKeys $ shakeExtras state) $ \x -> foldl' (flip insertKeySet) x keys + + L.logDebug (Shake.ideLogger state) "setSomethingModified before restartShakeSession" void $ restartShakeSession (shakeExtras state) vfs reason [] registerFileWatches :: [String] -> LSP.LspT Config IO Bool diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 09635e898a..3111755a9b 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -71,9 +71,9 @@ tests :: TestTree tests = testGroup "refactor" [ initializeTests - , codeActionTests - , codeActionHelperFunctionTests - , completionTests +-- , codeActionTests +-- , codeActionHelperFunctionTests +-- , completionTests ] initializeTests :: TestTree @@ -99,7 +99,9 @@ initializeTests = withResource acquire release tests mapM_ (\e -> any (\o -> T.isSuffixOf e o) commands @? show (expected, show commands)) expected acquire :: IO (TResponseMessage Method_Initialize) - acquire = run initializeResponse + acquire = do + -- liftIO $ sleep 0.01 + run initializeResponse release :: TResponseMessage Method_Initialize -> IO () release = mempty From 5de2de33cc4509adbd40c516e38bbe89991ecfd4 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 26 Mar 2024 08:23:58 +0800 Subject: [PATCH 02/14] move stopReactor to exit --- 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 5663165f02..c55d50d9d1 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -169,7 +169,7 @@ setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do let asyncHandlers = mconcat [ userHandlers , cancelHandler cancelRequest - , exitHandler exit + , exitHandler stopReactorLoop >> exit , shutdownHandler stopReactorLoop ] -- Cancel requests are special since they need to be handled @@ -266,7 +266,7 @@ shutdownHandler stopReactor = LSP.requestHandler SMethod_Shutdown $ \_ resp -> d (_, ide) <- ask liftIO $ logDebug (ideLogger ide) "Received shutdown message" -- stop the reactor to free up the hiedb connection - liftIO stopReactor + -- liftIO stopReactor -- flush out the Shake session to record a Shake profile if applicable liftIO $ shakeShut ide resp $ Right Null From 05a08da7946f0c5096e035cfe0e2992fd15d72bc Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 26 Mar 2024 08:24:21 +0800 Subject: [PATCH 03/14] move stopReactor to exit --- ghcide/src/Development/IDE/LSP/LanguageServer.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index c55d50d9d1..6177628056 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -169,7 +169,7 @@ setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do let asyncHandlers = mconcat [ userHandlers , cancelHandler cancelRequest - , exitHandler stopReactorLoop >> exit + , exitHandler $ stopReactorLoop >> exit , shutdownHandler stopReactorLoop ] -- Cancel requests are special since they need to be handled From e96a53e3fb90215cbc7a619441a1a7be5d7d3cd6 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 26 Mar 2024 08:38:21 +0800 Subject: [PATCH 04/14] wait for reactor close --- ghcide/src/Development/IDE/Core/FileStore.hs | 2 +- .../src/Development/IDE/LSP/LanguageServer.hs | 19 ++++++++++++++----- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 7046ff1661..a02e23e207 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -247,7 +247,7 @@ typecheckParentsAction recorder nfp = do -- independently tracks which files are modified. setSomethingModified :: VFSModified -> IdeState -> [Key] -> String -> IO () setSomethingModified vfs state keys reason = do - L.logDebug (Shake.ideLogger state) "begin restartShakeSession" + L.logDebug (Shake.ideLogger state) "begin setSomethingModified" -- Update database to remove any files that might have been renamed/deleted atomically $ do unsafeIOToSTM $ L.logDebug (Shake.ideLogger state) "begin writing indexQueue" diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 6177628056..54c961d926 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -142,6 +142,11 @@ setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do reactorLifetime <- newEmptyMVar let stopReactorLoop = void $ tryPutMVar reactorLifetime () + -- An MVar to control the lifetime of the reactor loop. + -- The loop will be stopped and resources freed when it's full + waitForReactor <- newEmptyMVar + let finishEndReactor = void $ tryPutMVar waitForReactor () + -- Forcefully exit let exit = void $ tryPutMVar clientMsgVar () @@ -166,17 +171,18 @@ setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do cancelled <- readTVar cancelledRequests unless (reqId `Set.member` cancelled) retry + + let doInitialize = handleInit recorder getHieDbLoc getIdeState reactorLifetime exit clearReqId waitForCancel clientMsgChan finishEndReactor + let asyncHandlers = mconcat [ userHandlers , cancelHandler cancelRequest - , exitHandler $ stopReactorLoop >> exit + , exitHandler $ stopReactorLoop >> takeMVar waitForReactor >> exit , shutdownHandler stopReactorLoop ] -- Cancel requests are special since they need to be handled -- out of order to be useful. Existing handlers are run afterwards. - let doInitialize = handleInit recorder getHieDbLoc getIdeState reactorLifetime exit clearReqId waitForCancel clientMsgChan - let interpretHandler (env, st) = LSP.Iso (LSP.runLspT env . flip (runReaderT . unServerM) (clientMsgChan,st)) liftIO pure (doInitialize, asyncHandlers, interpretHandler) @@ -191,8 +197,10 @@ handleInit -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> Chan ReactorMessage - -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)) -handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId waitForCancel clientMsgChan env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do + -> IO () + -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize + -> IO (Either err (LSP.LanguageContextEnv config, IdeState)) +handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId waitForCancel clientMsgChan finishEndReactor env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do traceWithSpan sp params let root = LSP.resRootPath env dir <- maybe getCurrentDirectory return root @@ -245,6 +253,7 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa ReactorNotification act -> handle exceptionInHandler act ReactorRequest _id act k -> void $ async $ checkCancelled _id act k logWith recorder Info LogReactorThreadStopped + finishEndReactor pure $ Right (env,ide) From 099e17f7b198947958d6cdfc2a736ac72f179772 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 26 Mar 2024 09:42:03 +0800 Subject: [PATCH 05/14] push the update of config to reactor thread --- .../src/Development/IDE/LSP/LanguageServer.hs | 27 +++++------------ ghcide/src/Development/IDE/Main.hs | 30 ++++++++++++------- 2 files changed, 28 insertions(+), 29 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 54c961d926..c45b1ef23e 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -128,25 +128,18 @@ setupLSP :: -> (FilePath -> IO FilePath) -- ^ Map root paths to the location of the hiedb for the project -> LSP.Handlers (ServerM config) -> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState) + -> Chan ReactorMessage -> MVar () -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)), LSP.Handlers (ServerM config), (LanguageContextEnv config, IdeState) -> ServerM config <~> IO) -setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do - -- Send everything over a channel, since you need to wait until after initialise before - -- LspFuncs is available - clientMsgChan :: Chan ReactorMessage <- newChan +setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgChan clientMsgVar = do -- An MVar to control the lifetime of the reactor loop. -- The loop will be stopped and resources freed when it's full reactorLifetime <- newEmptyMVar let stopReactorLoop = void $ tryPutMVar reactorLifetime () - -- An MVar to control the lifetime of the reactor loop. - -- The loop will be stopped and resources freed when it's full - waitForReactor <- newEmptyMVar - let finishEndReactor = void $ tryPutMVar waitForReactor () - -- Forcefully exit let exit = void $ tryPutMVar clientMsgVar () @@ -171,18 +164,17 @@ setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do cancelled <- readTVar cancelledRequests unless (reqId `Set.member` cancelled) retry - - let doInitialize = handleInit recorder getHieDbLoc getIdeState reactorLifetime exit clearReqId waitForCancel clientMsgChan finishEndReactor - let asyncHandlers = mconcat [ userHandlers , cancelHandler cancelRequest - , exitHandler $ stopReactorLoop >> takeMVar waitForReactor >> exit + , exitHandler exit , shutdownHandler stopReactorLoop ] -- Cancel requests are special since they need to be handled -- out of order to be useful. Existing handlers are run afterwards. + let doInitialize = handleInit recorder getHieDbLoc getIdeState reactorLifetime exit clearReqId waitForCancel clientMsgChan + let interpretHandler (env, st) = LSP.Iso (LSP.runLspT env . flip (runReaderT . unServerM) (clientMsgChan,st)) liftIO pure (doInitialize, asyncHandlers, interpretHandler) @@ -197,10 +189,8 @@ handleInit -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> Chan ReactorMessage - -> IO () - -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize - -> IO (Either err (LSP.LanguageContextEnv config, IdeState)) -handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId waitForCancel clientMsgChan finishEndReactor env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do + -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)) +handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId waitForCancel clientMsgChan env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do traceWithSpan sp params let root = LSP.resRootPath env dir <- maybe getCurrentDirectory return root @@ -253,7 +243,6 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa ReactorNotification act -> handle exceptionInHandler act ReactorRequest _id act k -> void $ async $ checkCancelled _id act k logWith recorder Info LogReactorThreadStopped - finishEndReactor pure $ Right (env,ide) @@ -275,7 +264,7 @@ shutdownHandler stopReactor = LSP.requestHandler SMethod_Shutdown $ \_ resp -> d (_, ide) <- ask liftIO $ logDebug (ideLogger ide) "Received shutdown message" -- stop the reactor to free up the hiedb connection - -- liftIO stopReactor + liftIO stopReactor -- flush out the Shake session to record a Shake profile if applicable liftIO $ shakeShut ide resp $ Right Null diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 2359b4a18a..aa426659e8 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -11,7 +11,9 @@ module Development.IDE.Main ,Log(..) ) where -import Control.Concurrent.Extra (withNumCapabilities) +import Control.Concurrent.Extra (Chan, newChan, + withNumCapabilities, + writeChan) import Control.Concurrent.MVar (newEmptyMVar, putMVar, tryReadMVar) import Control.Concurrent.STM.Stats (dumpSTMStats) @@ -63,6 +65,7 @@ import Development.IDE.Graph (action) import Development.IDE.LSP.LanguageServer (runLanguageServer, setupLSP) import qualified Development.IDE.LSP.LanguageServer as LanguageServer +import Development.IDE.LSP.Server import Development.IDE.Main.HeapStats (withHeapStats) import qualified Development.IDE.Main.HeapStats as HeapStats import qualified Development.IDE.Monitoring.EKG as EKG @@ -356,19 +359,26 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re putMVar ideStateVar ide pure ide - let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsGetHieDbLoc (pluginHandlers plugins) getIdeState + -- Send everything over a channel, since you need to wait until after initialise before + -- LspFuncs is available + clientMsgChan :: Chan ReactorMessage <- newChan + + let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsGetHieDbLoc (pluginHandlers plugins) getIdeState clientMsgChan -- See Note [Client configuration in Rules] onConfigChange cfg = do -- TODO: this is nuts, we're converting back to JSON just to get a fingerprint let cfgObj = J.toJSON cfg - mide <- liftIO $ tryReadMVar ideStateVar - case mide of - Nothing -> pure () - Just ide -> liftIO $ do - let msg = T.pack $ show cfg - logDebug (Shake.ideLogger ide) $ "Configuration changed: " <> msg - modifyClientSettings ide (const $ Just cfgObj) - setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change" + let configChangeIO = do + mide <- liftIO $ tryReadMVar ideStateVar + case mide of + Nothing -> pure () + Just ide -> liftIO $ do + let msg = T.pack $ show cfg + logDebug (Shake.ideLogger ide) $ "Configuration changed: " <> msg + modifyClientSettings ide (const $ Just cfgObj) + setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change" + liftIO $ writeChan clientMsgChan $ ReactorNotification configChangeIO + runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup dumpSTMStats From b3476c28e42949cf4d09daea3c944c43b55b3648 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 26 Mar 2024 10:20:44 +0800 Subject: [PATCH 06/14] remove log setSomethingModified --- ghcide/src/Development/IDE/Core/FileStore.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index a02e23e207..47a34ce128 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -247,16 +247,11 @@ typecheckParentsAction recorder nfp = do -- independently tracks which files are modified. setSomethingModified :: VFSModified -> IdeState -> [Key] -> String -> IO () setSomethingModified vfs state keys reason = do - L.logDebug (Shake.ideLogger state) "begin setSomethingModified" -- Update database to remove any files that might have been renamed/deleted atomically $ do - unsafeIOToSTM $ L.logDebug (Shake.ideLogger state) "begin writing indexQueue" writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles) - unsafeIOToSTM $ L.logDebug (Shake.ideLogger state) "begin writing dirtyKeys" modifyTVar' (dirtyKeys $ shakeExtras state) $ \x -> foldl' (flip insertKeySet) x keys - - L.logDebug (Shake.ideLogger state) "setSomethingModified before restartShakeSession" void $ restartShakeSession (shakeExtras state) vfs reason [] registerFileWatches :: [String] -> LSP.LspT Config IO Bool From 14eff93d6eea44cca1e8139ff1bd9fe9b7310f9b Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 26 Mar 2024 11:18:00 +0800 Subject: [PATCH 07/14] cleanup dirty trick --- ghcide/src/Development/IDE/LSP/LanguageServer.hs | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index c45b1ef23e..2b1568dc1f 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -195,18 +195,11 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa let root = LSP.resRootPath env dir <- maybe getCurrentDirectory return root dbLoc <- getHieDbLoc dir - - -- The database needs to be open for the duration of the reactor thread, but we need to pass in a reference - -- to 'getIdeState', so we use this dirty trick dbMVar <- newEmptyMVar - ~(WithHieDbShield withHieDb,hieChan) <- unsafeInterleaveIO $ takeMVar dbMVar - - ide <- getIdeState env root withHieDb hieChan let initConfig = parseConfiguration params logWith recorder Info $ LogRegisteringIdeConfig initConfig - registerIdeConfiguration (shakeExtras ide) initConfig let handleServerException (Left e) = do logWith recorder Error $ LogReactorThreadException e @@ -243,6 +236,10 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa ReactorNotification act -> handle exceptionInHandler act ReactorRequest _id act k -> void $ async $ checkCancelled _id act k logWith recorder Info LogReactorThreadStopped + + (WithHieDbShield withHieDb,hieChan) <- takeMVar dbMVar + ide <- getIdeState env root withHieDb hieChan + registerIdeConfiguration (shakeExtras ide) initConfig pure $ Right (env,ide) From abe68a12bce0aa848fe17604373e56c1dfe14fa7 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 26 Mar 2024 18:45:12 +0800 Subject: [PATCH 08/14] Revert "cleanup dirty trick" This reverts commit 14eff93d6eea44cca1e8139ff1bd9fe9b7310f9b. --- ghcide/src/Development/IDE/LSP/LanguageServer.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 2b1568dc1f..c45b1ef23e 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -195,11 +195,18 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa let root = LSP.resRootPath env dir <- maybe getCurrentDirectory return root dbLoc <- getHieDbLoc dir + + -- The database needs to be open for the duration of the reactor thread, but we need to pass in a reference + -- to 'getIdeState', so we use this dirty trick dbMVar <- newEmptyMVar + ~(WithHieDbShield withHieDb,hieChan) <- unsafeInterleaveIO $ takeMVar dbMVar + + ide <- getIdeState env root withHieDb hieChan let initConfig = parseConfiguration params logWith recorder Info $ LogRegisteringIdeConfig initConfig + registerIdeConfiguration (shakeExtras ide) initConfig let handleServerException (Left e) = do logWith recorder Error $ LogReactorThreadException e @@ -236,10 +243,6 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa ReactorNotification act -> handle exceptionInHandler act ReactorRequest _id act k -> void $ async $ checkCancelled _id act k logWith recorder Info LogReactorThreadStopped - - (WithHieDbShield withHieDb,hieChan) <- takeMVar dbMVar - ide <- getIdeState env root withHieDb hieChan - registerIdeConfiguration (shakeExtras ide) initConfig pure $ Right (env,ide) From dc530355df77d9953389b3972c5056389d62afed Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 26 Mar 2024 19:43:52 +0800 Subject: [PATCH 09/14] clean up --- ghcide/src/Development/IDE/Core/FileStore.hs | 1 - plugins/hls-refactor-plugin/test/Main.hs | 10 ++++------ 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 47a34ce128..7be4c71827 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -49,7 +49,6 @@ import Development.IDE.Import.DependencyInformation import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Options -import GHC.Conc.Sync (unsafeIOToSTM) import HieDb.Create (deleteMissingRealFiles) import Ide.Logger (Pretty (pretty), Priority (Info), diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 3111755a9b..09635e898a 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -71,9 +71,9 @@ tests :: TestTree tests = testGroup "refactor" [ initializeTests --- , codeActionTests --- , codeActionHelperFunctionTests --- , completionTests + , codeActionTests + , codeActionHelperFunctionTests + , completionTests ] initializeTests :: TestTree @@ -99,9 +99,7 @@ initializeTests = withResource acquire release tests mapM_ (\e -> any (\o -> T.isSuffixOf e o) commands @? show (expected, show commands)) expected acquire :: IO (TResponseMessage Method_Initialize) - acquire = do - -- liftIO $ sleep 0.01 - run initializeResponse + acquire = run initializeResponse release :: TResponseMessage Method_Initialize -> IO () release = mempty From f8018b917415a55601a40d710b89e78438f33079 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 27 Mar 2024 03:37:30 +0800 Subject: [PATCH 10/14] share the mvar --- .../src/Development/IDE/LSP/LanguageServer.hs | 16 ++++++---- ghcide/src/Development/IDE/Main.hs | 29 +++++++------------ 2 files changed, 20 insertions(+), 25 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index c45b1ef23e..1ea8ca8fe7 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -125,15 +125,18 @@ runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigCh setupLSP :: forall config err. Recorder (WithPriority Log) + -> MVar IdeState -> (FilePath -> IO FilePath) -- ^ Map root paths to the location of the hiedb for the project -> LSP.Handlers (ServerM config) -> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState) - -> Chan ReactorMessage -> MVar () -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)), LSP.Handlers (ServerM config), (LanguageContextEnv config, IdeState) -> ServerM config <~> IO) -setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgChan clientMsgVar = do +setupLSP recorder ideStateVar getHieDbLoc userHandlers getIdeState clientMsgVar = do + -- Send everything over a channel, since you need to wait until after initialise before + -- LspFuncs is available + clientMsgChan :: Chan ReactorMessage <- newChan -- An MVar to control the lifetime of the reactor loop. -- The loop will be stopped and resources freed when it's full @@ -168,7 +171,7 @@ setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgChan clientMsgV [ userHandlers , cancelHandler cancelRequest , exitHandler exit - , shutdownHandler stopReactorLoop + , shutdownHandler stopReactorLoop ideStateVar ] -- Cancel requests are special since they need to be handled -- out of order to be useful. Existing handlers are run afterwards. @@ -259,14 +262,15 @@ cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \T toLspId (InL x) = IdInt x toLspId (InR y) = IdString y -shutdownHandler :: IO () -> LSP.Handlers (ServerM c) -shutdownHandler stopReactor = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do - (_, ide) <- ask +shutdownHandler :: IO () -> MVar IdeState -> LSP.Handlers (ServerM c) +shutdownHandler stopReactor ideStateVar = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do + ide <- liftIO $ takeMVar ideStateVar liftIO $ logDebug (ideLogger ide) "Received shutdown message" -- 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 + -- liftIO $ tryReadMVar resp $ Right Null exitHandler :: IO () -> LSP.Handlers (ServerM c) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index aa426659e8..db868faf1c 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -11,9 +11,7 @@ module Development.IDE.Main ,Log(..) ) where -import Control.Concurrent.Extra (Chan, newChan, - withNumCapabilities, - writeChan) +import Control.Concurrent.Extra (withNumCapabilities) import Control.Concurrent.MVar (newEmptyMVar, putMVar, tryReadMVar) import Control.Concurrent.STM.Stats (dumpSTMStats) @@ -359,26 +357,19 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re putMVar ideStateVar ide pure ide - -- Send everything over a channel, since you need to wait until after initialise before - -- LspFuncs is available - clientMsgChan :: Chan ReactorMessage <- newChan - - let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsGetHieDbLoc (pluginHandlers plugins) getIdeState clientMsgChan + let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) ideStateVar argsGetHieDbLoc (pluginHandlers plugins) getIdeState -- See Note [Client configuration in Rules] onConfigChange cfg = do -- TODO: this is nuts, we're converting back to JSON just to get a fingerprint let cfgObj = J.toJSON cfg - let configChangeIO = do - mide <- liftIO $ tryReadMVar ideStateVar - case mide of - Nothing -> pure () - Just ide -> liftIO $ do - let msg = T.pack $ show cfg - logDebug (Shake.ideLogger ide) $ "Configuration changed: " <> msg - modifyClientSettings ide (const $ Just cfgObj) - setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change" - liftIO $ writeChan clientMsgChan $ ReactorNotification configChangeIO - + mide <- liftIO $ tryReadMVar ideStateVar + case mide of + Nothing -> pure () + Just ide -> liftIO $ do + let msg = T.pack $ show cfg + logDebug (Shake.ideLogger ide) $ "Configuration changed: " <> msg + modifyClientSettings ide (const $ Just cfgObj) + setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change" runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup dumpSTMStats From 8a8297c4588a29225eb7ed4cb89140f204b1ee11 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 27 Mar 2024 07:22:18 +0800 Subject: [PATCH 11/14] take and put mvar on config update --- .../src/Development/IDE/LSP/LanguageServer.hs | 2 +- ghcide/src/Development/IDE/Main.hs | 32 +++++++++++-------- 2 files changed, 19 insertions(+), 15 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 1ea8ca8fe7..5df3aca2f7 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -264,13 +264,13 @@ cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \T shutdownHandler :: IO () -> MVar IdeState -> LSP.Handlers (ServerM c) shutdownHandler stopReactor ideStateVar = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do + -- take away the ideStateVar to prevent onConfigChange from running and hangs. ide <- liftIO $ takeMVar ideStateVar liftIO $ logDebug (ideLogger ide) "Received shutdown message" -- 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 - -- liftIO $ tryReadMVar resp $ Right Null exitHandler :: IO () -> LSP.Handlers (ServerM c) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index db868faf1c..98da968b84 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -11,15 +11,18 @@ module Development.IDE.Main ,Log(..) ) where -import Control.Concurrent.Extra (withNumCapabilities) +import Control.Concurrent.Extra (tryTakeMVar, + withNumCapabilities) import Control.Concurrent.MVar (newEmptyMVar, putMVar, tryReadMVar) import Control.Concurrent.STM.Stats (dumpSTMStats) +import Control.Exception (bracket) import Control.Exception.Safe (SomeException, catchAny, displayException) -import Control.Monad.Extra (concatMapM, unless, - when) +import Control.Monad.Extra (concatMapM, maybeM, + unless, when, + whenJust, whenJustM) import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as J import Data.Coerce (coerce) @@ -63,7 +66,6 @@ import Development.IDE.Graph (action) import Development.IDE.LSP.LanguageServer (runLanguageServer, setupLSP) import qualified Development.IDE.LSP.LanguageServer as LanguageServer -import Development.IDE.LSP.Server import Development.IDE.Main.HeapStats (withHeapStats) import qualified Development.IDE.Main.HeapStats as HeapStats import qualified Development.IDE.Monitoring.EKG as EKG @@ -91,7 +93,8 @@ import Development.IDE.Types.Options (IdeGhcSession, optModifyDynFlags, optTesting) import Development.IDE.Types.Shake (WithHieDb, toKey) -import GHC.Conc (getNumProcessors) +import GHC.Conc (getNumProcessors, + withMVar) import GHC.IO.Encoding (setLocaleEncoding) import GHC.IO.Handle (hDuplicate) import HIE.Bios.Cradle (findCradle) @@ -191,7 +194,7 @@ isLSP _ = False commandP :: IdePlugins IdeState -> Parser Command commandP plugins = - hsubparser(command "typecheck" (info (Check <$> fileCmd) fileInfo) + hsubparser (command "typecheck" (info (Check <$> fileCmd) fileInfo) <> command "hiedb" (info (Db <$> HieDb.optParser "" True <*> HieDb.cmdParser) hieInfo) <> command "lsp" (info (pure LSP) lspInfo) <> pluginCommands @@ -362,14 +365,15 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re onConfigChange cfg = do -- TODO: this is nuts, we're converting back to JSON just to get a fingerprint let cfgObj = J.toJSON cfg - mide <- liftIO $ tryReadMVar ideStateVar - case mide of - Nothing -> pure () - Just ide -> liftIO $ do - let msg = T.pack $ show cfg - logDebug (Shake.ideLogger ide) $ "Configuration changed: " <> msg - modifyClientSettings ide (const $ Just cfgObj) - setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change" + -- tryReadMVar is essential here, as the MVar might be empty if the server is still starting up + -- and it might be gone if the server is shutting down. + liftIO $ bracket (liftIO $ tryTakeMVar ideStateVar) (`whenJust` putMVar ideStateVar) $ \case + Nothing -> pure () + Just ide -> liftIO $ do + let msg = T.pack $ show cfg + logDebug (Shake.ideLogger ide) $ "Configuration changed: " <> msg + modifyClientSettings ide (const $ Just cfgObj) + setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change" runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup dumpSTMStats From c331ae6e2601e2b6c35d42ac0b4a71b6651b1117 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 2 Apr 2024 19:05:54 +0800 Subject: [PATCH 12/14] update doc --- 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 98da968b84..b4245e9254 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -365,7 +365,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re onConfigChange cfg = do -- TODO: this is nuts, we're converting back to JSON just to get a fingerprint let cfgObj = J.toJSON cfg - -- tryReadMVar is essential here, as the MVar might be empty if the server is still starting up + -- tryTakeMVar is essential here, as the MVar might be empty if the server is still starting up -- and it might be gone if the server is shutting down. liftIO $ bracket (liftIO $ tryTakeMVar ideStateVar) (`whenJust` putMVar ideStateVar) $ \case Nothing -> pure () From cb21b0a30f226d60ff453592631684385da7e45f Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 2 Apr 2024 19:06:46 +0800 Subject: [PATCH 13/14] update doc --- 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 b4245e9254..e42da5833f 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 -- TODO: this is nuts, we're converting back to JSON just to get a fingerprint let cfgObj = J.toJSON cfg -- tryTakeMVar is essential here, as the MVar might be empty if the server is still starting up - -- and it might be gone if the server is shutting down. + -- and it might be gone if the server shut down. liftIO $ bracket (liftIO $ tryTakeMVar ideStateVar) (`whenJust` putMVar ideStateVar) $ \case Nothing -> pure () Just ide -> liftIO $ do From 9953607d662c07a50bc32ea5a11321e3e4d47bd2 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 2 Apr 2024 19:21:39 +0800 Subject: [PATCH 14/14] add doc --- ghcide/src/Development/IDE/Main.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index e42da5833f..6c0e389631 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -314,6 +314,10 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re ioT <- offsetTime logWith recorder Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins) + -- Notice why we are using `ideStateVar`: + -- 1. to pass the ide state to config update callback after the initialization + -- 2. guard against the case when the server is still starting up and + -- and after shutdown handler has been called(empty in this case). ideStateVar <- newEmptyMVar let getIdeState :: LSP.LanguageContextEnv Config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState getIdeState env rootPath withHieDb hieChan = do