haskell-language-server 2.1.0.0 → 2.2.0.0
raw patch · 9 files changed
+116/−111 lines, 9 filesdep ~ghcidedep ~hls-alternate-number-format-plugindep ~hls-cabal-fmt-pluginPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghcide, hls-alternate-number-format-plugin, hls-cabal-fmt-plugin, hls-cabal-plugin, hls-call-hierarchy-plugin, hls-change-type-signature-plugin, hls-class-plugin, hls-code-range-plugin, hls-eval-plugin, hls-explicit-fixity-plugin, hls-explicit-imports-plugin, hls-explicit-record-fields-plugin, hls-floskell-plugin, hls-fourmolu-plugin, hls-gadt-plugin, hls-haddock-comments-plugin, hls-hlint-plugin, hls-module-name-plugin, hls-ormolu-plugin, hls-overloaded-record-dot-plugin, hls-plugin-api, hls-pragmas-plugin, hls-qualify-imported-names-plugin, hls-refactor-plugin, hls-rename-plugin, hls-retrie-plugin, hls-splice-plugin, hls-stan-plugin, hls-stylish-haskell-plugin, hls-tactics-plugin, hls-test-utils, lsp
API changes (from Hackage documentation)
Files
- ChangeLog.md +22/−0
- exe/Wrapper.hs +4/−2
- haskell-language-server.cabal +33/−33
- test/functional/Completion.hs +9/−5
- test/functional/Config.hs +9/−9
- test/functional/Deferred.hs +1/−1
- test/functional/Format.hs +12/−26
- test/functional/FunctionalCodeAction.hs +15/−27
- test/functional/Progress.hs +11/−8
@@ -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
@@ -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)
@@ -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 <https://github.com/haskell/haskell-language-server#readme>@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 }
@@ -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)+ }++
@@ -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)}