diff --git a/lsp-test/ChangeLog.md b/lsp-test/ChangeLog.md index 0bc07e1c..621d2a11 100644 --- a/lsp-test/ChangeLog.md +++ b/lsp-test/ChangeLog.md @@ -1,10 +1,15 @@ # Revision history for lsp-test +# Unreleased + +- New function `setIgnoringProgressNotifications` to change whether progress notifications are + ignored during a `Session` without having to change the `SessionConfig`. + ## 0.17.0.0 - `ignoreRegistrationRequests` option to ignore `client/registerCapability` requests, on by default. -- New functions `setIgnoringRegistrationRequests` to change whether such messages are +- New function `setIgnoringRegistrationRequests` to change whether such messages are ignored during a `Session` without having to change the `SessionConfig`. - `lsp-test` will no longer send `workspace/didChangConfiguration` notifications unless the server dynamically registers for them. @@ -44,7 +49,7 @@ * Compatibility with new `lsp-types` major version. -## 0.14.0.2 +## 0.14.0.2 * Compatibility with new `lsp-types` major version. diff --git a/lsp-test/func-test/FuncTest.hs b/lsp-test/func-test/FuncTest.hs index 1cc2ef9f..b6555c86 100644 --- a/lsp-test/func-test/FuncTest.hs +++ b/lsp-test/func-test/FuncTest.hs @@ -79,6 +79,7 @@ spec = do updater $ ProgressAmount (Just 75) (Just "step3") runSessionWithServer logger definition Test.defaultConfig Test.fullCaps "." $ do + Test.setIgnoringProgressNotifications False Test.sendRequest (SMethod_CustomMethod (Proxy @"something")) J.Null -- Wait until we have seen a begin messsage. This means that the token setup @@ -137,6 +138,7 @@ spec = do liftIO $ threadDelay (1 * 1000000) `Control.Exception.catch` (\(e :: ProgressCancelledException) -> modifyMVar_ wasCancelled (\_ -> pure True)) runSessionWithServer logger definition Test.defaultConfig Test.fullCaps "." $ do + Test.setIgnoringProgressNotifications False Test.sendRequest (SMethod_CustomMethod (Proxy @"something")) J.Null -- Wait until we have created the progress so the updates will be sent individually @@ -183,6 +185,7 @@ spec = do Control.Exception.throwIO AsyncCancelled runSessionWithServer logger definition Test.defaultConfig Test.fullCaps "." $ do + Test.setIgnoringProgressNotifications False -- First make sure that we get a $/progress begin notification skipManyTill Test.anyMessage $ do x <- Test.message SMethod_Progress @@ -219,6 +222,7 @@ spec = do updater $ ProgressAmount (Just 75) (Just "step3") runSessionWithServer logger definition Test.defaultConfig Test.fullCaps "." $ do + Test.setIgnoringProgressNotifications False Test.sendRequest SMethod_TextDocumentCodeLens (CodeLensParams (Just $ ProgressToken $ InR "hello") Nothing (TextDocumentIdentifier $ Uri ".")) -- First make sure that we get a $/progress begin notification @@ -297,6 +301,7 @@ spec = do in Test.sendNotification SMethod_WorkspaceDidChangeWorkspaceFolders ps runSessionWithServer logger definition config Test.fullCaps "." $ do + Test.setIgnoringProgressNotifications False changeFolders [wf1] [] changeFolders [wf2] [wf1] diff --git a/lsp-test/src/Language/LSP/Test.hs b/lsp-test/src/Language/LSP/Test.hs index 06e68a77..a6c50b89 100644 --- a/lsp-test/src/Language/LSP/Test.hs +++ b/lsp-test/src/Language/LSP/Test.hs @@ -24,6 +24,7 @@ module Language.LSP.Test ( runSessionWithHandles, runSessionWithHandles', setIgnoringLogNotifications, + setIgnoringProgressNotifications, setIgnoringConfigurationRequests, setIgnoringRegistrationRequests, @@ -472,15 +473,19 @@ initializeResponse :: Session (TResponseMessage Method_Initialize) initializeResponse = ask >>= (liftIO . readMVar) . initRsp setIgnoringLogNotifications :: Bool -> Session () -setIgnoringLogNotifications value = do +setIgnoringLogNotifications value = modify (\ss -> ss{ignoringLogNotifications = value}) +setIgnoringProgressNotifications :: Bool -> Session () +setIgnoringProgressNotifications value = + modify (\ss -> ss{ignoringProgressNotifications = value}) + setIgnoringConfigurationRequests :: Bool -> Session () -setIgnoringConfigurationRequests value = do +setIgnoringConfigurationRequests value = modify (\ss -> ss{ignoringConfigurationRequests = value}) setIgnoringRegistrationRequests :: Bool -> Session () -setIgnoringRegistrationRequests value = do +setIgnoringRegistrationRequests value = modify (\ss -> ss{ignoringRegistrationRequests = value}) {- | Modify the client config. This will send a notification to the server that the diff --git a/lsp-test/src/Language/LSP/Test/Session.hs b/lsp-test/src/Language/LSP/Test/Session.hs index 9263b65f..fab18601 100644 --- a/lsp-test/src/Language/LSP/Test/Session.hs +++ b/lsp-test/src/Language/LSP/Test/Session.hs @@ -118,13 +118,15 @@ data SessionConfig = SessionConfig -- with a 'mylang' key whose value is the actual config for the server. You -- can also include other config sections if your server may request those. , ignoreLogNotifications :: Bool - -- ^ Whether or not to ignore @window/showMessage@ and @window/logMessage@ notifications + -- ^ Whether or not to ignore @window/showMessage@ and @window/logMessage@ notifications -- from the server, defaults to True. + , ignoreProgressNotifications :: Bool + -- ^ Whether or not to ignore @$/progress@ notifications from the server, defaults to True. , ignoreConfigurationRequests :: Bool -- ^ Whether or not to ignore @workspace/configuration@ requests from the server, -- defaults to True. , ignoreRegistrationRequests :: Bool - -- ^ Whether or not to ignore @client/registerCapability@ and @client/unregisterCapability@ + -- ^ Whether or not to ignore @client/registerCapability@ and @client/unregisterCapability@ -- requests from the server, defaults to True. , initialWorkspaceFolders :: Maybe [WorkspaceFolder] -- ^ The initial workspace folders to send in the @initialize@ request. @@ -133,7 +135,7 @@ data SessionConfig = SessionConfig -- | The configuration used in 'Language.LSP.Test.runSession'. defaultConfig :: SessionConfig -defaultConfig = SessionConfig 60 False False True mempty True True True Nothing +defaultConfig = SessionConfig 60 False False True mempty True True True True Nothing instance Default SessionConfig where def = defaultConfig @@ -192,6 +194,7 @@ data SessionState = SessionState , curLspConfig :: Object , curProgressSessions :: !(Set.Set ProgressToken) , ignoringLogNotifications :: Bool + , ignoringProgressNotifications :: Bool , ignoringConfigurationRequests :: Bool , ignoringRegistrationRequests :: Bool } @@ -297,6 +300,7 @@ runSession' serverIn serverOut mServerProc serverHandler config caps rootDir exi (lspConfig config) mempty (ignoreLogNotifications config) + (ignoreProgressNotifications config) (ignoreConfigurationRequests config) (ignoreRegistrationRequests config) runSession' = runSessionMonad context initState @@ -347,12 +351,13 @@ updateStateC = awaitForever $ \msg -> do -- we have to return exactly the number of sections requested, so if we can't find all of them then that's an error sendMessage $ TResponseMessage "2.0" (Just $ r ^. L.id) $ - if null errs + if null errs then (Right configs) else Left $ ResponseError (InL LSPErrorCodes_RequestFailed) ("No configuration for requested sections: " <> (T.pack $ show errs)) Nothing _ -> pure () unless ( (ignoringLogNotifications state && isLogNotification msg) + || (ignoringProgressNotifications state && isProgressNotification msg) || (ignoringConfigurationRequests state && isConfigRequest msg) || (ignoringRegistrationRequests state && isRegistrationRequest msg)) $ yield msg @@ -364,6 +369,9 @@ updateStateC = awaitForever $ \msg -> do isLogNotification (FromServerMess SMethod_WindowShowDocument _) = True isLogNotification _ = False + isProgressNotification (FromServerMess SMethod_Progress _) = True + isProgressNotification _ = False + isConfigRequest (FromServerMess SMethod_WorkspaceConfiguration _) = True isConfigRequest _ = False