diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -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 diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -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 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 category: Development name: haskell-language-server -version: 2.0.0.1 +version: 2.1.0.0 synopsis: LSP server for GHC description: Please see the README on GitHub at @@ -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 diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -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: diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs --- a/src/Ide/Arguments.hs +++ b/src/Ide/Arguments.hs @@ -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)" diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -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), diff --git a/test/functional/Command.hs b/test/functional/Command.hs --- a/test/functional/Command.hs +++ b/test/functional/Command.hs @@ -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. diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -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" diff --git a/test/functional/Config.hs b/test/functional/Config.hs --- a/test/functional/Config.hs +++ b/test/functional/Config.hs @@ -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) diff --git a/test/functional/Deferred.hs b/test/functional/Deferred.hs --- a/test/functional/Deferred.hs +++ b/test/functional/Deferred.hs @@ -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 @?= "[]" ] diff --git a/test/functional/Definition.hs b/test/functional/Definition.hs --- a/test/functional/Definition.hs +++ b/test/functional/Definition.hs @@ -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 diff --git a/test/functional/Diagnostic.hs b/test/functional/Diagnostic.hs --- a/test/functional/Diagnostic.hs +++ b/test/functional/Diagnostic.hs @@ -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 ] diff --git a/test/functional/Format.hs b/test/functional/Format.hs --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -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 diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -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 () diff --git a/test/functional/HieBios.hs b/test/functional/HieBios.hs --- a/test/functional/HieBios.hs +++ b/test/functional/HieBios.hs @@ -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 diff --git a/test/functional/Highlight.hs b/test/functional/Highlight.hs --- a/test/functional/Highlight.hs +++ b/test/functional/Highlight.hs @@ -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 diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -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 diff --git a/test/functional/Reference.hs b/test/functional/Reference.hs --- a/test/functional/Reference.hs +++ b/test/functional/Reference.hs @@ -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 diff --git a/test/functional/Symbol.hs b/test/functional/Symbol.hs --- a/test/functional/Symbol.hs +++ b/test/functional/Symbol.hs @@ -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 diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs --- a/test/functional/TypeDefinition.hs +++ b/test/functional/TypeDefinition.hs @@ -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 diff --git a/test/testdata/definition/Bar.hs b/test/testdata/definition/Bar.hs --- a/test/testdata/definition/Bar.hs +++ b/test/testdata/definition/Bar.hs @@ -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 diff --git a/test/testdata/definition/Foo.hs b/test/testdata/definition/Foo.hs --- a/test/testdata/definition/Foo.hs +++ b/test/testdata/definition/Foo.hs @@ -1,3 +1,6 @@ module Foo (module Bar) where import Bar + +fortyTwo = a +fortyThree = b diff --git a/test/testdata/definition/hie.yaml b/test/testdata/definition/hie.yaml new file mode 100644 --- /dev/null +++ b/test/testdata/definition/hie.yaml @@ -0,0 +1,5 @@ +cradle: + direct: + arguments: + - "Foo" + - "Bar" diff --git a/test/testdata/hieBiosError/hie.yaml b/test/testdata/hieBiosError/hie.yaml new file mode 100644 --- /dev/null +++ b/test/testdata/hieBiosError/hie.yaml