haskell-language-server 2.0.0.1 → 2.1.0.0
raw patch · 25 files changed
+628/−440 lines, 25 filesdep +row-typesdep −hls-refine-imports-plugindep ~ghcidedep ~hls-alternate-number-format-plugindep ~hls-cabal-fmt-pluginPVP ok
version bump matches the API change (PVP)
Dependencies added: row-types
Dependencies removed: hls-refine-imports-plugin
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, prettyprinter
API changes (from Hackage documentation)
- Ide.Arguments: [argsDebugOn] :: GhcideArguments -> Bool
+ Ide.Arguments: [argsLogClient] :: GhcideArguments -> Bool
+ Ide.Arguments: [argsLogLevel] :: GhcideArguments -> Priority
+ Ide.Arguments: [argsLogStderr] :: GhcideArguments -> Bool
- Ide.Arguments: GhcideArguments :: Command -> Maybe FilePath -> Maybe FilePath -> Bool -> Bool -> Bool -> Maybe String -> Int -> Bool -> GhcideArguments
+ Ide.Arguments: GhcideArguments :: Command -> Maybe FilePath -> Maybe FilePath -> Bool -> Bool -> Priority -> Maybe String -> Bool -> Bool -> Int -> Bool -> GhcideArguments
Files
- ChangeLog.md +142/−1
- exe/Main.hs +78/−67
- exe/Wrapper.hs +14/−13
- haskell-language-server.cabal +38/−48
- src/HlsPlugins.hs +9/−10
- src/Ide/Arguments.hs +61/−19
- src/Ide/Main.hs +2/−2
- test/functional/Command.hs +10/−10
- test/functional/Completion.hs +61/−69
- test/functional/Config.hs +14/−39
- test/functional/Deferred.hs +10/−9
- test/functional/Definition.hs +35/−10
- test/functional/Diagnostic.hs +3/−3
- test/functional/Format.hs +13/−13
- test/functional/FunctionalCodeAction.hs +32/−32
- test/functional/HieBios.hs +5/−5
- test/functional/Highlight.hs +4/−4
- test/functional/Progress.hs +45/−45
- test/functional/Reference.hs +1/−1
- test/functional/Symbol.hs +36/−39
- test/functional/TypeDefinition.hs +1/−1
- test/testdata/definition/Bar.hs +6/−0
- test/testdata/definition/Foo.hs +3/−0
- test/testdata/definition/hie.yaml +5/−0
- test/testdata/hieBiosError/hie.yaml +0/−0
ChangeLog.md view
@@ -1,8 +1,149 @@ # Changelog for haskell-language-server +## 2.1.0.0++* Binaries for GHC 9.4.6+* Completions for .cabal files+* Performance improvements+* Show package name and its version while hovering on import statements+ ([#3691](https://github.com/haskell/haskell-language-server/pull/3691))+* Fix code edits in lsp spec compliant editors like helix.+ ([#3643](https://github.com/haskell/haskell-language-server/pull/3643))++### Pull requests merged++- Update to latest lsp packages+ ([#3747](https://github.com/haskell/haskell-language-server/pull/3747)) by @joyfulmantis+- Remove unnecessary allow-newer in stack.yaml+ ([#3746](https://github.com/haskell/haskell-language-server/pull/3746)) by @July541+- Log fourmolu and ormolu version that hls using+ ([#3744](https://github.com/haskell/haskell-language-server/pull/3744)) by @July541+- Various PluginError PR suggestions I missed earlier+ ([#3737](https://github.com/haskell/haskell-language-server/pull/3737)) by @joyfulmantis+- Add resolve support in refine imports by merging it with explicit imports+ ([#3729](https://github.com/haskell/haskell-language-server/pull/3729)) by @joyfulmantis+- Fix other file goto definition+ ([#3725](https://github.com/haskell/haskell-language-server/pull/3725)) by @nlander+- Fix Nix builds+ ([#3724](https://github.com/haskell/haskell-language-server/pull/3724)) by @cydparser+- Better plugin error infrastructure+ ([#3717](https://github.com/haskell/haskell-language-server/pull/3717)) by @joyfulmantis+- Move Recorder to hls-plugin-api+ ([#3714](https://github.com/haskell/haskell-language-server/pull/3714)) by @joyfulmantis+- Actually force usages+ ([#3713](https://github.com/haskell/haskell-language-server/pull/3713)) by @wz1000+- Best-effort support of Qualified Imports in GHC 9.4+ ([#3712](https://github.com/haskell/haskell-language-server/pull/3712)) by @konn+- Skip test if only CODEOWNERS changed+ ([#3707](https://github.com/haskell/haskell-language-server/pull/3707)) by @July541+- Update stack stuff+ ([#3706](https://github.com/haskell/haskell-language-server/pull/3706)) by @July541+- Mark hls-floskell-plugin as tier 3+ ([#3705](https://github.com/haskell/haskell-language-server/pull/3705)) by @July541+- Remove isovector as an owner+ ([#3700](https://github.com/haskell/haskell-language-server/pull/3700)) by @isovector+- Bump haskell/actions from 2.4.3 to 2.4.4 in /.github/actions/setup-build+ ([#3699](https://github.com/haskell/haskell-language-server/pull/3699)) by @dependabot[bot]+- Bump haskell/actions from 2.4.3 to 2.4.4+ ([#3698](https://github.com/haskell/haskell-language-server/pull/3698)) by @dependabot[bot]+- Catch exceptions in commands and use lsp null+ ([#3696](https://github.com/haskell/haskell-language-server/pull/3696)) by @joyfulmantis+- Show package name and its version while hovering on import statements+ ([#3691](https://github.com/haskell/haskell-language-server/pull/3691)) by @July541+- Resolve refactoring+ ([#3688](https://github.com/haskell/haskell-language-server/pull/3688)) by @joyfulmantis+- Prefer non-boot files when creating the FinderCache.+ ([#3687](https://github.com/haskell/haskell-language-server/pull/3687)) by @wz1000+- Some fixes for multi component stuff+ ([#3686](https://github.com/haskell/haskell-language-server/pull/3686)) by @wz1000+- Further hlint resolve changes.+ ([#3685](https://github.com/haskell/haskell-language-server/pull/3685)) by @joyfulmantis+- docs (plugin-support): fix plugin name typo+ ([#3683](https://github.com/haskell/haskell-language-server/pull/3683)) by @PiDelport+- Resolve for explicit-imports+ ([#3682](https://github.com/haskell/haskell-language-server/pull/3682)) by @joyfulmantis+- Hls 2.0.0.1 forward port+ ([#3680](https://github.com/haskell/haskell-language-server/pull/3680)) by @hasufell+- Resolve 2: Support for resolve in hls-hlint-plugin+ ([#3679](https://github.com/haskell/haskell-language-server/pull/3679)) by @joyfulmantis+- Resolve 0: Generic support for resolve in hls packages+ ([#3678](https://github.com/haskell/haskell-language-server/pull/3678)) by @joyfulmantis+- Ship hls-hlint-plugin for ghc-9.6+ ([#3677](https://github.com/haskell/haskell-language-server/pull/3677)) by @July541+- Remove extra call to newHscEnvEqWithImportPaths+ ([#3676](https://github.com/haskell/haskell-language-server/pull/3676)) by @nlander+- Fixes pragma plugin offering incorrect code actions #3673+ ([#3674](https://github.com/haskell/haskell-language-server/pull/3674)) by @joyfulmantis+- Restore short option for logfile+ ([#3672](https://github.com/haskell/haskell-language-server/pull/3672)) by @michaelpj+- Enable stylish-haskell for 9.6+ ([#3670](https://github.com/haskell/haskell-language-server/pull/3670)) by @michaelpj+- Bump supported ormolu, allow for 9.6+ ([#3668](https://github.com/haskell/haskell-language-server/pull/3668)) by @michaelpj+- Bump cachix/install-nix-action from 21 to 22+ ([#3666](https://github.com/haskell/haskell-language-server/pull/3666)) by @dependabot[bot]+- Add arguments to direct logs to various locations+ ([#3665](https://github.com/haskell/haskell-language-server/pull/3665)) by @michaelpj+- Support fourmolu 0.13+ ([#3662](https://github.com/haskell/haskell-language-server/pull/3662)) by @brandonchinn178+- Resolve 1: Support for resolve in overloaded-record-dot+ ([#3658](https://github.com/haskell/haskell-language-server/pull/3658)) by @joyfulmantis+- fix ISO8601 related deprecation in time+ ([#3654](https://github.com/haskell/haskell-language-server/pull/3654)) by @HugoPeters1024+- Add a log-level argument to set the log level+ ([#3651](https://github.com/haskell/haskell-language-server/pull/3651)) by @michaelpj+- Update Contributing.md+ ([#3650](https://github.com/haskell/haskell-language-server/pull/3650)) by @VeryMilkyJoe+- Commit to prettyprinter >= 1.7+ ([#3649](https://github.com/haskell/haskell-language-server/pull/3649)) by @michaelpj+- Add missing Monad constraint in the eval plugin+ ([#3648](https://github.com/haskell/haskell-language-server/pull/3648)) by @sandydoo+- hls-pragmas-plugin: Reduce noisy completions+ ([#3647](https://github.com/haskell/haskell-language-server/pull/3647)) by @akshaymankar+- Correctly pass VersionedTextDocumentIdentifier through hls+ ([#3643](https://github.com/haskell/haskell-language-server/pull/3643)) by @maralorn+- Add an assist for importing record fields when using OverloadedRecordDot+ ([#3642](https://github.com/haskell/haskell-language-server/pull/3642)) by @simmsb+- update flakes to compile with ghc928 and ghc962+ ([#3641](https://github.com/haskell/haskell-language-server/pull/3641)) by @smunix+- Split pragmas plugin by providers + decrease disable-warning priority+ ([#3640](https://github.com/haskell/haskell-language-server/pull/3640)) by @mrcjkb+- Reintroduce cabal-install in flake.nix+ ([#3637](https://github.com/haskell/haskell-language-server/pull/3637)) by @cgeorgii+- Delete dead cbits+ ([#3635](https://github.com/haskell/haskell-language-server/pull/3635)) by @michaelpj+- Simplify selection of GHCs to build on+ ([#3633](https://github.com/haskell/haskell-language-server/pull/3633)) by @michaelpj+- Support fourmolu 0.13.0.0+ ([#3631](https://github.com/haskell/haskell-language-server/pull/3631)) by @brandonchinn178+- Bump haskell/actions from 2.4.1 to 2.4.3 in /.github/actions/setup-build+ ([#3627](https://github.com/haskell/haskell-language-server/pull/3627)) by @dependabot[bot]+- Bump haskell/actions from 2.4.1 to 2.4.3+ ([#3626](https://github.com/haskell/haskell-language-server/pull/3626)) by @dependabot[bot]+- remove ghc minor versions in nix flake package builds+ ([#3625](https://github.com/haskell/haskell-language-server/pull/3625)) by @smunix+- HLS for the new generated LSP 2 release+ ([#3621](https://github.com/haskell/haskell-language-server/pull/3621)) by @joyfulmantis+- Keep plugin id of cabal-fmt in sync with default config id+ ([#3615](https://github.com/haskell/haskell-language-server/pull/3615)) by @VeryMilkyJoe+- Fix some grammar mistakes and typos+ ([#3614](https://github.com/haskell/haskell-language-server/pull/3614)) by @VeryMilkyJoe+- Bump cachix/install-nix-action from 20 to 21+ ([#3612](https://github.com/haskell/haskell-language-server/pull/3612)) by @dependabot[bot]+- fix: remove the `Indexing` progress message when exeption in withHieDb+ ([#3610](https://github.com/haskell/haskell-language-server/pull/3610)) by @guibou+- Bump haskell/actions from 2.4.0 to 2.4.1 in /.github/actions/setup-build+ ([#3604](https://github.com/haskell/haskell-language-server/pull/3604)) by @dependabot[bot]+- Bump haskell/actions from 2.4.0 to 2.4.1+ ([#3603](https://github.com/haskell/haskell-language-server/pull/3603)) by @dependabot[bot]+- Cabal file completions+ ([#3268](https://github.com/haskell/haskell-language-server/pull/3268)) by @VeryMilkyJoe+- Share ModuleGraphs for all files+ ([#3232](https://github.com/haskell/haskell-language-server/pull/3232)) by @wz1000+ ## 2.0.0.1 -- Add overloaded record dot plugin intial version (closes #3350) (#3560)+- Add overloaded record dot plugin initial version (closes #3350) (#3560) - Binaries for GHC 9.2.8 and GHC 9.6.2 ## 2.0.0.0
exe/Main.hs view
@@ -1,42 +1,40 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0-{-# LANGUAGE CPP #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} module Main(main) where -import Control.Arrow ((&&&))-import Control.Monad.IO.Class (liftIO)-import Data.Function ((&))-import Data.Text (Text)-import qualified Development.IDE.Main as GhcideMain-import Development.IDE.Types.Logger (Doc,- Priority (Debug, Error, Info),- WithPriority (WithPriority, priority),- cfilter, cmapWithPrio,- defaultLayoutOptions,- layoutPretty,- makeDefaultStderrRecorder,- payload, renderStrict,- withDefaultRecorder)-import qualified Development.IDE.Types.Logger as Logger-import qualified HlsPlugins as Plugins-import Ide.Arguments (Arguments (..),- GhcideArguments (..),- getArguments)-import Ide.Main (defaultMain)-import qualified Ide.Main as IdeMain-import Ide.PluginUtils (pluginDescToIdePlugins)-import Ide.Types (PluginDescriptor (pluginNotificationHandlers),- defaultPluginDescriptor,- mkPluginNotificationHandler)-import Language.LSP.Server as LSP-import Language.LSP.Types as LSP-#if MIN_VERSION_prettyprinter(1,7,0)-import Prettyprinter (Pretty (pretty), vsep)-#else-import Data.Text.Prettyprint.Doc (Pretty (pretty), vsep)-#endif+import Control.Exception (displayException)+import Control.Monad.IO.Class (liftIO)+import Data.Bifunctor (first)+import Data.Function ((&))+import Data.Functor ((<&>))+import Data.Maybe (catMaybes)+import Data.Text (Text)+import Ide.Logger (Doc, Priority (Error, Info),+ Recorder,+ WithPriority (WithPriority, priority),+ cfilter, cmapWithPrio,+ defaultLayoutOptions,+ layoutPretty, logWith,+ makeDefaultStderrRecorder,+ renderStrict, withFileRecorder)+import qualified Ide.Logger as Logger+import qualified HlsPlugins as Plugins+import Ide.Arguments (Arguments (..),+ GhcideArguments (..),+ getArguments)+import Ide.Main (defaultMain)+import qualified Ide.Main as IdeMain+import Ide.PluginUtils (pluginDescToIdePlugins)+import Ide.Types (PluginDescriptor (pluginNotificationHandlers),+ defaultPluginDescriptor,+ mkPluginNotificationHandler)+import Language.LSP.Protocol.Message as LSP+import Language.LSP.Server as LSP+import Prettyprinter (Pretty (pretty), vcat, vsep) data Log = LogIdeMain IdeMain.Log@@ -49,44 +47,64 @@ main :: IO () main = do+ stderrRecorder <- makeDefaultStderrRecorder Nothing -- plugin cli commands use stderr logger for now unless we change the args -- parser to get logging arguments first or do more complicated things- pluginCliRecorder <- cmapWithPrio pretty <$> makeDefaultStderrRecorder Nothing+ let pluginCliRecorder = cmapWithPrio pretty stderrRecorder args <- getArguments "haskell-language-server" (Plugins.idePlugins (cmapWithPrio LogPlugins pluginCliRecorder)) - (lspLogRecorder, cb1) <- Logger.withBacklog Logger.lspClientLogRecorder- (lspMessageRecorder, cb2) <- Logger.withBacklog Logger.lspClientMessageRecorder+ -- Recorder that logs to the LSP client with logMessage+ (lspLogRecorder, cb1) <-+ Logger.withBacklog Logger.lspClientLogRecorder+ <&> first (cmapWithPrio renderDoc)+ -- Recorder that logs to the LSP client with showMessage+ (lspMessageRecorder, cb2) <-+ Logger.withBacklog Logger.lspClientMessageRecorder+ <&> first (cmapWithPrio renderDoc)+ -- Recorder that logs Error severity logs to the client with showMessage and some extra text+ let lspErrorMessageRecorder = lspMessageRecorder+ & cfilter (\WithPriority{ priority } -> priority >= Error)+ & cmapWithPrio (\msg -> vsep+ ["Error condition, please check your setup and/or the [issue tracker](" <> issueTrackerUrl <> "): "+ , msg+ ]) -- This plugin just installs a handler for the `initialized` notification, which then -- picks up the LSP environment and feeds it to our recorders let lspRecorderPlugin = (defaultPluginDescriptor "LSPRecorderCallback")- { pluginNotificationHandlers = mkPluginNotificationHandler LSP.SInitialized $ \_ _ _ _ -> do+ { pluginNotificationHandlers = mkPluginNotificationHandler LSP.SMethod_Initialized $ \_ _ _ _ -> do env <- LSP.getLspEnv liftIO $ (cb1 <> cb2) env } - let (argsTesting, minPriority, logFilePath) =+ let (minPriority, logFilePath, logStderr, logClient) = case args of- Ghcide GhcideArguments{ argsTesting, argsDebugOn, argsLogFile} ->- let minPriority = if argsDebugOn || argsTesting then Debug else Info- in (argsTesting, minPriority, argsLogFile)- _ -> (False, Info, Nothing)+ Ghcide GhcideArguments{ argsLogLevel, argsLogFile, argsLogStderr, argsLogClient} ->+ (argsLogLevel, argsLogFile, argsLogStderr, argsLogClient)+ _ -> (Info, Nothing, True, False) - withDefaultRecorder logFilePath Nothing $ \textWithPriorityRecorder -> do+ -- Adapter for withFileRecorder to handle the case where we don't want to log to a file+ let withLogFileRecorder action = case logFilePath of+ Just p -> withFileRecorder p Nothing $ \case+ Left e -> do+ let exceptionMessage = pretty $ displayException e+ let message = vcat [exceptionMessage, "Couldn't open log file; not logging to it."]+ logWith stderrRecorder Error message+ action Nothing+ Right r -> action (Just r)+ Nothing -> action Nothing++ withLogFileRecorder $ \logFileRecorder -> do let- recorder = cmapWithPrio (pretty &&& id) $ mconcat- [textWithPriorityRecorder- & cfilter (\WithPriority{ priority } -> priority >= minPriority)- & cmapWithPrio fst- , lspMessageRecorder- & cfilter (\WithPriority{ priority } -> priority >= Error)- & cmapWithPrio (renderDoc . fst)- , lspLogRecorder- & cfilter (\WithPriority{ priority } -> priority >= minPriority)- & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions . fst)- -- do not log heap stats to the LSP log as they interfere with the- -- ability of lsp-test to detect a stuck server in tests and benchmarks- & if argsTesting then cfilter (not . heapStats . snd . payload) else id- ]+ lfr = logFileRecorder+ ser = if logStderr then Just stderrRecorder else Nothing+ lemr = Just lspErrorMessageRecorder+ llr = if logClient then Just lspLogRecorder else Nothing+ recorder :: Recorder (WithPriority Log) =+ [lfr, ser, lemr, llr]+ & catMaybes+ & mconcat+ & cmapWithPrio pretty+ & cfilter (\WithPriority{ priority } -> priority >= minPriority) plugins = Plugins.idePlugins (cmapWithPrio LogPlugins recorder) defaultMain@@ -95,14 +113,7 @@ (plugins <> pluginDescToIdePlugins [lspRecorderPlugin]) renderDoc :: Doc a -> Text-renderDoc d = renderStrict $ layoutPretty defaultLayoutOptions $ vsep- ["Error condition, please check your setup and/or the [issue tracker](" <> issueTrackerUrl <> "): "- ,d- ]+renderDoc d = renderStrict $ layoutPretty defaultLayoutOptions d issueTrackerUrl :: Doc a issueTrackerUrl = "https://github.com/haskell/haskell-language-server/issues"--heapStats :: Log -> Bool-heapStats (LogIdeMain (IdeMain.LogIDEMain (GhcideMain.LogHeapStats _))) = True-heapStats _ = False
exe/Wrapper.hs view
@@ -45,25 +45,26 @@ import qualified Data.Text.IO as T import Development.IDE.LSP.LanguageServer (runLanguageServer) import qualified Development.IDE.Main as Main-import Development.IDE.Types.Logger (Doc, Logger (Logger),+import GHC.Stack.Types (emptyCallStack)+import Ide.Logger (Doc, Logger (Logger), Pretty (pretty), Recorder (logger_), WithPriority (WithPriority), cmapWithPrio, makeDefaultStderrRecorder, toCologActionWithPrio)-import GHC.Stack.Types (emptyCallStack) import Ide.Plugin.Config (Config) import Ide.Types (IdePlugins (IdePlugins))+import Language.LSP.Protocol.Message (Method (Method_Initialize),+ ResponseError,+ SMethod (SMethod_Exit, SMethod_WindowShowMessageRequest),+ TRequestMessage)+import Language.LSP.Protocol.Types (MessageActionItem (MessageActionItem),+ MessageType (MessageType_Error),+ ShowMessageRequestParams (ShowMessageRequestParams),+ type (|?) (InL)) import Language.LSP.Server (LspM) import qualified Language.LSP.Server as LSP-import Language.LSP.Types (MessageActionItem (MessageActionItem),- MessageType (MtError),- Method (Initialize),- RequestMessage,- ResponseError,- SMethod (SExit, SWindowShowMessageRequest),- ShowMessageRequestParams (ShowMessageRequestParams)) -- --------------------------------------------------------------------- @@ -288,12 +289,12 @@ -- Forcefully exit let exit = void $ tryPutMVar clientMsgVar () - let doInitialize :: LSP.LanguageContextEnv Config -> RequestMessage Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv Config, ()))+ let doInitialize :: LSP.LanguageContextEnv Config -> TRequestMessage Method_Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv Config, ())) doInitialize env _ = do let restartTitle = "Try to restart"- void $ LSP.runLspT env $ LSP.sendRequest SWindowShowMessageRequest (ShowMessageRequestParams MtError errorMsg (Just [MessageActionItem restartTitle])) $ \case- Right (Just (MessageActionItem title))+ void $ LSP.runLspT env $ LSP.sendRequest SMethod_WindowShowMessageRequest (ShowMessageRequestParams MessageType_Error errorMsg (Just [MessageActionItem restartTitle])) $ \case+ Right (InL (MessageActionItem title)) | title == restartTitle -> liftIO exit _ -> pure () @@ -314,4 +315,4 @@ setup exitHandler :: IO () -> LSP.Handlers (ErrorLSPM c)-exitHandler exit = LSP.notificationHandler SExit $ const $ liftIO exit+exitHandler exit = LSP.notificationHandler SMethod_Exit $ const $ liftIO exit
haskell-language-server.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 category: Development name: haskell-language-server-version: 2.0.0.1+version: 2.1.0.0 synopsis: LSP server for GHC description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -40,7 +40,7 @@ , extra , filepath , text- , prettyprinter+ , prettyprinter >= 1.7 -- Default warnings in HLS common warnings@@ -94,11 +94,6 @@ default: True manual: True -flag refineImports- description: Enable refineImports plugin- default: True- manual: True- flag rename description: Enable rename plugin default: True@@ -218,149 +213,144 @@ common cabalfmt if flag(cabalfmt)- build-depends: hls-cabal-fmt-plugin == 2.0.0.1+ build-depends: hls-cabal-fmt-plugin == 2.1.0.0 cpp-options: -Dhls_cabalfmt common cabal if flag(cabal)- build-depends: hls-cabal-plugin == 2.0.0.1+ build-depends: hls-cabal-plugin == 2.1.0.0 cpp-options: -Dhls_cabal common class if flag(class)- build-depends: hls-class-plugin == 2.0.0.1+ build-depends: hls-class-plugin == 2.1.0.0 cpp-options: -Dhls_class common callHierarchy if flag(callHierarchy)- build-depends: hls-call-hierarchy-plugin == 2.0.0.1+ build-depends: hls-call-hierarchy-plugin == 2.1.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.0.0.1+ build-depends: hls-haddock-comments-plugin == 2.1.0.0 cpp-options: -Dhls_haddockComments common eval if flag(eval)- build-depends: hls-eval-plugin == 2.0.0.1+ build-depends: hls-eval-plugin == 2.1.0.0 cpp-options: -Dhls_eval common importLens if flag(importLens)- build-depends: hls-explicit-imports-plugin == 2.0.0.1+ build-depends: hls-explicit-imports-plugin == 2.1.0.0 cpp-options: -Dhls_importLens -common refineImports- if flag(refineImports)- build-depends: hls-refine-imports-plugin == 2.0.0.1- cpp-options: -Dhls_refineImports- common rename if flag(rename)- build-depends: hls-rename-plugin == 2.0.0.1+ build-depends: hls-rename-plugin == 2.1.0.0 cpp-options: -Dhls_rename common retrie if flag(retrie)- build-depends: hls-retrie-plugin == 2.0.0.1+ build-depends: hls-retrie-plugin == 2.1.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.0.0.1+ build-depends: hls-tactics-plugin == 2.1.0.0 cpp-options: -Dhls_tactic common hlint- if flag(hlint) && impl(ghc < 9.5)- build-depends: hls-hlint-plugin == 2.0.0.1+ if flag(hlint)+ build-depends: hls-hlint-plugin == 2.1.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.0.0.1+ build-depends: hls-stan-plugin == 2.1.0.0 cpp-options: -Dhls_stan common moduleName if flag(moduleName)- build-depends: hls-module-name-plugin == 2.0.0.1+ build-depends: hls-module-name-plugin == 2.1.0.0 cpp-options: -Dhls_moduleName common pragmas if flag(pragmas)- build-depends: hls-pragmas-plugin == 2.0.0.1+ build-depends: hls-pragmas-plugin == 2.1.0.0 cpp-options: -Dhls_pragmas common splice if flag(splice)- build-depends: hls-splice-plugin == 2.0.0.1+ build-depends: hls-splice-plugin == 2.1.0.0 cpp-options: -Dhls_splice common alternateNumberFormat if flag(alternateNumberFormat)- build-depends: hls-alternate-number-format-plugin == 2.0.0.1+ build-depends: hls-alternate-number-format-plugin == 2.1.0.0 cpp-options: -Dhls_alternateNumberFormat common qualifyImportedNames if flag(qualifyImportedNames)- build-depends: hls-qualify-imported-names-plugin == 2.0.0.1+ build-depends: hls-qualify-imported-names-plugin == 2.1.0.0 cpp-options: -Dhls_qualifyImportedNames common codeRange if flag(codeRange)- build-depends: hls-code-range-plugin == 2.0.0.1+ build-depends: hls-code-range-plugin == 2.1.0.0 cpp-options: -Dhls_codeRange common changeTypeSignature if flag(changeTypeSignature)- build-depends: hls-change-type-signature-plugin == 2.0.0.1+ build-depends: hls-change-type-signature-plugin == 2.1.0.0 cpp-options: -Dhls_changeTypeSignature common gadt if flag(gadt)- build-depends: hls-gadt-plugin == 2.0.0.1+ build-depends: hls-gadt-plugin == 2.1.0.0 cpp-options: -Dhls_gadt common explicitFixity if flag(explicitFixity)- build-depends: hls-explicit-fixity-plugin == 2.0.0.1+ build-depends: hls-explicit-fixity-plugin == 2.1.0.0 cpp-options: -DexplicitFixity common explicitFields if flag(explicitFields)- build-depends: hls-explicit-record-fields-plugin == 2.0.0.1+ build-depends: hls-explicit-record-fields-plugin == 2.1.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.0.0.1+ build-depends: hls-overloaded-record-dot-plugin == 2.1.0.0 cpp-options: -Dhls_overloaded_record_dot -- formatters common floskell if flag(floskell) && impl(ghc < 9.5)- build-depends: hls-floskell-plugin == 2.0.0.1+ build-depends: hls-floskell-plugin == 2.1.0.0 cpp-options: -Dhls_floskell common fourmolu if flag(fourmolu)- build-depends: hls-fourmolu-plugin == 2.0.0.1+ build-depends: hls-fourmolu-plugin == 2.1.0.0 cpp-options: -Dhls_fourmolu common ormolu- if flag(ormolu) && impl(ghc < 9.5)- build-depends: hls-ormolu-plugin == 2.0.0.1+ if flag(ormolu) && impl(ghc < 9.7)+ build-depends: hls-ormolu-plugin == 2.1.0.0 cpp-options: -Dhls_ormolu common stylishHaskell- if flag(stylishHaskell) && impl(ghc < 9.5)- build-depends: hls-stylish-haskell-plugin == 2.0.0.1+ if flag(stylishHaskell)+ build-depends: hls-stylish-haskell-plugin == 2.1.0.0 cpp-options: -Dhls_stylishHaskell common refactor if flag(refactor)- build-depends: hls-refactor-plugin == 2.0.0.1+ build-depends: hls-refactor-plugin == 2.1.0.0 cpp-options: -Dhls_refactor library@@ -377,7 +367,6 @@ , haddockComments , eval , importLens- , refineImports , rename , retrie , tactic@@ -416,12 +405,12 @@ , cryptohash-sha1 , data-default , ghc- , ghcide == 2.0.0.1+ , ghcide == 2.1.0.0 , githash >=0.1.6.1- , lsp+ , lsp >= 2.1.0.0 , hie-bios , hiedb- , hls-plugin-api == 2.0.0.1+ , hls-plugin-api == 2.1.0.0 , optparse-applicative , optparse-simple , process@@ -560,13 +549,14 @@ , lens-aeson , ghcide , ghcide-test-utils- , hls-test-utils == 2.0.0.1+ , hls-test-utils == 2.1.0.0 , lsp-types , aeson , hls-plugin-api , lsp-test , containers , unordered-containers+ , row-types hs-source-dirs: test/functional test/utils
src/HlsPlugins.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} module HlsPlugins where -import Development.IDE.Types.Logger (Pretty (pretty), Recorder,+import Ide.Logger (Pretty (pretty), Recorder, WithPriority, cmapWithPrio) import Ide.PluginUtils (pluginDescToIdePlugins) import Ide.Types (IdePlugins,@@ -40,10 +40,8 @@ import qualified Ide.Plugin.ExplicitImports as ExplicitImports #endif -#if hls_refineImports-import qualified Ide.Plugin.RefineImports as RefineImports-#endif + #if hls_rename import qualified Ide.Plugin.Rename as Rename #endif@@ -152,7 +150,9 @@ let pId = "cabal" in Cabal.descriptor (pluginRecorder pId) pId : #endif #if hls_pragmas- Pragmas.descriptor "pragmas" :+ Pragmas.suggestPragmaDescriptor "pragmas-suggest" :+ Pragmas.completionDescriptor "pragmas-completion" :+ Pragmas.suggestDisableWarningDescriptor "pragmas-disable" : #endif #if hls_floskell Floskell.descriptor "floskell" :@@ -161,13 +161,15 @@ let pId = "fourmolu" in Fourmolu.descriptor (pluginRecorder pId) pId: #endif #if hls_cabalfmt- let pId = "cabalfmt" in CabalFmt.descriptor (pluginRecorder pId) pId:+ -- this pId needs to be kept in sync with the hardcoded+ -- cabalFormattingProvider in the Default Config+ let pId = "cabal-fmt" in CabalFmt.descriptor (pluginRecorder pId) pId: #endif #if hls_tactic let pId = "tactics" in Tactic.descriptor (pluginRecorder pId) pId: #endif #if hls_ormolu- Ormolu.descriptor "ormolu" :+ let pId = "ormolu" in Ormolu.descriptor (pluginRecorder pId) pId : #endif #if hls_stylishHaskell StylishHaskell.descriptor "stylish-haskell" :@@ -195,9 +197,6 @@ #endif #if hls_qualifyImportedNames QualifyImportedNames.descriptor "qualifyImportedNames" :-#endif-#if hls_refineImports- let pId = "refineImports" in RefineImports.descriptor (pluginRecorder pId) pId: #endif #if hls_moduleName let pId = "moduleName" in ModuleName.descriptor (pluginRecorder pId) pId:
src/Ide/Arguments.hs view
@@ -1,10 +1,11 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0-{-# LANGUAGE CPP #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above+{-# LANGUAGE TypeApplications #-} module Ide.Arguments ( Arguments(..)@@ -20,6 +21,7 @@ import Development.IDE (IdeState) import Development.IDE.Main (Command (..), commandP) import GitHash (giHash, tGitInfoCwdTry)+import Ide.Logger (Priority (..)) import Ide.Types (IdePlugins) import Options.Applicative import Paths_haskell_language_server@@ -38,15 +40,16 @@ | PrintLibDir data GhcideArguments = GhcideArguments- {argsCommand :: Command- ,argsCwd :: Maybe FilePath- ,argsShakeProfiling :: Maybe FilePath- ,argsTesting :: Bool- ,argsExamplePlugin :: Bool- -- These next two are for compatibility with existing hie clients, allowing- -- them to just change the name of the exe and still work.- , argsDebugOn :: Bool+ { argsCommand :: Command+ , argsCwd :: Maybe FilePath+ , argsShakeProfiling :: Maybe FilePath+ , argsTesting :: Bool+ , argsExamplePlugin :: Bool+ , argsLogLevel :: Priority , argsLogFile :: Maybe String+ -- ^ the minimum log level to show+ , argsLogStderr :: Bool+ , argsLogClient :: Bool , argsThreads :: Int , argsProjectGhcVersion :: Bool } deriving Show@@ -122,17 +125,56 @@ <*> switch (long "example" <> help "Include the Example Plugin. For Plugin devs only") - <*> switch- ( long "debug"+ <*>+ (option @Priority auto+ (long "log-level"+ <> help "Only show logs at or above this log level"+ <> metavar "LOG_LEVEL"+ <> value Info+ <> showDefault+ )+ <|>+ flag' Debug+ (long "debug" <> short 'd'- <> help "Generate debug output"- )- <*> optional (strOption+ <> help "Sets the log level to Debug, alias for '--log-level Debug'"+ )+ )+ -- This option is a little inconsistent with the other log options, since+ -- it's not a boolean and there is no way to turn it off. That's okay+ -- since the default is off.+ <*> (optional (strOption+ ( long "log-file"+ <> metavar "LOGFILE"+ <> help "Send logs to a file"+ )) <|> (optional (strOption ( long "logfile" <> short 'l' <> metavar "LOGFILE"- <> help "File to log to, defaults to stdout"- ))+ <> help "Send logs to a file"+ -- deprecated alias so users don't need to update their CLI calls+ -- immediately+ <> internal+ )))+ )+ -- Boolean option so we can toggle the default in a consistent way+ <*> option auto+ ( long "log-stderr"+ <> help "Send logs to stderr"+ <> metavar "BOOL"+ <> value True+ <> showDefault+ )+ -- Boolean option so we can toggle the default in a consistent way+ <*> option auto+ ( long "log-client"+ <> help "Send logs to the client using the window/logMessage LSP method"+ <> metavar "BOOL"+ -- This is off by default, since some clients will show duplicate logs+ -- if we log both to stderr and the client+ <> value False+ <> showDefault+ ) <*> option auto (short 'j' <> help "Number of threads (0: automatic)"
src/Ide/Main.hs view
@@ -24,13 +24,13 @@ import Development.IDE.Main (isLSP) import qualified Development.IDE.Main as IDEMain import qualified Development.IDE.Session as Session-import Development.IDE.Types.Logger as G import qualified Development.IDE.Types.Options as Ghcide import GHC.Stack (emptyCallStack) import qualified HIE.Bios.Environment as HieBios-import qualified HIE.Bios.Types as HieBios import HIE.Bios.Types hiding (Log)+import qualified HIE.Bios.Types as HieBios import Ide.Arguments+import Ide.Logger as G import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, pluginsToVSCodeExtensionSchema) import Ide.Types (IdePlugins, PluginId (PluginId),
test/functional/Command.hs view
@@ -1,30 +1,30 @@ {-# LANGUAGE OverloadedStrings #-} module Command (tests) where -import Control.Lens hiding (List)+import Control.Lens hiding (List) import Data.Char-import qualified Data.Text as T-import Language.LSP.Types as LSP-import Language.LSP.Types.Lens as LSP+import qualified Data.Text as T+import qualified Language.LSP.Protocol.Lens as L+import Language.LSP.Protocol.Types as LSP import Test.Hls import Test.Hls.Command-import Test.Hls.Flags (requiresEvalPlugin)+import Test.Hls.Flags (requiresEvalPlugin) tests :: TestTree tests = testGroup "commands" [ testCase "are prefixed" $ runSession hlsCommand fullCaps "test/testdata/" $ do- ResponseMessage _ _ (Right res) <- initializeResponse- let List cmds = res ^. LSP.capabilities . executeCommandProvider . _Just . commands+ TResponseMessage _ _ (Right res) <- initializeResponse+ let cmds = res ^. L.capabilities . L.executeCommandProvider . _Just . L.commands f x = (T.length (T.takeWhile isNumber x) >= 1) && (T.count ":" x >= 2) liftIO $ do all f cmds @? "All prefixed" not (null cmds) @? "Commands aren't empty" , requiresEvalPlugin $ testCase "get de-prefixed" $ runSession hlsCommand fullCaps "test/testdata/" $ do- ResponseMessage _ _ (Left err) <- request- SWorkspaceExecuteCommand- (ExecuteCommandParams Nothing "34133:eval:evalCommand" (Just (List [])))+ TResponseMessage _ _ (Left err) <- request+ SMethod_WorkspaceExecuteCommand+ (ExecuteCommandParams Nothing "34133:eval:evalCommand" (Just [])) let ResponseError _ msg _ = err -- We expect an error message about the dud arguments, but we can -- check that we found the right plugin.
test/functional/Completion.hs view
@@ -1,26 +1,18 @@+{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Completion(tests) where -import Control.Monad-import Control.Lens hiding ((.=))-import Data.Aeson (object, (.=))-import Data.Foldable (find)-import qualified Data.Text as T-import Ide.Plugin.Config (maxCompletions)-import Language.LSP.Types.Lens hiding (applyEdit)+import Control.Lens hiding ((.=))+import Data.Aeson (object, (.=))+import Data.Foldable (find)+import Data.Row.Records (focus)+import qualified Data.Text as T+import Ide.Plugin.Config (maxCompletions)+import Language.LSP.Protocol.Lens hiding (applyEdit, length) import Test.Hls import Test.Hls.Command -getResolvedCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]-getResolvedCompletions doc pos = do- xs <- getCompletions doc pos- forM xs $ \item -> do- rsp <- request SCompletionItemResolve item- case rsp ^. result of- Left err -> liftIO $ assertFailure ("completionItem/resolve failed with: " <> show err)- Right x -> pure x- tests :: TestTree tests = testGroup "completions" [ testCase "works" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -29,13 +21,13 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 9)+ compls <- getAndResolveCompletions doc (Position 5 9) item <- getCompletionByLabel "putStrLn" compls liftIO $ do item ^. label @?= "putStrLn"- item ^. kind @?= Just CiFunction+ item ^. kind @?= Just CompletionItemKind_Function item ^. detail @?= Just ":: String -> IO ()\nfrom Prelude"- item ^. insertTextFormat @?= Just Snippet+ item ^. insertTextFormat @?= Just InsertTextFormat_Snippet item ^. insertText @?= Just "putStrLn" , testCase "itemCompletion/resolve works" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -44,13 +36,13 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 9)+ compls <- getAndResolveCompletions doc (Position 5 9) item <- getCompletionByLabel "putStrLn" compls liftIO $ do item ^. label @?= "putStrLn"- item ^. kind @?= Just CiFunction+ item ^. kind @?= Just CompletionItemKind_Function item ^. detail @?= Just ":: String -> IO ()\nfrom Prelude"- item ^. insertTextFormat @?= Just Snippet+ item ^. insertTextFormat @?= Just InsertTextFormat_Snippet item ^. insertText @?= Just "putStrLn" , testCase "completes imports" $ runSession (hlsCommand <> " --test") fullCaps "test/testdata/completion" $ do@@ -61,12 +53,12 @@ let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 1 23)+ compls <- getAndResolveCompletions doc (Position 1 23) item <- getCompletionByLabel "Maybe" compls liftIO $ do item ^. label @?= "Maybe" item ^. detail @?= Just "Data.Maybe"- item ^. kind @?= Just CiModule+ item ^. kind @?= Just CompletionItemKind_Module , testCase "completes qualified imports" $ runSession (hlsCommand <> " --test") fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell"@@ -76,17 +68,17 @@ let te = TextEdit (Range (Position 2 17) (Position 2 25)) "Data.L" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 2 24)+ compls <- getAndResolveCompletions doc (Position 2 24) item <- getCompletionByLabel "List" compls liftIO $ do item ^. label @?= "List" item ^. detail @?= Just "Data.List"- item ^. kind @?= Just CiModule+ item ^. kind @?= Just CompletionItemKind_Module , testCase "completes with no prefix" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" - compls <- getResolvedCompletions doc (Position 5 7)+ compls <- getAndResolveCompletions doc (Position 5 7) liftIO $ assertBool "Expected completions" $ not $ null compls , expectFailIfBeforeGhc92 "record dot syntax is introduced in GHC 9.2"@@ -97,7 +89,7 @@ let te = TextEdit (Range (Position 25 0) (Position 25 5)) "z = x.a" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 25 6)+ compls <- getAndResolveCompletions doc (Position 25 6) item <- getCompletionByLabel "a" compls liftIO $ do@@ -108,7 +100,7 @@ let te = TextEdit (Range (Position 27 0) (Position 27 8)) "z2 = x.c.z" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 27 9)+ compls <- getAndResolveCompletions doc (Position 27 9) item <- getCompletionByLabel "z" compls liftIO $ do@@ -122,17 +114,17 @@ let te = TextEdit (Range (Position 5 0) (Position 5 2)) "acc" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 4)+ compls <- getAndResolveCompletions doc (Position 5 4) item <- getCompletionByLabel "accessor" compls liftIO $ do item ^. label @?= "accessor"- item ^. kind @?= Just CiFunction+ item ^. kind @?= Just CompletionItemKind_Function , testCase "have implicit foralls on basic polymorphic types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id" _ <- applyEdit doc te- compls <- getResolvedCompletions doc (Position 5 9)+ compls <- getAndResolveCompletions doc (Position 5 9) item <- getCompletionByLabel "id" compls liftIO $ do item ^. detail @?= Just ":: a -> a\nfrom Prelude"@@ -142,7 +134,7 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip" _ <- applyEdit doc te- compls <- getResolvedCompletions doc (Position 5 11)+ compls <- getAndResolveCompletions doc (Position 5 11) item <- getCompletionByLabel "flip" compls liftIO $ item ^. detail @?= Just ":: (a -> b -> c) -> b -> a -> c\nfrom Prelude"@@ -150,7 +142,7 @@ , testCase "maxCompletions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" - compls <- getResolvedCompletions doc (Position 5 7)+ compls <- getAndResolveCompletions doc (Position 5 7) liftIO $ length compls @?= maxCompletions def , testCase "import function completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -159,11 +151,11 @@ let te = TextEdit (Range (Position 0 30) (Position 0 41)) "A" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 0 31)+ compls <- getAndResolveCompletions doc (Position 0 31) item <- getCompletionByLabel "Alternative" compls liftIO $ do item ^. label @?= "Alternative"- item ^. kind @?= Just CiFunction+ item ^. kind @?= Just CompletionItemKind_Function item ^. detail @?= Just "Control.Applicative" , testCase "import second function completion" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -172,21 +164,21 @@ let te = TextEdit (Range (Position 0 39) (Position 0 39)) ", l" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 0 42)+ compls <- getAndResolveCompletions doc (Position 0 42) item <- getCompletionByLabel "liftA" compls liftIO $ do item ^. label @?= "liftA"- item ^. kind @?= Just CiFunction+ item ^. kind @?= Just CompletionItemKind_Function item ^. detail @?= Just "Control.Applicative" , testCase "completes locally defined associated type family" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "AssociatedTypeFamily.hs" "haskell" - compls <- getResolvedCompletions doc (Position 5 20)+ compls <- getAndResolveCompletions doc (Position 5 20) item <- getCompletionByLabel "Fam" compls liftIO $ do item ^. label @?= "Fam"- item ^. kind @?= Just CiStruct+ item ^. kind @?= Just CompletionItemKind_Struct , contextTests , snippetTests@@ -200,10 +192,10 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "Nothing" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 14)+ compls <- getAndResolveCompletions doc (Position 5 14) item <- getCompletionByLabel "Nothing" compls liftIO $ do- item ^. insertTextFormat @?= Just Snippet+ item ^. insertTextFormat @?= Just InsertTextFormat_Snippet item ^. insertText @?= Just "Nothing" , testCase "work for polymorphic types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -212,12 +204,12 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 11)+ compls <- getAndResolveCompletions doc (Position 5 11) item <- getCompletionByLabel "foldl" compls liftIO $ do item ^. label @?= "foldl"- item ^. kind @?= Just CiFunction- item ^. insertTextFormat @?= Just Snippet+ item ^. kind @?= Just CompletionItemKind_Function+ item ^. insertTextFormat @?= Just InsertTextFormat_Snippet item ^. insertText @?= Just "foldl" , testCase "work for complex types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -226,12 +218,12 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "mapM" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 11)+ compls <- getAndResolveCompletions doc (Position 5 11) item <- getCompletionByLabel "mapM" compls liftIO $ do item ^. label @?= "mapM"- item ^. kind @?= Just CiFunction- item ^. insertTextFormat @?= Just Snippet+ item ^. kind @?= Just CompletionItemKind_Function+ item ^. insertTextFormat @?= Just InsertTextFormat_Snippet item ^. insertText @?= Just "mapM" , testCase "work for infix functions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -240,12 +232,12 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 18)+ compls <- getAndResolveCompletions doc (Position 5 18) item <- getCompletionByLabel "filter" compls liftIO $ do item ^. label @?= "filter"- item ^. kind @?= Just CiFunction- item ^. insertTextFormat @?= Just PlainText+ item ^. kind @?= Just CompletionItemKind_Function+ item ^. insertTextFormat @?= Just InsertTextFormat_PlainText item ^. insertText @?= Nothing , testCase "work for infix functions in backticks" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -254,12 +246,12 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 18)+ compls <- getAndResolveCompletions doc (Position 5 18) item <- getCompletionByLabel "filter" compls liftIO $ do item ^. label @?= "filter"- item ^. kind @?= Just CiFunction- item ^. insertTextFormat @?= Just PlainText+ item ^. kind @?= Just CompletionItemKind_Function+ item ^. insertTextFormat @?= Just InsertTextFormat_PlainText item ^. insertText @?= Nothing , testCase "work for qualified infix functions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -268,12 +260,12 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 29)+ compls <- getAndResolveCompletions doc (Position 5 29) item <- getCompletionByLabel "intersperse" compls liftIO $ do item ^. label @?= "intersperse"- item ^. kind @?= Just CiFunction- item ^. insertTextFormat @?= Just PlainText+ item ^. kind @?= Just CompletionItemKind_Function+ item ^. insertTextFormat @?= Just InsertTextFormat_PlainText item ^. insertText @?= Nothing , testCase "work for qualified infix functions in backticks" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -282,12 +274,12 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 29)+ compls <- getAndResolveCompletions doc (Position 5 29) item <- getCompletionByLabel "intersperse" compls liftIO $ do item ^. label @?= "intersperse"- item ^. kind @?= Just CiFunction- item ^. insertTextFormat @?= Just PlainText+ item ^. kind @?= Just CompletionItemKind_Function+ item ^. insertTextFormat @?= Just InsertTextFormat_PlainText item ^. insertText @?= Nothing , testCase "respects lsp configuration" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do@@ -309,12 +301,12 @@ let te = TextEdit (Range (Position 1 0) (Position 1 2)) "MkF" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 1 6)+ compls <- getAndResolveCompletions doc (Position 1 6) item <- case find (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls of Just c -> pure c Nothing -> liftIO . assertFailure $ "Completion with label 'MkFoo' and insertText starting with 'MkFoo {' not found among " <> show compls liftIO $ do- item ^. insertTextFormat @?= Just Snippet+ item ^. insertTextFormat @?= Just InsertTextFormat_Snippet item ^. insertText @?= Just "MkFoo {arg1=${1:_arg1}, arg2=${2:_arg2}, arg3=${3:_arg3}, arg4=${4:_arg4}, arg5=${5:_arg5}}" ] where@@ -322,12 +314,12 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold" _ <- applyEdit doc te - compls <- getResolvedCompletions doc (Position 5 11)+ compls <- getAndResolveCompletions doc (Position 5 11) item <- getCompletionByLabel "foldl" compls liftIO $ do item ^. label @?= "foldl"- item ^. kind @?= Just CiFunction- item ^. insertTextFormat @?= Just PlainText+ item ^. kind @?= Just CompletionItemKind_Function+ item ^. insertTextFormat @?= Just InsertTextFormat_PlainText item ^. insertText @?= Nothing noSnippetsCaps =@@ -337,7 +329,7 @@ . _Just . completionItem . _Just- . snippetSupport+ . focus #snippetSupport ?~ False ) fullCaps@@ -347,7 +339,7 @@ testCase "only provides type suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Context.hs" "haskell" - compls <- getResolvedCompletions doc (Position 2 17)+ compls <- getAndResolveCompletions doc (Position 2 17) liftIO $ do compls `shouldContainCompl` "Integer" compls `shouldNotContainCompl` "interact"@@ -355,7 +347,7 @@ , testCase "only provides value suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Context.hs" "haskell" - compls <- getResolvedCompletions doc (Position 3 10)+ compls <- getAndResolveCompletions doc (Position 3 10) liftIO $ do compls `shouldContainCompl` "abs" compls `shouldNotContainCompl` "Applicative"@@ -363,7 +355,7 @@ , testCase "completes qualified type suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Context.hs" "haskell" - compls <- getResolvedCompletions doc (Position 2 26)+ compls <- getAndResolveCompletions doc (Position 2 26) liftIO $ do compls `shouldNotContainCompl` "forkOn" compls `shouldContainCompl` "MVar"
test/functional/Config.hs view
@@ -1,32 +1,28 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}- module Config (tests) where import Control.DeepSeq-import Control.Lens hiding (List, (.=)) import Control.Monad import Data.Aeson import Data.Hashable-import qualified Data.HashMap.Strict as HM-import qualified Data.Map as Map-import qualified Data.Text as T-import Data.Typeable (Typeable)-import Development.IDE (RuleResult, action, define,- getFilesOfInterestUntracked,- getPluginConfigAction, ideErrorText,- uses_)-import Development.IDE.Test (expectDiagnostics)+import qualified Data.HashMap.Strict as HM+import qualified Data.Map as Map+import Data.Typeable (Typeable)+import Development.IDE (RuleResult, action, define,+ getFilesOfInterestUntracked,+ getPluginConfigAction, ideErrorText,+ uses_)+import Development.IDE.Test (expectDiagnostics) import GHC.Generics import Ide.Plugin.Config import Ide.Types-import Language.LSP.Test as Test-import qualified Language.LSP.Types.Lens as L-import System.FilePath ((</>))+import Language.LSP.Test as Test+import System.FilePath ((</>)) import Test.Hls-import Test.Hls.Command {-# ANN module ("HLint: ignore Reduce duplication"::String) #-} @@ -34,30 +30,9 @@ tests = testGroup "plugin config" [ -- Note: there are more comprehensive tests over config in hls-hlint-plugin -- TODO: Add generic tests over some example plugin- configParsingTests, genericConfigTests- ]--configParsingTests :: TestTree-configParsingTests = testGroup "config parsing"- [ testCase "empty object as user configuration should not send error logMessage" $ runConfigSession "" $ do- let config = object []- sendConfigurationChanged (toJSON config)-- -- Send custom request so server returns a response to prevent blocking- void $ sendNotification (SCustomMethod "non-existent-method") Null-- logNot <- skipManyTill Test.anyMessage (message SWindowLogMessage)-- liftIO $ (logNot ^. L.params . L.xtype) > MtError- || "non-existent-method" `T.isInfixOf` (logNot ^. L.params . L.message)- @? "Server sends logMessage with MessageType = Error"+ genericConfigTests ] - where- runConfigSession :: FilePath -> Session a -> IO a- runConfigSession subdir =- failIfSessionTimeout . runSession hlsCommand fullCaps ("test/testdata" </> subdir)- genericConfigTests :: TestTree genericConfigTests = testGroup "generic plugin config" [@@ -92,8 +67,8 @@ expectDiagnostics standardDiagnostics ] where- standardDiagnostics = [("Foo.hs", [(DsWarning, (1,0), "Top-level binding")])]- testPluginDiagnostics = [("Foo.hs", [(DsError, (0,0), "testplugin")])]+ 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)
test/functional/Deferred.hs view
@@ -3,10 +3,11 @@ {-# LANGUAGE OverloadedStrings #-} module Deferred(tests) where -import Control.Lens hiding (List)+import Control.Lens hiding (List) -- import Control.Monad -- import Data.Maybe-import Language.LSP.Types.Lens hiding (id, message)+import Language.LSP.Protocol.Lens hiding (id, length, message)+import Language.LSP.Protocol.Types (Null (Null)) -- import qualified Language.LSP.Types.Lens as LSP import Test.Hls import Test.Hls.Command@@ -88,7 +89,7 @@ testCase "instantly respond to failed modules with no cache" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "FuncTestFail.hs" "haskell" defs <- getDefinitions doc (Position 1 11)- liftIO $ defs @?= InR []+ liftIO $ defs @?= InR (InR Null) -- TODO: the benefits of caching parsed modules is doubted. -- TODO: add issue link@@ -154,17 +155,17 @@ testCase "Can load one file at a time, when more than one Main module exists" $ runSession hlsCommand fullCaps "test/testdata" $ do _doc <- openDoc "ApplyRefact2.hs" "haskell"- _diagsRspHlint <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics)- diagsRspGhc <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics)- let (List diags) = diagsRspGhc ^. params . diagnostics+ _diagsRspHlint <- skipManyTill anyNotification (message SMethod_TextDocumentPublishDiagnostics)+ diagsRspGhc <- skipManyTill anyNotification (message SMethod_TextDocumentPublishDiagnostics)+ let diags = diagsRspGhc ^. params . diagnostics liftIO $ length diags @?= 2 _doc2 <- openDoc "HaReRename.hs" "haskell"- _diagsRspHlint2 <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics)+ _diagsRspHlint2 <- skipManyTill anyNotification (message SMethod_TextDocumentPublishDiagnostics) -- errMsg <- skipManyTill anyNotification notification :: Session ShowMessageNotification- diagsRsp2 <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics)- let (List diags2) = diagsRsp2 ^. params . diagnostics+ diagsRsp2 <- skipManyTill anyNotification (message SMethod_TextDocumentPublishDiagnostics)+ let diags2 = diagsRsp2 ^. params . diagnostics liftIO $ show diags2 @?= "[]" ]
test/functional/Definition.hs view
@@ -1,30 +1,55 @@ module Definition (tests) where import Control.Lens-import Language.LSP.Types.Lens+import Language.LSP.Protocol.Lens import System.Directory import Test.Hls import Test.Hls.Command tests :: TestTree-tests = testGroup "definitions" [+tests = testGroup "definitions" [symbolTests, moduleTests] - ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/References.hs" $- testCase "goto's symbols" $ runSession hlsCommand fullCaps "test/testdata" $ do+symbolTests :: TestTree+symbolTests = testGroup "gotoDefinition on symbols"+ -- gotoDefinition where the definition is in the same file+ [ testCase "gotoDefinition in this file" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "References.hs" "haskell" defs <- getDefinitions doc (Position 7 8) let expRange = Range (Position 4 0) (Position 4 3)- liftIO $ defs @?= InL [Location (doc ^. uri) expRange]+ liftIO $ defs @?= InL (Definition (InR [Location (doc ^. uri) expRange])) + -- gotoDefinition where the definition is in a different file+ , testCase "gotoDefinition in other file" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do+ doc <- openDoc "Foo.hs" "haskell"+ defs <- getDefinitions doc (Position 4 11)+ let expRange = Range (Position 2 0) (Position 2 1)+ liftIO $ do+ fp <- canonicalizePath "test/testdata/definition/Bar.hs"+ defs @?= InL (Definition (InR [Location (filePathToUri fp) expRange]))++ -- gotoDefinition where the definition is in a different file and the+ -- definition in the other file is on a line number that is greater+ -- than the number of lines in the file we are requesting from+ , testCase "gotoDefinition in other file past lines in this file" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do+ doc <- openDoc "Foo.hs" "haskell"+ defs <- getDefinitions doc (Position 5 13)+ let expRange = Range (Position 8 0) (Position 8 1)+ liftIO $ do+ fp <- canonicalizePath "test/testdata/definition/Bar.hs"+ defs @?= InL (Definition (InR [Location (filePathToUri fp) expRange]))+ ]+ -- ----------------------------------- - , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $+moduleTests :: TestTree+moduleTests = testGroup "gotoDefinition on modules"+ [ ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $ testCase "goto's imported modules" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do doc <- openDoc "Foo.hs" "haskell" defs <- getDefinitions doc (Position 2 8) liftIO $ do fp <- canonicalizePath "test/testdata/definition/Bar.hs"- defs @?= InL [Location (filePathToUri fp) zeroRange]+ defs @?= InL (Definition (InR [Location (filePathToUri fp) zeroRange])) , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $ testCase "goto's exported modules" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do@@ -32,7 +57,7 @@ defs <- getDefinitions doc (Position 0 15) liftIO $ do fp <- canonicalizePath "test/testdata/definition/Bar.hs"- defs @?= InL [Location (filePathToUri fp) zeroRange]+ defs @?= InL (Definition (InR [Location (filePathToUri fp) zeroRange])) , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $ testCase "goto's imported modules that are loaded" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do@@ -41,7 +66,7 @@ defs <- getDefinitions doc (Position 2 8) liftIO $ do fp <- canonicalizePath "test/testdata/definition/Bar.hs"- defs @?= InL [Location (filePathToUri fp) zeroRange]+ defs @?= InL (Definition (InR [Location (filePathToUri fp) zeroRange])) , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $ testCase "goto's imported modules that are loaded, and then closed" $@@ -54,7 +79,7 @@ liftIO $ putStrLn "D" liftIO $ do fp <- canonicalizePath "test/testdata/definition/Bar.hs"- defs @?= InL [Location (filePathToUri fp) zeroRange]+ defs @?= InL (Definition (InR [Location (filePathToUri fp) zeroRange])) liftIO $ putStrLn "E" -- AZ noDiagnostics
test/functional/Diagnostic.hs view
@@ -2,8 +2,8 @@ module Diagnostic (tests) where -import Control.Lens hiding (List)-import qualified Language.LSP.Types.Lens as LSP+import Control.Lens hiding (List)+import qualified Language.LSP.Protocol.Lens as L import Test.Hls import Test.Hls.Command @@ -19,6 +19,6 @@ runSession hlsCommand fullCaps "test/testdata/wErrorTest" $ do doc <- openDoc "src/WError.hs" "haskell" [diag] <- waitForDiagnosticsFrom doc- liftIO $ diag ^. LSP.severity @?= Just DsWarning+ liftIO $ diag ^. L.severity @?= Just DiagnosticSeverity_Warning ]
test/functional/Format.hs view
@@ -2,20 +2,20 @@ {-# LANGUAGE OverloadedStrings #-} module Format (tests) where -import Control.Lens ((^.))+import Control.Lens ((^.)) import Control.Monad.IO.Class import Data.Aeson-import qualified Data.ByteString.Lazy as BS-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T+import qualified Data.ByteString.Lazy as BS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import qualified Language.LSP.Protocol.Lens as L+import Language.LSP.Protocol.Types import Language.LSP.Test-import Language.LSP.Types-import qualified Language.LSP.Types.Lens as LSP import Test.Hls import Test.Hls.Command-import Test.Hls.Flags (requiresFloskellPlugin,- requiresOrmoluPlugin)+import Test.Hls.Flags (requiresFloskellPlugin,+ requiresOrmoluPlugin) tests :: TestTree tests = testGroup "format document" [@@ -47,11 +47,11 @@ providerTests = testGroup "formatting provider" [ testCase "respects none" $ runSessionWithConfig (formatConfig "none") hlsCommand fullCaps "test/testdata/format" $ do doc <- openDoc "Format.hs" "haskell"- resp <- request STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing)- liftIO $ case resp ^. LSP.result of+ resp <- request SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing)+ liftIO $ case resp ^. L.result of result@(Left (ResponseError reason message Nothing)) -> case reason of- MethodNotFound -> pure () -- No formatter- InvalidRequest | "No plugin enabled for STextDocumentFormatting" `T.isPrefixOf` message -> pure ()+ (InR ErrorCodes_MethodNotFound) -> pure () -- No formatter+ (InR ErrorCodes_InvalidRequest) | "No plugin enabled for SMethod_TextDocumentFormatting" `T.isPrefixOf` message -> pure () _ -> assertFailure $ "strange response from formatting provider:" ++ show result result -> assertFailure $ "strange response from formatting provider:" ++ show result
test/functional/FunctionalCodeAction.hs view
@@ -4,22 +4,22 @@ module FunctionalCodeAction (tests) where -import Control.Lens hiding (List)+import Control.Lens hiding (List) import Control.Monad import Data.Aeson-import Data.Aeson.Lens (_Object)+import Data.Aeson.Lens (_Object) import Data.List-import qualified Data.Map as M+import qualified Data.Map as M import Data.Maybe-import qualified Data.Text as T+import qualified Data.Text as T+import Development.IDE.Core.Compile (sourceTypecheck)+import Development.IDE.Test (configureCheckProject) import Ide.Plugin.Config-import Language.LSP.Test as Test-import qualified Language.LSP.Types.Lens as L+import qualified Language.LSP.Protocol.Lens as L+import Language.LSP.Test as Test import Test.Hls-import Test.Hspec.Expectations--import Development.IDE.Test (configureCheckProject) import Test.Hls.Command+import Test.Hspec.Expectations {-# ANN module ("HLint: ignore Reduce duplication"::String) #-} @@ -43,7 +43,7 @@ testCase "works" $ runSession hlsCommand noLiteralCaps "test/testdata" $ do doc <- openDoc "CodeActionRename.hs" "haskell" - _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cars <- getAllCodeActions doc replaceButStrLn <- liftIO $ inspectCommand cars ["Replace with", "putStrLn"]@@ -58,13 +58,13 @@ configureCheckProject False doc <- openDoc "CodeActionRename.hs" "haskell" - _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cars <- getAllCodeActions doc cmd <- liftIO $ inspectCommand cars ["Replace with", "putStrLn"] let mbArgs = cmd ^. L.arguments case mbArgs of- Just (List [args]) -> liftIO $ do+ Just [args] -> liftIO $ do let editParams = args ^. ix "fallbackWorkspaceEdit" . _Object (editParams & has (ix "changes")) @? "Contains changes" not (editParams & has (ix "documentChanges")) @? "Doesn't contain documentChanges"@@ -184,7 +184,7 @@ (InR action:_) -> do liftIO $ do action ^. L.title @?= "Add text as a dependency"- action ^. L.kind @?= Just CodeActionQuickFix+ action ^. L.kind @?= Just CodeActionKind_QuickFix "package:add" `T.isSuffixOf` (action ^. L.command . _Just . L.command) @? "Command contains package:add" executeCodeAction action@@ -218,7 +218,7 @@ liftIO $ do action ^. L.title @?= "Add zlib as a dependency"- forM_ allActions $ \a -> a ^. L.kind @?= Just CodeActionQuickFix+ forM_ allActions $ \a -> a ^. L.kind @?= Just CodeActionKind_QuickFix forM_ allActions $ \a -> "package:add" `T.isSuffixOf` (a ^. L.command . _Just . L.command) @? "Command contains package:add" executeCodeAction action@@ -235,7 +235,7 @@ runSession hlsCommand fullCaps "test/testdata/redundantImportTest/" $ do doc <- openDoc "src/CodeActionRedundant.hs" "haskell" - diags <- waitForDiagnosticsFromSource doc "typecheck"+ diags <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) liftIO $ expectDiagnostic diags [ "The import of", "Data.List", "is redundant" ] liftIO $ expectDiagnostic diags [ "Empty", "from module", "Data.Sequence" ] @@ -255,7 +255,7 @@ case mbRemoveAction of Just removeAction -> do liftIO $ do- forM_ allActions $ \a -> a ^. L.kind @?= Just CodeActionQuickFix+ forM_ allActions $ \a -> a ^. L.kind @?= Just CodeActionKind_QuickFix forM_ allActions $ \a -> a ^. L.command @?= Nothing forM_ allActions $ \a -> isJust (a ^. L.edit) @? "Has edit" @@ -281,7 +281,7 @@ , testCase "doesn't touch other imports" $ runSession hlsCommand noLiteralCaps "test/testdata/redundantImportTest/" $ do doc <- openDoc "src/MultipleImports.hs" "haskell"- _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cas <- getAllCodeActions doc cmd <- liftIO $ inspectCommand cas ["redundant import"] executeCommand cmd@@ -303,7 +303,7 @@ runSession hlsCommand fullCaps "test/testdata" $ do disableWingman doc <- openDoc "TypedHoles.hs" "haskell"- _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cas <- getAllCodeActions doc liftIO $ do expectCodeAction cas ["replace _ with minBound"]@@ -324,7 +324,7 @@ testCase "doesn't work when wingman is active" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles.hs" "haskell"- _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cas <- getAllCodeActions doc liftIO $ do dontExpectCodeAction cas ["replace _ with minBound"]@@ -334,7 +334,7 @@ runSession hlsCommand fullCaps "test/testdata" $ do disableWingman doc <- openDoc "TypedHoles2.hs" "haskell"- _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cas <- getAllCodeActions doc liftIO $ do@@ -359,7 +359,7 @@ testCase "doesnt show more suggestions when wingman is active" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles2.hs" "haskell"- _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cas <- getAllCodeActions doc liftIO $ do@@ -373,7 +373,7 @@ runSession hlsCommand fullCaps "test/testdata/" $ do doc <- openDoc "TopLevelSignature.hs" "haskell" - _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cas <- getAllCodeActions doc liftIO $ expectCodeAction cas ["add signature: main :: IO ()"]@@ -400,7 +400,7 @@ runSession hlsCommand fullCaps "test/testdata/" $ do doc <- openDoc "UnusedTerm.hs" "haskell" - _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) cars <- getAllCodeActions doc prefixImUnused <- liftIO $ inspectCodeAction cars ["Prefix imUnused with _"] @@ -425,23 +425,23 @@ _ <- waitForDiagnosticsFrom doc diags <- getCurrentDiagnostics doc let params = CodeActionParams Nothing Nothing doc (Range (Position 1 0) (Position 4 0)) caContext- caContext = CodeActionContext (List diags) (Just (List [CodeActionRefactor]))- caContextAllActions = CodeActionContext (List diags) Nothing+ caContext = CodeActionContext diags (Just [CodeActionKind_Refactor]) Nothing+ caContextAllActions = CodeActionContext diags Nothing Nothing -- Verify that we get code actions of at least two different kinds.- ResponseMessage _ _ (Right (List res))- <- request STextDocumentCodeAction (params & L.context .~ caContextAllActions)+ TResponseMessage _ _ (Right res)+ <- request SMethod_TextDocumentCodeAction (params & L.context .~ caContextAllActions) liftIO $ do- let cas = map fromAction res+ let cas = map fromAction $ absorbNull res kinds = map (^. L.kind) cas- assertBool "Test precondition failed" $ Just CodeActionQuickFix `elem` kinds+ assertBool "Test precondition failed" $ Just CodeActionKind_QuickFix `elem` kinds -- Verify that that when we set the only parameter, we only get actions -- of the right kind.- ResponseMessage _ _ (Right (List res)) <- request STextDocumentCodeAction params+ TResponseMessage _ _ (Right res) <- request SMethod_TextDocumentCodeAction params liftIO $ do- let cas = map fromAction res+ let cas = map fromAction $ absorbNull res kinds = map (^. L.kind) cas assertBool "Quick fixes should have been filtered out"- $ Just CodeActionQuickFix `notElem` kinds+ $ Just CodeActionKind_QuickFix `notElem` kinds ] disableWingman :: Session ()
test/functional/HieBios.hs view
@@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module HieBios (tests) where -import Control.Lens ((^.))+import Control.Lens ((^.)) import Control.Monad.IO.Class-import qualified Data.Text as T-import qualified Language.LSP.Types.Lens as L-import System.FilePath ((</>))+import qualified Data.Text as T+import qualified Language.LSP.Protocol.Lens as L+import System.FilePath ((</>)) import Test.Hls import Test.Hls.Command @@ -19,7 +19,7 @@ Just mainHoverText <- getHover doc (Position 3 1) let hoverContents = mainHoverText ^. L.contents case hoverContents of- (HoverContents (MarkupContent _ x)) -> do+ (InL (MarkupContent _ x)) -> do liftIO $ "main :: IO ()" `T.isInfixOf` x @? "found hover text for main" _ -> error $ "Unexpected hover contents: " ++ show hoverContents
test/functional/Highlight.hs view
@@ -12,10 +12,10 @@ highlights <- getHighlights doc (Position 2 2) liftIO $ do let hls =- [ DocumentHighlight (mkRange 2 0 2 3) (Just HkWrite)- , DocumentHighlight (mkRange 4 22 4 25) (Just HkRead)- , DocumentHighlight (mkRange 3 6 3 9) (Just HkRead)- , DocumentHighlight (mkRange 1 0 1 3) (Just HkRead)]+ [ DocumentHighlight (mkRange 2 0 2 3) (Just DocumentHighlightKind_Write)+ , DocumentHighlight (mkRange 4 22 4 25) (Just DocumentHighlightKind_Read)+ , DocumentHighlight (mkRange 3 6 3 9) (Just DocumentHighlightKind_Read)+ , DocumentHighlight (mkRange 1 0 1 3) (Just DocumentHighlightKind_Read)] mapM_ (\x -> x `elem` highlights @? "Contains highlight") hls ] where
test/functional/Progress.hs view
@@ -5,20 +5,19 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-}-+{-# LANGUAGE ViewPatterns #-} module Progress (tests) where -import Control.Exception (throw)-import Control.Lens hiding ((.=))-import Data.Aeson (Value, decode, encode, object,- (.=))-import Data.List (delete)-import Data.Maybe (fromJust)-import Data.Text (Text, pack)-import qualified Language.LSP.Types as LSP-import Language.LSP.Types.Capabilities-import qualified Language.LSP.Types.Lens as L-import System.FilePath ((</>))+import Control.Exception (throw)+import Control.Lens hiding ((.=))+import Data.Aeson (Value, decode, encode,+ object, (.=))+import Data.List (delete)+import Data.Maybe (fromJust)+import Data.Text (Text, pack)+import Language.LSP.Protocol.Capabilities+import qualified Language.LSP.Protocol.Lens as L+import System.FilePath ((</>)) import Test.Hls import Test.Hls.Command import Test.Hls.Flags@@ -36,20 +35,20 @@ , requiresEvalPlugin $ testCase "eval plugin sends progress reports" $ runSession hlsCommand progressCaps "plugins/hls-eval-plugin/test/testdata" $ do doc <- openDoc "T1.hs" "haskell"- lspId <- sendRequest STextDocumentCodeLens (CodeLensParams Nothing Nothing doc)+ lspId <- sendRequest SMethod_TextDocumentCodeLens (CodeLensParams Nothing Nothing doc) (codeLensResponse, activeProgressTokens) <- expectProgressMessagesTill- (responseForId STextDocumentCodeLens lspId)+ (responseForId SMethod_TextDocumentCodeLens lspId) ["Setting up testdata (for T1.hs)", "Processing", "Indexing"] [] -- this is a test so exceptions result in fails- let response = getResponseResult codeLensResponse+ let response = getMessageResult codeLensResponse case response of- LSP.List [evalLens] -> do+ InL [evalLens] -> do let command = evalLens ^?! L.command . _Just - _ <- sendRequest SWorkspaceExecuteCommand $+ _ <- sendRequest SMethod_WorkspaceExecuteCommand $ ExecuteCommandParams Nothing (command ^. L.command)@@ -62,14 +61,14 @@ sendConfigurationChanged (formatLspConfig "ormolu") doc <- openDoc "Format.hs" "haskell" expectProgressMessages ["Setting up testdata (for Format.hs)", "Processing", "Indexing"] []- _ <- sendRequest STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing)+ _ <- 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") doc <- openDoc "Format.hs" "haskell" expectProgressMessages ["Setting up testdata (for Format.hs)", "Processing", "Indexing"] []- _ <- sendRequest STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing)+ _ <- sendRequest SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) expectProgressMessages ["Formatting Format.hs"] [] ] @@ -81,9 +80,9 @@ data ProgressMessage = ProgressCreate WorkDoneProgressCreateParams- | ProgressBegin (ProgressParams WorkDoneProgressBeginParams)- | ProgressReport (ProgressParams WorkDoneProgressReportParams)- | ProgressEnd (ProgressParams WorkDoneProgressEndParams)+ | ProgressBegin ProgressToken WorkDoneProgressBegin+ | ProgressReport ProgressToken WorkDoneProgressReport+ | ProgressEnd ProgressToken WorkDoneProgressEnd data InterestingMessage a = InterestingMessage a@@ -93,15 +92,21 @@ progressMessage = progressCreate <|> progressBegin <|> progressReport <|> progressEnd where- progressCreate = ProgressCreate . view L.params <$> message SWindowWorkDoneProgressCreate- progressBegin = ProgressBegin <$> satisfyMaybe (\case- FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (Begin x))) -> Just (ProgressParams t x)+ progressCreate = ProgressCreate . view L.params <$> message SMethod_WindowWorkDoneProgressCreate+ progressBegin :: Session ProgressMessage+ progressBegin = satisfyMaybe (\case+ FromServerMess SMethod_Progress (TNotificationMessage _ _ (ProgressParams t (preview _workDoneProgressBegin -> Just params))) ->+ Just (ProgressBegin t params) _ -> Nothing)- progressReport = ProgressReport <$> satisfyMaybe (\case- FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (Report x))) -> Just (ProgressParams t x)+ progressReport :: Session ProgressMessage+ progressReport = satisfyMaybe (\case+ FromServerMess SMethod_Progress (TNotificationMessage _ _ (ProgressParams t (preview _workDoneProgressReport -> Just params))) ->+ Just (ProgressReport t params) _ -> Nothing)- progressEnd = ProgressEnd <$> satisfyMaybe (\case- FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (End x))) -> Just (ProgressParams t x)+ progressEnd :: Session ProgressMessage+ progressEnd = satisfyMaybe (\case+ FromServerMess SMethod_Progress (TNotificationMessage _ _ (ProgressParams t (preview _workDoneProgressEnd -> Just params)))+ -> Just (ProgressEnd t params) _ -> Nothing) interestingMessage :: Session a -> Session (InterestingMessage a)@@ -142,28 +147,23 @@ updateExpectProgressStateAndRecurseWith f progressMessage expectedTitles activeProgressTokens = do case progressMessage of ProgressCreate params -> do- f expectedTitles (getToken params : activeProgressTokens)- ProgressBegin params -> do- liftIO $ getToken params `expectedIn` activeProgressTokens- f (delete (getTitle params) expectedTitles) activeProgressTokens- ProgressReport params -> do- liftIO $ getToken params `expectedIn` activeProgressTokens+ f expectedTitles ((params ^. L.token): activeProgressTokens)+ ProgressBegin token params -> do+ liftIO $ token `expectedIn` activeProgressTokens+ f (delete (params ^. L.title) expectedTitles) activeProgressTokens+ ProgressReport token _ -> do+ liftIO $ token `expectedIn` activeProgressTokens f expectedTitles activeProgressTokens- ProgressEnd params -> do- liftIO $ getToken params `expectedIn` activeProgressTokens- f expectedTitles (delete (getToken params) activeProgressTokens)+ ProgressEnd token _ -> do+ liftIO $ token `expectedIn` activeProgressTokens+ f expectedTitles (delete token activeProgressTokens) -getTitle :: (L.HasValue s a1, L.HasTitle a1 a2) => s -> a2-getTitle msg = msg ^. L.value . L.title -getToken :: L.HasToken s a => s -> a-getToken msg = msg ^. L.token- expectedIn :: (Foldable t, Eq a, Show a) => a -> t a -> Assertion expectedIn a as = a `elem` as @? "Unexpected " ++ show a -getResponseResult :: ResponseMessage m -> ResponseResult m-getResponseResult rsp =+getMessageResult :: TResponseMessage m -> MessageResult m+getMessageResult rsp = case rsp ^. L.result of Right x -> x Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) err
test/functional/Reference.hs view
@@ -3,7 +3,7 @@ import Control.Lens import Data.Coerce import Data.List-import Language.LSP.Types.Lens+import Language.LSP.Protocol.Lens import Test.Hls import Test.Hls.Command
test/functional/Symbol.hs view
@@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module Symbol (tests) where -import Control.Lens (_Just, ix, to, (^?))+import Control.Lens (_Just, ix, (^?)) import Data.List-import Language.LSP.Test as Test-import Language.LSP.Types.Capabilities-import qualified Language.LSP.Types.Lens as L+import Language.LSP.Protocol.Capabilities+import qualified Language.LSP.Protocol.Lens as L+import Language.LSP.Test as Test import Test.Hls import Test.Hls.Command @@ -19,44 +19,44 @@ v310Tests = testGroup "3.10 hierarchical document symbols" [ testCase "provides nested data types and constructors" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "Symbols.hs" "haskell"- Left symbs <- getDocumentSymbols doc+ Right symbs <- getDocumentSymbols doc - let myData = DocumentSymbol "MyData" Nothing SkStruct Nothing Nothing myDataR myDataSR (Just (List [a, b]))- a = DocumentSymbol "A" Nothing SkConstructor Nothing Nothing aR aSR Nothing- b = DocumentSymbol "B" Nothing SkConstructor Nothing Nothing bR bSR Nothing- let myData' = symbs ^? ix 0 . L.children . _Just .to fromList . ix 2+ let myData = DocumentSymbol "MyData" Nothing SymbolKind_Struct Nothing Nothing myDataR myDataSR (Just [a, b])+ a = DocumentSymbol "A" Nothing SymbolKind_Constructor Nothing Nothing aR aSR Nothing+ b = DocumentSymbol "B" Nothing SymbolKind_Constructor Nothing Nothing bR bSR Nothing+ let myData' = symbs ^? ix 0 . L.children . _Just . ix 2 liftIO $ Just myData == myData' @? "Contains symbol" , ignoreTestBecause "extracting symbols from nested wheres not supported" $ testCase "provides nested where functions" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "Symbols.hs" "haskell"- Left symbs <- getDocumentSymbols doc+ Right symbs <- getDocumentSymbols doc - let foo = DocumentSymbol "foo" Nothing SkFunction Nothing Nothing fooR fooSR (Just (List [bar]))- bar = DocumentSymbol "bar" Nothing SkFunction Nothing Nothing barR barSR (Just (List [dog, cat]))- dog = DocumentSymbol "dog" Nothing SkVariable Nothing Nothing dogR dogSR (Just mempty)- cat = DocumentSymbol "cat" Nothing SkVariable Nothing Nothing catR catSR (Just mempty)- let foo' = symbs ^? ix 0 . L.children . _Just .to fromList . ix 1+ let foo = DocumentSymbol "foo" Nothing SymbolKind_Function Nothing Nothing fooR fooSR (Just [bar])+ bar = DocumentSymbol "bar" Nothing SymbolKind_Function Nothing Nothing barR barSR (Just [dog, cat])+ dog = DocumentSymbol "dog" Nothing SymbolKind_Variable Nothing Nothing dogR dogSR (Just mempty)+ cat = DocumentSymbol "cat" Nothing SymbolKind_Variable Nothing Nothing catR catSR (Just mempty)+ let foo' = symbs ^? ix 0 . L.children . _Just . ix 1 liftIO $ Just foo == foo' @? "Contains symbol" , ignoreTestBecause "extracting pattern synonym symbols not supported" $ testCase "provides pattern synonyms" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "Symbols.hs" "haskell"- Left symbs <- getDocumentSymbols doc+ Right symbs <- getDocumentSymbols doc let testPattern = DocumentSymbol "TestPattern"- Nothing SkFunction Nothing Nothing testPatternR testPatternSR (Just mempty)- let testPattern' = symbs ^? ix 0 . L.children . _Just .to fromList . ix 3+ Nothing SymbolKind_Function Nothing Nothing testPatternR testPatternSR (Just mempty)+ let testPattern' = symbs ^? ix 0 . L.children . _Just . ix 3 liftIO $ Just testPattern == testPattern' @? "Contains symbol" , testCase "provides imports" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "Symbols.hs" "haskell"- Left symbs <- getDocumentSymbols doc+ Right symbs <- getDocumentSymbols doc - let imports = DocumentSymbol "imports" Nothing SkModule Nothing Nothing importsR importsSR (Just (List [importDataMaybe]))- importDataMaybe = DocumentSymbol "import Data.Maybe" Nothing SkModule Nothing Nothing importDataMaybeR importDataMaybeSR Nothing- let imports' = symbs ^? ix 0 . L.children . _Just .to fromList . ix 0+ let imports = DocumentSymbol "imports" Nothing SymbolKind_Module Nothing Nothing importsR importsSR (Just [importDataMaybe])+ importDataMaybe = DocumentSymbol "import Data.Maybe" Nothing SymbolKind_Module Nothing Nothing importDataMaybeR importDataMaybeSR Nothing+ let imports' = symbs ^? ix 0 . L.children . _Just . ix 0 liftIO $ Just imports == imports' @? "Contains symbol" ]@@ -65,50 +65,47 @@ pre310Tests = testGroup "pre 3.10 symbol information" [ testCase "provides nested data types and constructors" $ runSession hlsCommand oldCaps "test/testdata" $ do doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell"- Right symbs <- getDocumentSymbols doc+ Left symbs <- getDocumentSymbols doc - let myData = SymbolInformation "MyData" SkStruct Nothing Nothing (Location testUri myDataR) (Just "Symbols")- a = SymbolInformation "A" SkConstructor Nothing Nothing (Location testUri aR) (Just "MyData")- b = SymbolInformation "B" SkConstructor Nothing Nothing (Location testUri bR) (Just "MyData")+ let myData = SymbolInformation "MyData" SymbolKind_Struct Nothing (Just "Symbols") Nothing (Location testUri myDataR)+ a = SymbolInformation "A" SymbolKind_Constructor Nothing (Just "MyData") Nothing (Location testUri aR)+ b = SymbolInformation "B" SymbolKind_Constructor Nothing (Just "MyData") Nothing (Location testUri bR) liftIO $ [myData, a, b] `isInfixOf` symbs @? "Contains symbols" , ignoreTestBecause "extracting symbols from nested wheres not supported" $ testCase "provides nested where functions" $ runSession hlsCommand oldCaps "test/testdata" $ do doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell"- Right symbs <- getDocumentSymbols doc+ Left symbs <- getDocumentSymbols doc - let foo = SymbolInformation "foo" SkFunction Nothing Nothing (Location testUri fooR) (Just "Symbols")- bar = SymbolInformation "bar" SkFunction Nothing Nothing (Location testUri barR) (Just "foo")- dog = SymbolInformation "dog" SkVariable Nothing Nothing (Location testUri dogR) (Just "bar")- cat = SymbolInformation "cat" SkVariable Nothing Nothing (Location testUri catR) (Just "bar")+ let foo = SymbolInformation "foo" SymbolKind_Function Nothing (Just "Symbols") Nothing (Location testUri fooR)+ bar = SymbolInformation "bar" SymbolKind_Function Nothing (Just "foo") Nothing (Location testUri barR)+ dog = SymbolInformation "dog" SymbolKind_Variable Nothing (Just "bar") Nothing (Location testUri dogR)+ cat = SymbolInformation "cat" SymbolKind_Variable Nothing (Just "bar") Nothing (Location testUri catR) -- Order is important! liftIO $ [foo, bar, dog, cat] `isInfixOf` symbs @? "Contains symbols" , ignoreTestBecause "extracting pattern synonym symbols not supported" $ testCase "provides pattern synonyms" $ runSession hlsCommand oldCaps "test/testdata" $ do doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell"- Right symbs <- getDocumentSymbols doc+ Left symbs <- getDocumentSymbols doc let testPattern = SymbolInformation "TestPattern"- SkFunction Nothing Nothing (Location testUri testPatternR) (Just "Symbols")+ SymbolKind_Function Nothing (Just "Symbols") Nothing (Location testUri testPatternR) liftIO $ testPattern `elem` symbs @? "Contains symbols" , testCase "provides imports" $ runSession hlsCommand oldCaps "test/testdata" $ do doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell"- Right symbs <- getDocumentSymbols doc+ Left symbs <- getDocumentSymbols doc - let imports = SymbolInformation "imports" SkModule Nothing Nothing (Location testUri importsR) (Just "Symbols")- importDataMaybe = SymbolInformation "import Data.Maybe" SkModule Nothing Nothing (Location testUri importDataMaybeR) (Just "imports")+ let imports = SymbolInformation "imports" SymbolKind_Module Nothing (Just "Symbols") Nothing (Location testUri importsR)+ importDataMaybe = SymbolInformation "import Data.Maybe" SymbolKind_Module Nothing (Just "imports") Nothing (Location testUri importDataMaybeR) liftIO $ [imports, importDataMaybe] `isInfixOf` symbs @? "Contains symbol" ] oldCaps :: ClientCapabilities oldCaps = capsForVersion (LSPVersion 3 9)--fromList :: List a -> [a]-fromList (List a) = a -- Some common ranges and selection ranges in Symbols.hs importsR :: Range
test/functional/TypeDefinition.hs view
@@ -33,7 +33,7 @@ getTypeDefinitionTest (symbolFile, symbolLine, symbolCol) definitionLocations = failIfSessionTimeout . runSession (hlsCommand ++ " --test") fullCaps definitionsPath $ do doc <- openDoc symbolFile "haskell"- InL defs <- getTypeDefinitions doc $ Position symbolLine symbolCol+ InL (Definition (InR defs)) <- getTypeDefinitions doc $ Position symbolLine symbolCol liftIO $ defs `expectSameLocations` map (first3 (definitionsPath </>)) definitionLocations getTypeDefinitionTest' :: UInt -> UInt -> UInt -> UInt -> Assertion
test/testdata/definition/Bar.hs view
@@ -1,3 +1,9 @@ module Bar where a = 42++-- These blank lines are here+-- to ensure that b is defined+-- on a line number larger than+-- the number of lines in Foo.hs.+b = 43
test/testdata/definition/Foo.hs view
@@ -1,3 +1,6 @@ module Foo (module Bar) where import Bar++fortyTwo = a+fortyThree = b
+ test/testdata/definition/hie.yaml view
@@ -0,0 +1,5 @@+cradle:+ direct:+ arguments:+ - "Foo"+ - "Bar"
+ test/testdata/hieBiosError/hie.yaml view