diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,27 @@ # Changelog for haskell-language-server +## 2.2.0.0 + +* Binaries for GHC 9.4.7 +* Forward compatibility with latest VSCode client changes + +### Pull Requests + +- hls-cabal-fmt-plugin: Use the file contents of the LSP request + ([#3776](https://github.com/haskell/haskell-language-server/pull/3776)) by @fendor +- Adapt to lsp changes for workspace/configuration + ([#3773](https://github.com/haskell/haskell-language-server/pull/3773)) by @michaelpj +- Rework "Configuration" and "Manually testing HLS" documentations + ([#3772](https://github.com/haskell/haskell-language-server/pull/3772)) by @sir4ur0n +- Fix `main-is` completion suggestions not being relative to `hs-source-dirs` + ([#3766](https://github.com/haskell/haskell-language-server/pull/3766)) by @VeryMilkyJoe +- Remove suggestion of stanzas inside of stanza context + ([#3761](https://github.com/haskell/haskell-language-server/pull/3761)) by @VeryMilkyJoe +- Pedantic ghcide + ([#3751](https://github.com/haskell/haskell-language-server/pull/3751)) by @joyfulmantis +- Fix #3574 and support resolve in explicit records + ([#3750](https://github.com/haskell/haskell-language-server/pull/3750)) by @joyfulmantis + ## 2.1.0.0 * Binaries for GHC 9.4.6 diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -283,7 +283,8 @@ outH <- Main.argsHandleOut defaultArguments - let onConfigurationChange cfg _ = Right cfg + let parseConfig cfg _ = Right cfg + onConfigChange _ = pure () let setup clientMsgVar = do -- Forcefully exit @@ -311,7 +312,8 @@ inH outH (Main.argsDefaultHlsConfig defaultArguments) - onConfigurationChange + parseConfig + onConfigChange setup exitHandler :: IO () -> LSP.Handlers (ErrorLSPM c) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 category: Development name: haskell-language-server -version: 2.1.0.0 +version: 2.2.0.0 synopsis: LSP server for GHC description: Please see the README on GitHub at @@ -213,144 +213,144 @@ common cabalfmt if flag(cabalfmt) - build-depends: hls-cabal-fmt-plugin == 2.1.0.0 + build-depends: hls-cabal-fmt-plugin == 2.2.0.0 cpp-options: -Dhls_cabalfmt common cabal if flag(cabal) - build-depends: hls-cabal-plugin == 2.1.0.0 + build-depends: hls-cabal-plugin == 2.2.0.0 cpp-options: -Dhls_cabal common class if flag(class) - build-depends: hls-class-plugin == 2.1.0.0 + build-depends: hls-class-plugin == 2.2.0.0 cpp-options: -Dhls_class common callHierarchy if flag(callHierarchy) - build-depends: hls-call-hierarchy-plugin == 2.1.0.0 + build-depends: hls-call-hierarchy-plugin == 2.2.0.0 cpp-options: -Dhls_callHierarchy common haddockComments if flag(haddockComments) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds)) - build-depends: hls-haddock-comments-plugin == 2.1.0.0 + build-depends: hls-haddock-comments-plugin == 2.2.0.0 cpp-options: -Dhls_haddockComments common eval if flag(eval) - build-depends: hls-eval-plugin == 2.1.0.0 + build-depends: hls-eval-plugin == 2.2.0.0 cpp-options: -Dhls_eval common importLens if flag(importLens) - build-depends: hls-explicit-imports-plugin == 2.1.0.0 + build-depends: hls-explicit-imports-plugin == 2.2.0.0 cpp-options: -Dhls_importLens common rename if flag(rename) - build-depends: hls-rename-plugin == 2.1.0.0 + build-depends: hls-rename-plugin == 2.2.0.0 cpp-options: -Dhls_rename common retrie if flag(retrie) - build-depends: hls-retrie-plugin == 2.1.0.0 + build-depends: hls-retrie-plugin == 2.2.0.0 cpp-options: -Dhls_retrie common tactic if flag(tactic) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds)) - build-depends: hls-tactics-plugin == 2.1.0.0 + build-depends: hls-tactics-plugin == 2.2.0.0 cpp-options: -Dhls_tactic common hlint if flag(hlint) - build-depends: hls-hlint-plugin == 2.1.0.0 + build-depends: hls-hlint-plugin == 2.2.0.0 cpp-options: -Dhls_hlint common stan if flag(stan) && (impl(ghc >= 8.10) && impl(ghc < 9.0)) - build-depends: hls-stan-plugin == 2.1.0.0 + build-depends: hls-stan-plugin == 2.2.0.0 cpp-options: -Dhls_stan common moduleName if flag(moduleName) - build-depends: hls-module-name-plugin == 2.1.0.0 + build-depends: hls-module-name-plugin == 2.2.0.0 cpp-options: -Dhls_moduleName common pragmas if flag(pragmas) - build-depends: hls-pragmas-plugin == 2.1.0.0 + build-depends: hls-pragmas-plugin == 2.2.0.0 cpp-options: -Dhls_pragmas common splice if flag(splice) - build-depends: hls-splice-plugin == 2.1.0.0 + build-depends: hls-splice-plugin == 2.2.0.0 cpp-options: -Dhls_splice common alternateNumberFormat if flag(alternateNumberFormat) - build-depends: hls-alternate-number-format-plugin == 2.1.0.0 + build-depends: hls-alternate-number-format-plugin == 2.2.0.0 cpp-options: -Dhls_alternateNumberFormat common qualifyImportedNames if flag(qualifyImportedNames) - build-depends: hls-qualify-imported-names-plugin == 2.1.0.0 + build-depends: hls-qualify-imported-names-plugin == 2.2.0.0 cpp-options: -Dhls_qualifyImportedNames common codeRange if flag(codeRange) - build-depends: hls-code-range-plugin == 2.1.0.0 + build-depends: hls-code-range-plugin == 2.2.0.0 cpp-options: -Dhls_codeRange common changeTypeSignature if flag(changeTypeSignature) - build-depends: hls-change-type-signature-plugin == 2.1.0.0 + build-depends: hls-change-type-signature-plugin == 2.2.0.0 cpp-options: -Dhls_changeTypeSignature common gadt if flag(gadt) - build-depends: hls-gadt-plugin == 2.1.0.0 + build-depends: hls-gadt-plugin == 2.2.0.0 cpp-options: -Dhls_gadt common explicitFixity if flag(explicitFixity) - build-depends: hls-explicit-fixity-plugin == 2.1.0.0 + build-depends: hls-explicit-fixity-plugin == 2.2.0.0 cpp-options: -DexplicitFixity common explicitFields if flag(explicitFields) - build-depends: hls-explicit-record-fields-plugin == 2.1.0.0 + build-depends: hls-explicit-record-fields-plugin == 2.2.0.0 cpp-options: -DexplicitFields common overloadedRecordDot if flag(overloadedRecordDot) && (impl(ghc >= 9.2.0) || flag(ignore-plugins-ghc-bounds)) - build-depends: hls-overloaded-record-dot-plugin == 2.1.0.0 + build-depends: hls-overloaded-record-dot-plugin == 2.2.0.0 cpp-options: -Dhls_overloaded_record_dot -- formatters common floskell if flag(floskell) && impl(ghc < 9.5) - build-depends: hls-floskell-plugin == 2.1.0.0 + build-depends: hls-floskell-plugin == 2.2.0.0 cpp-options: -Dhls_floskell common fourmolu if flag(fourmolu) - build-depends: hls-fourmolu-plugin == 2.1.0.0 + build-depends: hls-fourmolu-plugin == 2.2.0.0 cpp-options: -Dhls_fourmolu common ormolu if flag(ormolu) && impl(ghc < 9.7) - build-depends: hls-ormolu-plugin == 2.1.0.0 + build-depends: hls-ormolu-plugin == 2.2.0.0 cpp-options: -Dhls_ormolu common stylishHaskell if flag(stylishHaskell) - build-depends: hls-stylish-haskell-plugin == 2.1.0.0 + build-depends: hls-stylish-haskell-plugin == 2.2.0.0 cpp-options: -Dhls_stylishHaskell common refactor if flag(refactor) - build-depends: hls-refactor-plugin == 2.1.0.0 + build-depends: hls-refactor-plugin == 2.2.0.0 cpp-options: -Dhls_refactor library @@ -405,12 +405,12 @@ , cryptohash-sha1 , data-default , ghc - , ghcide == 2.1.0.0 + , ghcide == 2.2.0.0 , githash >=0.1.6.1 - , lsp >= 2.1.0.0 + , lsp >= 2.2.0.0 , hie-bios , hiedb - , hls-plugin-api == 2.1.0.0 + , hls-plugin-api == 2.2.0.0 , optparse-applicative , optparse-simple , process @@ -549,7 +549,7 @@ , lens-aeson , ghcide , ghcide-test-utils - , hls-test-utils == 2.1.0.0 + , hls-test-utils == 2.2.0.0 , lsp-types , aeson , hls-plugin-api diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -1,14 +1,17 @@ {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Completion(tests) where import Control.Lens hiding ((.=)) -import Data.Aeson (object, (.=)) +import Data.Aeson (toJSON) import Data.Foldable (find) +import Data.Functor (void) +import qualified Data.Map as Map import Data.Row.Records (focus) import qualified Data.Text as T -import Ide.Plugin.Config (maxCompletions) +import Ide.Plugin.Config (maxCompletions, plcConfig, plugins) import Language.LSP.Protocol.Lens hiding (applyEdit, length) import Test.Hls import Test.Hls.Command @@ -282,12 +285,13 @@ item ^. insertTextFormat @?= Just InsertTextFormat_PlainText item ^. insertText @?= Nothing - , testCase "respects lsp configuration" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + , testCase "respects lsp configuration" $ runSessionWithConfig (def {ignoreConfigurationRequests=False}) hlsCommand fullCaps "test/testdata/completion" $ do + void configurationRequest doc <- openDoc "Completion.hs" "haskell" - let config = object ["haskell" .= object ["plugin" .= object ["ghcide-completions" .= object ["config" .= object ["snippetsOn" .= False]]]]] + let config = def { plugins = Map.insert "ghcide-completions" (def { plcConfig = [("snippetsOn", (toJSON False))]}) (plugins def) } - sendConfigurationChanged config + setHlsConfig config checkNoSnippets doc diff --git a/test/functional/Config.hs b/test/functional/Config.hs --- a/test/functional/Config.hs +++ b/test/functional/Config.hs @@ -7,7 +7,6 @@ import Control.DeepSeq import Control.Monad -import Data.Aeson import Data.Hashable import qualified Data.HashMap.Strict as HM import qualified Data.Map as Map @@ -43,26 +42,26 @@ , testCase "custom defaults and user config on some other plugin" $ runConfigSession "diagnostics" $ do _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False" -- test that the user config doesn't accidentally override the initial config - sendConfigurationChanged $ toJSON (changeConfig "someplugin" def{plcHoverOn = False}) + setHlsConfig $ changeConfig "someplugin" def{plcHoverOn = False} -- getting only the expected diagnostics means the plugin wasn't enabled expectDiagnostics standardDiagnostics , expectFailBecause "partial config is not supported" $ testCase "custom defaults and non overlapping user config" $ runConfigSession "diagnostics" $ do _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False" -- test that the user config doesn't accidentally override the initial config - sendConfigurationChanged $ toJSON (changeConfig testPluginId def{plcHoverOn = False}) + setHlsConfig $ changeConfig testPluginId def{plcHoverOn = False} -- getting only the expected diagnostics means the plugin wasn't enabled expectDiagnostics standardDiagnostics , testCase "custom defaults and overlapping user plugin config" $ runConfigSession "diagnostics" $ do _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False" -- test that the user config overrides the default initial config - sendConfigurationChanged $ toJSON (changeConfig testPluginId def{plcGlobalOn = True}) + setHlsConfig $ changeConfig testPluginId def{plcGlobalOn = True} -- getting only the expected diagnostics means the plugin wasn't enabled expectDiagnostics testPluginDiagnostics , testCase "custom defaults and non plugin user config" $ runConfigSession "diagnostics" $ do _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False" -- test that the user config doesn't accidentally override the initial config - sendConfigurationChanged $ toJSON (def {formattingProvider = "foo"}) + setHlsConfig $ def {formattingProvider = "foo"} -- getting only the expected diagnostics means the plugin wasn't enabled expectDiagnostics standardDiagnostics ] @@ -70,12 +69,13 @@ standardDiagnostics = [("Foo.hs", [(DiagnosticSeverity_Warning, (1,0), "Top-level binding")])] testPluginDiagnostics = [("Foo.hs", [(DiagnosticSeverity_Error, (0,0), "testplugin")])] - runConfigSession subdir = - failIfSessionTimeout . runSessionWithServer @() plugin ("test/testdata" subdir) + runConfigSession subdir session = do + recorder <- pluginTestRecorder + failIfSessionTimeout $ runSessionWithServer' @() (plugin recorder) def (def {ignoreConfigurationRequests=False}) fullCaps ("test/testdata" subdir) session testPluginId = "testplugin" -- A disabled-by-default plugin that creates diagnostics - plugin = mkPluginTestDescriptor' pd testPluginId + plugin = mkPluginTestDescriptor' @() pd testPluginId pd plId = (defaultPluginDescriptor plId) { pluginConfigDescriptor = configDisabled @@ -95,7 +95,7 @@ } changeConfig :: PluginId -> PluginConfig -> Config changeConfig plugin conf = - def{plugins = Map.fromList [(plugin, conf)]} + def{plugins = Map.insert plugin conf (plugins def)} data GetTestDiagnostics = GetTestDiagnostics diff --git a/test/functional/Deferred.hs b/test/functional/Deferred.hs --- a/test/functional/Deferred.hs +++ b/test/functional/Deferred.hs @@ -106,7 +106,7 @@ -- cwd <- liftIO getCurrentDirectory -- let testUri = filePathToUri $ cwd "test/testdata/FuncTest.hs" - -- diags <- skipManyTill loggingNotification publishDiagnosticsNotification + -- diags <- publishDiagnosticsNotification -- liftIO $ diags ^? params @?= (Just $ PublishDiagnosticsParams -- { _uri = testUri -- , _diagnostics = List diff --git a/test/functional/Format.hs b/test/functional/Format.hs --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -4,11 +4,12 @@ import Control.Lens ((^.)) import Control.Monad.IO.Class -import Data.Aeson import qualified Data.ByteString.Lazy as BS +import Data.Functor (void) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T +import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types import Language.LSP.Test @@ -46,6 +47,7 @@ providerTests :: TestTree providerTests = testGroup "formatting provider" [ testCase "respects none" $ runSessionWithConfig (formatConfig "none") hlsCommand fullCaps "test/testdata/format" $ do + void configurationRequest doc <- openDoc "Format.hs" "haskell" resp <- request SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) liftIO $ case resp ^. L.result of @@ -55,45 +57,29 @@ _ -> assertFailure $ "strange response from formatting provider:" ++ show result result -> assertFailure $ "strange response from formatting provider:" ++ show result - , requiresOrmoluPlugin . requiresFloskellPlugin $ testCase "can change on the fly" $ runSession hlsCommand fullCaps "test/testdata/format" $ do + , requiresOrmoluPlugin . requiresFloskellPlugin $ testCase "can change on the fly" $ runSessionWithConfig (formatConfig "none") hlsCommand fullCaps "test/testdata/format" $ do + void configurationRequest formattedOrmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu.formatted.hs" formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.formatted.hs" formattedOrmoluPostFloskell <- liftIO $ T.readFile "test/testdata/format/Format.ormolu_post_floskell.formatted.hs" doc <- openDoc "Format.hs" "haskell" - sendConfigurationChanged (formatLspConfig "ormolu") + setHlsConfig (formatLspConfig "ormolu") formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) documentContents doc >>= liftIO . (@?= formattedOrmolu) - sendConfigurationChanged (formatLspConfig "floskell") + setHlsConfig (formatLspConfig "floskell") formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) documentContents doc >>= liftIO . (@?= formattedFloskell) - sendConfigurationChanged (formatLspConfig "ormolu") + setHlsConfig (formatLspConfig "ormolu") formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) documentContents doc >>= liftIO . (@?= formattedOrmoluPostFloskell) - , requiresOrmoluPlugin . requiresFloskellPlugin $ testCase "supports both new and old configuration sections" $ runSession hlsCommand fullCaps "test/testdata/format" $ do - formattedOrmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu.formatted.hs" - formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.formatted.hs" - - doc <- openDoc "Format.hs" "haskell" - - sendConfigurationChanged (formatLspConfigOld "ormolu") - formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) - documentContents doc >>= liftIO . (@?= formattedOrmolu) - - sendConfigurationChanged (formatLspConfigOld "floskell") - formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) - documentContents doc >>= liftIO . (@?= formattedFloskell) ] -formatLspConfig :: Value -> Value -formatLspConfig provider = object [ "haskell" .= object ["formattingProvider" .= (provider :: Value)] ] - --- | The same as 'formatLspConfig' but using the legacy section name -formatLspConfigOld :: Value -> Value -formatLspConfigOld provider = object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ] +formatLspConfig :: T.Text -> Config +formatLspConfig provider = def { formattingProvider = provider } -formatConfig :: Value -> SessionConfig -formatConfig provider = defaultConfig { lspConfig = Just (formatLspConfig provider) } +formatConfig :: T.Text -> SessionConfig +formatConfig provider = defaultConfig { lspConfig = hlsConfigToClientConfig (formatLspConfig provider), ignoreConfigurationRequests = False } diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -6,7 +6,6 @@ import Control.Lens hiding (List) import Control.Monad -import Data.Aeson import Data.Aeson.Lens (_Object) import Data.List import qualified Data.Map as M @@ -48,7 +47,7 @@ cars <- getAllCodeActions doc replaceButStrLn <- liftIO $ inspectCommand cars ["Replace with", "putStrLn"] executeCommand replaceButStrLn - _ <- skipManyTill loggingNotification anyRequest + _ <- anyRequest x:_ <- T.lines <$> documentContents doc liftIO $ x @?= "main = putStrLn \"hello\"" @@ -71,7 +70,7 @@ _ -> error $ "Unexpected arguments: " ++ show mbArgs executeCommand cmd - _ <- skipManyTill loggingNotification anyRequest + _ <- anyRequest x1:x2:_ <- T.lines <$> documentContents doc liftIO $ @@ -82,11 +81,8 @@ importTests :: TestTree importTests = testGroup "import suggestions" [ - testCase "import works with 3.8 code action kinds" $ runSession hlsCommand fullCaps "test/testdata" $ do + testCase "import works with 3.8 code action kinds" $ runSessionWithConfig (def {lspConfig = hlsConfigToClientConfig testConfig}) hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImport.hs" "haskell" - -- No Formatting: - let config = def { formattingProvider = "none" } - sendConfigurationChanged (toJSON config) (diag:_) <- waitForDiagnosticsFrom doc liftIO $ diag ^. L.message @?= "Variable not in scope: when :: Bool -> IO () -> IO ()" @@ -107,12 +103,8 @@ importQualifiedTests :: TestTree importQualifiedTests = testGroup "import qualified prefix suggestions" [ - testCase "qualified import works with 3.8 code action kinds" $ runSession hlsCommand fullCaps "test/testdata" $ do + testCase "qualified import works with 3.8 code action kinds" $ runSessionWithConfig (def {lspConfig = hlsConfigToClientConfig testConfig}) hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImportQualified.hs" "haskell" - -- No Formatting: - let config = def { formattingProvider = "none" } - sendConfigurationChanged (toJSON config) - (diag:_) <- waitForDiagnosticsFrom doc liftIO $ diag ^. L.message @?= if ghcVersion >= GHC96 @@ -136,12 +128,8 @@ importQualifiedPostTests :: TestTree importQualifiedPostTests = testGroup "import qualified postfix suggestions" [ - testCase "qualified import in postfix position works with 3.8 code action kinds" $ runSession hlsCommand fullCaps "test/testdata" $ do + testCase "qualified import in postfix position works with 3.8 code action kinds" $ runSessionWithConfig (def {lspConfig = hlsConfigToClientConfig testConfig}) hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImportPostQualified.hs" "haskell" - -- No Formatting: - let config = def { formattingProvider = "none" } - sendConfigurationChanged (toJSON config) - (diag:_) <- waitForDiagnosticsFrom doc liftIO $ diag ^. L.message @?= if ghcVersion >= GHC96 @@ -285,7 +273,7 @@ cas <- getAllCodeActions doc cmd <- liftIO $ inspectCommand cas ["redundant import"] executeCommand cmd - _ <- skipManyTill loggingNotification anyRequest + _ <- anyRequest contents <- documentContents doc liftIO $ T.lines contents @?= [ "{-# OPTIONS_GHC -Wunused-imports #-}" @@ -300,8 +288,7 @@ typedHoleTests :: TestTree typedHoleTests = testGroup "typed hole code actions" [ testCase "works" $ - runSession hlsCommand fullCaps "test/testdata" $ do - disableWingman + runSessionWithConfig (def {lspConfig = hlsConfigToClientConfig testConfig}) hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles.hs" "haskell" _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cas <- getAllCodeActions doc @@ -331,8 +318,7 @@ dontExpectCodeAction cas ["replace _ with foo _"] , testCase "shows more suggestions" $ - runSession hlsCommand fullCaps "test/testdata" $ do - disableWingman + runSessionWithConfig (def {lspConfig = hlsConfigToClientConfig testConfig}) hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles2.hs" "haskell" _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cas <- getAllCodeActions doc @@ -444,8 +430,10 @@ $ Just CodeActionKind_QuickFix `notElem` kinds ] -disableWingman :: Session () -disableWingman = - sendConfigurationChanged $ toJSON $ def - { plugins = M.fromList [ ("tactics", def { plcGlobalOn = False }) ] - } +testConfig :: Config +testConfig = def { + formattingProvider = "none" + , plugins = M.insert "tactics" (def { plcGlobalOn = False }) (plugins def) + } + + diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -10,11 +10,12 @@ import Control.Exception (throw) import Control.Lens hiding ((.=)) -import Data.Aeson (Value, decode, encode, - object, (.=)) +import Data.Aeson (decode, encode) +import Data.Functor (void) import Data.List (delete) import Data.Maybe (fromJust) import Data.Text (Text, pack) +import Ide.Types import Language.LSP.Protocol.Capabilities import qualified Language.LSP.Protocol.Lens as L import System.FilePath (()) @@ -57,23 +58,25 @@ expectProgressMessages ["Evaluating"] activeProgressTokens _ -> error $ "Unexpected response result: " ++ show response , requiresOrmoluPlugin $ testCase "ormolu plugin sends progress notifications" $ do - runSession hlsCommand progressCaps "test/testdata/format" $ do - sendConfigurationChanged (formatLspConfig "ormolu") + runSessionWithConfig (def { ignoreConfigurationRequests = False }) hlsCommand progressCaps "test/testdata/format" $ do + void configurationRequest + setHlsConfig (formatLspConfig "ormolu") doc <- openDoc "Format.hs" "haskell" expectProgressMessages ["Setting up testdata (for Format.hs)", "Processing", "Indexing"] [] _ <- sendRequest SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) expectProgressMessages ["Formatting Format.hs"] [] , requiresFourmoluPlugin $ testCase "fourmolu plugin sends progress notifications" $ do - runSession hlsCommand progressCaps "test/testdata/format" $ do - sendConfigurationChanged (formatLspConfig "fourmolu") + runSessionWithConfig (def { ignoreConfigurationRequests = False }) hlsCommand progressCaps "test/testdata/format" $ do + void configurationRequest + setHlsConfig (formatLspConfig "fourmolu") doc <- openDoc "Format.hs" "haskell" expectProgressMessages ["Setting up testdata (for Format.hs)", "Processing", "Indexing"] [] _ <- sendRequest SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) expectProgressMessages ["Formatting Format.hs"] [] ] -formatLspConfig :: Value -> Value -formatLspConfig provider = object ["haskell" .= object ["formattingProvider" .= (provider :: Value)]] +formatLspConfig :: Text -> Config +formatLspConfig provider = def { formattingProvider = provider } progressCaps :: ClientCapabilities progressCaps = fullCaps{_window = Just (WindowClientCapabilities (Just True) Nothing Nothing)}