haskell-language-server (empty) → 0.8.0.0
raw patch · 46 files changed
+7184/−0 lines, 46 filesdep +aesondep +basedep +binarysetup-changed
Dependencies added: aeson, base, binary, blaze-markup, brittany, bytestring, containers, data-default, deepseq, directory, extra, filepath, floskell, fourmolu, ghc, ghc-boot-th, ghc-paths, ghcide, gitrev, hashable, haskell-language-server, haskell-lsp, hie-bios, hls-class-plugin, hls-eval-plugin, hls-explicit-imports-plugin, hls-hlint-plugin, hls-plugin-api, hls-retrie-plugin, hls-tactics-plugin, hslogger, hspec, hspec-core, hspec-expectations, lens, lsp-test, mtl, optparse-applicative, optparse-simple, ormolu, process, regex-tdfa, safe-exceptions, shake, stm, stylish-haskell, tasty, tasty-ant-xml, tasty-expected-failure, tasty-golden, tasty-hunit, tasty-rerun, temporary, text, transformers, unordered-containers, with-utf8, yaml
Files
- ChangeLog.md +679/−0
- LICENSE +201/−0
- README.md +749/−0
- Setup.hs +2/−0
- exe/Main.hs +22/−0
- exe/Plugins.hs +128/−0
- exe/Wrapper.hs +147/−0
- haskell-language-server.cabal +444/−0
- include/ghc-api-version.h +10/−0
- plugins/default/src/Ide/Plugin/Brittany.hs +99/−0
- plugins/default/src/Ide/Plugin/Example.hs +230/−0
- plugins/default/src/Ide/Plugin/Example2.hs +224/−0
- plugins/default/src/Ide/Plugin/Floskell.hs +61/−0
- plugins/default/src/Ide/Plugin/Fourmolu.hs +110/−0
- plugins/default/src/Ide/Plugin/ModuleName.hs +204/−0
- plugins/default/src/Ide/Plugin/Ormolu.hs +81/−0
- plugins/default/src/Ide/Plugin/Pragmas.hs +144/−0
- plugins/default/src/Ide/Plugin/StylishHaskell.hs +59/−0
- plugins/hls-eval-plugin/test/Eval.hs +211/−0
- plugins/tactics/src/Ide/Plugin/Tactic/TestTypes.hs +27/−0
- src/Ide/Arguments.hs +127/−0
- src/Ide/Main.hs +203/−0
- src/Ide/Version.hs +79/−0
- test/functional/Class.hs +73/−0
- test/functional/Command.hs +37/−0
- test/functional/Completion.hs +376/−0
- test/functional/Config.hs +78/−0
- test/functional/Deferred.hs +176/−0
- test/functional/Definition.hs +69/−0
- test/functional/Diagnostic.hs +103/−0
- test/functional/Format.hs +184/−0
- test/functional/FunctionalBadProject.hs +41/−0
- test/functional/FunctionalCodeAction.hs +494/−0
- test/functional/FunctionalLiquid.hs +102/−0
- test/functional/HieBios.hs +36/−0
- test/functional/Highlight.hs +26/−0
- test/functional/Main.hs +61/−0
- test/functional/ModuleName.hs +45/−0
- test/functional/Progress.hs +111/−0
- test/functional/Reference.hs +35/−0
- test/functional/Rename.hs +27/−0
- test/functional/Symbol.hs +157/−0
- test/functional/Tactic.hs +193/−0
- test/functional/TypeDefinition.hs +55/−0
- test/utils/Test/Hls/Util.hs +425/−0
- test/wrapper/Main.hs +39/−0
+ ChangeLog.md view
@@ -0,0 +1,679 @@+# Changelog for haskell-language-server++## 0.8.0++- This version adds support for ghc-8.10.3+- `hls-plugin-api` has been bumped to 0.6.0.0 and `ghcide` has been bumped from 0.6.0.1 to 0.7.0.0.+- It has a new brand plugin: hls-class-plugin, which helps to write class instances++++- The eval plugin has been revamped, adding these new features:+ - Tests in both plain comments and Haddock comments+ - For Haddock comments: shows differences between latest and previous result+ - Setup section, executed before every test+ - Execution of a section/group of tests at the time+ - Property testing+ - Setup of GHC extensions+- A new tactic to generate automatically `Arbitrary` instances has been added to tactic plugin+- There had been lot of internal changes:+ - ghcide lives now directly in this repository+ - the test suite has been cleaned and improved (continuing the work done in 0.7.0)+++Thanks to all contributors and happy new year!++### Pull requests merged for 0.8.0++- Ci fixes+([#783)](https://github.com/haskell/haskell-language-server/pull/783) by @pepeiborra+- Fix extend imports regression+([#769)](https://github.com/haskell/haskell-language-server/pull/769) by @pepeiborra+- Cleanup format testfiles+([#765)](https://github.com/haskell/haskell-language-server/pull/765) by @peterwicksstringfield+- Retry a failed cradle if the cradle descriptor changes+([#762)](https://github.com/haskell/haskell-language-server/pull/762) by @pepeiborra+- Perform memory measurement on SIGUSR1+([#761)](https://github.com/haskell/haskell-language-server/pull/761) by @pepeiborra+- Add ghc-8.10.3 support after merging ghcide repo+([#721)](https://github.com/haskell/haskell-language-server/pull/721) by @jneira+- Merge ghcide repository (replacing the submodule)+([#702)](https://github.com/haskell/haskell-language-server/pull/702) by @pepeiborra+- Invert the dependency between hls-plugin-api and ghcide+([#701)](https://github.com/haskell/haskell-language-server/pull/701) by @pepeiborra+- Move eval plugin to hls-eval-plugin+([#700)](https://github.com/haskell/haskell-language-server/pull/700) by @tittoassini+- Fix and enable progress message tests.+([#698)](https://github.com/haskell/haskell-language-server/pull/698) by @peterwicksstringfield+- Add a known tactic for writing arbitrary instances+([#695)](https://github.com/haskell/haskell-language-server/pull/695) by @isovector+- Introduce generic config for plugins+([#691)](https://github.com/haskell/haskell-language-server/pull/691) by @alanz+- Enable get type definition tests+([#690)](https://github.com/haskell/haskell-language-server/pull/690) by @peterwicksstringfield+- Fix ghc version for windows 8.10.2.2 in github build workflow+([#688)](https://github.com/haskell/haskell-language-server/pull/688) by @jneira+- Add plugins conditionally at compile time+([#687)](https://github.com/haskell/haskell-language-server/pull/687) by @jneira+- Implement basic Class plugin+([#661)](https://github.com/haskell/haskell-language-server/pull/661) by @Ailrun+- Extended Eval Plugin+([#438)](https://github.com/haskell/haskell-language-server/pull/438) by @tittoassini++## 0.7.1++- This is a minor bug fix release:+ - It fixes an issue that removed accidentally desugarer warnings (#676).+ - It disables auto extend import lists in completions, see #679.++### Pull requests merged for 0.7.1++- Disable auto extend import lists in completions. It fixes #679.+([#685)](https://github.com/haskell/haskell-language-server/pull/685) by @pepeiborra+- Restore kick (#676). It fixes #676.+([#677)](https://github.com/haskell/haskell-language-server/pull/677) by @wz1000+- README: Remove instructions to execute data target+([#675)](https://github.com/haskell/haskell-language-server/pull/675) by @andys8+- Add hlint tests over cpp, extensions and ignore hints+([#674)](https://github.com/haskell/haskell-language-server/pull/674) by @jneira++## 0.7.0++- This version contains mainly refactors and updates of upstream packages+- It bumps up some formatter versions:+ - ormolu is 0.1.4.1+ - fourmolu is 0.3.0.0+ - brittany is 0.13.1.0+- It uses last implicit-hie-cradle-0.3.0.2, with some [bug](https://github.com/Avi-D-coder/implicit-hie/issues/29) [fixes](https://github.com/Avi-D-coder/implicit-hie/issues/30)+- It uses last ghcide-0.6.0.1 with [improvements and bug fixes](https://github.com/haskell/ghcide/blob/master/CHANGELOG.md#060-2020-12-06):+ - Do not enable every "unnecessary" warning by default+ - Improvements over completions:+ - record fields+ - identifiers not in explicit import lists+ - extend explicit import list automatically++Thanks to all haskell-language-server, ghcide and other upstream packages contributors (the list continue growing healthy) for make this release possible.++### Pull requests merged for 0.7.0++- Miscellanous fixes: correct tactic plugin package metadata and cabal.hie.yaml/stack.hie.yaml+([#672)](https://github.com/haskell/haskell-language-server/pull/672) by @berberman+- Remove unnecessary pluginId setting and user Better Map functions in tactics plugin+([#669)](https://github.com/haskell/haskell-language-server/pull/669) by @jhrcek+- Do not suggest explicitly disabled pragmas+([#666)](https://github.com/haskell/haskell-language-server/pull/666) by @berberman+- fixed hie.yaml.stack+([#664)](https://github.com/haskell/haskell-language-server/pull/664) by @tittoassini+- Add pragmas completions+([#662)](https://github.com/haskell/haskell-language-server/pull/662) by @gdevanla+- Enable code completion tests+([#657)](https://github.com/haskell/haskell-language-server/pull/657) by @peterwicksstringfield+- Enable highlight unittests+([#656)](https://github.com/haskell/haskell-language-server/pull/656) by @peterwicksstringfield+- Fix document symbols unit tests.+([#655)](https://github.com/haskell/haskell-language-server/pull/655) by @peterwicksstringfield+- Delete duplicate cabal clause for applyrefact2+([#654)](https://github.com/haskell/haskell-language-server/pull/654) by @peterwicksstringfield+- Add extra-source-files for split plugins+([#650)](https://github.com/haskell/haskell-language-server/pull/650) by @berberman+- [nix-shell] Actually use gitignore+([#649)](https://github.com/haskell/haskell-language-server/pull/649) by @pepeiborra+- idempotent command and code cleanup+([#648)](https://github.com/haskell/haskell-language-server/pull/648) by @tittoassini+- Split the Imports and Retrie plugins+([#647)](https://github.com/haskell/haskell-language-server/pull/647) by @pepeiborra+- Simplify and Bump implicit-hie version constraints+([#645)](https://github.com/haskell/haskell-language-server/pull/645) by @Avi-D-coder+- Fix and enable disabled code action unit tests, fix fallback handler+([#643)](https://github.com/haskell/haskell-language-server/pull/643) by @peterwicksstringfield+- Add Ghcide hie.yaml instruction for Stack users+([#641)](https://github.com/haskell/haskell-language-server/pull/641) by @Sir4ur0n+- Upgrade the Nix build system+([#639)](https://github.com/haskell/haskell-language-server/pull/639) by @pepeiborra+- No longer needed to build once for Stack+([#637)](https://github.com/haskell/haskell-language-server/pull/637) by @Sir4ur0n+- Preserve the last empty comment line after eval plugin+([#631)](https://github.com/haskell/haskell-language-server/pull/631) by @expipiplus1+- Update fourmolu to 0.3.0.0+([#624)](https://github.com/haskell/haskell-language-server/pull/624) by @gwils+- Add hspec-discover to build-tool-depends in tactics plugin+([#623)](https://github.com/haskell/haskell-language-server/pull/623) by @gwils+- Add build to ghc-8.10.2 and windows+([#619)](https://github.com/haskell/haskell-language-server/pull/619) by @jneira+- Module Name Plugin: Treat modules starting with lowercase as Main module+([#616)](https://github.com/haskell/haskell-language-server/pull/616) by @konn+- Bump ormolu to 0.1.4.1+([#614)](https://github.com/haskell/haskell-language-server/pull/614) by @AlistairB+- Fix fourmolu plugin inconsistent formatting+([#599)](https://github.com/haskell/haskell-language-server/pull/599) by @zweimach+- Hlint: bring over idea2Message for formatting+([#598)](https://github.com/haskell/haskell-language-server/pull/598) by @alanz+- Makes dictionary argument exclusion logic in Tactic plugin more robust+([#508)](https://github.com/haskell/haskell-language-server/pull/508) by @konn++## 0.6.0++0.6.0 includes two brand new plugins!++- [Hlint Plugin](https://github.com/haskell/haskell-language-server/pull/166): it integrates hlint diagnostics and lets you apply suggestions to fix them.++++- [Module Name Plugin](https://github.com/haskell/haskell-language-server/pull/480): it makes easier create new modules and modify them, suggesting the appropiate module name as a code lens.++++This release also includes many improvements and bug fixes for the tactic plugin (see pull requests authored by @isovector for more details).++We have updated two essential tools used by the ide:++- `implicit-hie`: [to fix a bug](https://github.com/haskell/haskell-language-server/issues/498) present when loading cabal based projects with executables containing `other-modules`++- `ghcide`: the ide uses [the just released version 0.5](https://github.com/haskell/ghcide/blob/master/CHANGELOG.md#050-2020-10-08) with many bug fixes and improvements, including:+ - code action to remove *all* redundant imports+ - improved support for Template Haskell+ - emit desugarer warnings++### Pull requests merged for 0.6.0++- Fix tasty rerun+([#570)](https://github.com/haskell/haskell-language-server/pull/570) by @jneira+- Bump up ghcide submodule to version 0.5.0+([#568)](https://github.com/haskell/haskell-language-server/pull/568) by @jneira+- Refactor tactics to track hypothesis provenance+([#557)](https://github.com/haskell/haskell-language-server/pull/557) by @isovector+- Use bash shell to allow its idioms+([#552)](https://github.com/haskell/haskell-language-server/pull/552) by @jneira+- Ignore flakey tactics test+([#546)](https://github.com/haskell/haskell-language-server/pull/546) by @isovector+- Better scoring metric for deriving safeHead+([#545)](https://github.com/haskell/haskell-language-server/pull/545) by @isovector+- Discover skolems in the hypothesis, not just goal+([#542)](https://github.com/haskell/haskell-language-server/pull/542) by @isovector+- [retrie] Fix code action title+([#538)](https://github.com/haskell/haskell-language-server/pull/538) by @pepeiborra+- Tactics support for using given constraints+([#534)](https://github.com/haskell/haskell-language-server/pull/534) by @isovector+- Add missing tactic subpackage in default stack.yaml+([#529)](https://github.com/haskell/haskell-language-server/pull/529) by @jneira+- Use implicit-hie-0.1.2.0+([#528)](https://github.com/haskell/haskell-language-server/pull/528) by @jneira+- Wait for diagnostics in tactics tests+([#525)](https://github.com/haskell/haskell-language-server/pull/525) by @isovector+- Fix a bug in tactics preventing split of split+([#520)](https://github.com/haskell/haskell-language-server/pull/520) by @isovector+- Use infix notation for destructing and splitting infix data cons+([#519)](https://github.com/haskell/haskell-language-server/pull/519) by @isovector+- Retry the build three times+([#518)](https://github.com/haskell/haskell-language-server/pull/518) by @jneira+- Separate tactics into its own package+([#516)](https://github.com/haskell/haskell-language-server/pull/516) by @isovector+- Add a Troubleshooting section to the README+([#507)](https://github.com/haskell/haskell-language-server/pull/507) by @michaelpj+- Add GitHub Actions CI for testing+([#504)](https://github.com/haskell/haskell-language-server/pull/504) by @bubba+- Fix stack build for ghc-8.8.3 failing on some machines+([#503)](https://github.com/haskell/haskell-language-server/pull/503) by @luntain+- Expand explanation of how to configure HLS+([#497)](https://github.com/haskell/haskell-language-server/pull/497) by @michaelpj+- Module Name Plugin+([#480)](https://github.com/haskell/haskell-language-server/pull/480) by @tittoassini+- Allow hole filling to deal with recursion+([#472)](https://github.com/haskell/haskell-language-server/pull/472) by @isovector+- Restrict editor config to Haskell file, to avoid affecting Makefiles or other tab-based formats+([#442)](https://github.com/haskell/haskell-language-server/pull/442) by @tittoassini+- Hlint plugin using ghc-lib+([#166)](https://github.com/haskell/haskell-language-server/pull/166) by @jneira++## 0.5.1++0.5.1 is a minor bug fix release, mainly fixing an issue with the eval plugin+as well as upgrading the ormolu and stylish-haskell dependencies.++### Pull requests merged for 0.5.1++- Minimal fix for eval regression+([#488)](https://github.com/haskell/haskell-language-server/pull/488) by @pepeiborra+- Bump stylish-haskell to 0.12.2.0+([#482)](https://github.com/haskell/haskell-language-server/pull/482) by @maksbotan+- Improve the emacs instructions a little+([#479)](https://github.com/haskell/haskell-language-server/pull/479) by @michaelpj+- Update README: HLS is no longer in *very* early stage+([#475)](https://github.com/haskell/haskell-language-server/pull/475) by @Anrock+- Tactic plugin: Excludes Dictionary arguments in GADTs in Destruct Tactic+([#474)](https://github.com/haskell/haskell-language-server/pull/474) by @konn+- Update doom emacs install instructions in README+([#470)](https://github.com/haskell/haskell-language-server/pull/470) by @iyefrat+- Add ghc-8.10.2 to circleci+([#464)](https://github.com/haskell/haskell-language-server/pull/464) by @jneira+- Bump ormolu to 0.1.3.0+([#422)](https://github.com/haskell/haskell-language-server/pull/422) by @AlistairB++## 0.5.0++0.5.0 comes with a new tactics plugin which provides case splitting, homomorphic case splitting, and lambda introduction:++++It can even attempt to fully fill a hole!++++The imports lens plugin also learnt a new code action to make all imports explicit:++++There's also plenty of bug fixes, improvements and updates to the underlying tools, including Fourmolu, implicit-hie-cradle and ghcide. [Some of the improvements from ghcide](https://github.com/haskell/ghcide/releases/tag/v0.4.0) include:++- The entire project is typechecked on load+- Reverse dependencies of a module are typechecked upon saving+- Code completion includes local terms+- Import code actions now also suggest open imports+- Documentation on hover shows for symbols defined in the same module++If you're eager to try all this out, haskell-language-server is now also installable via [ghcup](https://www.haskell.org/ghcup/):++```shell+$ ghcup install hls+```++### Pull requests merged for 0.5.0++- Update GHC version 8.12 to 9.0 in README+([#460)](https://github.com/haskell/haskell-language-server/pull/460) by @maralorn+- Update Fourmolu to 0.2+([#455)](https://github.com/haskell/haskell-language-server/pull/455) by @georgefst+- Generate .gz tars of all the binaries for macOS and Linux in GitHub Actions+([#454)](https://github.com/haskell/haskell-language-server/pull/454) by @bubba+- install: create hls hardlinks instead of copies except on Windows+([#451)](https://github.com/haskell/haskell-language-server/pull/451) by @juhp+- wrapper: cd to --cwd earlier+([#448)](https://github.com/haskell/haskell-language-server/pull/448) by @ocharles+- Update README.md+([#446)](https://github.com/haskell/haskell-language-server/pull/446) by @moodmosaic+- Upate Emacs setup notes+([#440)](https://github.com/haskell/haskell-language-server/pull/440) by @gdevanla+- Use ghcide master and prepare hls-plugin-api-0.4.1.0+([#439)](https://github.com/haskell/haskell-language-server/pull/439) by @jneira+- Add a code action to make all imports explicit+([#436)](https://github.com/haskell/haskell-language-server/pull/436) by @pepeiborra+- Add docs on how to choose a formatter+([#432)](https://github.com/haskell/haskell-language-server/pull/432) by @googleson78+- Implement 'Attempt to fill hole' code action+([#431)](https://github.com/haskell/haskell-language-server/pull/431) by @TOTBWF+- Clarify that eval is a lens+([#428)](https://github.com/haskell/haskell-language-server/pull/428) by @Anrock+- Use implicit-hie-cradle-0.2.0.1+([#427)](https://github.com/haskell/haskell-language-server/pull/427) by @jneira+- [retrie] Fix uris in workspace edit+([#424)](https://github.com/haskell/haskell-language-server/pull/424) by @pepeiborra+- Separate paragraphs+([#423)](https://github.com/haskell/haskell-language-server/pull/423) by @jneira+- Include .editorconfig in the contributing section+([#420)](https://github.com/haskell/haskell-language-server/pull/420) by @jneira+- Mention the copy of executables wit ghc version+([#419)](https://github.com/haskell/haskell-language-server/pull/419) by @jneira+- Eval plugin: proper multilined results handling and command-name abbreviations+([#413)](https://github.com/haskell/haskell-language-server/pull/413) by @konn+- Retrie - calculate imports in the command handler+([#408)](https://github.com/haskell/haskell-language-server/pull/408) by @pepeiborra+- Progress reporting for Eval plugin+([#398)](https://github.com/haskell/haskell-language-server/pull/398) by @pepeiborra+- bump ghcide submodule+([#396)](https://github.com/haskell/haskell-language-server/pull/396) by @wz1000+- Fix cradles+([#393)](https://github.com/haskell/haskell-language-server/pull/393) by @pepeiborra+- Case splitting and lambda introduction+([#391)](https://github.com/haskell/haskell-language-server/pull/391) by @isovector+- Use stale data in explicit imports lens+([#383)](https://github.com/haskell/haskell-language-server/pull/383) by @pepeiborra+- Create hls-plugin-api and move plugins to exe+([#379)](https://github.com/haskell/haskell-language-server/pull/379) by @jneira+- Rebase on ghcide HEAD+([#378)](https://github.com/haskell/haskell-language-server/pull/378) by @pepeiborra+- README clarify how exactly to use code evaluation+([#377)](https://github.com/haskell/haskell-language-server/pull/377) by @DunetsNM+- Revise README.md+([#374)](https://github.com/haskell/haskell-language-server/pull/374) by @gihyeonsung++## 0.4.0++0.4.0 introduces the import lens plugin, which can convert your import statements into qualified imports, or into an explicit import list:++++The eval plugin has also learnt two new commands, `:type` and `:kind`:++```haskell+{-# LANGUAGE TypeApplications #-}+foo :: Show a => a -> String+foo = show++-- >>> :type foo @Int+-- foo @Int :: Int -> String++-- >>> :type +v foo @Int+-- foo @Int :: Show Int => Int -> String+```++```haskell+-- >>> type N = 1+-- >>> type M = 40+-- >>> :kind N + M + 1+-- N + M + 1 :: Nat++-- >>> type N = 1+-- >>> type M = 40+-- >>> :kind N + M + 1+-- N + M + 1 :: Nat+```++There is now also support for GHC 8.10.2, and a new `haskell-language-server --probe-tools` command to help debug what version of each tool HLS is using.++```shell+$ haskell-language-server --probe-tools+haskell-language-server version: 0.3.0.0 (GHC: 8.10.1) (PATH: /Users/luke/.cabal/store/ghc-8.10.1/hskll-lngg-srvr-0.3.0.0-7c6d48c3/bin/haskell-language-server)+Tool versions found on the $PATH+cabal: 3.2.0.0+stack: 2.3.3+ghc: 8.10.2+```++### Pull requests merged for 0.4.0++- Bring over a [tutorial about how to add hls plugins](https://github.com/pepeiborra/hls-tutorial)+([#372](https://github.com/haskell/haskell-language-server/pull/372) by @bubba)+- Update the ghcide upstream to be in haskell/ghcide+([#370](https://github.com/haskell/haskell-language-server/pull/370) by @alanz)+- Add ISSUE_TEMPLATE for github+([#305](https://github.com/haskell/haskell-language-server/pull/305) by @fendor)+- Add use-package to the list of emacs packages+([#343](https://github.com/haskell/haskell-language-server/pull/343) by @rgleichman)+- Implements `:type [+v/+d]` in Eval Plugin+([#361](https://github.com/haskell/haskell-language-server/pull/361) by @konn)+- Bump bounds of hie-bios to 0.7.0+([#357](https://github.com/haskell/haskell-language-server/pull/357) by @maralorn)+- Fix ImportLens plugin to work with GHC 8.10+([#356](https://github.com/haskell/haskell-language-server/pull/356) by @Ailrun)+- Add single file rewrites and ignore unknown files+([#321](https://github.com/haskell/haskell-language-server/pull/321) by @pepeiborra)+- Do not suggest explicit import lists for qualified imports+([#354](https://github.com/haskell/haskell-language-server/pull/354) by @expipiplus1)+- Explicit imports lens (as seen on Twitter)+([#310](https://github.com/haskell/haskell-language-server/pull/310) by @pepeiborra)+- Adds `:kind` and `:kind!` commands to Eval Plugin+([#345](https://github.com/haskell/haskell-language-server/pull/345) by @konn)+- tech(nix): update niv and remove allowbroken+([#350](https://github.com/haskell/haskell-language-server/pull/350) by @willbush)+- Update VS Code Haskell URL/repo+([#338](https://github.com/haskell/haskell-language-server/pull/338) by @Sir4ur0n)+- doc(hack): Add explanation to hack and test HLS+([#329](https://github.com/haskell/haskell-language-server/pull/329) by @Sir4ur0n)+- Apply the module pragmas for evaluation+([#322](https://github.com/haskell/haskell-language-server/pull/322) by @pepeiborra)+- Copy working stack-8.6.5.yaml to stack.yaml+([#332](https://github.com/haskell/haskell-language-server/pull/332) by @jneira)+- tech(nix): Allow broken as retrie is marked as broken+([#331](https://github.com/haskell/haskell-language-server/pull/331) by @Sir4ur0n)+- feat(git): Add install/hie.yaml to gitignore+([#328](https://github.com/haskell/haskell-language-server/pull/328) by @Sir4ur0n)+- Replace wrong occurrences of "engine" by "server"+([#319](https://github.com/haskell/haskell-language-server/pull/319) by @tchoutri)+- Simplify coc.nvim instructions+([#315](https://github.com/haskell/haskell-language-server/pull/315) by @oblitum)+- Coc config file requires a {} nesting everything+([#317](https://github.com/haskell/haskell-language-server/pull/317) by @hyiltiz)+- Restrict opentelemetry version for stack builds+([#312](https://github.com/haskell/haskell-language-server/pull/312) by @jneira)+- Add support for ghc-8.10.2+([#308](https://github.com/haskell/haskell-language-server/pull/308) by @jneira)+- Return nothing if tool is not on the PATH+([#309](https://github.com/haskell/haskell-language-server/pull/309) by @fendor)+- Probe tools cli+([#306](https://github.com/haskell/haskell-language-server/pull/306) by @fendor)+- Add fourmolu plugin (attempt 2) and add Brittany for ghc-8.10.1+([#264](https://github.com/haskell/haskell-language-server/pull/264) by @georgefst)++## 0.3.0++0.3.0 comes with two new plugins, retrie and fourmolu, provides binaries for+GHC 8.8.4, and comes with a host of bug fixes.++The retrie plugin supports RULES, functions and type synonyms which can be+accessed through contextual code actions.++Fourmolu can be used to format your code by setting the+`haskell.formattingProvider` field in your LSP configuration to++```json+{+ "haskell": {+ "formattingProvider": "fourmolu"+ }+}+```++The Brittany formatter is now also available on GHC 8.10.1.++### Pull requests merged++- Fix haddock parse error in install.hs+([#255](https://github.com/haskell/haskell-language-server/pull/255) by @georgefst)+- Ormolu flags+([#246](https://github.com/haskell/haskell-language-server/pull/246) by @pepeiborra)+- Ormolu fix+([#257](https://github.com/haskell/haskell-language-server/pull/257) by @sureyeaah)+- Remove redundant CircleCI steps+([#259](https://github.com/haskell/haskell-language-server/pull/259) by @bubba)+- Slow down Tasty by limiting it to -j1+([#261](https://github.com/haskell/haskell-language-server/pull/261) by @bubba)+- Remove hspec-expectations+([#260](https://github.com/haskell/haskell-language-server/pull/260) by @bubba)+- Remove a redundant caching step+([#262](https://github.com/haskell/haskell-language-server/pull/262) by @Ailrun)+- add hie.yaml to coc configuration+([#267](https://github.com/haskell/haskell-language-server/pull/267) by @sureyeaah)+- Initial Retrie plugin+([#266](https://github.com/haskell/haskell-language-server/pull/266) by @pepeiborra)+- Add exe extension to win executables+([#284](https://github.com/haskell/haskell-language-server/pull/284) by @jneira)+- Use wz1000/hls-3 ghcide branch+([#275](https://github.com/haskell/haskell-language-server/pull/275) by @alanz)+- Fix rename capability being declared+([#285](https://github.com/haskell/haskell-language-server/pull/285) by @bubba)+- Add CI job for 8.8.4+([#287](https://github.com/haskell/haskell-language-server/pull/287) by @bubba)+- Make the AGPL flag manual in cabal+([#250](https://github.com/haskell/haskell-language-server/pull/250) by @fendor)+- Bring in doc URL fix for Windows+([#289](https://github.com/haskell/haskell-language-server/pull/289) by @bubba)+- Bring in fix for libm on Linux static binaries+([#293](https://github.com/haskell/haskell-language-server/pull/293) by @bubba)+- Add fourmolu plugin (attempt 2) and add Brittany for ghc-8.10.1+([#264](https://github.com/haskell/haskell-language-server/pull/264) by @georgefst)+- Trying new hls-3 branch+([#300](https://github.com/haskell/haskell-language-server/pull/300) by @alanz)++## 0.2.2++This changes the configuration section from "languageServerHaskell" to "haskell"+to align it with vscode-haskell-1.0.0. Whilst the old section is still+supported for now, you should update your LSP configuration (which varies per+client) from++```json+{+ "languageServerHaskell": {+ "formattingProvider": "stylish-haskell"+ }+}+```++to++```json+{+ "haskell": {+ "formattingProvider": "stylish-haskell"+ }+}+```++### Pull requests merged for 0.2.2++- Mention docs on hover feature in README+([#209](https://github.com/haskell/haskell-language-server/pull/209) by @georgefst)+- Add static binaries for ghc-8.8.4+([#224](https://github.com/haskell/haskell-language-server/pull/224) by @bubba)+- Rename the configuration section from languageServerHaskell => haskell+([#227](https://github.com/haskell/haskell-language-server/pull/227) by @bubba)+- Use -haddock for cabal and stack+([#214](https://github.com/haskell/haskell-language-server/pull/214) by @jneira)+- slightly better shell.nix for local development+([#235](https://github.com/haskell/haskell-language-server/pull/235) by @pepeiborra)+- Shell nix further steps+([#240](https://github.com/haskell/haskell-language-server/pull/240) by @pepeiborra)+- Add numeric-version option for wrapper and server+([#241](https://github.com/haskell/haskell-language-server/pull/241) by @fendor)+- Accept the legacy "languageServerHaskell" config name+([#243](https://github.com/haskell/haskell-language-server/pull/243) by @bubba)+- Fix for Eval plugin: Error from tests not reported+([#244](https://github.com/haskell/haskell-language-server/pull/244) by @tittoassini)+- Rename binaries before uploading+([#248](https://github.com/haskell/haskell-language-server/pull/248) by @bubba)++## 0.2.1++This release includes a new eval plugin that allows Haddock code examples to be+evaluated through a code lens. For example, the code below will now offer to+evaluate `intercalate " " example`, and will insert the output in the line+below.++```haskell+example :: [String]+example = ["This is an example", "of", "interactive", "evaluation"]++-- >>> intercalate " " example+-- "This is an example of interactive evaluation"+--+```++This is also the first release to have binaries distributed alongside it. Some+behind the scene changes include the GHC library directory now being obtained on+the fly, so either `ghc`, `cabal` or `stack` will need to be present on your+PATH depending on your project. See `docs/releases.md` for more information. If+you find any issues with this, please let us know!++### Pull requests merged for 0.2.1++- Bump ormolu to 0.1.2.0+([#189](https://github.com/haskell/haskell-language-server/pull/189) by @AlistairB)+- Remove dependency on Cabal+([#195](https://github.com/haskell/haskell-language-server/pull/195) by @bubba)+- Fix extraneous extra-dep in stack-8.6.4.yaml+([#199](https://github.com/haskell/haskell-language-server/pull/199) by @bubba)+- Fix install script stack targets+([#203](https://github.com/haskell/haskell-language-server/pull/203) by @jneira)+- Add support for ghc-8.8.4+([#206](https://github.com/haskell/haskell-language-server/pull/206) by @jneira)+- Simple Eval plugin+([#191](https://github.com/haskell/haskell-language-server/pull/191) by @pepeiborra)+- Distributable binaries+([#165](https://github.com/haskell/haskell-language-server/pull/165) by @bubba)++## 0.2++- Use cabal-plan from Hackage+([#185](https://github.com/haskell/haskell-language-server/pull/185) by @georgefst)+- Bump ghcide to wz1000 hls-2 branch+([#184](https://github.com/haskell/haskell-language-server/pull/184) by @alanz)+- doc(preprocessor): Document the preprocessor limitation+([#177](https://github.com/haskell/haskell-language-server/pull/177) by @Sir4ur0n)+- Use shell.nix from Haskell-IDE-Engine+([#169](https://github.com/haskell/haskell-language-server/pull/169) by @fendor)+- Remove last occurrences of shake.yaml+([#163](https://github.com/haskell/haskell-language-server/pull/163) by @fendor)+- Use an unique install/stack.yaml+([#154](https://github.com/haskell/haskell-language-server/pull/154) by @jneira)+- Introduce golden testing+([#152](https://github.com/haskell/haskell-language-server/pull/152) by @Ailrun)+- Revert "Use bullet as separator instead of HR"+([#150](https://github.com/haskell/haskell-language-server/pull/150) by @alanz)+- feat(hie-bios): Multi-cradle, ignore directories+([#147](https://github.com/haskell/haskell-language-server/pull/147) by @Sir4ur0n)+- [Plugin] stylish-haskell formatter+([#146](https://github.com/haskell/haskell-language-server/pull/146) by @Ailrun)+- Separate ghcide tests and disable them for now+([#137](https://github.com/haskell/haskell-language-server/pull/137) by @jneira)+- Convert private lib in common stanza+([#136](https://github.com/haskell/haskell-language-server/pull/136) by @jneira)+- Add zlibc to readme+([#134](https://github.com/haskell/haskell-language-server/pull/134) by @Sir4ur0n)+- Complete editor integrations+([#132](https://github.com/haskell/haskell-language-server/pull/132) by @jneira)+- Remove inexistent component from hie.yaml.stack+([#131](https://github.com/haskell/haskell-language-server/pull/131) by @jneira)+- Bump to new mpickering/ghcide+([#130](https://github.com/haskell/haskell-language-server/pull/130) by @alanz)+- Update ghc-lib-parser version+([#129](https://github.com/haskell/haskell-language-server/pull/129) by @jneira)+- Remove redundant import+([#128](https://github.com/haskell/haskell-language-server/pull/128) by @bubba)+- Default the number of Shake threads to 0 (automatic)+([#127](https://github.com/haskell/haskell-language-server/pull/127) by @bubba)+- Added kakoune integration instructions+([#125](https://github.com/haskell/haskell-language-server/pull/125) by @414owen)+- Fix install script dev target+([#124](https://github.com/haskell/haskell-language-server/pull/124) by @jneira)+- Add plugin support for Rename providers+([#123](https://github.com/haskell/haskell-language-server/pull/123) by @pepeiborra)+- Add jobs for stack and cabal using ghc-8.10.1+([#120](https://github.com/haskell/haskell-language-server/pull/120) by @jneira)+- Add lower bound to tasty-ant-xml+([#119](https://github.com/haskell/haskell-language-server/pull/119) by @jneira)+- Fix build using brittany revision+([#117](https://github.com/haskell/haskell-language-server/pull/117) by @jneira)+- Use floskell released version 0.10.3+([#116](https://github.com/haskell/haskell-language-server/pull/116) by @jneira)+- Add emacs/doom-emacs integration sub-section+([#115](https://github.com/haskell/haskell-language-server/pull/115) by @yuanw)+- Port hie README partially+([#112](https://github.com/haskell/haskell-language-server/pull/112) by @jneira)+- Use cabal-helper-1.1, add stack-8.10.1.yaml and unify cabal.project's+([#108](https://github.com/haskell/haskell-language-server/pull/108) by @jneira)+- [#87] Fix completion via ghcide's `getCompletionsLSP`+([#107](https://github.com/haskell/haskell-language-server/pull/107) by @korayal)+- Create specific project file for ghc-8.10.+([#106](https://github.com/haskell/haskell-language-server/pull/106) by @jneira)+- Issue 5 - Move HIE Tests and convert to Tasty+([#105](https://github.com/haskell/haskell-language-server/pull/105) by @jeffwindsor)+- Hls update latest hie bios+([#100](https://github.com/haskell/haskell-language-server/pull/100) by @fendor)+- Update extra-deps to use latest fork version of shake+([#98](https://github.com/haskell/haskell-language-server/pull/98) by @fendor)+- Activate typechecking in non-lsp mode+([#95](https://github.com/haskell/haskell-language-server/pull/95) by @jneira)+- Fix haddock parsing errors+([#92](https://github.com/haskell/haskell-language-server/pull/92) by @jneira)+- Update for haskell-lsp 0.22+([#89](https://github.com/haskell/haskell-language-server/pull/89) by @alanz)+- Get building with ghc-8.10+([#83](https://github.com/haskell/haskell-language-server/pull/83) by @bubba)++## 0.1++### In this version++- cabal to 2020-05-02T10:11:15Z+- stack-8.8.3 to lts-15.10+- stack to nightly-2020-05-01++### Changes++This is the initial version, so too many to list individually.++The key point is that is now supports multi-component cradles, and has been in+daily use by the developers for some time.++It still does not have feature parity with `haskell-ide-engine`, but it is+currently useful.
+ LICENSE view
@@ -0,0 +1,201 @@+ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,749 @@+# haskell-language-server++[![License Apache 2.0][badge-license]][license]+[![CircleCI][badge-circleci]][circleci]++[badge-license]: https://img.shields.io/badge/license-Apache2-green.svg?dummy+[license]: https://github.com/haskell/haskell-language-server/blob/master/LICENSE+[badge-circleci]: https://img.shields.io/circleci/project/github/haskell/haskell-language-server/master.svg+[circleci]: https://circleci.com/gh/haskell/haskell-language-server/++Integration point for [ghcide](https://github.com/haskell/ghcide) and [haskell-ide-engine](https://github.com/haskell/haskell-ide-engine). One IDE to rule+them all. Read the [project's+background](https://neilmitchell.blogspot.com/2020/01/one-haskell-ide-to-rule-them-all.html).++- [Haskell Language Server (HLS)](#haskell-language-server)+ - [Features](#features)+ - [Installation](#installation)+ - [Prerequisites](#prerequisites)+ - [ghcup](#ghcup)+ - [Visual Studio Code](#visual-studio-code)+ - [Pre-built binaries](#pre-built-binaries)+ - [Installation from source](#installation-from-source)+ - [Common pre-requirements](#common-pre-requirements)+ - [Linux-specific pre-requirements](#linux-specific-pre-requirements)+ - [Windows-specific pre-requirements](#windows-specific-pre-requirements)+ - [Download the source code](#download-the-source-code)+ - [Building](#building)+ - [Install via cabal](#install-via-cabal)+ - [Install specific GHC Version](#install-specific-ghc-version)+ - [Installation from Hackage](#installation-from-hackage)+ - [Configuring haskell-language-server](#configuring-haskell-language-server)+ - [Configuring your project build](#configuring-your-project-build)+ - [Configuring your editor](#configuring-your-editor)+ - [VS Code](#using-haskell-language-server-with-vs-code)+ - [Sublime Text](#using-haskell-language-server-with-sublime-text)+ - [Vim or Neovim](#using-haskell-language-server-with-vim-or-neovim)+ - [Atom](#using-haskell-language-server-with-atom)+ - [Emacs](#using-haskell-language-server-with-emacs)+ - [Kakoune](#using-haskell-language-server-with-kakoune)+ - [Known limitations](#known-limitations)+ - [Preprocessor](#preprocessor)+ - [Troubleshooting](#troubleshooting)+ - [Contributing](#contributing)+ - [Building haskell-language-server](#building-haskell-language-server)+ - [Using Cabal](#using-cabal)+ - [Using Stack](#using-stack)+ - [Introduction tutorial](#instructions-tutorial)+ - [Test your hacked HLS in your editor](#test-your-hacked-hls-in-your-editor)++## Features++ - Code evaluation codelens (inspired by [Dante](https://github.com/jyp/dante#-reploid)). You can evaluate code by writing it in a comment of the form -- >>>++ ++- Type information and documentation on hover. Note that currently, in order for docs to be displayed for dependencies, they must have been built with GHC's `-haddock` flag:++ - For cabal:+ - Add to your global config file (e.g. `~/.cabal/config`):+ ```+ program-default-options+ ghc-options: -haddock+ ```+ - Or, for a single project, run `cabal configure --ghc-options=-haddock`++ - For stack, add to global `$STACK_ROOT\config.yaml`, or project's `stack.yaml`:+ ```+ ghc-options:+ "$everything": -haddock+ ```++ This will cause compilation errors if a dependency contains invalid Haddock markup, though from GHC version 9.0, [these will be demoted to warnings](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2377).++ - Integration with [retrie](https://hackage.haskell.org/package/retrie)++ ++ - Code lenses for explicit import lists++ ++ - Many more (TBD)++## Installation++### Prerequisites++- For standalone `.hs`/`.lhs` files, [ghc](https://www.haskell.org/ghc/) must be installed and on the PATH. The easiest way to install it is with [ghcup](https://www.haskell.org/ghcup/) or [Chocolatey](https://www.haskell.org/platform/windows.html) on Windows.+- For Cabal based projects, both ghc and [cabal-install](https://www.haskell.org/cabal/) must be installed and on the PATH. It can also be installed with [ghcup](https://www.haskell.org/ghcup/) or [Chocolatey](https://www.haskell.org/platform/windows.html) on Windows.+- For Stack based projects, [stack](http://haskellstack.org) must be installed and on the PATH.++### ghcup++If you are using [`ghcup`](https://www.haskell.org/ghcup/) to manage your installations, you can install the latest version of `haskell-language-server` with+```+ghcup install hls+```++### Visual Studio Code++If you are using Visual Studio Code, the [Haskell extension](https://marketplace.visualstudio.com/items?itemName=haskell.haskell) will automatically download and install `haskell-language-server` for you.++### Pre-built binaries++There are pre-built binaries available from the [releases page](https://github.com/haskell/haskell-language-server/releases) for Linux, Windows and macOS.+To install, download the `haskell-language-server-wrapper` executable for your platform as well as any `haskell-language-server` executables for the GHC versions you plan on working with, and either put them on your PATH or point your client to them.++### Installation from source++#### Common pre-requirements++- `stack` or `cabal` must be in your PATH+ - You need stack version >= 2.1.1 or cabal >= 2.4.0.0+- `git` must be in your PATH+- The directory where `stack`or `cabal` put the binaries must be in you PATH:+ - For stack you can get it with `stack path --local-bin`+ - For cabal it is by default `$HOME/.cabal/bin` in linux and `%APPDATA%\cabal\bin` in windows.++Tip: you can quickly check if some command is in your path by running the command.+If you receive some meaningful output instead of "command not found"-like message+then it means you have the command in PATH.++#### Linux-specific pre-requirements++On Linux you will need install a couple of extra libraries:+- [Unicode (ICU)](http://site.icu-project.org/)+- [NCURSES](https://www.gnu.org/software/ncurses/)+- [Zlib](https://zlib.net/)++**Debian 9/Ubuntu 18.04 or earlier**:++```bash+sudo apt install libicu-dev libtinfo-dev libgmp-dev zlib1g-dev+```++**Debian 10/Ubuntu 18.10 or later**:++```bash+sudo apt install libicu-dev libncurses-dev libgmp-dev zlib1g-dev+```++**Fedora**:++```bash+sudo dnf install libicu-devel ncurses-devel zlib-devel+```++#### Windows-specific pre-requirements++In order to avoid problems with long paths on Windows you can do either one of the following:++1. Clone the `haskell-language-server` to a short path, for example the root of your logical drive (e.g. to+ `C:\hls`). Even if you choose `C:\haskell-language-server` you could hit the problem. If this doesn't work or you want to use a longer path, try the second option.++2. If the `Local Group Policy Editor` is available on your system, go to: `Local Computer Policy -> Computer Configuration -> Administrative Templates -> System -> Filesystem` set `Enable Win32 long paths` to `Enabled`. If you don't have the policy editor you can use regedit by using the following instructions [here](https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file#enable-long-paths-in-windows-10-version-1607-and-later). You also need to configure git to allow longer paths by using unicode paths. To set this for all your git repositories use `git config --system core.longpaths true` (you probably need an administrative shell for this) or for just this one repository use `git config core.longpaths true`.++In addition make sure `haskell-language-server.exe` is not running by closing your editor, otherwise in case of an upgrade the executable can not be installed.++#### Download the source code++```bash+git clone https://github.com/haskell/haskell-language-server --recurse-submodules+cd haskell-language-server+```++#### Building++Note, on first invocation of the build script with stack, a GHC is being installed for execution.+The GHC used for the `install.hs` can be adjusted in `./install/stack.yaml` by using a different resolver.++Available commands can be seen with:++```bash+stack ./install.hs help+```++Remember, this will take time to download a Stackage-LTS and an appropriate GHC for build+haskell-language-server the first time.++##### Install via cabal++The install-script can be invoked via `cabal` instead of `stack` with the command++```bash+cabal v2-run ./install.hs --project-file install/shake.project <target>+```++or using the existing alias script++```bash+./cabal-hls-install <target>+```++Running the script with cabal on windows requires a cabal version greater or equal to `3.0.0.0`.++For brevity, only the `stack`-based commands are presented in the following sections.++##### Install specific GHC Version++The script will install the executables `haskell-language-server-wrapper` and `haskell-language-server`.++It will copy the latter appending the used ghc version, needed by the wrapper to choose the suitable version+for the project at hand.++So installing the executables directly with `stack install` or `cabal v2-install` may not be enough+for it to work properly.++Install haskell-language-server for the latest available and supported GHC version (and hoogle docs):++```bash+stack ./install.hs hls+```++Install haskell-language-server for a specific GHC version (and hoogle docs):++```bash+stack ./install.hs hls-8.8.3+```++`hls-8.8.3` target will build the project and install `haskell-language-server-wrapper`,+`haskell-language-server`, `haskell-language-server-8.8.3` and `haskell-language-server-8.8`+executables.++The Haskell Language Server can also be built with `cabal v2-build` instead of `stack build`.+This has the advantage that you can decide how the GHC versions have been installed.+To see what GHC versions are available, the command `cabal-hls-install ghcs` can be used.+It will list all *supported* GHC versions that are on the path for build with their respective installation directory.+If you think, this list is incomplete, you can try to modify the PATH variable, such that the executables can be found.+Note, that the targets `hls` and `data` depend on the found GHC versions.++An example output is:++```bash+> ./cabal-hls-install ghcs+******************************************************************+Found the following GHC paths:+ghc-8.6.5: /opt/bin/ghc-8.6.5+ghc-8.8.3: /opt/bin/ghc-8.8.3++******************************************************************+```++If your desired ghc has been found, you use it to install haskell-language-server.++```bash+./cabal-hls-install hls-8.6.5+```++### Installation from Hackage++Direct installation from Hackage, while possible via `cabal install haskell-language-server`, is not recommended for most people.+Said command builds the `haskell-language-server` binary and installs it in the default Cabal binaries folder,+but the binary will only work with projects that use the same GHC version that built it.++## Configuring `haskell-language-server`++Language servers like `haskell-language-server` expose most of their configuration via the client (i.e. the editor).+That means that the way in which you configure the settings will depend on the client.++Most clients (editors) already have an opinion about how settings should be configured!+For example, in VS Code you use the graphical Settings tab or `settings.json`, whereas in Emacs you use customization variables.+In the [editor configuration section](#configuring-your-editor) we give some pointers for popular editors, but you should consult the documentation for your specific editor if you have trouble.++However, we can say some high-level things about the kinds of configuration `haskell-language-server` uses, and how to use them.+This can sound a bit confusing, but ultimately the client should present you with these options in a user-friendly way that makes sense for that editor.++### Generic server options++The LSP protocol is designed to support many useful server configuration options generically.+These are sent to the server by the client, and can be controlled without reference to a specific language.++For example, there are protocol methods for highlighting matching identifiers throughout a document.+This is a capability which any server can implement, so the client can decide generically whether to ask the server to do it or not.+So your editor can provide a setting to turn this on or off globally, for any language server you might use.++Settings like this are typically provided by the generic LSP client support for your editor, for example in Emacs by `lsp-mode`.++### Generic editor options++Your editor may provide some settings that affect how the information from the language server is used.+For example, whether popups are shown, or whether code lenses appear by default.++Settings like this are typically provided by the generic LSP client support for your editor, for example in Emacs by `lsp-mode`.++### Language-specific server options++A specific language server can also have its own configuration options.+These are still sent to the server by the client, but they can only be controlled by a specific client that knows about those options.++For example, `haskell-language-server` allows you to choose the formatting provider which will be used for formatting Haskell source.+This option obviously would not make sense for language servers for other languages, or even for other Haskell language servers (which need not even support formatting).++Here is a list of the additional settings currently supported by `haskell-language-server`, along with their setting key (you may not need to know this) and default:+- Formatting provider (`haskell.formattingProvider`, default `ormolu`): what formatter to use; one of `floskell`, `ormolu`, `fourmolu`, `stylish-haskell`, or `brittany` (if compiled with AGPL)+- Format on imports (`haskell.formatOnImportOn`, default true): whether to format after adding an import+- Maximum number of problems to report (`haskell.maxNumberOfProblems`, default 100): the maximum number of problems the server will send to the client+- Diagnostics on change (`haskell.diagnosticsOnChange`, default true): (currently unused)+- Completion snippets (`haskell.completionSnippetsOn`, default true): whether to support completion snippets (currently unused until we have snippets to provide)+- Liquid Haskell (`haskell.liquidOn`, default false): whether to enable Liquid Haskell support (currently unused until the Liquid Haskell support is functional again)+- Hlint (`haskell.hlintOn`, default true): whether to enable Hlint support++Settings like this are typically provided by the language-specific LSP client support for your editor, for example in Emacs by `lsp-haskell`.++### Client options++A particular client might also have some options of its own, for example to control how the server executable is started.++Settings like this are typically be provided by the language-specific LSP client support for your editor, for example in Emacs by `lsp-haskell`.++## Configuring your project build++`haskell-language-server` has to compile your project in order to give you diagnostics, which means that it needs to know how to do so.+This is handled by the [`hie-bios`](https://github.com/mpickering/hie-bios) project.++**For a full explanation of how `hie-bios` determines the project build configuration, and how to configure it manually, refer to the [`hie-bios` README](https://github.com/mpickering/hie-bios/blob/master/README.md).**++At the moment, `haskell-language-server` has some limited support to automatically detect your project build configuration.+The plan is to improve it to handle most use cases.++However, for now, the most reliable way is to manually configure `hie-bios` using a `hie.yaml` file in the root of the workspace.+A `hie.yaml` file **explicitly** describes how to setup the environment to compile the various parts of your project.+For that you need to know what *components* your project has, and the path associated with each one.+So you will need some knowledge about+[stack](https://docs.haskellstack.org/en/stable/build_command/#components) or [cabal](https://cabal.readthedocs.io/en/latest/cabal-commands.html?#cabal-v2-build) components.++You also can use [this utility](https://github.com/Avi-D-coder/implicit-hie) to automatically generate `hie.yaml` files for+the most common stack and cabal configurations++For example, to state that you want to use `stack` then the configuration file+would look like:++```yaml+cradle:+ stack:+ component: "haskell-language-server:lib"+```++If you use `cabal` then you probably need to specify which component you want+to use.++```yaml+cradle:+ cabal:+ component: "lib:haskell-language-server"+```++If you have a project with multiple components, you can use a cabal-multi+cradle:++```yaml+cradle:+ cabal:+ - path: "./test/functional/"+ component: "haskell-language-server:func-test"+ - path: "./test/utils/"+ component: "haskell-language-server:hls-test-utils"+ - path: "./exe/Main.hs"+ component: "haskell-language-server:exe:haskell-language-server"+ - path: "./exe/Wrapper.hs"+ component: "haskell-language-server:exe:haskell-language-server-wrapper"+ - path: "./src"+ component: "lib:haskell-language-server"+ - path: "./ghcide/src"+ component: "ghcide:lib:ghcide"+ - path: "./ghcide/exe"+ component: "ghcide:exe:ghcide"+```++Equivalently, you can use stack:++```yaml+cradle:+ stack:+ - path: "./test/functional/"+ component: "haskell-language-server:func-test"+ - path: "./exe/Main.hs"+ component: "haskell-language-server:exe:haskell-language-server"+ - path: "./exe/Wrapper.hs"+ component: "haskell-language-server:exe:haskell-language-server-wrapper"+ - path: "./src"+ component: "haskell-language-server:lib"+ - path: "./ghcide/src"+ component: "ghcide:lib:ghcide"+ - path: "./ghcide/exe"+ component: "ghcide:exe:ghcide"+```++Or you can explicitly state the program which should be used to collect+the options by supplying the path to the program. It is interpreted+relative to the current working directory if it is not an absolute path.++```yaml+cradle:+ bios:+ program: ".hie-bios"+```++The complete configuration is a subset of++```yaml+cradle:+ cabal:+ component: "optional component name"+ stack:+ component: "optional component name"+ bios:+ program: "program to run"+ dependency-program: "optional program to run"+ direct:+ arguments: ["list","of","ghc","arguments"]+ default:+ none:++dependencies:+ - someDep+```++## Configuring your editor++Most editors provide a Haskell-specific extension that provides support for launching `haskell-language-server` and talking to it, as well as [exposing configuration options](#configuring-haskell-language-server).++Editors typically assume that you have already installed `haskell-language-server` (see above) and that the installation script put the `haskell-language-server` and `haskell-language-server-wrapper` binaries in your `PATH` (usually `~/.local/bin` or `~/.cabal/bin` on Linux and macOS, `%APPDATA%\local\bin` or `%APPDATA%\cabal\bin` on Windows).+The exception is VS Code, which can automatically install the binaries if they are not installed already.++### Using Haskell Language Server with VS Code++Install from+[the VSCode marketplace](https://marketplace.visualstudio.com/items?itemName=haskell.haskell), or manually from the repository [vscode-haskell](https://github.com/haskell/vscode-haskell).+The `haskell-language-server` and `haskell-language-server-wrapper` binaries will be automatically downloaded on an ad-hoc basis, but if you have them already installed on your PATH then it will just use them instead.++Configuration is done via the "Haskell" section of "Settings".++### Using Haskell Language Server with Sublime Text++- Install [LSP](https://packagecontrol.io/packages/LSP) using [Package Control](https://packagecontrol.io/)+- From Sublime Text, go to Preferences and search for LSP Settings+- Paste in these settings. Make sure to change the command path to your `haskell-language-server-wrapper`++```json+{+ "clients": {+ "haskell-language-server": {+ "command": ["haskell-language-server-wrapper", "--lsp"],+ "scopes": ["source.haskell"],+ "syntaxes": ["Packages/Haskell/Haskell.sublime-syntax"],+ "languageId": "haskell"+ }+ }+}+```++Now open a Haskell project with Sublime Text and enable Language Server in the project.+You should have these features available:++1. Errors are underlined in red+2. LSP: Show Diagnostics will show a list of hints and errors+3. LSP: Format Document will prettify the file++### Using Haskell Language Server with Vim or Neovim++You can use [Coc](https://github.com/neoclide/coc.nvim), [LanguageClient-neovim](https://github.com/autozimu/LanguageClient-neovim)+or any other Vim Language server protocol client.+Coc is recommend since it is the only complete LSP implementation for Vim and Neovim and offers snippets and floating documentation out of the box.++#### Coc++Follow Coc's [installation instructions](https://github.com/neoclide/coc.nvim).+Then issue `:CocConfig` and add the following to your Coc config file.++```json+{+ "languageserver": {+ "haskell": {+ "command": "haskell-language-server-wrapper",+ "args": ["--lsp"],+ "rootPatterns": ["*.cabal", "stack.yaml", "cabal.project", "package.yaml", "hie.yaml"],+ "filetypes": ["haskell", "lhaskell"]+ }+ }+}+```++#### LanguageClient-neovim++##### vim-plug++If you use [vim-plug](https://github.com/junegunn/vim-plug), then you can do this by e.g.,+including the following line in the Plug section of your `init.vim` or `~/.vimrc`:++```text+Plug 'autozimu/LanguageClient-neovim', {+ \ 'branch': 'next',+ \ 'do': 'bash install.sh'+ \ }+```++and issuing a `:PlugInstall` command within Neovim or Vim.++##### Clone the LanguageClient-neovim repo++As an alternative to using [vim-plug](https://github.com/junegunn/vim-plug) shown above, clone [LanguageClient-neovim](https://github.com/autozimu/LanguageClient-neovim)+into `~/.vim/pack/XXX/start/`, where `XXX` is just a name for your "plugin suite".++##### Configuration and sample `~/.vimrc` sections++```vim+set rtp+=~/.vim/pack/XXX/start/LanguageClient-neovim+let g:LanguageClient_serverCommands = { 'haskell': ['haskell-language-server-wrapper', '--lsp'] }+```++You'll probably want to add some mappings for common commands:++```vim+nnoremap <F5> :call LanguageClient_contextMenu()<CR>+map <Leader>lk :call LanguageClient#textDocument_hover()<CR>+map <Leader>lg :call LanguageClient#textDocument_definition()<CR>+map <Leader>lr :call LanguageClient#textDocument_rename()<CR>+map <Leader>lf :call LanguageClient#textDocument_formatting()<CR>+map <Leader>lb :call LanguageClient#textDocument_references()<CR>+map <Leader>la :call LanguageClient#textDocument_codeAction()<CR>+map <Leader>ls :call LanguageClient#textDocument_documentSymbol()<CR>+```++Use <kbd>Ctrl+x</kbd><kbd>Ctrl+o</kbd> (`<C-x><C-o>`) to open up the auto-complete menu,+or for asynchronous auto-completion, follow the setup instructions on+[LanguageClient](https://github.com/autozimu/LanguageClient-neovim).++If you'd like diagnostics to be highlighted, add a highlight group for `ALEError`/`ALEWarning`/`ALEInfo`,+or customize `g:LanguageClient_diagnosticsDisplay`:++```vim+hi link ALEError Error+hi Warning term=underline cterm=underline ctermfg=Yellow gui=undercurl guisp=Gold+hi link ALEWarning Warning+hi link ALEInfo SpellCap+```++If you're finding that the server isn't starting at the correct project root,+it may also be helpful to also specify root markers:++```vim+let g:LanguageClient_rootMarkers = ['*.cabal', 'stack.yaml']+```++Further configuration can be done by pointing the [`g:LanguageClient_settingsPath`](https://github.com/autozimu/LanguageClient-neovim/blob/0e5c9546bfddbaa2b01e5056389c25aefc8bf989/doc/LanguageClient.txt#L221)+variable to the file in which you want to keep your LSP settings.++### Using Haskell Language Server with Atom++Install the two Atom packages [atom-ide-ui](https://atom.io/packages/atom-ide-ui) and [haskell](https://atom.io/packages/haskell),++```bash+$ apm install language-haskell atom-ide-ui haskell+```++### Using haskell-language-server with Emacs++Emacs support is provided by a combination of the following packages:++[lsp-mode](https://github.com/emacs-lsp/lsp-mode)+[lsp-ui](https://github.com/emacs-lsp/lsp-ui)+[lsp-haskell](https://github.com/emacs-lsp/lsp-haskell)++You can install these manually if you are using plain Emacs; instructions for some specific flavours+are included below.++Make sure to check the READMEs of each of these packages, which explain how to configure the+various parts of the Emacs integration.+In particular, `lsp-haskell` provides customization options for the `haskell-language-server`-specific parts,+such as the path to the server executable.++#### Using haskell-language-server with [doom-emacs](https://github.com/hlissner/doom-emacs/tree/develop/modules/lang/haskell#module-flags)++Manual installation of packages is not required.+Enable the lsp module and the haskell lang module with lsp flag in `.doom.d/init.el`:++``` emacs-lisp+:tools+lsp+;; ...+:lang+(haskell +lsp)+```++then do `$HOME/.emacs.d/bin/doom sync`++#### Using haskell-language-server with [Spacemacs](https://github.com/syl20bnr/spacemacs)++Manual installation of packages is not required.+Enable the `haskell` layer and the `lsp` layer in your Spacemacs config file:++```emacs-lisp+dotspacemacs-configuration-layers+ '(+ haskell+ lsp+ ;; ...+ )+```++### Using haskell-language-server with [Kakoune](https://github.com/mawww/kakoune)++1. Grab a copy of [kak-lsp](https://github.com/ul/kak-lsp), and follow the setup instructions.+2. Point your `kak-lsp.toml` to `haskell-language-server-wrapper`.++```toml+[language.haskell]+filetypes = ["haskell"]+roots = ["Setup.hs", "stack.yaml", "*.cabal"]+command = "haskell-language-server-wrapper"+args = ["--lsp"]+```++## Known limitations++### Preprocessor+HLS is not yet able to find project preprocessors, which may result in `could not execute: <preprocessor>` errors. This problem is+tracked in https://github.com/haskell/haskell-language-server/issues/176 and originally comes from https://github.com/mpickering/hie-bios/issues/125++As a workaround, you need to ensure the preprocessor is available in the path (install globally with Stack or Cabal, provide in `shell.nix`, etc.).++Example with `tasty-discover`:+```haskell+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}+```+This returns an error in HLS if 'tasty-discover' is not in the path: `could not execute: tasty-discover`.++## Troubleshooting++### Common issues++#### Difficulties with Stack and `Paths_` modules++These are known to be somewhat buggy at the moment: https://github.com/haskell/haskell-language-server/issues/478.+This issue should be fixed in Stack versions >= 2.5.++### Troubleshooting the server++#### Diagnostic mode++The `haskell-language-server` executable can be run in diagnostic mode, where it will just try to load modules from your project, printing all of its output to stdout.+This makes it much easier to see what's going on and to diagnose build-related problems.++To do this, simply run the executable directly from your shell in the project root.+You can either run it without an argument, in which case it will load random modules, or with a path, in which case it will load modules in that file or directory.++#### Examining the log++Most clients will launch `haskell-language-server` with `--logfile` to make it write a log file.+Please consult the documentation for your client to find out where this is (or how to set it).++The log will contain all the messages that are sent to the server and its responses.+This is helpful for low-level debugging: if you expect a certain action to happen, you can look in the log to see if the corresponding messages are+sent, or if there are any errors.++To get a more verbose, also pass `--debug` to the executable.++### Troubleshooting the client++Many clients provide diagnostic information about a LSP session.+In particular, look for a way to get the status of the server, the server stderr, or a log of the messages that the client has sent to the server.+For example, `lsp-mode` provides all of these (see its [troubleshooting page](https://emacs-lsp.github.io/lsp-mode/page/troubleshooting/) for details).++The most common client-related problem is the client simply not finding the server executable, so make sure that you have the right `PATH` and you have configured+it to look for the right executable.++## Contributing++:heart: The Haskell tooling dream is near, we need your help! :heart:++- Join [our IRC channel](https://webchat.freenode.net/?channels=haskell-ide-engine) at `#haskell-ide-engine` on `freenode`.+- Fork this repo and [ghcide](https://github.com/haskell/ghcide) and hack as much as you can.++### Style guidelines++The project includes a [`.editorconfig`](https://editorconfig.org) [file](https://github.com/haskell/haskell-language-server/blob/master/.editorconfig) with the editor basic settings used by the project.+However, most editors will need some action to honour those settings automatically.+For example vscode needs to have installed a specific [extension](https://marketplace.visualstudio.com/items?itemName=EditorConfig.EditorConfig).+Please, try to follow those basic settings to keep the codebase as uniform as possible.++### Building haskell-language-server++The project can be built with both `cabal build` and `stack build`.++haskell-language-server can also be used with itself. We provide preset samples of `hie.yaml` for Cabal and Stack.++Note: the `./install/` folder is not directly tied to the project so it has dedicated `./install/hie.yaml.[cbl|stack]`+templates.++#### Using Cabal++```shell+$ cp hie-cabal.yaml hie.yaml+$ cp install/hie-cabal.yaml install/hie.yaml+```++#### Using Stack++```shell+$ cp hie-stack.yaml hie.yaml+$ cp install/hie-stack.yaml install/hie.yaml+$ cp ghcide/hie-stack.yaml ghcide/hie.yaml+$ stack build --test --no-run-tests+$ cd install+$ stack build+```++#### Using Nix++The instructions below show how to set up a Cachix binary cache and open a nix shell for local development.++```shell+$ cachix use haskell-language-server+$ nix-shell+$ cabal update+$ cabal build+```++If you are looking for a Nix expression to create haskell-language-server binaries, see https://github.com/haskell/haskell-language-server/issues/122++#### Introduction tutorial+Pepeiborra [wrote an tutorial](https://github.com/pepeiborra/hls-tutorial) on writing a plugin in HLS.++#### Test your hacked HLS in your editor+If you want to test HLS while hacking on it, follow the steps below.++To do once:+- Open some codebase on which you want to test your hacked HLS in your favorite editor+- Configure this editor to use your custom HLS executable+ - With Cabal:+ - On Unix systems: `cabal exec which haskell-language-server`+ - On Windows: `cabal exec where haskell-language-server`+ - With Stack: `$(stack path --dist-dir)/build/haskell-language-server/haskell-language-server`++To do every time you changed code and want to test it:+- Build HLS+ - With Cabal: `cabal build exe:haskell-language-server`+ - With Stack: `stack build haskell-language-server:exe:haskell-language-server`+- Restart HLS+ - With VS Code: `Haskell: Restart Haskell LSP Server`++### Adding support for a new editor++Adding support for new editors is fairly easy if the editor already has good support for generic LSP-based extensions.+In that case, there will likely be an editor-specific support system for this (like `lsp-mode` for Emacs).+This will typically provide instructions for how to support new languages.++In some cases you may need to write a small bit of additional client support, or expose a way for the user to set the server's [configuration options](#configuring-haskell-language-server) and+for them to configure how the server is started.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ exe/Main.hs view
@@ -0,0 +1,22 @@+-- Copyright (c) 2019 The DAML Authors. All rights reserved.+-- SPDX-License-Identifier: Apache-2.0+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Main(main) where++import Ide.Arguments (Arguments (..), LspArguments (..),+ getArguments)+import Ide.Main (defaultMain)+import Plugins+import Main.Utf8 (withUtf8)++main :: IO ()+main = withUtf8 $ do+ args <- getArguments "haskell-language-server"++ let withExamples =+ case args of+ LspMode (LspArguments{..}) -> argsExamplePlugin+ _ -> False++ defaultMain args (idePlugins withExamples)
+ exe/Plugins.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+module Plugins where++import Ide.Types (IdePlugins)+import Ide.PluginUtils (pluginDescToIdePlugins)++-- fixed plugins+import Ide.Plugin.Example as Example+import Ide.Plugin.Example2 as Example2+import Development.IDE (IdeState)+import Development.IDE.Plugin.HLS.GhcIde as GhcIde++-- haskell-language-server optional plugins++#if class+import Ide.Plugin.Class as Class+#endif++#if eval+import Ide.Plugin.Eval as Eval+#endif++#if importLens+import Ide.Plugin.ExplicitImports as ExplicitImports+#endif++#if retrie+import Ide.Plugin.Retrie as Retrie+#endif++#if tactic+import Ide.Plugin.Tactic as Tactic+#endif++#if hlint+import Ide.Plugin.Hlint as Hlint+#endif++#if moduleName+import Ide.Plugin.ModuleName as ModuleName+#endif++#if pragmas+import Ide.Plugin.Pragmas as Pragmas+#endif++-- formatters++#if floskell+import Ide.Plugin.Floskell as Floskell+#endif++#if fourmolu+import Ide.Plugin.Fourmolu as Fourmolu+#endif++#if ormolu+import Ide.Plugin.Ormolu as Ormolu+#endif++#if stylishHaskell+import Ide.Plugin.StylishHaskell as StylishHaskell+#endif++#if AGPL && brittany+import Ide.Plugin.Brittany as Brittany+#endif++-- ---------------------------------------------------------------------++-- | The plugins configured for use in this instance of the language+-- server.+-- These can be freely added or removed to tailor the available+-- features of the server.++idePlugins :: Bool -> IdePlugins IdeState+idePlugins includeExamples = pluginDescToIdePlugins allPlugins+ where+ allPlugins = if includeExamples+ then basePlugins ++ examplePlugins+ else basePlugins+ basePlugins =+ [ GhcIde.descriptor "ghcide"+#if pragmas+ , Pragmas.descriptor "pragmas"+#endif+#if floskell+ , Floskell.descriptor "floskell"+#endif+#if fourmolu+ , Fourmolu.descriptor "fourmolu"+#endif+#if tactic+ , Tactic.descriptor "tactic"+#endif+#if ormolu+ , Ormolu.descriptor "ormolu"+#endif+#if stylishHaskell+ , StylishHaskell.descriptor "stylish-haskell"+#endif+#if retrie+ , Retrie.descriptor "retrie"+#endif+#if AGPL && brittany+ , Brittany.descriptor "brittany"+#endif+#if class+ , Class.descriptor "class"+#endif+#if eval+ , Eval.descriptor "eval"+#endif+#if importLens+ , ExplicitImports.descriptor "importLens"+#endif+#if moduleName+ , ModuleName.descriptor "moduleName"+#endif+#if hlint+ , Hlint.descriptor "hlint"+#endif+ ]+ examplePlugins =+ [Example.descriptor "eg"+ ,Example2.descriptor "eg2"+ ]
+ exe/Wrapper.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE RecordWildCards #-}+-- | This module is based on the hie-wrapper.sh script in+-- https://github.com/alanz/vscode-hie-server+module Main where++import Control.Monad.Extra+import Data.Foldable+import Data.List+import Data.Void+import Development.IDE.Session (findCradle, defaultLoadingOptions)+import HIE.Bios hiding (findCradle)+import HIE.Bios.Environment+import HIE.Bios.Types+import Ide.Arguments+import Ide.Version+import System.Directory+import System.Environment+import System.Exit+import System.FilePath+import System.IO+import System.Info+import System.Process++-- ---------------------------------------------------------------------++main :: IO ()+main = do+ -- WARNING: If you write to stdout before runLanguageServer+ -- then the language server will not work+ args <- getArguments "haskell-language-server-wrapper"++ hlsVer <- haskellLanguageServerVersion+ case args of+ ProbeToolsMode -> do+ programsOfInterest <- findProgramVersions+ putStrLn hlsVer+ putStrLn "Tool versions found on the $PATH"+ putStrLn $ showProgramVersionOfInterest programsOfInterest++ VersionMode PrintVersion ->+ putStrLn hlsVer++ VersionMode PrintNumericVersion ->+ putStrLn haskellLanguageServerNumericVersion++ LspMode lspArgs ->+ launchHaskellLanguageServer lspArgs++launchHaskellLanguageServer :: LspArguments -> IO ()+launchHaskellLanguageServer LspArguments{..} = do+ whenJust argsCwd setCurrentDirectory++ d <- getCurrentDirectory++ -- Get the cabal directory from the cradle+ cradle <- findLocalCradle (d </> "a")+ setCurrentDirectory $ cradleRootDir cradle++ when argsProjectGhcVersion $ getRuntimeGhcVersion' cradle >>= putStrLn >> exitSuccess++ progName <- getProgName+ hPutStrLn stderr $ "Run entered for haskell-language-server-wrapper(" ++ progName ++ ") "+ ++ hlsVersion+ hPutStrLn stderr $ "Current directory: " ++ d+ hPutStrLn stderr $ "Operating system: " ++ os+ args <- getArgs+ hPutStrLn stderr $ "Arguments: " ++ show args+ hPutStrLn stderr $ "Cradle directory: " ++ cradleRootDir cradle+ hPutStrLn stderr $ "Cradle type: " ++ show (actionName (cradleOptsProg cradle))+ programsOfInterest <- findProgramVersions+ hPutStrLn stderr ""+ hPutStrLn stderr "Tool versions found on the $PATH"+ hPutStrLn stderr $ showProgramVersionOfInterest programsOfInterest+ hPutStrLn stderr ""+ -- Get the ghc version -- this might fail!+ hPutStrLn stderr $ "Consulting the cradle to get project GHC version..."+ ghcVersion <- getRuntimeGhcVersion' cradle+ hPutStrLn stderr $ "Project GHC version: " ++ ghcVersion++ let+ hlsBin = "haskell-language-server-" ++ ghcVersion+ backupHlsBin =+ case dropWhileEnd (/='.') ghcVersion of+ [] -> "haskell-language-server"+ xs -> "haskell-language-server-" ++ init xs+ candidates' = [hlsBin, backupHlsBin, "haskell-language-server"]+ candidates = map (++ exeExtension) candidates'++ hPutStrLn stderr $ "haskell-language-server exe candidates: " ++ show candidates++ mexes <- traverse findExecutable candidates++ case asum mexes of+ Nothing -> hPutStrLn stderr $ "Cannot find any haskell-language-server exe, looked for: " ++ intercalate ", " candidates+ Just e -> do+ hPutStrLn stderr $ "Launching haskell-language-server exe at:" ++ e+ callProcess e args++-- | Version of 'getRuntimeGhcVersion' that dies if we can't get it, and also+-- checks to see if the tool is missing if it is one of+getRuntimeGhcVersion' :: Show a => Cradle a -> IO String+getRuntimeGhcVersion' cradle = do++ -- See if the tool is installed+ case actionName (cradleOptsProg cradle) of+ Stack -> checkToolExists "stack"+ Cabal -> checkToolExists "cabal"+ Default -> checkToolExists "ghc"+ Direct -> checkToolExists "ghc"+ _ -> pure ()++ ghcVersionRes <- getRuntimeGhcVersion cradle+ case ghcVersionRes of+ CradleSuccess ver -> do+ return ver+ CradleFail error -> die $ "Failed to get project GHC version:" ++ show error+ CradleNone -> die "Failed get project GHC version, since we have a none cradle"+ where+ checkToolExists exe = do+ exists <- findExecutable exe+ case exists of+ Just _ -> pure ()+ Nothing ->+ die $ "Cradle requires " ++ exe ++ " but couldn't find it" ++ "\n"+ ++ show cradle++-- | Find the cradle that the given File belongs to.+--+-- First looks for a "hie.yaml" file in the directory of the file+-- or one of its parents. If this file is found, the cradle+-- is read from the config. If this config does not comply to the "hie.yaml"+-- specification, an error is raised.+--+-- If no "hie.yaml" can be found, the implicit config is used.+-- The implicit config uses different heuristics to determine the type+-- of the project that may or may not be accurate.+findLocalCradle :: FilePath -> IO (Cradle Void)+findLocalCradle fp = do+ cradleConf <- (findCradle defaultLoadingOptions) fp+ crdl <- case cradleConf of+ Just yaml -> do+ hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ fp ++ "\""+ loadCradle yaml+ Nothing -> loadImplicitCradle fp+ hPutStrLn stderr $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl+ return crdl+
+ haskell-language-server.cabal view
@@ -0,0 +1,444 @@+cabal-version: 2.2+category: Development+name: haskell-language-server+version: 0.8.0.0+synopsis: LSP server for GHC+description:+ Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>++homepage: https://github.com/haskell/haskell-language-server#readme+bug-reports: https://github.com/haskell/haskell-language-server/issues+author: The Haskell IDE Team+maintainer: alan.zimm@gmail.com+copyright: The Haskell IDE Team+license: Apache-2.0+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md+ include/ghc-api-version.h++flag agpl+ description: Enable AGPL dependencies+ default: True+ manual: True++flag pedantic+ description: Enable -Werror+ default: False+ manual: True++source-repository head+ type: git+ location: https://github.com/haskell/haskell-language-server++common agpl+ if flag(agpl)+ cpp-options: -DAGPL++common common-deps+ build-depends:+ , base >=4.12 && <5+ , directory+ , extra+ , filepath+ , text++library+ import: agpl, common-deps+ exposed-modules:+ Ide.Arguments+ Ide.Main+ Ide.Version++ other-modules: Paths_haskell_language_server+ autogen-modules: Paths_haskell_language_server+ hs-source-dirs: src+ build-depends:+ , containers+ , data-default+ , ghc+ , ghcide >=0.7+ , gitrev+ , haskell-lsp ^>=0.22+ , hls-plugin-api >=0.6+ , hslogger+ , optparse-applicative+ , optparse-simple+ , process+ , shake+ , unordered-containers++ ghc-options: -Wall -Wredundant-constraints -Wno-name-shadowing++ if flag(pedantic)+ ghc-options: -Werror++ default-language: Haskell2010++-- Plugin flags are designed for 'cabal install haskell-language-server':+-- - Packaged plugins should be manual:False+-- - Non packaged plugins and bulk flags should be manual:True+-- - Bulk flags should be default:False+-- - Individual flags should be default:True++flag all-plugins+ description: Enable all non formatter plugins+ default: False+ manual: True++flag all-formatters+ description: Enable all fomatters+ default: False+ manual: True++flag class+ description: Enable class plugin+ default: True+ manual: False++flag eval+ description: Enable eval plugin+ default: True+ manual: False++flag importLens+ description: Enable importLens plugin+ default: True+ manual: False++flag retrie+ description: Enable retrie plugin+ default: True+ manual: False++flag tactic+ description: Enable tactic plugin+ default: True+ manual: False++flag hlint+ description: Enable hlint plugin+ default: True+ manual: False++flag moduleName+ description: Enable moduleName plugin+ default: True+ manual: True++flag pragmas+ description: Enable pragmas plugin+ default: True+ manual: True++-- formatters++flag floskell+ description: Enable floskell plugin+ default: True+ manual: True++flag fourmolu+ description: Enable fourmolu plugin+ default: True+ manual: True++flag ormolu+ description: Enable ormolu plugin+ default: True+ manual: True++flag stylishHaskell+ description: Enable stylishHaskell plugin+ default: True+ manual: True++flag brittany+ description: Enable brittany plugin+ default: True+ manual: True++common example-plugins+ hs-source-dirs: plugins/default/src+ other-modules: Ide.Plugin.Example,+ Ide.Plugin.Example2++common class+ if flag(class) || flag(all-plugins)+ build-depends: hls-class-plugin+ cpp-options: -Dclass++common eval+ if flag(eval) || flag(all-plugins)+ build-depends: hls-eval-plugin+ cpp-options: -Deval++common importLens+ if flag(importLens) || flag(all-plugins)+ build-depends: hls-explicit-imports-plugin+ cpp-options: -DimportLens++common retrie+ if flag(retrie) || flag(all-plugins)+ build-depends: hls-retrie-plugin+ cpp-options: -Dretrie++common tactic+ if flag(tactic) || flag(all-plugins)+ build-depends: hls-tactics-plugin+ cpp-options: -Dtactic++common hlint+ if flag(hlint) || flag(all-plugins)+ build-depends: hls-hlint-plugin+ cpp-options: -Dhlint++common moduleName+ if flag(moduleName) || flag(all-plugins)+ hs-source-dirs: plugins/default/src+ other-modules: Ide.Plugin.ModuleName+ cpp-options: -DmoduleName++common pragmas+ if flag(pragmas) || flag(all-plugins)+ hs-source-dirs: plugins/default/src+ other-modules: Ide.Plugin.Pragmas+ cpp-options: -Dpragmas++-- formatters++common floskell+ if flag(floskell) || flag(all-formatters)+ hs-source-dirs: plugins/default/src+ other-modules: Ide.Plugin.Floskell+ build-depends: floskell ^>=0.10+ cpp-options: -Dfloskell++common fourmolu+ if flag(fourmolu) || flag(all-formatters)+ hs-source-dirs: plugins/default/src+ other-modules: Ide.Plugin.Fourmolu+ build-depends: fourmolu ^>=0.3+ cpp-options: -Dfourmolu++common ormolu+ if flag(ormolu) || flag(all-formatters)+ hs-source-dirs: plugins/default/src+ other-modules: Ide.Plugin.Ormolu+ build-depends: ormolu ^>=0.1.2+ cpp-options: -Dormolu++common stylishHaskell+ if flag(stylishHaskell) || flag(all-formatters)+ hs-source-dirs: plugins/default/src+ other-modules: Ide.Plugin.StylishHaskell+ build-depends: stylish-haskell ^>=0.12+ cpp-options: -DstylishHaskell++common brittany+ if (flag(brittany) || flag(all-formatters)) && flag(agpl)+ hs-source-dirs: plugins/default/src+ other-modules: Ide.Plugin.Brittany+ build-depends: brittany >= 0.13.1.0+ cpp-options: -Dbrittany++executable haskell-language-server+ import: agpl+ , common-deps+ -- plugins+ , example-plugins+ , class+ , eval+ , importLens+ , retrie+ , tactic+ , hlint+ , moduleName+ , pragmas+ , floskell+ , fourmolu+ , ormolu+ , stylishHaskell+ , brittany++ main-is: Main.hs+ hs-source-dirs: exe+ other-modules: Plugins++ ghc-options:+ -threaded -Wall -Wno-name-shadowing -Wredundant-constraints+ -- allow user RTS overrides+ -rtsopts+ -- disable idle GC+ -- disable parallel GC+ -- increase nursery size+ "-with-rtsopts=-I0 -qg -A128M"+ if flag(pedantic)+ ghc-options: -Werror++ build-depends:+ , aeson+ , binary+ , bytestring+ , containers+ , deepseq+ , ghc+ , ghc-boot-th+ , ghcide+ , hashable+ , haskell-language-server+ , haskell-lsp ^>=0.22+ , lens+ , regex-tdfa+ , hslogger+ , optparse-applicative+ , hls-plugin-api+ , lens+ , mtl+ , regex-tdfa+ , safe-exceptions+ , shake >=0.17.5+ , temporary+ , transformers+ , unordered-containers+ , with-utf8++ include-dirs: include+ default-language: Haskell2010++executable haskell-language-server-wrapper+ import: agpl, common-deps+ main-is: Wrapper.hs+ hs-source-dirs: exe+ other-modules: Paths_haskell_language_server+ autogen-modules: Paths_haskell_language_server+ ghc-options:+ -threaded -Wall -Wno-name-shadowing -Wredundant-constraints+ -- allow user RTS overrides+ -rtsopts+ -- disable idle GC+ -- disable parallel GC+ -- increase nursery size+ "-with-rtsopts=-I0 -qg -A128M"+ if flag(pedantic)+ ghc-options: -Werror++ build-depends:+ , ghc+ , ghc-paths+ , ghcide+ , gitrev+ , haskell-language-server+ , hie-bios+ , optparse-applicative+ , optparse-simple+ , process++ default-language: Haskell2010++-- This common stanza simulates a previous private lib+-- We removed it due to issues with stack when loading the project using a stack based hie.yaml+-- See https://github.com/haskell/haskell-language-server/issues/114+common hls-test-utils+ import: agpl, common-deps+ hs-source-dirs: test/utils+ other-modules: Test.Hls.Util+ build-depends:+ , aeson+ , blaze-markup+ , containers+ , data-default+ , haskell-lsp+ , hie-bios+ , hls-plugin-api >=0.6+ , hslogger+ , hspec+ , hspec-core+ , lens+ , lsp-test >=0.11.0.6+ , stm+ , tasty-expected-failure+ , tasty-hunit+ , temporary+ , transformers+ , unordered-containers+ , yaml++ ghc-options: -Wall -Wredundant-constraints++ if flag(pedantic)+ ghc-options: -Werror++ default-language: Haskell2010++test-suite func-test+ import: agpl, common-deps, hls-test-utils+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ build-tool-depends:+ haskell-language-server:haskell-language-server -any,+ ghcide:ghcide-test-preprocessor -any++ build-depends:+ , bytestring+ , data-default+ , hspec-expectations+ , lens+ , tasty+ , tasty-ant-xml >=1.1.6+ , tasty-golden+ , tasty-rerun++ hs-source-dirs: test/functional plugins/tactics/src plugins/hls-eval-plugin/test++ main-is: Main.hs+ other-modules:+ Class+ Command+ Completion+ Config+ Deferred+ Definition+ Diagnostic+ Eval+ Format+ FunctionalBadProject+ FunctionalCodeAction+ FunctionalLiquid+ HieBios+ Highlight+ ModuleName+ Progress+ Reference+ Rename+ Symbol+ TypeDefinition+ Tactic+ Ide.Plugin.Tactic.TestTypes++ ghc-options:+ -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N++ if flag(pedantic)+ ghc-options: -Werror -Wredundant-constraints++test-suite wrapper-test+ import: agpl, hls-test-utils+ type: exitcode-stdio-1.0+ build-tool-depends:+ haskell-language-server:haskell-language-server-wrapper -any++ default-language: Haskell2010+ build-depends:+ , base+ , directory+ , process+ , tasty+ , tasty-ant-xml >=1.1.6+ , tasty-rerun++ hs-source-dirs: test/wrapper+ main-is: Main.hs+ ghc-options: -Wall
+ include/ghc-api-version.h view
@@ -0,0 +1,10 @@+#ifndef GHC_API_VERSION_H+#define GHC_API_VERSION_H++#ifdef GHC_LIB+#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc_lib(x,y,z)+#else+#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc(x,y,z)+#endif++#endif
+ plugins/default/src/Ide/Plugin/Brittany.hs view
@@ -0,0 +1,99 @@+module Ide.Plugin.Brittany where++import Control.Lens+import Control.Monad.IO.Class+import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)+import Data.Coerce+import Data.Semigroup+import Data.Text (Text)+import qualified Data.Text as T+import Development.IDE+-- import Development.IDE.Plugin.Formatter+import Language.Haskell.Brittany+import Language.Haskell.LSP.Types as J+import qualified Language.Haskell.LSP.Types.Lens as J+import Ide.PluginUtils+import Ide.Types++import System.FilePath+import Data.Maybe (maybeToList)++descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId = (defaultPluginDescriptor plId)+ { pluginFormattingProvider = Just provider+ }++-- | Formatter provider of Brittany.+-- Formats the given source in either a given Range or the whole Document.+-- If the provider fails an error is returned that can be displayed to the user.+provider+ :: FormattingProvider IdeState IO+provider _lf _ideState typ contents fp opts = do+-- text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do+ confFile <- liftIO $ getConfFile fp+ let (range, selectedContents) = case typ of+ FormatText -> (fullRange contents, contents)+ FormatRange r -> (normalize r, extractRange r contents)++ res <- formatText confFile opts selectedContents+ case res of+ Left err -> return $ Left $ responseError (T.pack $ "brittanyCmd: " ++ unlines (map showErr err))+ Right newText -> return $ Right $ J.List [TextEdit range newText]++-- | Primitive to format text with the given option.+-- May not throw exceptions but return a Left value.+-- Errors may be presented to the user.+formatText+ :: MonadIO m+ => Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.+ -> FormattingOptions -- ^ Options for the formatter such as indentation.+ -> Text -- ^ Text to format+ -> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany.+formatText confFile opts text =+ liftIO $ runBrittany tabSize confFile text+ where tabSize = opts ^. J.tabSize++-- | Recursively search in every directory of the given filepath for brittany.yaml.+-- If no such file has been found, return Nothing.+getConfFile :: NormalizedFilePath -> IO (Maybe FilePath)+getConfFile = findLocalConfigPath . takeDirectory . fromNormalizedFilePath++-- | Run Brittany on the given text with the given tab size and+-- a configuration path. If no configuration path is given, a+-- default configuration is chosen. The configuration may overwrite+-- tab size parameter.+--+-- Returns either a list of Brittany Errors or the reformatted text.+-- May not throw an exception.+runBrittany :: Int -- ^ tab size+ -> Maybe FilePath -- ^ local config file+ -> Text -- ^ text to format+ -> IO (Either [BrittanyError] Text)+runBrittany tabSize confPath text = do+ let cfg = mempty+ { _conf_layout =+ mempty { _lconfig_indentAmount = opt (coerce tabSize)+ }+ , _conf_forward =+ (mempty :: CForwardOptions Option)+ { _options_ghc = opt (runIdentity ( _options_ghc forwardOptionsSyntaxExtsEnabled))+ }+ }++ config <- fromMaybeT (pure staticDefaultConfig) (readConfigsWithUserConfig cfg (maybeToList confPath))+ parsePrintModule config text++fromMaybeT :: Monad m => m a -> MaybeT m a -> m a+fromMaybeT def act = runMaybeT act >>= maybe def return++opt :: a -> Option a+opt = Option . Just++showErr :: BrittanyError -> String+showErr (ErrorInput s) = s+showErr (ErrorMacroConfig err input)+ = "Error: parse error in inline configuration: " ++ err ++ " in the string \"" ++ input ++ "\"."+showErr (ErrorUnusedComment s) = s+showErr (LayoutWarning s) = s+showErr (ErrorUnknownNode s _) = s+showErr ErrorOutputCheck = "Brittany error - invalid output"
+ plugins/default/src/Ide/Plugin/Example.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++module Ide.Plugin.Example+ (+ descriptor+ ) where++import Control.DeepSeq ( NFData )+import Control.Monad.Trans.Maybe+import Data.Aeson+import Data.Binary+import Data.Functor+import qualified Data.HashMap.Strict as Map+import Data.Hashable+import qualified Data.Text as T+import Data.Typeable+import Development.IDE as D+import Development.IDE.GHC.Compat (ParsedModule(ParsedModule))+import Development.IDE.Core.Rules (useE)+import Development.IDE.Core.Shake (getDiagnostics, getHiddenDiagnostics)+import GHC.Generics+import Ide.PluginUtils+import Ide.Types+import Language.Haskell.LSP.Types+import Text.Regex.TDFA.Text()++-- ---------------------------------------------------------------------++descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId = (defaultPluginDescriptor plId)+ { pluginRules = exampleRules+ , pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd]+ , pluginCodeActionProvider = Just codeAction+ , pluginCodeLensProvider = Just codeLens+ , pluginHoverProvider = Just hover+ , pluginSymbolsProvider = Just symbols+ , pluginCompletionProvider = Just completion+ }++-- ---------------------------------------------------------------------++hover :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))+hover = request "Hover" blah (Right Nothing) foundHover++blah :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.Text]))+blah _ (Position line col)+ = return $ Just (Just (Range (Position line col) (Position (line+1) 0)), ["example hover 1\n"])++-- ---------------------------------------------------------------------+-- Generating Diagnostics via rules+-- ---------------------------------------------------------------------++data Example = Example+ deriving (Eq, Show, Typeable, Generic)+instance Hashable Example+instance NFData Example+instance Binary Example++type instance RuleResult Example = ()++exampleRules :: Rules ()+exampleRules = do+ define $ \Example file -> do+ _pm <- getParsedModule file+ let diag = mkDiag file "example" DsError (Range (Position 0 0) (Position 1 0)) "example diagnostic, hello world"+ return ([diag], Just ())++ action $ do+ files <- getFilesOfInterest+ void $ uses Example $ Map.keys files++mkDiag :: NormalizedFilePath+ -> DiagnosticSource+ -> DiagnosticSeverity+ -> Range+ -> T.Text+ -> FileDiagnostic+mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)+ Diagnostic+ { _range = loc+ , _severity = Just sev+ , _source = Just diagSource+ , _message = msg+ , _code = Nothing+ , _tags = Nothing+ , _relatedInformation = Nothing+ }++-- ---------------------------------------------------------------------+-- code actions+-- ---------------------------------------------------------------------++-- | Generate code actions.+codeAction :: CodeActionProvider IdeState+codeAction _lf state _pid (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs} = do+ let Just nfp = uriToNormalizedFilePath $ toNormalizedUri uri+ Just (ParsedModule{},_) <- runIdeAction "example" (shakeExtras state) $ useWithStaleFast GetParsedModule nfp+ let+ title = "Add TODO Item 1"+ tedit = [TextEdit (Range (Position 2 0) (Position 2 0))+ "-- TODO1 added by Example Plugin directly\n"]+ edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing+ pure $ Right $ List+ [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) (Just edit) Nothing ]++-- ---------------------------------------------------------------------++codeLens :: CodeLensProvider IdeState+codeLens _lf ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do+ logInfo (ideLogger ideState) "Example.codeLens entered (ideLogger)" -- AZ+ case uriToFilePath' uri of+ Just (toNormalizedFilePath -> filePath) -> do+ _ <- runIdeAction "Example.codeLens" (shakeExtras ideState) $ runMaybeT $ useE TypeCheck filePath+ _diag <- getDiagnostics ideState+ _hDiag <- getHiddenDiagnostics ideState+ let+ title = "Add TODO Item via Code Lens"+ -- tedit = [TextEdit (Range (Position 3 0) (Position 3 0))+ -- "-- TODO added by Example Plugin via code lens action\n"]+ -- edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing+ range = Range (Position 3 0) (Position 4 0)+ let cmdParams = AddTodoParams uri "do abc"+ cmd <- mkLspCommand plId "codelens.todo" title (Just [(toJSON cmdParams)])+ pure $ Right $ List [ CodeLens range (Just cmd) Nothing ]+ Nothing -> pure $ Right $ List []++-- ---------------------------------------------------------------------+-- | Parameters for the addTodo PluginCommand.+data AddTodoParams = AddTodoParams+ { file :: Uri -- ^ Uri of the file to add the pragma to+ , todoText :: T.Text+ }+ deriving (Show, Eq, Generic, ToJSON, FromJSON)++addTodoCmd :: CommandFunction IdeState AddTodoParams+addTodoCmd _lf _ide (AddTodoParams uri todoText) = do+ let+ pos = Position 3 0+ textEdits = List+ [TextEdit (Range pos pos)+ ("-- TODO:" <> todoText <> "\n")+ ]+ res = WorkspaceEdit+ (Just $ Map.singleton uri textEdits)+ Nothing+ return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res))++-- ---------------------------------------------------------------------++foundHover :: (Maybe Range, [T.Text]) -> Either ResponseError (Maybe Hover)+foundHover (mbRange, contents) =+ Right $ Just $ Hover (HoverContents $ MarkupContent MkMarkdown+ $ T.intercalate sectionSeparator contents) mbRange+++-- | Respond to and log a hover or go-to-definition request+request+ :: T.Text+ -> (NormalizedFilePath -> Position -> Action (Maybe a))+ -> Either ResponseError b+ -> (a -> Either ResponseError b)+ -> IdeState+ -> TextDocumentPositionParams+ -> IO (Either ResponseError b)+request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos _) = do+ mbResult <- case uriToFilePath' uri of+ Just path -> logAndRunRequest label getResults ide pos path+ Nothing -> pure Nothing+ pure $ maybe notFound found mbResult++logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> Action b)+ -> IdeState -> Position -> String -> IO b+logAndRunRequest label getResults ide pos path = do+ let filePath = toNormalizedFilePath path+ logInfo (ideLogger ide) $+ label <> " request at position " <> T.pack (showPosition pos) <>+ " in file: " <> T.pack path+ runAction "Example" ide $ getResults filePath pos++-- ---------------------------------------------------------------------++symbols :: SymbolsProvider IdeState+symbols _lf _ide (DocumentSymbolParams _doc _mt)+ = pure $ Right [r]+ where+ r = DocumentSymbol name detail kind deprecation range selR chList+ name = "Example_symbol_name"+ detail = Nothing+ kind = SkVariable+ deprecation = Nothing+ range = Range (Position 2 0) (Position 2 5)+ selR = range+ chList = Nothing++-- ---------------------------------------------------------------------++completion :: CompletionProvider IdeState+completion _lf _ide (CompletionParams _doc _pos _mctxt _mt)+ = pure $ Right $ Completions $ List [r]+ where+ r = CompletionItem label kind tags detail documentation deprecated preselect+ sortText filterText insertText insertTextFormat+ textEdit additionalTextEdits commitCharacters+ command xd+ label = "Example completion"+ kind = Nothing+ tags = List []+ detail = Nothing+ documentation = Nothing+ deprecated = Nothing+ preselect = Nothing+ sortText = Nothing+ filterText = Nothing+ insertText = Nothing+ insertTextFormat = Nothing+ textEdit = Nothing+ additionalTextEdits = Nothing+ commitCharacters = Nothing+ command = Nothing+ xd = Nothing++-- ---------------------------------------------------------------------
+ plugins/default/src/Ide/Plugin/Example2.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++module Ide.Plugin.Example2+ (+ descriptor+ ) where++import Control.DeepSeq (NFData)+import Control.Monad.Trans.Maybe+import Data.Aeson+import Data.Binary+import Data.Functor+import qualified Data.HashMap.Strict as Map+import Data.Hashable+import qualified Data.Text as T+import Data.Typeable+import Development.IDE as D+import Development.IDE.Core.Rules+import Development.IDE.Core.Shake+import GHC.Generics+import Ide.PluginUtils+import Ide.Types+import Language.Haskell.LSP.Types+import Text.Regex.TDFA.Text()++-- ---------------------------------------------------------------------++descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId = (defaultPluginDescriptor plId)+ { pluginRules = exampleRules+ , pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd]+ , pluginCodeActionProvider = Just codeAction+ , pluginCodeLensProvider = Just codeLens+ , pluginHoverProvider = Just hover+ , pluginSymbolsProvider = Just symbols+ , pluginCompletionProvider = Just completion+ }++-- ---------------------------------------------------------------------++hover :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))+hover = request "Hover" blah (Right Nothing) foundHover++blah :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.Text]))+blah _ (Position line col)+ = return $ Just (Just (Range (Position line col) (Position (line+1) 0)), ["example hover 2\n"])++-- ---------------------------------------------------------------------+-- Generating Diagnostics via rules+-- ---------------------------------------------------------------------++data Example2 = Example2+ deriving (Eq, Show, Typeable, Generic)+instance Hashable Example2+instance NFData Example2+instance Binary Example2++type instance RuleResult Example2 = ()++exampleRules :: Rules ()+exampleRules = do+ define $ \Example2 file -> do+ _pm <- getParsedModule file+ let diag = mkDiag file "example2" DsError (Range (Position 0 0) (Position 1 0)) "example2 diagnostic, hello world"+ return ([diag], Just ())++ action $ do+ files <- getFilesOfInterest+ void $ uses Example2 $ Map.keys files++mkDiag :: NormalizedFilePath+ -> DiagnosticSource+ -> DiagnosticSeverity+ -> Range+ -> T.Text+ -> FileDiagnostic+mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)+ Diagnostic+ { _range = loc+ , _severity = Just sev+ , _source = Just diagSource+ , _message = msg+ , _code = Nothing+ , _tags = Nothing+ , _relatedInformation = Nothing+ }++-- ---------------------------------------------------------------------+-- code actions+-- ---------------------------------------------------------------------++-- | Generate code actions.+codeAction :: CodeActionProvider IdeState+codeAction _lf _state _pid (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs} = do+ let+ title = "Add TODO2 Item"+ tedit = [TextEdit (Range (Position 3 0) (Position 3 0))+ "-- TODO2 added by Example2 Plugin directly\n"]+ edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing+ pure $ Right $ List+ [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) (Just edit) Nothing ]++-- ---------------------------------------------------------------------++codeLens :: CodeLensProvider IdeState+codeLens _lf ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do+ logInfo (ideLogger ideState) "Example2.codeLens entered (ideLogger)" -- AZ+ case uriToFilePath' uri of+ Just (toNormalizedFilePath -> filePath) -> do+ _ <- runIdeAction (fromNormalizedFilePath filePath) (shakeExtras ideState) $ runMaybeT $ useE TypeCheck filePath+ _diag <- getDiagnostics ideState+ _hDiag <- getHiddenDiagnostics ideState+ let+ title = "Add TODO2 Item via Code Lens"+ range = Range (Position 3 0) (Position 4 0)+ let cmdParams = AddTodoParams uri "do abc"+ cmd <- mkLspCommand plId "codelens.todo" title (Just [toJSON cmdParams])+ pure $ Right $ List [ CodeLens range (Just cmd) Nothing ]+ Nothing -> pure $ Right $ List []++-- ---------------------------------------------------------------------+-- | Parameters for the addTodo PluginCommand.+data AddTodoParams = AddTodoParams+ { file :: Uri -- ^ Uri of the file to add the pragma to+ , todoText :: T.Text+ }+ deriving (Show, Eq, Generic, ToJSON, FromJSON)++addTodoCmd :: CommandFunction IdeState AddTodoParams+addTodoCmd _lf _ide (AddTodoParams uri todoText) = do+ let+ pos = Position 5 0+ textEdits = List+ [TextEdit (Range pos pos)+ ("-- TODO2:" <> todoText <> "\n")+ ]+ res = WorkspaceEdit+ (Just $ Map.singleton uri textEdits)+ Nothing+ return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res))++-- ---------------------------------------------------------------------++foundHover :: (Maybe Range, [T.Text]) -> Either ResponseError (Maybe Hover)+foundHover (mbRange, contents) =+ Right $ Just $ Hover (HoverContents $ MarkupContent MkMarkdown+ $ T.intercalate sectionSeparator contents) mbRange+++-- | Respond to and log a hover or go-to-definition request+request+ :: T.Text+ -> (NormalizedFilePath -> Position -> Action (Maybe a))+ -> Either ResponseError b+ -> (a -> Either ResponseError b)+ -> IdeState+ -> TextDocumentPositionParams+ -> IO (Either ResponseError b)+request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos _) = do+ mbResult <- case uriToFilePath' uri of+ Just path -> logAndRunRequest label getResults ide pos path+ Nothing -> pure Nothing+ pure $ maybe notFound found mbResult++logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> Action b)+ -> IdeState -> Position -> String -> IO b+logAndRunRequest label getResults ide pos path = do+ let filePath = toNormalizedFilePath path+ logInfo (ideLogger ide) $+ label <> " request at position " <> T.pack (showPosition pos) <>+ " in file: " <> T.pack path+ runAction "Example2" ide $ getResults filePath pos++-- ---------------------------------------------------------------------++symbols :: SymbolsProvider IdeState+symbols _lf _ide (DocumentSymbolParams _doc _mt)+ = pure $ Right [r]+ where+ r = DocumentSymbol name detail kind deprecation range selR chList+ name = "Example2_symbol_name"+ detail = Nothing+ kind = SkVariable+ deprecation = Nothing+ range = Range (Position 4 1) (Position 4 7)+ selR = range+ chList = Nothing++-- ---------------------------------------------------------------------++completion :: CompletionProvider IdeState+completion _lf _ide (CompletionParams _doc _pos _mctxt _mt)+ = pure $ Right $ Completions $ List [r]+ where+ r = CompletionItem label kind tags detail documentation deprecated preselect+ sortText filterText insertText insertTextFormat+ textEdit additionalTextEdits commitCharacters+ command xd+ label = "Example2 completion"+ kind = Nothing+ tags = List []+ detail = Nothing+ documentation = Nothing+ deprecated = Nothing+ preselect = Nothing+ sortText = Nothing+ filterText = Nothing+ insertText = Nothing+ insertTextFormat = Nothing+ textEdit = Nothing+ additionalTextEdits = Nothing+ commitCharacters = Nothing+ command = Nothing+ xd = Nothing++-- ---------------------------------------------------------------------
+ plugins/default/src/Ide/Plugin/Floskell.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++module Ide.Plugin.Floskell+ (+ descriptor+ , provider+ )+where++import qualified Data.ByteString.Lazy as BS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Development.IDE as D+import Floskell+import Ide.PluginUtils+import Ide.Types+import Language.Haskell.LSP.Types+import Text.Regex.TDFA.Text()++-- ---------------------------------------------------------------------++descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId = (defaultPluginDescriptor plId)+ { pluginFormattingProvider = Just provider+ }++-- ---------------------------------------------------------------------++-- | Format provider of Floskell.+-- Formats the given source in either a given Range or the whole Document.+-- If the provider fails an error is returned that can be displayed to the user.+provider :: FormattingProvider IdeState IO+provider _lf _ideState typ contents fp _ = do+ let file = fromNormalizedFilePath fp+ config <- findConfigOrDefault file+ let (range, selectedContents) = case typ of+ FormatText -> (fullRange contents, contents)+ FormatRange r -> (r, extractRange r contents)+ result = reformat config (Just file) (BS.fromStrict (T.encodeUtf8 selectedContents))+ case result of+ Left err -> return $ Left $ responseError (T.pack $ "floskellCmd: " ++ err)+ Right new -> return $ Right $ List [TextEdit range (T.decodeUtf8 (BS.toStrict new))]++-- | Find Floskell Config, user and system wide or provides a default style.+-- Every directory of the filepath will be searched to find a user configuration.+-- Also looks into places such as XDG_CONFIG_DIRECTORY<https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html>.+-- This function may not throw an exception and returns a default config.+findConfigOrDefault :: FilePath -> IO AppConfig+findConfigOrDefault file = do+ mbConf <- findAppConfigIn file+ case mbConf of+ Just confFile -> readAppConfig confFile+ Nothing ->+ let gibiansky = head (filter (\s -> styleName s == "gibiansky") styles)+ in return $ defaultAppConfig { appStyle = gibiansky }++-- ---------------------------------------------------------------------
+ plugins/default/src/Ide/Plugin/Fourmolu.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++module Ide.Plugin.Fourmolu (+ descriptor,+ provider,+) where++import Control.Exception+import Data.Either.Extra+import System.FilePath++import Control.Lens ((^.))+import qualified Data.Text as T+import Development.IDE as D+import qualified DynFlags as D+import qualified EnumSet as S+import GHC (DynFlags, moduleNameString)+import GHC.LanguageExtensions.Type (Extension (Cpp))+import GhcPlugins (HscEnv (hsc_dflags))+import Ide.PluginUtils (responseError, makeDiffTextEdit)+import Language.Haskell.LSP.Messages (FromServerMessage (ReqShowMessage))++import Ide.Types+import Language.Haskell.LSP.Core+import Language.Haskell.LSP.Types+import Language.Haskell.LSP.Types.Lens+import "fourmolu" Ormolu++-- ---------------------------------------------------------------------++descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId =+ (defaultPluginDescriptor plId)+ { pluginFormattingProvider = Just provider+ }++-- ---------------------------------------------------------------------++provider :: FormattingProvider IdeState IO+provider lf ideState typ contents fp fo = withIndefiniteProgress lf title Cancellable $ do+ ghc <- runAction "Fourmolu" ideState $ use GhcSession fp+ fileOpts <- case hsc_dflags . hscEnv <$> ghc of+ Nothing -> return []+ Just df -> convertDynFlags df++ let format printerOpts =+ mapLeft (responseError . ("Fourmolu: " <>) . T.pack . show)+ <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents))+ where+ config =+ defaultConfig+ { cfgDynOptions = fileOpts+ , cfgRegion = region+ , cfgDebug = True+ , cfgPrinterOpts =+ fillMissingPrinterOpts+ (printerOpts <> lspPrinterOpts)+ defaultPrinterOpts+ }++ loadConfigFile fp' >>= \case+ ConfigLoaded file opts -> do+ putStrLn $ "Loaded Fourmolu config from: " <> file+ format opts+ ConfigNotFound searchDirs -> do+ putStrLn+ . unlines+ $ ("No " ++ show configFileName ++ " found in any of:") :+ map (" " ++) searchDirs+ format mempty+ ConfigParseError f (_, err) -> do+ sendFunc lf . ReqShowMessage $+ RequestMessage+ { _jsonrpc = ""+ , _id = IdString "fourmolu"+ , _method = WindowShowMessageRequest+ , _params =+ ShowMessageRequestParams+ { _xtype = MtError+ , _message = errorMessage+ , _actions = Nothing+ }+ }+ return . Left $ responseError errorMessage+ where+ errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err+ where+ fp' = fromNormalizedFilePath fp+ title = "Formatting " <> T.pack (takeFileName fp')+ lspPrinterOpts = mempty{poIndentation = Just $ fo ^. tabSize}+ region = case typ of+ FormatText ->+ RegionIndices Nothing Nothing+ FormatRange (Range (Position sl _) (Position el _)) ->+ RegionIndices (Just $ sl + 1) (Just $ el + 1)++convertDynFlags :: DynFlags -> IO [DynOption]+convertDynFlags df =+ let pp = if null p then [] else ["-pgmF=" <> p]+ p = D.sPgm_F $ D.settings df+ pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df+ ex = map showExtension $ S.toList $ D.extensionFlags df+ showExtension = \case+ Cpp -> "-XCPP"+ x -> "-X" ++ show x+ in return $ map DynOption $ pp <> pm <> ex
+ plugins/default/src/Ide/Plugin/ModuleName.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -Wall -Wwarn -fno-warn-type-defaults -fno-warn-unused-binds -fno-warn-unused-imports #-}++{- | Keep the module name in sync with its file path.++Provide CodeLenses to:+* Add a module header ("module /moduleName/ where") to empty Haskell files+* Fix the module name if incorrect+-}+module Ide.Plugin.ModuleName (+ descriptor,+) where++import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.Aeson (+ ToJSON (toJSON),+ Value (Null),+ )+import Data.Char (isLower)+import qualified Data.HashMap.Strict as Map+import Data.List (find, intercalate, isPrefixOf)+import Data.Maybe (maybeToList)+import Data.String (IsString)+import Data.Text (Text, pack)+import qualified Data.Text as T+-- import Debug.Trace (trace)+import Development.IDE (+ GetParsedModule (+ GetParsedModule+ ),+ GhcSession (GhcSession),+ HscEnvEq,+ IdeState,+ List (..),+ NormalizedFilePath,+ Position (Position),+ Range (Range),+ evalGhcEnv,+ hscEnvWithImportPaths,+ realSrcSpanToRange,+ runAction,+ toNormalizedUri,+ uriToFilePath',+ use,+ use_,+ )+import GHC (+ DynFlags (importPaths),+ GenLocated (L),+ HsModule (hsmodName),+ ParsedModule (pm_parsed_source),+ SrcSpan (RealSrcSpan),+ getSessionDynFlags,+ unLoc,+ )+import Ide.PluginUtils (mkLspCmdId, getProcessID)+import Ide.Types (+ CommandFunction,+ PluginCommand (..),+ PluginDescriptor (..),+ PluginId (..),+ defaultPluginDescriptor,+ )+import Language.Haskell.LSP.Core (+ LspFuncs,+ getVirtualFileFunc,+ )+import Language.Haskell.LSP.Types (+ ApplyWorkspaceEditParams (..),+ CodeLens (CodeLens),+ CodeLensParams (CodeLensParams),+ Command (Command),+ ServerMethod (..),+ TextDocumentIdentifier (+ TextDocumentIdentifier+ ),+ TextEdit (TextEdit),+ Uri,+ WorkspaceEdit (..),+ uriToNormalizedFilePath,+ )+import Language.Haskell.LSP.VFS (virtualFileText)+import System.Directory (canonicalizePath)+import System.FilePath (+ dropExtension,+ splitDirectories,+ takeFileName,+ )++-- |Plugin descriptor+descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId =+ (defaultPluginDescriptor plId)+ { pluginCodeLensProvider = Just codeLens+ , pluginCommands = [PluginCommand editCommandName editCommandName command]+ }++editCommandName :: IsString p => p+editCommandName = "edit"++asCodeLens :: Text -> Action -> CodeLens+asCodeLens cid Replace{..} =+ CodeLens+ aRange+ (Just $ Command aTitle cid (Just (List [toJSON aUri])))+ Nothing++-- | Generate code lenses+codeLens ::+ LspFuncs c ->+ IdeState ->+ PluginId ->+ CodeLensParams ->+ IO (Either a2 (List CodeLens))+codeLens lsp state pluginId (CodeLensParams (TextDocumentIdentifier uri) _) =+ do+ pid <- pack . show <$> getProcessID+ Right . List . maybeToList . (asCodeLens (mkLspCmdId pid pluginId editCommandName) <$>) <$> action lsp state uri++-- | (Quasi) Idempotent command execution: recalculate action to execute on command request+command :: CommandFunction IdeState Uri+command lsp state uri = do+ actMaybe <- action lsp state uri+ return+ ( Right Null+ , (\act -> (WorkspaceApplyEdit, ApplyWorkspaceEditParams $ asEdit act)) <$> actMaybe+ )++-- | A source code change+data Action = Replace {aUri :: Uri, aRange :: Range, aTitle :: Text, aCode :: Text} deriving (Show)++-- | Convert an Action to the corresponding edit operation+asEdit :: Action -> WorkspaceEdit+asEdit act@Replace{..} =+ WorkspaceEdit (Just $ Map.singleton aUri $ List (asTextEdits act)) Nothing++asTextEdits :: Action -> [TextEdit]+asTextEdits Replace{..} = [TextEdit aRange aCode]++-- | Required action (that can be converted to either CodeLenses or CodeActions)+action :: LspFuncs c -> IdeState -> Uri -> IO (Maybe Action)+action lsp state uri =+ traceAs "action" <$> do+ let Just nfp = uriToNormalizedFilePath $ toNormalizedUri uri+ let Just fp = uriToFilePath' uri++ contents <- liftIO $ getVirtualFileFunc lsp $ toNormalizedUri uri+ let emptyModule = maybe True (T.null . T.strip . virtualFileText) contents++ correctNameMaybe <- traceAs "correctName" <$> pathModuleName state nfp fp+ statedNameMaybe <- traceAs "statedName" <$> codeModuleName state nfp++ let act = Replace uri+ let todo = case (correctNameMaybe, statedNameMaybe) of+ (Just correctName, Just (nameRange, statedName))+ | correctName /= statedName ->+ Just $+ act+ nameRange+ ("Set module name to " <> correctName)+ correctName+ (Just correctName, _)+ | emptyModule ->+ let code = T.unwords ["module", correctName, "where\n"]+ in Just $ act (Range (Position 0 0) (Position 0 0)) code code+ _ -> Nothing+ return todo++-- | The module name, as derived by the position of the module in its source directory+pathModuleName :: IdeState -> NormalizedFilePath -> String -> IO (Maybe Text)+pathModuleName state normFilePath filePath+ | isLower (head $ takeFileName filePath) = return $ Just "Main"+ | otherwise = do+ session :: HscEnvEq <- runAction "ModuleName.ghcSession" state $ use_ GhcSession normFilePath+ srcPaths <- evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags+ paths <- mapM canonicalizePath srcPaths+ mdlPath <- canonicalizePath filePath+ let maybePrefix = find (`isPrefixOf` mdlPath) paths++ let maybeMdlName =+ ( \prefix ->+ intercalate "."+ . splitDirectories+ . drop (length prefix + 1)+ $ dropExtension mdlPath+ )+ <$> maybePrefix+ return $ T.pack <$> maybeMdlName++-- | The module name, as stated in the module+codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, Text))+codeModuleName state nfp =+ ((\(L (RealSrcSpan l) m) -> (realSrcSpanToRange l, T.pack . show $ m)) <$>)+ . ((hsmodName . unLoc . pm_parsed_source) =<<)+ <$> runAction "ModuleName.GetParsedModule" state (use GetParsedModule nfp)++-- traceAs :: Show a => String -> a -> a+-- traceAs lbl a = trace (lbl ++ " = " ++ show a) a++traceAs :: b -> a -> a+traceAs _ a = a
+ plugins/default/src/Ide/Plugin/Ormolu.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Ide.Plugin.Ormolu+ (+ descriptor+ , provider+ )+where++import Control.Exception+import qualified Data.Text as T+import Development.IDE+import qualified DynFlags as D+import qualified EnumSet as S+import GHC+import GHC.LanguageExtensions.Type+import GhcPlugins (HscEnv (hsc_dflags))+import Ide.PluginUtils+import Ide.Types+import Language.Haskell.LSP.Core (LspFuncs (withIndefiniteProgress),+ ProgressCancellable (Cancellable))+import Language.Haskell.LSP.Types+import "ormolu" Ormolu+import System.FilePath (takeFileName)+import Text.Regex.TDFA.Text ()++-- ---------------------------------------------------------------------++descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId = (defaultPluginDescriptor plId)+ { pluginFormattingProvider = Just provider+ }++-- ---------------------------------------------------------------------++provider :: FormattingProvider IdeState IO+provider lf ideState typ contents fp _ = withIndefiniteProgress lf title Cancellable $ do+ let+ fromDyn :: DynFlags -> IO [DynOption]+ fromDyn df =+ let+ pp =+ let p = D.sPgm_F $ D.settings df+ in if null p then [] else ["-pgmF=" <> p]+ pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df+ ex = map showExtension $ S.toList $ D.extensionFlags df+ in+ return $ map DynOption $ pp <> pm <> ex++ ghc <- runAction "Ormolu" ideState $ use GhcSession fp+ let df = hsc_dflags . hscEnv <$> ghc+ fileOpts <- case df of+ Nothing -> return []+ Just df -> fromDyn df++ let+ fullRegion = RegionIndices Nothing Nothing+ rangeRegion s e = RegionIndices (Just $ s + 1) (Just $ e + 1)+ mkConf o region = defaultConfig { cfgDynOptions = o, cfgRegion = region }+ fmt :: T.Text -> Config RegionIndices -> IO (Either OrmoluException T.Text)+ fmt cont conf =+ try @OrmoluException (ormolu conf (fromNormalizedFilePath fp) $ T.unpack cont)++ case typ of+ FormatText -> ret <$> fmt contents (mkConf fileOpts fullRegion)+ FormatRange (Range (Position sl _) (Position el _)) ->+ ret <$> fmt contents (mkConf fileOpts (rangeRegion sl el))+ where+ title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp)+ ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit)+ ret (Left err) = Left+ (responseError (T.pack $ "ormoluCmd: " ++ show err) )+ ret (Right new) = Right (makeDiffTextEdit contents new)++showExtension :: Extension -> String+showExtension Cpp = "-XCPP"+showExtension other = "-X" ++ show other
+ plugins/default/src/Ide/Plugin/Pragmas.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Provides code actions to add missing pragmas (whenever GHC suggests to)+module Ide.Plugin.Pragmas+ (+ descriptor+ -- , commands -- TODO: get rid of this+ ) where++import Control.Lens hiding (List)+import Data.Aeson+import qualified Data.HashMap.Strict as H+import qualified Data.Text as T+import Development.IDE as D+import qualified GHC.Generics as Generics+import Ide.Types+import Language.Haskell.LSP.Types+import qualified Language.Haskell.LSP.Types as J+import qualified Language.Haskell.LSP.Types.Lens as J++import Control.Monad (join)+import Development.IDE.GHC.Compat+import qualified Language.Haskell.LSP.Core as LSP+import qualified Language.Haskell.LSP.VFS as VFS++-- ---------------------------------------------------------------------++descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId = (defaultPluginDescriptor plId)+ { pluginCodeActionProvider = Just codeActionProvider+ , pluginCompletionProvider = Just completion+ }++-- ---------------------------------------------------------------------++-- | Parameters for the addPragma PluginCommand.+data AddPragmaParams = AddPragmaParams+ { file :: J.Uri -- ^ Uri of the file to add the pragma to+ , pragma :: T.Text -- ^ Name of the Pragma to add+ }+ deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)++-- | Add a Pragma to the given URI at the top of the file.+-- Pragma is added to the first line of the Uri.+-- It is assumed that the pragma name is a valid pragma,+-- thus, not validated.+mkPragmaEdit :: Uri -> T.Text -> WorkspaceEdit+mkPragmaEdit uri pragmaName = res where+ pos = J.Position 0 0+ textEdits = J.List+ [J.TextEdit (J.Range pos pos)+ ("{-# LANGUAGE " <> pragmaName <> " #-}\n")+ ]+ res = J.WorkspaceEdit+ (Just $ H.singleton uri textEdits)+ Nothing++-- ---------------------------------------------------------------------+-- | Offer to add a missing Language Pragma to the top of a file.+-- Pragmas are defined by a curated list of known pragmas, see 'possiblePragmas'.+codeActionProvider :: CodeActionProvider IdeState+codeActionProvider _ state _plId docId _ (J.CodeActionContext (J.List diags) _monly) = do+ let mFile = docId ^. J.uri & uriToFilePath <&> toNormalizedFilePath'+ pm <- fmap join $ runAction "addPragma" state $ getParsedModule `traverse` mFile+ let dflags = ms_hspp_opts . pm_mod_summary <$> pm+ -- Filter diagnostics that are from ghcmod+ ghcDiags = filter (\d -> d ^. J.source == Just "typecheck") diags+ -- Get all potential Pragmas for all diagnostics.+ pragmas = concatMap (\d -> genPragma dflags (d ^. J.message)) ghcDiags+ cmds <- mapM mkCodeAction pragmas+ return $ Right $ List cmds+ where+ mkCodeAction pragmaName = do+ let+ codeAction = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) (Just edit) Nothing+ title = "Add \"" <> pragmaName <> "\""+ edit = mkPragmaEdit (docId ^. J.uri) pragmaName+ return codeAction++ genPragma mDynflags target+ | Just dynFlags <- mDynflags,+ -- GHC does not export 'OnOff', so we have to view it as string+ disabled <- [ e | Just e <- T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags]+ = [ r | r <- findPragma target, r `notElem` disabled]+ | otherwise = []+++-- ---------------------------------------------------------------------++-- | Find all Pragmas are an infix of the search term.+findPragma :: T.Text -> [T.Text]+findPragma str = concatMap check possiblePragmas+ where+ check p = [p | T.isInfixOf p str]++-- ---------------------------------------------------------------------++-- | Possible Pragma names.+-- See discussion at https://github.com/haskell/ghcide/pull/638+possiblePragmas :: [T.Text]+possiblePragmas = [name | FlagSpec{flagSpecName = T.pack -> name} <- xFlags, "Strict" /= name]++-- ---------------------------------------------------------------------++completion :: CompletionProvider IdeState+completion lspFuncs _ide complParams = do+ let (TextDocumentIdentifier uri) = complParams ^. J.textDocument+ position = complParams ^. J.position+ contents <- LSP.getVirtualFileFunc lspFuncs $ toNormalizedUri uri+ fmap Right $ case (contents, uriToFilePath' uri) of+ (Just cnts, Just _path) -> do+ pfix <- VFS.getCompletionPrefix position cnts+ return $ result pfix+ where+ result (Just pfix)+ | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix+ = Completions $ List $ map buildCompletion possiblePragmas+ | otherwise+ = Completions $ List []+ result Nothing = Completions $ List []+ buildCompletion p =+ CompletionItem+ { _label = p,+ _kind = Just CiKeyword,+ _tags = List [],+ _detail = Nothing,+ _documentation = Nothing,+ _deprecated = Nothing,+ _preselect = Nothing,+ _sortText = Nothing,+ _filterText = Nothing,+ _insertText = Nothing,+ _insertTextFormat = Nothing,+ _textEdit = Nothing,+ _additionalTextEdits = Nothing,+ _commitCharacters = Nothing,+ _command = Nothing,+ _xdata = Nothing+ }+ _ -> return $ Completions $ List []
+ plugins/default/src/Ide/Plugin/StylishHaskell.hs view
@@ -0,0 +1,59 @@+module Ide.Plugin.StylishHaskell+ (+ descriptor+ , provider+ )+where++import Control.Monad.IO.Class+import Data.Text (Text)+import qualified Data.Text as T+import Development.IDE (IdeState)+import Ide.PluginUtils+import Ide.Types+import Language.Haskell.Stylish+import Language.Haskell.LSP.Types as J++import System.Directory+import System.FilePath++descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId = (defaultPluginDescriptor plId)+ { pluginFormattingProvider = Just provider+ }++-- | Formatter provider of stylish-haskell.+-- Formats the given source in either a given Range or the whole Document.+-- If the provider fails an error is returned that can be displayed to the user.+provider :: FormattingProvider IdeState IO+provider _lf _ideState typ contents fp _opts = do+ let file = fromNormalizedFilePath fp+ config <- liftIO $ loadConfigFrom file+ let (range, selectedContents) = case typ of+ FormatText -> (fullRange contents, contents)+ FormatRange r -> (normalize r, extractRange r contents)+ result = runStylishHaskell file config selectedContents+ case result of+ Left err -> return $ Left $ responseError $ T.pack $ "stylishHaskellCmd: " ++ err+ Right new -> return $ Right $ J.List [TextEdit range new]++-- | Recursively search in every directory of the given filepath for .stylish-haskell.yaml.+-- If no such file has been found, return default config.+loadConfigFrom :: FilePath -> IO Config+loadConfigFrom file = do+ currDir <- getCurrentDirectory+ setCurrentDirectory (takeDirectory file)+ config <- loadConfig (makeVerbose False) Nothing+ setCurrentDirectory currDir+ return config++-- | Run stylish-haskell on the given text with the given configuration.+runStylishHaskell :: FilePath -- ^ Location of the file being formatted. Used for error message+ -> Config -- ^ Configuration for stylish-haskell+ -> Text -- ^ Text to format+ -> Either String Text -- ^ Either formatted Text or an error message+runStylishHaskell file config = fmap fromLines . fmt . toLines+ where+ fromLines = T.pack . unlines+ fmt = runSteps (configLanguageExtensions config) (Just file) (configSteps config)+ toLines = lines . T.unpack
+ plugins/hls-eval-plugin/test/Eval.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Eval (+ tests,+) where++import Control.Applicative.Combinators (+ skipManyTill,+ )+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO (liftIO))+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Language.Haskell.LSP.Test (+ Session,+ anyMessage,+ documentContents,+ executeCommand,+ fullCaps,+ getCodeLenses,+ message,+ openDoc,+ runSession,+ )+import Language.Haskell.LSP.Types (+ ApplyWorkspaceEditRequest,+ CodeLens (CodeLens, _command, _range),+ Command (Command, _title),+ Position (..),+ Range (..),+ TextDocumentIdentifier,+ )+import System.Directory (doesFileExist)+import System.FilePath (+ (<.>),+ (</>),+ )+import Test.Hls.Util (hlsCommand)+import Test.Tasty (+ TestTree,+ testGroup,+ )+import Test.Tasty.ExpectedFailure (+ expectFailBecause,+ ignoreTestBecause,+ )+import Test.Tasty.HUnit (+ testCase,+ (@?=),+ )++tests :: TestTree+tests =+ testGroup+ "eval"+ [ testCase "Produces Evaluate code lenses" $+ runSession hlsCommand fullCaps evalPath $ do+ doc <- openDoc "T1.hs" "haskell"+ lenses <- getEvalCodeLenses doc+ liftIO $ map (fmap _title . _command) lenses @?= [Just "Evaluate..."]+ , testCase "Produces Refresh code lenses" $+ runSession hlsCommand fullCaps evalPath $ do+ doc <- openDoc "T2.hs" "haskell"+ lenses <- getEvalCodeLenses doc+ liftIO $ map (fmap _title . _command) lenses @?= [Just "Refresh..."]+ , testCase "Code lenses have ranges" $+ runSession hlsCommand fullCaps evalPath $ do+ doc <- openDoc "T1.hs" "haskell"+ lenses <- getEvalCodeLenses doc+ liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 5 0)]+ , testCase "Multi-line expressions have a multi-line range" $ do+ runSession hlsCommand fullCaps evalPath $ do+ doc <- openDoc "T3.hs" "haskell"+ lenses <- getEvalCodeLenses doc+ liftIO $ map _range lenses @?= [Range (Position 3 0) (Position 5 0)]+ , testCase "Executed expressions range covers only the expression" $ do+ runSession hlsCommand fullCaps evalPath $ do+ doc <- openDoc "T2.hs" "haskell"+ lenses <- getEvalCodeLenses doc+ liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 5 0)]+ , testCase "Evaluation of expressions" $ goldenTest "T1.hs"+ , testCase "Reevaluation of expressions" $ goldenTest "T2.hs"+ , testCase "Evaluation of expressions w/ imports" $ goldenTest "T3.hs"+ , testCase "Evaluation of expressions w/ lets" $ goldenTest "T4.hs"+ , testCase "Refresh an evaluation" $ goldenTest "T5.hs"+ , testCase "Refresh an evaluation w/ lets" $ goldenTest "T6.hs"+ , testCase "Refresh a multiline evaluation" $ goldenTest "T7.hs"+ , testCase "Semantic and Lexical errors are reported" $ goldenTest "T8.hs"+ , testCase "Applies file LANGUAGE extensions" $ goldenTest "T9.hs"+ , testCase "Evaluate a type with :kind!" $ goldenTest "T10.hs"+ , testCase "Reports an error for an incorrect type with :kind!" $+ goldenTest "T11.hs"+ , testCase "Shows a kind with :kind" $ goldenTest "T12.hs"+ , testCase "Reports an error for an incorrect type with :kind" $+ goldenTest "T13.hs"+ , testCase "Returns a fully-instantiated type for :type" $+ goldenTest "T14.hs"+ , testCase "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" $+ goldenTest "T15.hs"+ , testCase "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" $+ goldenTest "T16.hs"+ , testCase ":type reports an error when given with unknown +x option" $+ goldenTest "T17.hs"+ , testCase "Reports an error when given with unknown command" $+ goldenTest "T18.hs"+ , testCase "Returns defaulted type for :type +d reflecting the default declaration specified in the >>> prompt" $+ goldenTest "T19.hs"+ , expectFailBecause "known issue - see a note in P.R. #361" $+ testCase ":type +d reflects the `default' declaration of the module" $+ goldenTest "T20.hs"+ , testCase ":type handles a multilined result properly" $+ goldenTest "T21.hs"+ , testCase ":t behaves exactly the same as :type" $+ goldenTest "T22.hs"+ , testCase ":type does \"dovetails\" for short identifiers" $+ goldenTest "T23.hs"+ , testCase ":kind! treats a multilined result properly" $+ goldenTest "T24.hs"+ , testCase ":kind treats a multilined result properly" $+ goldenTest "T25.hs"+ , testCase "local imports" $+ goldenTest "T26.hs"+ , testCase "Preserves one empty comment line after prompt" $+ goldenTest "T27.hs"+ , testCase+ "Multi line comments"+ $ goldenTest "TMulti.hs"+ , testCase+ "Evaluate expressions in Plain comments in both single line and multi line format"+ $ goldenTest "TPlainComment.hs"+ , testCase+ "Evaluate expressions in Haddock comments in both single line and multi line format"+ $ goldenTest "THaddock.hs"+ , testCase "Compare results (for Haddock tests only)" $+ goldenTest "TCompare.hs"+ , testCase "Local Modules imports are accessible in a test" $+ goldenTest "TLocalImport.hs"+ , -- , testCase "Local Modules can be imported in a test" $ goldenTest "TLocalImportInTest.hs"+ ignoreTestBecause "Unexplained but minor issue" $+ testCase "Setting language option TupleSections" $+ goldenTest "TLanguageOptionsTupleSections.hs"+ , testCase "IO expressions are supported, stdout/stderr output is ignored" $+ goldenTest "TIO.hs"+ , testCase "Property checking" $ goldenTest "TProperty.hs"+ , testCase+ "Prelude has no special treatment, it is imported as stated in the module"+ $ goldenTest "TPrelude.hs"+#if __GLASGOW_HASKELL__ >= 808+ , testCase "CPP support" $ goldenTest "TCPP.hs"+ , testCase "Literate Haskell Bird Style" $ goldenTest "TLHS.lhs"+#endif+ -- , testCase "Literate Haskell LaTeX Style" $ goldenTest "TLHSLateX.lhs"+ ]++goldenTest :: FilePath -> IO ()+goldenTest = goldenTestBy isEvalTest++{- |Execute all CodeLens accepted by 'filter'+ Compare results with the contents of corresponding '.expected' file (and creates it, if missing)+-}+goldenTestBy :: (CodeLens -> Bool) -> FilePath -> IO ()+goldenTestBy f input = runSession hlsCommand fullCaps evalPath $ do+ doc <- openDoc input "haskell"++ -- Execute lenses backwards, to avoid affecting their position in the source file+ codeLenses <- reverse <$> getCodeLensesBy f doc+ -- liftIO $ print codeLenses++ -- Execute sequentially+ mapM_ executeCmd $ [c | CodeLens{_command = Just c} <- codeLenses]++ edited <- replaceUnicodeQuotes <$> documentContents doc+ -- liftIO $ T.putStrLn edited++ let expectedFile = evalPath </> input <.> "expected"++ liftIO $ do+ -- Write expected file if missing+ missingExpected <- not <$> doesFileExist expectedFile+ when missingExpected $ T.writeFile expectedFile edited++ expected <- liftIO $ T.readFile expectedFile+ liftIO $ edited @?= expected++getEvalCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]+getEvalCodeLenses = getCodeLensesBy isEvalTest++getCodeLensesBy :: (CodeLens -> Bool) -> TextDocumentIdentifier -> Session [CodeLens]+getCodeLensesBy f doc = filter f <$> getCodeLenses doc++-- Execute command and wait for result+executeCmd :: Command -> Session ()+executeCmd cmd = do+ executeCommand cmd+ _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message+ -- liftIO $ print _resp+ return ()++-- Execute only Eval tests to avoid interference from other plugins (e.g ghcide:typesignature.add)+isEvalTest :: CodeLens -> Bool+isEvalTest (CodeLens _ (Just (Command _ cmd _)) _)+ | ":eval:" `T.isInfixOf` cmd = True+isEvalTest _ = False++replaceUnicodeQuotes :: T.Text -> T.Text+replaceUnicodeQuotes = T.replace "‘" "'" . T.replace "’" "'"++evalPath :: FilePath+evalPath = "plugins/hls-eval-plugin/test/testdata"
+ plugins/tactics/src/Ide/Plugin/Tactic/TestTypes.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}++module Ide.Plugin.Tactic.TestTypes where++import qualified Data.Text as T++------------------------------------------------------------------------------+-- | The list of tactics exposed to the outside world. These are attached to+-- actual tactics via 'commandTactic' and are contextually provided to the+-- editor via 'commandProvider'.+data TacticCommand+ = Auto+ | Intros+ | Destruct+ | Homomorphism+ | DestructLambdaCase+ | HomomorphismLambdaCase+ deriving (Eq, Ord, Show, Enum, Bounded)++-- | Generate a title for the command.+tacticTitle :: TacticCommand -> T.Text -> T.Text+tacticTitle Auto _ = "Attempt to fill hole"+tacticTitle Intros _ = "Introduce lambda"+tacticTitle Destruct var = "Case split on " <> var+tacticTitle Homomorphism var = "Homomorphic case split on " <> var+tacticTitle DestructLambdaCase _ = "Lambda case split"+tacticTitle HomomorphismLambdaCase _ = "Homomorphic lambda case split"
+ src/Ide/Arguments.hs view
@@ -0,0 +1,127 @@+-- Copyright (c) 2019 The DAML Authors. All rights reserved.+-- SPDX-License-Identifier: Apache-2.0+{-# LANGUAGE CPP #-} -- To get precise GHC version+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above++module Ide.Arguments+ ( Arguments(..)+ , LspArguments(..)+ , PrintVersion(..)+ , getArguments+ , haskellLanguageServerVersion+ , haskellLanguageServerNumericVersion+ ) where++import Data.Version+import Development.GitRev+import Options.Applicative+import Paths_haskell_language_server+import System.Environment++-- ---------------------------------------------------------------------++data Arguments+ = VersionMode PrintVersion+ | ProbeToolsMode+ | LspMode LspArguments+ deriving Show++data LspArguments = LspArguments+ {argLSP :: Bool+ ,argsCwd :: Maybe FilePath+ ,argFiles :: [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+ , argsLogFile :: Maybe String+ , argsThreads :: Int+ , argsProjectGhcVersion :: Bool+ } deriving Show++data PrintVersion+ = PrintVersion+ | PrintNumericVersion+ deriving (Show, Eq, Ord)++getArguments :: String -> IO Arguments+getArguments exeName = execParser opts+ where+ opts = info ((+ VersionMode <$> printVersionParser exeName+ <|> probeToolsParser exeName+ <|> LspMode <$> arguments)+ <**> helper)+ ( fullDesc+ <> progDesc "Used as a test bed to check your IDE Client will work"+ <> header (exeName ++ " - GHC Haskell LSP server"))++printVersionParser :: String -> Parser PrintVersion+printVersionParser exeName =+ flag' PrintVersion+ (long "version" <> help ("Show " ++ exeName ++ " and GHC versions"))+ <|>+ flag' PrintNumericVersion+ (long "numeric-version" <> help ("Show numeric version of " ++ exeName))++probeToolsParser :: String -> Parser Arguments+probeToolsParser exeName =+ flag' ProbeToolsMode+ (long "probe-tools" <> help ("Show " ++ exeName ++ " version and other tools of interest"))++arguments :: Parser LspArguments+arguments = LspArguments+ <$> switch (long "lsp" <> help "Start talking to an LSP server")+ <*> optional (strOption $ long "cwd" <> metavar "DIR"+ <> help "Change to this directory")+ <*> many (argument str (metavar "FILES/DIRS..."))+ <*> optional (strOption $ long "shake-profiling" <> metavar "DIR"+ <> help "Dump profiling reports to this directory")+ <*> switch (long "test"+ <> help "Enable additional lsp messages used by the testsuite")+ <*> switch (long "example"+ <> help "Include the Example Plugin. For Plugin devs only")++ <*> switch+ ( long "debug"+ <> short 'd'+ <> help "Generate debug output"+ )+ <*> optional (strOption+ ( long "logfile"+ <> short 'l'+ <> metavar "LOGFILE"+ <> help "File to log to, defaults to stdout"+ ))+ <*> option auto+ (short 'j'+ <> help "Number of threads (0: automatic)"+ <> metavar "NUM"+ <> value 0+ <> showDefault+ )+ <*> switch (long "project-ghc-version"+ <> help "Work out the project GHC version and print it")++-- ---------------------------------------------------------------------++haskellLanguageServerNumericVersion :: String+haskellLanguageServerNumericVersion = showVersion version++haskellLanguageServerVersion :: IO String+haskellLanguageServerVersion = do+ path <- getExecutablePath+ let gitHashSection = case $(gitHash) of+ x | x == "UNKNOWN" -> ""+ x -> " (GIT hash: " <> x <> ")"+ return $ "haskell-language-server version: " <> haskellLanguageServerNumericVersion+ <> " (GHC: " <> VERSION_ghc+ <> ") (PATH: " <> path <> ")"+ <> gitHashSection+
+ src/Ide/Main.hs view
@@ -0,0 +1,203 @@+-- Copyright (c) 2019 The DAML Authors. All rights reserved.+-- SPDX-License-Identifier: Apache-2.0+{-# LANGUAGE CPP #-} -- To get precise GHC version+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++module Ide.Main(defaultMain, runLspMode) where++import Control.Concurrent.Extra+import Control.Monad.Extra+import Data.Default+import Data.List.Extra+import qualified Data.Map.Strict as Map+import qualified Data.HashMap.Strict as HashMap+import Data.Maybe+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Development.IDE.Core.Debouncer+import Development.IDE.Core.FileStore+import Development.IDE.Core.OfInterest+import Development.IDE.Core.RuleTypes+import Development.IDE.Core.Rules+import Development.IDE.Core.Service+import Development.IDE.Core.Shake+import Development.IDE.LSP.LanguageServer+import Development.IDE.LSP.Protocol+import Development.IDE.Plugin+import Development.IDE.Plugin.HLS+import Development.IDE.Session (loadSession, findCradle, defaultLoadingOptions)+import Development.IDE.Types.Diagnostics+import Development.IDE.Types.Location+import Development.IDE.Types.Logger as G+import Development.IDE.Types.Options+import qualified Language.Haskell.LSP.Core as LSP+import Ide.Arguments+import Ide.Logger+import Ide.Version+import Ide.Plugin.Config+import Ide.PluginUtils+import Ide.Types (IdePlugins, ipMap)+import Language.Haskell.LSP.Messages+import Language.Haskell.LSP.Types+import qualified System.Directory.Extra as IO+import System.Exit+import System.FilePath+import System.IO+import qualified System.Log.Logger as L+import System.Time.Extra+import Development.Shake (action)++ghcIdePlugins :: T.Text -> IdePlugins IdeState -> (Plugin Config, [T.Text])+ghcIdePlugins pid ps = (asGhcIdePlugin ps, allLspCmdIds' pid ps)++defaultMain :: Arguments -> IdePlugins IdeState -> IO ()+defaultMain args idePlugins = do+ -- WARNING: If you write to stdout before runLanguageServer+ -- then the language server will not work++ hlsVer <- haskellLanguageServerVersion+ case args of+ ProbeToolsMode -> do+ programsOfInterest <- findProgramVersions+ putStrLn hlsVer+ putStrLn "Tool versions found on the $PATH"+ putStrLn $ showProgramVersionOfInterest programsOfInterest++ VersionMode PrintVersion ->+ putStrLn hlsVer++ VersionMode PrintNumericVersion ->+ putStrLn haskellLanguageServerNumericVersion++ LspMode lspArgs -> do+ {- see WARNING above -}+ hPutStrLn stderr hlsVer+ runLspMode lspArgs idePlugins++-- ---------------------------------------------------------------------++hlsLogger :: G.Logger+hlsLogger = G.Logger $ \pri txt ->+ case pri of+ G.Telemetry -> logm (T.unpack txt)+ G.Debug -> debugm (T.unpack txt)+ G.Info -> logm (T.unpack txt)+ G.Warning -> warningm (T.unpack txt)+ G.Error -> errorm (T.unpack txt)++-- ---------------------------------------------------------------------++runLspMode :: LspArguments -> IdePlugins IdeState -> IO ()+runLspMode lspArgs@LspArguments{..} idePlugins = do+ LSP.setupLogger argsLogFile ["hls", "hie-bios"]+ $ if argsDebugOn then L.DEBUG else L.INFO++ -- lock to avoid overlapping output on stdout+ lock <- newLock+ let logger p = Logger $ \pri msg -> when (pri >= p) $ withLock lock $+ T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg++ whenJust argsCwd IO.setCurrentDirectory++ dir <- IO.getCurrentDirectory++ pid <- T.pack . show <$> getProcessID+ let+ (plugins, commandIds) = ghcIdePlugins pid idePlugins+ options = def { LSP.executeCommandCommands = Just commandIds+ , LSP.completionTriggerCharacters = Just "."+ }++ if argLSP then do+ t <- offsetTime+ hPutStrLn stderr "Starting (haskell-language-server)LSP server..."+ hPutStrLn stderr $ " with arguments: " <> show lspArgs+ hPutStrLn stderr $ " with plugins: " <> show (Map.keys $ ipMap idePlugins)+ hPutStrLn stderr $ " in directory: " <> dir+ hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"++ runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps wProg wIndefProg _getConfig _rootPath -> do+ t <- t+ hPutStrLn stderr $ "Started LSP server in " ++ showDuration t+ sessionLoader <- loadSession dir+ -- config <- fromMaybe defaultLspConfig <$> getConfig+ let options = (defaultIdeOptions sessionLoader)+ { optReportProgress = clientSupportsProgress caps+ , optShakeProfiling = argsShakeProfiling+ , optTesting = IdeTesting argsTesting+ , optThreads = argsThreads+ -- , optCheckParents = checkParents config+ -- , optCheckProject = checkProject config+ }+ debouncer <- newAsyncDebouncer+ initialise caps (mainRule >> pluginRules plugins >> action kick)+ getLspId event wProg wIndefProg hlsLogger debouncer options vfs+ else do+ -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error+ hSetEncoding stdout utf8+ hSetEncoding stderr utf8++ putStrLn $ "(haskell-language-server)Ghcide setup tester in " ++ dir ++ "."+ putStrLn "Report bugs at https://github.com/haskell/haskell-language-server/issues"+ programsOfInterest <- findProgramVersions+ putStrLn ""+ putStrLn "Tool versions found on the $PATH"+ putStrLn $ showProgramVersionOfInterest programsOfInterest++ putStrLn $ "\nStep 1/4: Finding files to test in " ++ dir+ files <- expandFiles (argFiles ++ ["." | null argFiles])+ -- LSP works with absolute file paths, so try and behave similarly+ files <- nubOrd <$> mapM IO.canonicalizePath files+ putStrLn $ "Found " ++ show (length files) ++ " files"++ putStrLn "\nStep 2/4: Looking for hie.yaml files that control setup"+ cradles <- mapM (findCradle defaultLoadingOptions) files+ let ucradles = nubOrd cradles+ let n = length ucradles+ putStrLn $ "Found " ++ show n ++ " cradle" ++ ['s' | n /= 1]+ putStrLn "\nStep 3/4: Initializing the IDE"+ vfs <- makeVFSHandle+ debouncer <- newAsyncDebouncer+ let dummyWithProg _ _ f = f (const (pure ()))+ sessionLoader <- loadSession dir+ ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger Info) debouncer (defaultIdeOptions sessionLoader) vfs++ putStrLn "\nStep 4/4: Type checking the files"+ setFilesOfInterest ide $ HashMap.fromList $ map ((, OnDisk) . toNormalizedFilePath') files+ results <- runAction "User TypeCheck" ide $ uses TypeCheck (map toNormalizedFilePath' files)+ let (worked, failed) = partition fst $ zip (map isJust results) files+ when (failed /= []) $+ putStr $ unlines $ "Files that failed:" : map ((++) " * " . snd) failed++ let files xs = let n = length xs in if n == 1 then "1 file" else show n ++ " files"+ putStrLn $ "\nCompleted (" ++ files worked ++ " worked, " ++ files failed ++ " failed)"+ unless (null failed) (exitWith $ ExitFailure (length failed))++expandFiles :: [FilePath] -> IO [FilePath]+expandFiles = concatMapM $ \x -> do+ b <- IO.doesFileExist x+ if b then return [x] else do+ let recurse "." = True+ recurse x | "." `isPrefixOf` takeFileName x = False -- skip .git etc+ recurse x = takeFileName x `notElem` ["dist","dist-newstyle"] -- cabal directories+ files <- filter (\x -> takeExtension x `elem` [".hs",".lhs"]) <$> IO.listFilesInside (return . recurse) x+ when (null files) $+ fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x+ return files++-- | Print an LSP event.+showEvent :: Lock -> FromServerMessage -> IO ()+showEvent _ (EventFileDiagnostics _ []) = return ()+showEvent lock (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) =+ withLock lock $ T.putStrLn $ showDiagnosticsColored $ map (file,ShowDiag,) diags+showEvent lock e = withLock lock $ print e
+ src/Ide/Version.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+-- | Information and display strings for HIE's version+-- and the current project's version+module Ide.Version where++import Development.GitRev (gitCommitCount)+import Options.Applicative.Simple (simpleVersion)+import qualified Paths_haskell_language_server as Meta+import System.Info+import Data.Version+import Data.Maybe (listToMaybe)+import System.Directory+import System.Process+import System.Exit+import Text.ParserCombinators.ReadP++-- >>> hlsVersion+hlsVersion :: String+hlsVersion =+ let commitCount = $gitCommitCount+ in concat $ concat+ [ [$(simpleVersion Meta.version)]+ -- Leave out number of commits for --depth=1 clone+ -- See https://github.com/commercialhaskell/stack/issues/792+ , [" (" ++ commitCount ++ " commits)" | commitCount /= ("1"::String) &&+ commitCount /= ("UNKNOWN" :: String)]+ , [" ", arch]+ , [" ", hlsGhcDisplayVersion]+ ]+ where+ hlsGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc++data ProgramsOfInterest = ProgramsOfInterest+ { cabalVersion :: Maybe Version+ , stackVersion :: Maybe Version+ , ghcVersion :: Maybe Version+ }++showProgramVersionOfInterest :: ProgramsOfInterest -> String+showProgramVersionOfInterest ProgramsOfInterest {..} =+ unlines+ [ concat ["cabal:\t\t", showVersionWithDefault cabalVersion]+ , concat ["stack:\t\t", showVersionWithDefault stackVersion]+ , concat ["ghc:\t\t", showVersionWithDefault ghcVersion]+ ]+ where+ showVersionWithDefault :: Maybe Version -> String+ showVersionWithDefault = maybe ("Not found") showVersion++findProgramVersions :: IO ProgramsOfInterest+findProgramVersions = ProgramsOfInterest+ <$> findVersionOf "cabal"+ <*> findVersionOf "stack"+ <*> findVersionOf "ghc"++-- | Find the version of the given program.+-- Assumes the program accepts the cli argument "--numeric-version".+-- If the invocation has a non-zero exit-code, we return 'Nothing'+findVersionOf :: FilePath -> IO (Maybe Version)+findVersionOf tool =+ findExecutable tool >>= \case+ Nothing -> pure Nothing+ Just path ->+ readProcessWithExitCode path ["--numeric-version"] "" >>= \case+ (ExitSuccess, sout, _) -> pure $ consumeParser myVersionParser sout+ _ -> pure $ Nothing+ where+ myVersionParser = do+ skipSpaces+ version <- parseVersion+ skipSpaces+ pure version++ consumeParser :: ReadP a -> String -> Maybe a+ consumeParser p input = listToMaybe $ map fst . filter (null . snd) $ readP_to_S p input
+ test/functional/Class.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE LambdaCase #-}+-- {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Class+ ( tests+ )+where++import Control.Lens hiding ((<.>))+import Control.Monad.IO.Class (MonadIO(liftIO))+import qualified Data.ByteString.Lazy as BS+import qualified Data.Text.Encoding as T+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types hiding (_title, _command)+import qualified Language.Haskell.LSP.Types.Lens as J+import System.FilePath+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.Golden+import Test.Tasty.HUnit++tests :: TestTree+tests = testGroup+ "class"+ [ testCase "Produces addMinimalMethodPlaceholders code actions for one instance" $ do+ runSession hlsCommand fullCaps classPath $ do+ doc <- openDoc "T1.hs" "haskell"+ _ <- waitForDiagnosticsFromSource doc "typecheck"+ caResults <- getAllCodeActions doc+ liftIO $ map (^? _CACodeAction . J.title) caResults+ @?=+ [ Just "Add placeholders for '=='"+ , Just "Add placeholders for '/='"+ ]+ , glodenTest "Creates a placeholder for '=='" "T1" "eq"+ $ \(eqAction:_) -> do+ executeCodeAction eqAction+ , glodenTest "Creates a placeholder for '/='" "T1" "ne"+ $ \(_:neAction:_) -> do+ executeCodeAction neAction+ , glodenTest "Creates a placeholder for 'fmap'" "T2" "fmap"+ $ \(_:_:fmapAction:_) -> do+ executeCodeAction fmapAction+ , glodenTest "Creates a placeholder for multiple methods 1" "T3" "1"+ $ \(mmAction:_) -> do+ executeCodeAction mmAction+ , glodenTest "Creates a placeholder for multiple methods 2" "T3" "2"+ $ \(_:mmAction:_) -> do+ executeCodeAction mmAction+ ]++_CACodeAction :: Prism' CAResult CodeAction+_CACodeAction = prism' CACodeAction $ \case+ CACodeAction action -> Just action+ _ -> Nothing++classPath :: FilePath+classPath = "test" </> "testdata" </> "class"++glodenTest :: String -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree+glodenTest name fp deco execute+ = goldenVsStringDiff name goldenGitDiff (classPath </> fp <.> deco <.> "expected" <.> "hs")+ $ runSession hlsCommand fullCaps classPath+ $ do+ doc <- openDoc (fp <.> "hs") "haskell"+ _ <- waitForDiagnosticsFromSource doc "typecheck"+ actions <- concatMap (^.. _CACodeAction) <$> getAllCodeActions doc+ execute actions+ BS.fromStrict . T.encodeUtf8 <$> getDocumentEdit doc++goldenGitDiff :: FilePath -> FilePath -> [String]+goldenGitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]
+ test/functional/Command.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+module Command (tests) where++import Control.Lens hiding (List)+import Control.Monad.IO.Class+import qualified Data.Text as T+import Data.Char+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types as LSP+import Language.Haskell.LSP.Types.Lens as LSP+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+++--TODO : Response Message no longer has 4 inputs+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+ 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"+ , ignoreTestBecause "Broken: Plugin package doesn't exist" $+ testCase "get de-prefixed" $+ runSession hlsCommand fullCaps "test/testdata/" $ do+ ResponseMessage _ _ (Left err) <- request+ WorkspaceExecuteCommand+ (ExecuteCommandParams "1234:package:add" (Just (List [])) Nothing) :: Session ExecuteCommandResponse+ let ResponseError _ msg _ = err+ -- We expect an error message about the dud arguments, but should pickup "add" and "package"+ liftIO $ (msg `T.isInfixOf` "while parsing args for add in plugin package") @? "Has error message"+ ]
+ test/functional/Completion.hs view
@@ -0,0 +1,376 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Completion(tests) where++import Control.Monad.IO.Class+import Control.Lens hiding ((.=))+import Data.Aeson (object, (.=))+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types+import Language.Haskell.LSP.Types.Lens hiding (applyEdit)+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+import Test.Tasty.HUnit+import qualified Data.Text as T+import System.Time.Extra (sleep)++tests :: TestTree+tests = testGroup "completions" [+ testCase "works" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 9)+ let item = head $ filter ((== "putStrLn") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "putStrLn"+ item ^. kind @?= Just CiFunction+ item ^. detail @?= Just ":: String -> IO ()"+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "putStrLn ${1:String}"++ , ignoreTestBecause "no support for itemCompletion/resolve requests"+ $ testCase "itemCompletion/resolve works" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 9)+ let item = head $ filter ((== "putStrLn") . (^. label)) compls+ resolvedRes <- request CompletionItemResolve item+ let Right (resolved :: CompletionItem) = resolvedRes ^. result+ liftIO $ print resolved+ liftIO $ do+ resolved ^. label @?= "putStrLn"+ resolved ^. kind @?= Just CiFunction+ resolved ^. detail @?= Just "String -> IO ()\nPrelude"+ resolved ^. insertTextFormat @?= Just Snippet+ resolved ^. insertText @?= Just "putStrLn ${1:String}"++ , testCase "completes imports" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ liftIO $ sleep 4++ let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 1 22)+ let item = head $ filter ((== "Maybe") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "Maybe"+ item ^. detail @?= Just "Data.Maybe"+ item ^. kind @?= Just CiModule++ , testCase "completes qualified imports" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ liftIO $ sleep 4++ let te = TextEdit (Range (Position 2 17) (Position 1 25)) "Dat"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 1 19)+ let item = head $ filter ((== "Data.List") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "Data.List"+ item ^. detail @?= Just "Data.List"+ item ^. kind @?= Just CiModule++ , testCase "completes language extensions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ liftIO $ sleep 4++ let te = TextEdit (Range (Position 0 24) (Position 0 31)) ""+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 0 24)+ let item = head $ filter ((== "OverloadedStrings") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "OverloadedStrings"+ item ^. kind @?= Just CiKeyword++ , testCase "completes pragmas" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ liftIO $ sleep 4++ let te = TextEdit (Range (Position 0 4) (Position 0 34)) ""+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 0 4)+ let item = head $ filter ((== "LANGUAGE") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "LANGUAGE"+ item ^. kind @?= Just CiKeyword+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "LANGUAGE ${1:extension} #-}"++ , testCase "completes pragmas no close" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 0 4) (Position 0 24)) ""+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 0 4)+ let item = head $ filter ((== "LANGUAGE") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "LANGUAGE"+ item ^. kind @?= Just CiKeyword+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "LANGUAGE ${1:extension}"++ , testCase "completes options pragma" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ liftIO $ sleep 4++ let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 0 4)+ let item = head $ filter ((== "OPTIONS_GHC") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "OPTIONS_GHC"+ item ^. kind @?= Just CiKeyword+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "OPTIONS_GHC -${1:option} #-}"++ , testCase "completes ghc options pragma values" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 0 0) (Position 0 0)) "{-# OPTIONS_GHC -Wno-red #-}\n"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 0 24)+ let item = head $ filter ((== "Wno-redundant-constraints") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "Wno-redundant-constraints"+ item ^. kind @?= Just CiKeyword+ item ^. insertTextFormat @?= Nothing+ item ^. insertText @?= Nothing++ , testCase "completes with no prefix" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ compls <- getCompletions doc (Position 5 7)+ liftIO $ any ((== "!!") . (^. label)) compls @? ""++ -- See https://github.com/haskell/haskell-ide-engine/issues/903+ , testCase "strips compiler generated stuff from completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "DupRecFields.hs" "haskell"++ let te = TextEdit (Range (Position 5 0) (Position 5 2)) "acc"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 4)+ let item = head $ filter (\c -> c^.label == "accessor") compls+ liftIO $ do+ item ^. label @?= "accessor"+ item ^. kind @?= Just CiFunction++ , 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 <- getCompletions doc (Position 5 9)+ let item = head $ filter ((== "id") . (^. label)) compls+ liftIO $ do+ item ^. detail @?= Just ":: a -> a"++ , testCase "have implicit foralls with multiple type variables" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip"+ _ <- applyEdit doc te+ compls <- getCompletions doc (Position 5 11)+ let item = head $ filter ((== "flip") . (^. label)) compls+ liftIO $+ item ^. detail @?= Just ":: (a -> b -> c) -> b -> a -> c"++ , contextTests+ , snippetTests+ ]++snippetTests :: TestTree+snippetTests = testGroup "snippets" [+ testCase "work for argumentless constructors" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "Nothing"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 14)+ let item = head $ filter ((== "Nothing") . (^. label)) compls+ liftIO $ do+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "Nothing "++ , testCase "work for polymorphic types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 11)+ let item = head $ filter ((== "foldl") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "foldl"+ item ^. kind @?= Just CiFunction+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "foldl ${1:b -> a -> b} ${2:b} ${3:t a}"++ , testCase "work for complex types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "mapM"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 11)+ let item = head $ filter ((== "mapM") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "mapM"+ item ^. kind @?= Just CiFunction+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "mapM ${1:a -> m b} ${2:t a}"++ , testCase "work for infix functions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 18)+ let item = head $ filter ((== "filter") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "filter"+ item ^. kind @?= Just CiFunction+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "filter ${1:a -> Bool} ${2:[a]}"++ , testCase "work for infix functions in backticks" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 18)+ let item = head $ filter ((== "filter") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "filter"+ item ^. kind @?= Just CiFunction+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "filter ${1:a -> Bool} ${2:[a]}"++ , testCase "work for qualified infix functions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 29)+ let item = head $ filter ((== "intersperse") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "intersperse"+ item ^. kind @?= Just CiFunction+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "intersperse ${1:a} ${2:[a]}"++ , testCase "work for qualified infix functions in backticks" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 29)+ let item = head $ filter ((== "intersperse") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "intersperse"+ item ^. kind @?= Just CiFunction+ item ^. insertTextFormat @?= Just Snippet+ item ^. insertText @?= Just "intersperse ${1:a} ${2:[a]}"++ , ignoreTestBecause "ghcide does not support the completionSnippetsOn option" $+ testCase "respects lsp configuration" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ let config = object [ "haskell" .= (object ["completionSnippetsOn" .= False])]++ sendNotification WorkspaceDidChangeConfiguration+ (DidChangeConfigurationParams config)++ checkNoSnippets doc++ , testCase "respects client capabilities" $ runSession hlsCommand noSnippetsCaps "test/testdata/completion" $ do+ doc <- openDoc "Completion.hs" "haskell"++ checkNoSnippets doc+ ]+ where+ checkNoSnippets doc = do+ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold"+ _ <- applyEdit doc te++ compls <- getCompletions doc (Position 5 11)+ let item = head $ filter ((== "foldl") . (^. label)) compls+ liftIO $ do+ item ^. label @?= "foldl"+ item ^. kind @?= Just CiFunction+ item ^. insertTextFormat @?= Just PlainText+ item ^. insertText @?= Nothing++ noSnippetsCaps =+ ( textDocument+ . _Just+ . completion+ . _Just+ . completionItem+ . _Just+ . snippetSupport+ ?~ False+ )+ fullCaps++contextTests :: TestTree+contextTests = testGroup "contexts" [+ testCase "only provides type suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Context.hs" "haskell"++ compls <- getCompletions doc (Position 2 17)+ liftIO $ do+ compls `shouldContainCompl` "Integer"+ compls `shouldNotContainCompl` "interact"++ , testCase "only provides value suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Context.hs" "haskell"++ compls <- getCompletions doc (Position 3 9)+ liftIO $ do+ compls `shouldContainCompl` "abs"+ compls `shouldNotContainCompl` "Applicative"++ , testCase "completes qualified type suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "Context.hs" "haskell"++ compls <- getCompletions doc (Position 2 26)+ liftIO $ do+ compls `shouldNotContainCompl` "forkOn"+ compls `shouldContainCompl` "MVar"+ compls `shouldContainCompl` "Chan"+ ]++shouldContainCompl :: [CompletionItem] -> T.Text -> Assertion+compls `shouldContainCompl` x =+ any ((== x) . (^. label)) compls+ @? "Should contain completion: " ++ show x++shouldNotContainCompl :: [CompletionItem] -> T.Text -> Assertion+compls `shouldNotContainCompl` x =+ all ((/= x) . (^. label)) compls+ @? "Should not contain completion: " ++ show x
+ test/functional/Config.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}++module Config (tests) where++import Control.Lens hiding (List)+import Control.Monad.IO.Class+import Data.Aeson+import Data.Default+import qualified Data.Map as Map+import qualified Data.Text as T+import Ide.Plugin.Config+import Language.Haskell.LSP.Test as Test+import Language.Haskell.LSP.Types+import qualified Language.Haskell.LSP.Types.Lens as L+import System.FilePath ((</>))+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.HUnit++{-# ANN module ("HLint: ignore Reduce duplication"::String) #-}++tests :: TestTree+tests = testGroup "plugin config" [+ -- Note: because the flag is treated generically in the plugin handler, we+ -- do not have to test each individual plugin+ hlintTests+ ]++hlintTests :: TestTree+hlintTests = testGroup "hlint plugin enables" [++ testCase "changing hlintOn configuration enables or disables hlint diagnostics" $ runHlintSession "" $ do+ let config = def { hlintOn = True }+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))++ doc <- openDoc "ApplyRefact2.hs" "haskell"+ testHlintDiagnostics doc++ let config' = def { hlintOn = False }+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config'))++ diags' <- waitForDiagnosticsFrom doc++ liftIO $ noHlintDiagnostics diags'++ , testCase "changing hlint plugin configuration enables or disables hlint diagnostics" $ runHlintSession "" $ do+ let config = def { hlintOn = True }+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))++ doc <- openDoc "ApplyRefact2.hs" "haskell"+ testHlintDiagnostics doc++ let config' = pluginGlobalOn config "hlint" False+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config'))++ diags' <- waitForDiagnosticsFrom doc++ liftIO $ noHlintDiagnostics diags'++ ]+ where+ runHlintSession :: FilePath -> Session a -> IO a+ runHlintSession subdir =+ failIfSessionTimeout . runSession hlsCommand fullCaps ("test/testdata/hlint" </> subdir)++ noHlintDiagnostics :: [Diagnostic] -> Assertion+ noHlintDiagnostics diags =+ Just "hlint" `notElem` map (^. L.source) diags @? "There are no hlint diagnostics"++ testHlintDiagnostics doc = do+ diags <- waitForDiagnosticsFromSource doc "hlint"+ liftIO $ length diags > 0 @? "There are hlint diagnostics"++pluginGlobalOn :: Config -> T.Text -> Bool -> Config+pluginGlobalOn config pid state = config'+ where+ pluginConfig = def { plcGlobalOn = state }+ config' = def { plugins = Map.insert pid pluginConfig (plugins config) }
+ test/functional/Deferred.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+module Deferred(tests) where++import Control.Applicative.Combinators+import Control.Monad.IO.Class+import Control.Lens hiding (List)+-- import Control.Monad+-- import Data.Maybe+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types+import Language.Haskell.LSP.Types.Lens hiding (id, message)+-- import qualified Language.Haskell.LSP.Types.Lens as LSP+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+import Test.Tasty.HUnit+++tests :: TestTree+tests = testGroup "deferred responses" [++ --TODO: DOes not compile+ -- testCase "do not affect hover requests" $ runSession hlsCommand fullCaps "test/testdata" $ do+ -- doc <- openDoc "FuncTest.hs" "haskell"++ -- id1 <- sendRequest TextDocumentHover (TextDocumentPositionParams doc (Position 4 2) Nothing)++ -- skipMany anyNotification+ -- hoverRsp <- message :: Session HoverResponse+ -- liftIO $ hoverRsp ^? result . _Just . _Just . contents @?= Nothing+ -- liftIO $ hoverRsp ^. LSP.id @?= responseId id1++ -- id2 <- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing)+ -- symbolsRsp <- skipManyTill anyNotification message :: Session DocumentSymbolsResponse+ -- liftIO $ symbolsRsp ^. LSP.id @?= responseId id2++ -- id3 <- sendRequest TextDocumentHover (TextDocumentPositionParams doc (Position 4 2) Nothing)+ -- hoverRsp2 <- skipManyTill anyNotification message :: Session HoverResponse+ -- liftIO $ hoverRsp2 ^. LSP.id @?= responseId id3++ -- let contents2 = hoverRsp2 ^? result . _Just . _Just . contents+ -- liftIO $ contents2 `shouldNotSatisfy` null++ -- -- Now that we have cache the following request should be instant+ -- let highlightParams = TextDocumentPositionParams doc (Position 7 0) Nothing+ -- highlightRsp <- request TextDocumentDocumentHighlight highlightParams+ -- let (Just (List locations)) = highlightRsp ^. result+ -- liftIO $ locations @?= [ DocumentHighlight+ -- { _range = Range+ -- { _start = Position {_line = 7, _character = 0}+ -- , _end = Position {_line = 7, _character = 2}+ -- }+ -- , _kind = Just HkWrite+ -- }+ -- , DocumentHighlight+ -- { _range = Range+ -- { _start = Position {_line = 7, _character = 0}+ -- , _end = Position {_line = 7, _character = 2}+ -- }+ -- , _kind = Just HkWrite+ -- }+ -- , DocumentHighlight+ -- { _range = Range+ -- { _start = Position {_line = 5, _character = 6}+ -- , _end = Position {_line = 5, _character = 8}+ -- }+ -- , _kind = Just HkRead+ -- }+ -- , DocumentHighlight+ -- { _range = Range+ -- { _start = Position {_line = 7, _character = 0}+ -- , _end = Position {_line = 7, _character = 2}+ -- }+ -- , _kind = Just HkWrite+ -- }+ -- , DocumentHighlight+ -- { _range = Range+ -- { _start = Position {_line = 7, _character = 0}+ -- , _end = Position {_line = 7, _character = 2}+ -- }+ -- , _kind = Just HkWrite+ -- }+ -- , DocumentHighlight+ -- { _range = Range+ -- { _start = Position {_line = 5, _character = 6}+ -- , _end = Position {_line = 5, _character = 8}+ -- }+ -- , _kind = Just HkRead+ -- }+ -- ]++ 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 @?= []++ -- TODO: the benefits of caching parsed modules is doubted.+ -- TODO: add issue link+ -- , testCase "respond to untypecheckable modules with parsed module cache" $+ -- runSession hlsCommand fullCaps "test/testdata" $ do+ -- doc <- openDoc "FuncTestFail.hs" "haskell"+ -- (Left (sym:_)) <- getDocumentSymbols doc+ -- liftIO $ sym ^. name @?= "main"++ -- TODO does not compile+ -- , testCase "returns hints as diagnostics" $ runSession hlsCommand fullCaps "test/testdata" $ do+ -- _ <- openDoc "FuncTest.hs" "haskell"++ -- cwd <- liftIO getCurrentDirectory+ -- let testUri = filePathToUri $ cwd </> "test/testdata/FuncTest.hs"++ -- diags <- skipManyTill loggingNotification publishDiagnosticsNotification+ -- liftIO $ diags ^? params @?= (Just $ PublishDiagnosticsParams+ -- { _uri = testUri+ -- , _diagnostics = List+ -- [ Diagnostic+ -- (Range (Position 9 6) (Position 10 18))+ -- (Just DsInfo)+ -- (Just (StringValue "Redundant do"))+ -- (Just "hlint")+ -- "Redundant do\nFound:\n do putStrLn \"hello\"\nWhy not:\n putStrLn \"hello\"\n"+ -- Nothing+ -- ]+ -- }+ -- )+ -- let args' = H.fromList [("pos", toJSON (Position 7 0)), ("file", toJSON testUri)]+ -- args = List [Object args']+ --+ -- executeRsp <- request WorkspaceExecuteCommand (ExecuteCommandParams "hare:demote" (Just args) Nothing)+ -- liftIO $ executeRsp ^. result @?= Just (Object H.empty)++ -- editReq <- message :: Session ApplyWorkspaceEditRequest+ -- let expectedTextEdits = List [TextEdit (Range (Position 6 0) (Position 7 6)) " where\n bb = 5"]+ -- expectedTextDocEdits = List [TextDocumentEdit (VersionedTextDocumentIdentifier testUri (Just 0)) expectedTextEdits]+ -- liftIO $ editReq ^. params . edit @?= WorkspaceEdit+ -- Nothing+ -- (Just expectedTextDocEdits)+ -- , multiServerTests+ , multiMainTests+ ]++--TODO: Does not compile+-- multiServerTests :: TestTree+-- multiServerTests = testGroup "multi-server setup" [+-- testCase "doesn't have clashing commands on two servers" $ do+-- let getCommands = runSession hlsCommand fullCaps "test/testdata" $ do+-- rsp <- initializeResponse+-- let uuids = rsp ^? result . _Just . capabilities . executeCommandProvider . _Just . commands+-- return $ fromJust uuids+-- List uuids1 <- getCommands+-- List uuids2 <- getCommands+-- liftIO $ forM_ (zip uuids1 uuids2) (uncurry shouldNotBe)+-- ]++multiMainTests :: TestTree+multiMainTests = testGroup "multiple main modules" [+ ignoreTestBecause "Broken: Unexpected ConduitParser.empty" $+ 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 :: Session PublishDiagnosticsNotification+ diagsRspGhc <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification+ let (List diags) = diagsRspGhc ^. params . diagnostics++ liftIO $ length diags @?= 2++ _doc2 <- openDoc "HaReRename.hs" "haskell"+ _diagsRspHlint2 <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification+ -- errMsg <- skipManyTill anyNotification notification :: Session ShowMessageNotification+ diagsRsp2 <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification+ let (List diags2) = diagsRsp2 ^. params . diagnostics++ liftIO $ show diags2 @?= "[]"+ ]
+ test/functional/Definition.hs view
@@ -0,0 +1,69 @@+module Definition (tests) where++import Control.Lens+import Control.Monad.IO.Class+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types+import Language.Haskell.LSP.Types.Lens+import System.Directory+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+import Test.Tasty.HUnit++tests :: TestTree+tests = testGroup "definitions" [++ ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/References.hs" $+ testCase "goto's symbols" $ 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 @?= [Location (doc ^. uri) expRange]++ -- -----------------------------------++ , 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 @?= [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+ doc <- openDoc "Foo.hs" "haskell"+ defs <- getDefinitions doc (Position 0 15)+ liftIO $ do+ fp <- canonicalizePath "test/testdata/definition/Bar.hs"+ defs @?= [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+ doc <- openDoc "Foo.hs" "haskell"+ _ <- openDoc "Bar.hs" "haskell"+ defs <- getDefinitions doc (Position 2 8)+ liftIO $ do+ fp <- canonicalizePath "test/testdata/definition/Bar.hs"+ defs @?= [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" $+ runSession hlsCommand fullCaps "test/testdata/definition" $ do+ doc <- openDoc "Foo.hs" "haskell"+ otherDoc <- openDoc "Bar.hs" "haskell"+ closeDoc otherDoc+ defs <- getDefinitions doc (Position 2 8)+ _ <- waitForDiagnostics+ liftIO $ putStrLn "D"+ liftIO $ do+ fp <- canonicalizePath "test/testdata/definition/Bar.hs"+ defs @?= [Location (filePathToUri fp) zeroRange]+ liftIO $ putStrLn "E" -- AZ++ noDiagnostics+ ]++zeroRange :: Range+zeroRange = Range (Position 0 0) (Position 0 0)
+ test/functional/Diagnostic.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}++module Diagnostic (tests) where++import Control.Applicative.Combinators+import Control.Lens hiding (List)+import Control.Monad.IO.Class+import Data.Aeson (toJSON)+import qualified Data.Text as T+import qualified Data.Default+import Ide.Logger+import Ide.Plugin.Config+import Language.Haskell.LSP.Test hiding (message)+import Language.Haskell.LSP.Types+import qualified Language.Haskell.LSP.Types.Lens as LSP+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+import Test.Tasty.HUnit++-- ---------------------------------------------------------------------++tests :: TestTree+tests = testGroup "diagnostics providers" [+ saveTests+ , triggerTests+ , errorTests+ , warningTests+ ]+++triggerTests :: TestTree+triggerTests = testGroup "diagnostics triggers" [+ ignoreTestBecause "Broken" $+ ignoreTestBecause "Broken" $ testCase "runs diagnostics on save" $+ runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do+ logm "starting DiagnosticSpec.runs diagnostic on save"+ doc <- openDoc "ApplyRefact2.hs" "haskell"++ diags@(reduceDiag:_) <- waitForDiagnostics++ liftIO $ do+ length diags @?= 2+ reduceDiag ^. LSP.range @?= Range (Position 1 0) (Position 1 12)+ reduceDiag ^. LSP.severity @?= Just DsInfo+ reduceDiag ^. LSP.code @?= Just (StringValue "Eta reduce")+ reduceDiag ^. LSP.source @?= Just "hlint"++ diags2a <- waitForDiagnostics++ liftIO $ length diags2a @?= 2++ sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)++ diags3@(d:_) <- waitForDiagnosticsSource "eg2"++ liftIO $ do+ length diags3 @?= 1+ d ^. LSP.range @?= Range (Position 0 0) (Position 1 0)+ d ^. LSP.severity @?= Nothing+ d ^. LSP.code @?= Nothing+ d ^. LSP.message @?= T.pack "Example plugin diagnostic, triggered byDiagnosticOnSave"+ ]++errorTests :: TestTree+errorTests = testGroup "typed hole errors" [+ ignoreTestBecause "Broken" $ testCase "is deferred" $+ runSession hlsCommand fullCaps "test/testdata" $ do+ _ <- openDoc "TypedHoles.hs" "haskell"+ [diag] <- waitForDiagnosticsSource "bios"+ liftIO $ diag ^. LSP.severity @?= Just DsWarning+ ]++warningTests :: TestTree+warningTests = testGroup "Warnings are warnings" [+ ignoreTestBecause "Broken" $ testCase "Overrides -Werror" $+ runSession hlsCommand fullCaps "test/testdata/wErrorTest" $ do+ _ <- openDoc "src/WError.hs" "haskell"+ [diag] <- waitForDiagnosticsSource "bios"+ liftIO $ diag ^. LSP.severity @?= Just DsWarning+ ]++saveTests :: TestTree+saveTests = testGroup "only diagnostics on save" [+ ignoreTestBecause "Broken" $ testCase "Respects diagnosticsOnChange setting" $+ runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do+ let config = Data.Default.def { diagnosticsOnChange = False } :: Config+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))+ doc <- openDoc "Hover.hs" "haskell"+ diags <- waitForDiagnostics++ liftIO $ do+ length diags @?= 0++ let te = TextEdit (Range (Position 0 0) (Position 0 13)) ""+ _ <- applyEdit doc te+ skipManyTill loggingNotification noDiagnostics++ sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)+ diags2 <- waitForDiagnostics+ liftIO $+ length diags2 @?= 1+ ]
+ test/functional/Format.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE OverloadedStrings, CPP #-}+module Format (tests) where++import Control.Monad.IO.Class+import Data.Aeson+import qualified Data.ByteString.Lazy as BS+import qualified Data.Text.Encoding as T+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.Golden+import Test.Tasty.HUnit++#if AGPL+import qualified Data.Text.IO as T+#endif++tests :: TestTree+tests = testGroup "format document" [+ goldenVsStringDiff "works" goldenGitDiff "test/testdata/format/Format.formatted_document.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ doc <- openDoc "Format.hs" "haskell"+ formatDoc doc (FormattingOptions 2 True)+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ , goldenVsStringDiff "works with custom tab size" goldenGitDiff "test/testdata/format/Format.formatted_document_with_tabsize.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ doc <- openDoc "Format.hs" "haskell"+ formatDoc doc (FormattingOptions 5 True)+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ , rangeTests+ , providerTests+ , stylishHaskellTests+#if AGPL+ , brittanyTests+#endif+ , ormoluTests+ , fourmoluTests+ ]++rangeTests :: TestTree+rangeTests = testGroup "format range" [+ goldenVsStringDiff "works" goldenGitDiff "test/testdata/format/Format.formatted_range.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ doc <- openDoc "Format.hs" "haskell"+ formatRange doc (FormattingOptions 2 True) (Range (Position 5 0) (Position 7 10))+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ , goldenVsStringDiff "works with custom tab size" goldenGitDiff "test/testdata/format/Format.formatted_range_with_tabsize.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ doc <- openDoc "Format.hs" "haskell"+ formatRange doc (FormattingOptions 5 True) (Range (Position 8 0) (Position 11 19))+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ ]++providerTests :: TestTree+providerTests = testGroup "formatting provider" [+ testCase "respects none" $ runSessionWithConfig (formatConfig "none") hlsCommand fullCaps "test/testdata/format" $ do+ doc <- openDoc "Format.hs" "haskell"+ orig <- documentContents doc++ formatDoc doc (FormattingOptions 2 True)+ documentContents doc >>= liftIO . (@?= orig)++ formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10))+ documentContents doc >>= liftIO . (@?= orig)++#if AGPL+ , testCase "can change on the fly" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ formattedBrittany <- liftIO $ T.readFile "test/testdata/format/Format.brittany.formatted.hs"+ formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.formatted.hs"+ formattedBrittanyPostFloskell <- liftIO $ T.readFile "test/testdata/format/Format.brittany_post_floskell.formatted.hs"++ doc <- openDoc "Format.hs" "haskell"++ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))+ formatDoc doc (FormattingOptions 2 True)+ documentContents doc >>= liftIO . (@?= formattedBrittany)++ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "floskell"))+ formatDoc doc (FormattingOptions 2 True)+ documentContents doc >>= liftIO . (@?= formattedFloskell)++ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))+ formatDoc doc (FormattingOptions 2 True)+ documentContents doc >>= liftIO . (@?= formattedBrittanyPostFloskell)+ , testCase "supports both new and old configuration sections" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ formattedBrittany <- liftIO $ T.readFile "test/testdata/format/Format.brittany.formatted.hs"+ formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.formatted.hs"++ doc <- openDoc "Format.hs" "haskell"++ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfigOld "brittany"))+ formatDoc doc (FormattingOptions 2 True)+ documentContents doc >>= liftIO . (@?= formattedBrittany)++ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfigOld "floskell"))+ formatDoc doc (FormattingOptions 2 True)+ documentContents doc >>= liftIO . (@?= formattedFloskell)+#endif+ ]++stylishHaskellTests :: TestTree+stylishHaskellTests = testGroup "stylish-haskell" [+ goldenVsStringDiff "formats a document" goldenGitDiff "test/testdata/format/StylishHaskell.formatted_document.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "stylish-haskell"))+ doc <- openDoc "StylishHaskell.hs" "haskell"+ formatDoc doc (FormattingOptions 2 True)+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ , goldenVsStringDiff "formats a range" goldenGitDiff "test/testdata/format/StylishHaskell.formatted_range.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "stylish-haskell"))+ doc <- openDoc "StylishHaskell.hs" "haskell"+ formatRange doc (FormattingOptions 2 True) (Range (Position 0 0) (Position 2 21))+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ ]++#if AGPL+brittanyTests :: TestTree+brittanyTests = testGroup "brittany" [+ goldenVsStringDiff "formats a document with LF endings" goldenGitDiff "test/testdata/format/BrittanyLF.formatted_document.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))+ doc <- openDoc "BrittanyLF.hs" "haskell"+ formatDoc doc (FormattingOptions 4 True)+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc++ , goldenVsStringDiff "formats a document with CRLF endings" goldenGitDiff "test/testdata/format/BrittanyCRLF.formatted_document.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))+ doc <- openDoc "BrittanyCRLF.hs" "haskell"+ formatDoc doc (FormattingOptions 4 True)+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc++ , goldenVsStringDiff "formats a range with LF endings" goldenGitDiff "test/testdata/format/BrittanyLF.formatted_range.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))+ doc <- openDoc "BrittanyLF.hs" "haskell"+ let range = Range (Position 1 0) (Position 2 22)+ formatRange doc (FormattingOptions 4 True) range+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc++ , goldenVsStringDiff "formats a range with CRLF endings" goldenGitDiff "test/testdata/format/BrittanyCRLF.formatted_range.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))+ doc <- openDoc "BrittanyCRLF.hs" "haskell"+ let range = Range (Position 1 0) (Position 2 22)+ formatRange doc (FormattingOptions 4 True) range+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ ]+#endif++ormoluTests :: TestTree+ormoluTests = testGroup "ormolu"+ [ goldenVsStringDiff "formats correctly" goldenGitDiff "test/testdata/format/Format.ormolu.formatted.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu"))+ doc <- openDoc "Format.hs" "haskell"+ formatDoc doc (FormattingOptions 2 True)+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ , goldenVsStringDiff "formats imports correctly" goldenGitDiff "test/testdata/format/Format2.ormolu.formatted.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu"))+ doc <- openDoc "Format2.hs" "haskell"+ formatDoc doc (FormattingOptions 2 True)+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ ]++fourmoluTests :: TestTree+fourmoluTests = testGroup "fourmolu"+ [ goldenVsStringDiff "formats correctly" goldenGitDiff "test/testdata/format/Format.fourmolu.formatted.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "fourmolu"))+ doc <- openDoc "Format.hs" "haskell"+ formatDoc doc (FormattingOptions 4 True)+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ , goldenVsStringDiff "formats imports correctly" goldenGitDiff "test/testdata/format/Format2.fourmolu.formatted.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "fourmolu"))+ doc <- openDoc "Format2.hs" "haskell"+ formatDoc doc (FormattingOptions 4 True)+ BS.fromStrict . T.encodeUtf8 <$> documentContents doc+ ]++formatLspConfig :: Value -> Value+formatLspConfig provider = object [ "haskell" .= object ["formattingProvider" .= (provider :: Value)] ]++#if AGPL+-- | The same as 'formatLspConfig' but using the legacy section name+formatLspConfigOld :: Value -> Value+formatLspConfigOld provider = object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ]+#endif++formatConfig :: Value -> SessionConfig+formatConfig provider = defaultConfig { lspConfig = Just (formatLspConfig provider) }++goldenGitDiff :: FilePath -> FilePath -> [String]+goldenGitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]
+ test/functional/FunctionalBadProject.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++module FunctionalBadProject (tests) where++-- import Control.Lens hiding (List)+-- import Control.Monad.IO.Class+-- import qualified Data.Text as T+-- import Language.Haskell.LSP.Test hiding (message)+-- import Language.Haskell.LSP.Types as LSP+-- import Language.Haskell.LSP.Types.Lens as LSP hiding (contents, error )+-- import Test.Hls.Util+import Test.Tasty+import Test.Tasty.HUnit++-- ---------------------------------------------------------------------+-- TODO: Currently this can not succeed, since such an error is thrown in "runActionWithContext" which+-- can produce diagnostics at the moment. Needs more investigation+-- TODO: @fendor: Add issue link here+--+tests :: TestTree+tests = testGroup "behaviour on malformed projects" [+ testCase "no test executed" $ True @?= True+ ]++ -- testCase "deals with cabal file with unsatisfiable dependency" $+ -- runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata/badProjects/cabal" $ do+ -- -- runSessionWithConfig logConfig hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do+ -- _doc <- openDoc "Foo.hs" "haskell"++ -- diags@(d:_) <- waitForDiagnosticsSource "bios"+ -- -- liftIO $ show diags @?= ""+ -- -- liftIO $ putStrLn $ show diags+ -- -- liftIO $ putStrLn "a"+ -- liftIO $ do+ -- length diags @?= 1+ -- d ^. range @?= Range (Position 0 0) (Position 1 0)+ -- d ^. severity @?= (Just DsError)+ -- d ^. code @?= Nothing+ -- d ^. source @?= Just "bios"+ -- d ^. message @?=+ -- (T.pack "readCreateProcess: stack \"build\" \"--only-configure\" \".\" (exit 1): failed\n")
+ test/functional/FunctionalCodeAction.hs view
@@ -0,0 +1,494 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module FunctionalCodeAction (tests) where++import Control.Applicative.Combinators+import Control.Lens hiding (List)+import Control.Monad+import Control.Monad.IO.Class+import Data.Aeson+import Data.Default+import qualified Data.HashMap.Strict as HM+import Data.List+import Data.Maybe+import qualified Data.Text as T+import Ide.Plugin.Config+import Language.Haskell.LSP.Test as Test+import Language.Haskell.LSP.Types+import qualified Language.Haskell.LSP.Types.Lens as L+import qualified Language.Haskell.LSP.Types.Capabilities as C+import Test.Hls.Util+import Test.Hspec.Expectations++import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause, expectFailBecause)+import Test.Tasty.HUnit+import System.FilePath ((</>))++{-# ANN module ("HLint: ignore Reduce duplication"::String) #-}++tests :: TestTree+tests = testGroup "code actions" [+ hlintTests+ , importTests+ , missingPragmaTests+ , packageTests+ , redundantImportTests+ , renameTests+ , signatureTests+ , typedHoleTests+ , unusedTermTests+ ]+++hlintTests :: TestTree+hlintTests = testGroup "hlint suggestions" [+ testCase "provides 3.8 code actions including apply all" $ runHlintSession "" $ do+ doc <- openDoc "ApplyRefact2.hs" "haskell"+ diags@(reduceDiag:_) <- waitForDiagnosticsFromSource doc "hlint"++ liftIO $ do+ length diags @?= 2 -- "Eta Reduce" and "Redundant Id"+ reduceDiag ^. L.range @?= Range (Position 1 0) (Position 1 12)+ reduceDiag ^. L.severity @?= Just DsInfo+ reduceDiag ^. L.code @?= Just (StringValue "refact:Eta reduce")+ reduceDiag ^. L.source @?= Just "hlint"++ cas <- map fromAction <$> getAllCodeActions doc++ let applyAll = find (\ca -> "Apply all hints" `T.isSuffixOf` (ca ^. L.title)) cas+ let redId = find (\ca -> "Redundant id" `T.isSuffixOf` (ca ^. L.title)) cas+ let redEta = find (\ca -> "Eta reduce" `T.isSuffixOf` (ca ^. L.title)) cas++ liftIO $ isJust applyAll @? "There is 'Apply all hints' code action"+ liftIO $ isJust redId @? "There is 'Redundant id' code action"+ liftIO $ isJust redEta @? "There is 'Eta reduce' code action"++ executeCodeAction (fromJust redId)++ contents <- skipManyTill anyMessage $ getDocumentEdit doc+ liftIO $ contents @?= "main = undefined\nfoo x = x\n"++ , testCase "falls back to pre 3.8 code actions" $ runSession hlsCommand noLiteralCaps "test/testdata/hlint" $ do+ doc <- openDoc "ApplyRefact2.hs" "haskell"++ _ <- waitForDiagnosticsFromSource doc "hlint"++ cars <- getAllCodeActions doc+ etaReduce <- liftIO $ inspectCommand cars ["Eta reduce"]++ executeCommand etaReduce++ contents <- skipManyTill anyMessage $ getDocumentEdit doc+ liftIO $ contents @?= "main = undefined\nfoo = id\n"++ , knownBrokenForGhcVersions [GHC88, GHC86] "hlint doesn't take in account cpp flag as ghc -D argument" $+ testCase "hlint diagnostics works with CPP via ghc -XCPP argument (#554)" $ runHlintSession "cpp" $ do+ doc <- openDoc "ApplyRefact3.hs" "haskell"+ testHlintDiagnostics doc++ , knownBrokenForGhcVersions [GHC88, GHC86] "hlint doesn't take in account cpp flag as ghc -D argument" $+ testCase "hlint diagnostics works with CPP via language pragma (#554)" $ runHlintSession "" $ do+ doc <- openDoc "ApplyRefact3.hs" "haskell"+ testHlintDiagnostics doc++ , testCase "hlint diagnostics works with CPP via -XCPP argument and flag via #include header (#554)" $ runHlintSession "cpp" $ do+ doc <- openDoc "ApplyRefact2.hs" "haskell"+ testHlintDiagnostics doc++ , knownBrokenForGhcVersions [GHC88, GHC86] "apply-refact doesn't take in account the -X argument" $+ testCase "apply-refact works with LambdaCase via ghc -XLambdaCase argument (#590)" $ runHlintSession "lambdacase" $ do+ testRefactor "ApplyRefact1.hs" "Redundant bracket"+ expectedLambdaCase++ , testCase "apply hints works with LambdaCase via language pragma" $ runHlintSession "" $ do+ testRefactor "ApplyRefact1.hs" "Redundant bracket"+ ("{-# LANGUAGE LambdaCase #-}" : expectedLambdaCase)++ , expectFailBecause "apply-refact doesn't work with cpp" $+ testCase "apply hints works with CPP via -XCPP argument" $ runHlintSession "cpp" $ do+ testRefactor "ApplyRefact3.hs" "Redundant bracket"+ expectedCPP++ , expectFailBecause "apply-refact doesn't work with cpp" $+ testCase "apply hints works with CPP via language pragma" $ runHlintSession "" $ do+ testRefactor "ApplyRefact3.hs" "Redundant bracket"+ ("{-# LANGUAGE CPP #-}" : expectedCPP)++ , testCase "hlint diagnostics ignore hints honouring .hlint.yaml" $ runHlintSession "ignore" $ do+ doc <- openDoc "ApplyRefact.hs" "haskell"+ expectNoMoreDiagnostics 3 doc "hlint"++ , testCase "hlint diagnostics ignore hints honouring ANN annotations" $ runHlintSession "" $ do+ doc <- openDoc "ApplyRefact4.hs" "haskell"+ expectNoMoreDiagnostics 3 doc "hlint"++ , knownBrokenForGhcVersions [GHC810] "hlint plugin doesn't honour HLINT annotations (#838)" $+ testCase "hlint diagnostics ignore hints honouring HLINT annotations" $ runHlintSession "" $ do+ doc <- openDoc "ApplyRefact5.hs" "haskell"+ expectNoMoreDiagnostics 3 doc "hlint"+ ]+ where+ runHlintSession :: FilePath -> Session a -> IO a+ runHlintSession subdir =+ failIfSessionTimeout . runSession hlsCommand fullCaps ("test/testdata/hlint" </> subdir)++ testHlintDiagnostics doc = do+ diags <- waitForDiagnosticsFromSource doc "hlint"+ liftIO $ length diags > 0 @? "There are hlint diagnostics"++ testRefactor file caTitle expected = do+ doc <- openDoc file "haskell"+ testHlintDiagnostics doc++ cas <- map fromAction <$> getAllCodeActions doc+ let ca = find (\ca -> caTitle `T.isSuffixOf` (ca ^. L.title)) cas+ liftIO $ isJust ca @? ("There is '" ++ T.unpack caTitle ++"' code action")++ executeCodeAction (fromJust ca)++ contents <- getDocumentEdit doc+ liftIO $ contents @?= T.unlines expected++ expectedLambdaCase = [ "module ApplyRefact1 where", ""+ , "f = \\case \"true\" -> True"+ , " _ -> False"+ ]+ expectedCPP = [ "module ApplyRefact3 where", ""+ , "#ifdef FLAG"+ , "f = 1"+ , "#else"+ , "g = 2"+ , "#endif", ""+ ]++renameTests :: TestTree+renameTests = testGroup "rename suggestions" [+ testCase "works" $ runSession hlsCommand noLiteralCaps "test/testdata" $ do+ doc <- openDoc "CodeActionRename.hs" "haskell"++ _ <- waitForDiagnosticsFromSource doc "typecheck"++ cars <- getAllCodeActions doc+ replaceButStrLn <- liftIO $ inspectCommand cars ["Replace with", "putStrLn"]+ executeCommand replaceButStrLn++ x:_ <- T.lines <$> documentContents doc+ liftIO $ x @?= "main = putStrLn \"hello\""++ , testCase "doesn't give both documentChanges and changes"+ $ runSession hlsCommand noLiteralCaps "test/testdata" $ do+ doc <- openDoc "CodeActionRename.hs" "haskell"++ _ <- waitForDiagnosticsFromSource doc "typecheck"++ cars <- getAllCodeActions doc+ cmd <- liftIO $ inspectCommand cars ["Replace with", "putStrLn"]+ let Just (List [Object args]) = cmd ^. L.arguments+ Object editParams = args HM.! "fallbackWorkspaceEdit"+ liftIO $ do+ "changes" `HM.member` editParams @? "Contains changes"+ not ("documentChanges" `HM.member` editParams) @? "Doesn't contain documentChanges"++ executeCommand cmd++ x1:x2:_ <- T.lines <$> documentContents doc+ liftIO $+ x1 == "main = putStrLn \"hello\""+ || x2 == "foo = putStrLn \"world\""+ @? "One of the typos got fixed"+ ]++importTests :: TestTree+importTests = testGroup "import suggestions" [+ testCase "works with 3.8 code action kinds" $ runSession hlsCommand fullCaps "test/testdata" $ do+ doc <- openDoc "CodeActionImport.hs" "haskell"+ -- No Formatting:+ let config = def { formattingProvider = "none" }+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))++ (diag:_) <- waitForDiagnosticsFrom doc+ liftIO $ diag ^. L.message @?= "Variable not in scope: when :: Bool -> IO () -> IO ()"++ actionsOrCommands <- getAllCodeActions doc+ let actns = map fromAction actionsOrCommands++ importControlMonad <- liftIO $ inspectCodeAction actionsOrCommands ["import Control.Monad"]+ liftIO $ do+ expectCodeAction actionsOrCommands ["import Control.Monad (when)"]+ forM_ actns $ \a -> do+ a ^. L.kind @?= Just CodeActionQuickFix+ length actns >= 10 @? "There are some actions"++ executeCodeAction importControlMonad++ contents <- documentContents doc+ liftIO $ contents @?= "import Control.Monad\nmain :: IO ()\nmain = when True $ putStrLn \"hello\""+ ]++packageTests :: TestTree+packageTests = testGroup "add package suggestions" [+ ignoreTestBecause "no support for adding dependent packages via code action" $ testCase "adds to .cabal files" $ do+ flushStackEnvironment+ runSession hlsCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do+ doc <- openDoc "AddPackage.hs" "haskell"++ -- ignore the first empty hlint diagnostic publish+ [_,diag:_] <- count 2 $ waitForDiagnosticsFrom doc++ let prefixes = [ "Could not load module `Data.Text'" -- Windows && GHC >= 8.6+ , "Could not find module `Data.Text'" -- Windows+ , "Could not load module ‘Data.Text’" -- GHC >= 8.6+ , "Could not find module ‘Data.Text’"+ ]+ in liftIO $ any (`T.isPrefixOf` (diag ^. L.message)) prefixes @? "Contains prefix"++ acts <- getAllCodeActions doc+ let (CACodeAction action:_) = acts++ liftIO $ do+ action ^. L.title @?= "Add text as a dependency"+ action ^. L.kind @?= Just CodeActionQuickFix+ "package:add" `T.isSuffixOf` (action ^. L.command . _Just . L.command) @? "Command contains package:add"++ executeCodeAction action++ contents <- skipManyTill anyMessage $ getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal"+ liftIO $+ any (\l -> "text -any" `T.isSuffixOf` l || "text : {} -any" `T.isSuffixOf` l) (T.lines contents) @? "Contains text package"++ , ignoreTestBecause "no support for adding dependent packages via code action" $ testCase "adds to hpack package.yaml files" $+ runSession hlsCommand fullCaps "test/testdata/addPackageTest/hpack-exe" $ do+ doc <- openDoc "app/Asdf.hs" "haskell"++ -- ignore the first empty hlint diagnostic publish+ [_,_:diag:_] <- count 2 $ waitForDiagnosticsFrom doc++ let prefixes = [ "Could not load module `Codec.Compression.GZip'" -- Windows && GHC >= 8.6+ , "Could not find module `Codec.Compression.GZip'" -- Windows+ , "Could not load module ‘Codec.Compression.GZip’" -- GHC >= 8.6+ , "Could not find module ‘Codec.Compression.GZip’"+ ]+ in liftIO $ any (`T.isPrefixOf` (diag ^. L.message)) prefixes @? "Diagnostic contains message"++ mActions <- getAllCodeActions doc+ let allActions = map fromAction mActions+ action = head allActions++ liftIO $ do+ action ^. L.title @?= "Add zlib as a dependency"+ forM_ allActions $ \a -> a ^. L.kind @?= Just CodeActionQuickFix+ forM_ allActions $ \a -> "package:add" `T.isSuffixOf` (a ^. L.command . _Just . L.command) @? "Command contains package:add"++ executeCodeAction action++ contents <- skipManyTill anyMessage $ getDocumentEdit . TextDocumentIdentifier =<< getDocUri "package.yaml"+ liftIO $ do+ "zlib" `T.isSuffixOf` (T.lines contents !! 3) @? "Contains zlib"+ "zlib" `T.isSuffixOf` (T.lines contents !! 21) @? "Does not contain zlib in unrelated component"+ ]++redundantImportTests :: TestTree+redundantImportTests = testGroup "redundant import code actions" [+ testCase "remove solitary redundant imports" $+ runSession hlsCommand fullCaps "test/testdata/redundantImportTest/" $ do+ doc <- openDoc "src/CodeActionRedundant.hs" "haskell"++ diags <- waitForDiagnosticsFromSource doc "typecheck"+ liftIO $ expectDiagnostic diags ["The import of", "Data.List", "is redundant"]++ mActions <- getAllCodeActions doc++ let allActions = map fromAction mActions+ actionTitles = map (view L.title) allActions++ liftIO $ actionTitles `shouldContain` ["Remove import", "Remove all redundant imports"]++ let Just removeAction = find (\x -> x ^. L.title == "Remove import") allActions++ liftIO $ do+ forM_ allActions $ \a -> a ^. L.kind @?= Just CodeActionQuickFix+ forM_ allActions $ \a -> a ^. L.command @?= Nothing+ forM_ allActions $ \a -> isJust (a ^. L.edit) @? "Has edit"++ executeCodeAction removeAction++ -- No command/applyworkspaceedit should be here, since action+ -- provides workspace edit property which skips round trip to+ -- the server+ contents <- documentContents doc+ liftIO $ contents @?= "{-# OPTIONS_GHC -Wunused-imports #-}\nmodule CodeActionRedundant where\nmain :: IO ()\nmain = putStrLn \"hello\"\n"++ , testCase "doesn't touch other imports" $ runSession hlsCommand noLiteralCaps "test/testdata/redundantImportTest/" $ do+ doc <- openDoc "src/MultipleImports.hs" "haskell"+ _ <- waitForDiagnosticsFromSource doc "typecheck"+ CACommand cmd : _ <- getAllCodeActions doc+ executeCommand cmd+ contents <- documentContents doc+ liftIO $ (T.lines contents) @?=+ [ "{-# OPTIONS_GHC -Wunused-imports #-}"+ , "module MultipleImports where"+ , "import Data.Maybe"+ , "foo :: Int"+ , "foo = fromJust (Just 3)"+ ]+ ]++typedHoleTests :: TestTree+typedHoleTests = testGroup "typed hole code actions" [+ testCase "works" $+ runSession hlsCommand fullCaps "test/testdata" $ do+ doc <- openDoc "TypedHoles.hs" "haskell"+ _ <- waitForDiagnosticsFromSource doc "typecheck"+ cas <- getAllCodeActions doc+ liftIO $ do+ expectCodeAction cas ["replace _ with minBound"]+ expectCodeAction cas ["replace _ with foo _"]+ replaceWithMaxBound <- liftIO $ inspectCodeAction cas ["replace _ with maxBound"]++ executeCodeAction replaceWithMaxBound++ contents <- documentContents doc++ liftIO $ contents @?= T.concat+ [ "module TypedHoles where\n"+ , "foo :: [Int] -> Int\n"+ , "foo x = maxBound"+ ]++ , testCase "shows more suggestions" $+ runSession hlsCommand fullCaps "test/testdata" $ do+ doc <- openDoc "TypedHoles2.hs" "haskell"+ _ <- waitForDiagnosticsFromSource doc "typecheck"+ cas <- getAllCodeActions doc++ liftIO $ do+ expectCodeAction cas ["replace _ with foo2 _"]+ expectCodeAction cas ["replace _ with A _"]+ replaceWithStuff <- liftIO $ inspectCodeAction cas ["replace _ with stuff _"]++ executeCodeAction replaceWithStuff++ contents <- documentContents doc++ liftIO $ T.lines contents @?=+ [ "module TypedHoles2 (foo2) where"+ , "newtype A = A Int"+ , "foo2 :: [A] -> A"+ , "foo2 x = (stuff _)"+ , " where"+ , " stuff (A a) = A (a + 1)"+ ]+ ]++signatureTests :: TestTree+signatureTests = testGroup "missing top level signature code actions" [+ testCase "Adds top level signature" $+ runSession hlsCommand fullCaps "test/testdata/" $ do+ doc <- openDoc "TopLevelSignature.hs" "haskell"++ _ <- waitForDiagnosticsFromSource doc "typecheck"+ cas <- map fromAction <$> getAllCodeActions doc++ liftIO $ "add signature: main :: IO ()" `elem` (map (^. L.title) cas) @? "Contains code action"++ executeCodeAction $ head cas++ contents <- documentContents doc++ let expected = [ "{-# OPTIONS_GHC -Wall #-}"+ , "module TopLevelSignature where"+ , "main :: IO ()"+ , "main = do"+ , " putStrLn \"Hello\""+ , " return ()"+ ]++ liftIO $ (T.lines contents) @?= expected+ ]++missingPragmaTests :: TestTree+missingPragmaTests = testGroup "missing pragma warning code actions" [+ testCase "Adds TypeSynonymInstances pragma" $ do+ runSession hlsCommand fullCaps "test/testdata/addPragmas" $ do+ doc <- openDoc "NeedsPragmas.hs" "haskell"++ _ <- waitForDiagnosticsFromSource doc "typecheck"+ cas <- map fromAction <$> getAllCodeActions doc++ liftIO $ "Add \"TypeSynonymInstances\"" `elem` map (^. L.title) cas @? "Contains TypeSynonymInstances code action"+ liftIO $ "Add \"FlexibleInstances\"" `elem` map (^. L.title) cas @? "Contains FlexibleInstances code action"++ executeCodeAction $ head cas++ contents <- documentContents doc++ let expected = [ "{-# LANGUAGE TypeSynonymInstances #-}"+ , ""+ , "import GHC.Generics"+ , ""+ , "main = putStrLn \"hello\""+ , ""+ , "type Foo = Int"+ , ""+ , "instance Show Foo where"+ , " show x = undefined"+ , ""+ , "instance Show (Int,String) where"+ , " show = undefined"+ , ""+ , "data FFF a = FFF Int String a"+ , " deriving (Generic,Functor,Traversable)"+ ]++ liftIO $ (T.lines contents) @?= expected+ ]++unusedTermTests :: TestTree+unusedTermTests = testGroup "unused term code actions" [+ ignoreTestBecause "no support for prefixing unused names with _" $ testCase "Prefixes with '_'" $+ runSession hlsCommand fullCaps "test/testdata/" $ do+ doc <- openDoc "UnusedTerm.hs" "haskell"++ _ <- waitForDiagnosticsFromSource doc "typecheck"+ cars <- getAllCodeActions doc+ prefixImUnused <- liftIO $ inspectCodeAction cars ["Prefix imUnused with _"]++ executeCodeAction prefixImUnused++ edit <- skipManyTill anyMessage $ getDocumentEdit doc++ let expected = [ "{-# OPTIONS_GHC -Wall #-}"+ , "module UnusedTerm () where"+ , "_imUnused :: Int -> Int"+ , "_imUnused 1 = 1"+ , "_imUnused 2 = 2"+ , "_imUnused _ = 3"+ ]++ liftIO $ edit @?= T.unlines expected++ -- See https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#textDocument_codeAction+ -- `CodeActionContext`+ , testCase "respect 'only' parameter" $ runSession hlsCommand fullCaps "test/testdata" $ do+ doc <- openDoc "CodeActionOnly.hs" "haskell"+ _ <- waitForDiagnosticsFrom doc+ diags <- getCurrentDiagnostics doc+ let params = CodeActionParams doc (Range (Position 2 10) (Position 4 0)) caContext Nothing+ caContext = CodeActionContext (List diags) (Just (List [CodeActionRefactorInline]))+ ResponseMessage _ _ (Right (List res)) <- request TextDocumentCodeAction params+ let cas = map fromAction res+ kinds = map (^. L.kind) cas+ liftIO $ do+ -- TODO: When HaRe is back this should be uncommented+ -- kinds `shouldNotSatisfy` null+ not (any (Just CodeActionRefactorInline /=) kinds) @? "None not CodeActionRefactorInline"+ all (Just CodeActionRefactorInline ==) kinds @? "All CodeActionRefactorInline"+ ]++noLiteralCaps :: C.ClientCapabilities+noLiteralCaps = def { C._textDocument = Just textDocumentCaps }+ where+ textDocumentCaps = def { C._codeAction = Just codeActionCaps }+ codeActionCaps = C.CodeActionClientCapabilities (Just True) Nothing
+ test/functional/FunctionalLiquid.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}++module FunctionalLiquid (tests) where++import Control.Lens hiding (List)+import Control.Monad.IO.Class+import Data.Aeson+import Data.Default+import qualified Data.Text as T+import Language.Haskell.LSP.Test hiding (message)+import Language.Haskell.LSP.Types as LSP+import Language.Haskell.LSP.Types.Lens as LSP hiding (contents)+import Ide.Plugin.Config+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+import Test.Tasty.HUnit++-- ---------------------------------------------------------------------++tests :: TestTree+tests = testGroup "liquid haskell diagnostics" [+ ignoreTestBecause "Broken" $ testCase "runs diagnostics on save, no liquid" $+ runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do+ doc <- openDoc "liquid/Evens.hs" "haskell"++ diags@(reduceDiag:_) <- waitForDiagnostics++ liftIO $ do+ length diags @?= 2+ reduceDiag ^. range @?= Range (Position 5 18) (Position 5 22)+ reduceDiag ^. severity @?= Just DsHint+ reduceDiag ^. code @?= Just (StringValue "Use negate")+ reduceDiag ^. source @?= Just "hlint"++ diags2hlint <- waitForDiagnostics++ liftIO $ length diags2hlint @?= 2++ sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)++ diags3@(d:_) <- waitForDiagnosticsSource "eg2"++ liftIO $ do+ length diags3 @?= 1+ d ^. LSP.range @?= Range (Position 0 0) (Position 1 0)+ d ^. LSP.severity @?= Nothing+ d ^. LSP.code @?= Nothing+ d ^. LSP.message @?= T.pack "Example plugin diagnostic, triggered byDiagnosticOnSave"++ -- ---------------------------------++ , ignoreTestBecause "Broken" $ testCase "runs diagnostics on save, with liquid haskell" $+ runSession hlsCommand codeActionSupportCaps "test/testdata" $ do+ -- runSessionWithConfig logConfig hlsCommand codeActionSupportCaps "test/testdata" $ do+ doc <- openDoc "liquid/Evens.hs" "haskell"++ diags@(reduceDiag:_) <- waitForDiagnostics++ -- liftIO $ show diags @?= ""++ liftIO $ do+ length diags @?= 2+ reduceDiag ^. range @?= Range (Position 5 18) (Position 5 22)+ reduceDiag ^. severity @?= Just DsHint+ reduceDiag ^. code @?= Just (StringValue "Use negate")+ reduceDiag ^. source @?= Just "hlint"++ -- Enable liquid haskell plugin and disable hlint+ let config = def { liquidOn = True, hlintOn = False }+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))++ -- docItem <- getDocItem file languageId+ sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)+ -- TODO: what does that test?+ -- TODO: whether hlint is really disbabled?+ -- TODO: @fendor, document or remove+ -- diags2hlint <- waitForDiagnostics+ -- -- liftIO $ show diags2hlint @?= ""++ -- -- We turned hlint diagnostics off+ -- liftIO $ length diags2hlint @?= 0+ -- diags2liquid <- waitForDiagnostics+ -- liftIO $ length diags2liquid @?= 0+ -- liftIO $ show diags2liquid @?= ""+ diags3@(d:_) <- waitForDiagnosticsSource "liquid"+ -- liftIO $ show diags3 @?= ""+ liftIO $ do+ length diags3 @?= 1+ d ^. range @?= Range (Position 8 0) (Position 8 11)+ d ^. severity @?= Just DsError+ d ^. code @?= Nothing+ d ^. source @?= Just "liquid"+ (d ^. message) `T.isPrefixOf`+ ("Error: Liquid Type Mismatch\n" <>+ " Inferred type\n" <>+ " VV : {v : GHC.Types.Int | v == 7}\n" <>+ " \n" <>+ " not a subtype of Required type\n" <>+ " VV : {VV : GHC.Types.Int | VV mod 2 == 0}\n ")+ @? "Contains error message"+ ]
+ test/functional/HieBios.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}+module HieBios (tests) where++import Control.Applicative.Combinators+import qualified Data.Text as T+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types+import Language.Haskell.LSP.Messages+import System.FilePath ((</>))+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+import Test.Tasty.HUnit++tests :: TestTree+tests = testGroup "hie-bios" [+ ignoreTestBecause "Broken" $ testCase "loads modules inside main-is" $ do+ writeFile (hieBiosErrorPath </> "hie.yaml") ""+ runSession hlsCommand fullCaps "test/testdata/hieBiosMainIs" $ do+ _ <- openDoc "Main.hs" "haskell"+ _ <- count 2 waitForDiagnostics+ return ()++ , ignoreTestBecause "Broken" $ testCase "reports errors in hie.yaml" $ do+ writeFile (hieBiosErrorPath </> "hie.yaml") ""+ runSession hlsCommand fullCaps hieBiosErrorPath $ do+ _ <- openDoc "Foo.hs" "haskell"+ _ <- skipManyTill loggingNotification (satisfy isMessage)+ return ()+ ]+ where+ hieBiosErrorPath = "test/testdata/hieBiosError"++ isMessage (NotShowMessage (NotificationMessage _ _ (ShowMessageParams MtError s))) =+ "Couldn't parse hie.yaml" `T.isInfixOf` s+ isMessage _ = False
+ test/functional/Highlight.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}+module Highlight (tests) where++import Control.Monad.IO.Class+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests = testGroup "highlight" [+ testCase "works" $ runSession hlsCommand fullCaps "test/testdata" $ do+ doc <- openDoc "Highlight.hs" "haskell"+ _ <- waitForDiagnosticsFrom doc+ 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)]+ mapM_ (\x -> x `elem` highlights @? "Contains highlight") hls+ ]+ where+ mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
+ test/functional/Main.hs view
@@ -0,0 +1,61 @@+module Main where++import Class+import Command+import Completion+import Config+import Deferred+import Definition+import Diagnostic+import Eval+import Format+import FunctionalBadProject+import FunctionalCodeAction+import FunctionalLiquid+import HieBios+import Highlight+import ModuleName+import Progress+import Reference+import Rename+import Symbol+import Tactic+import Test.Tasty+import Test.Tasty.Ingredients.Rerun+import Test.Tasty.Runners (+ consoleTestReporter,+ listingTests,+ )+import Test.Tasty.Runners.AntXML+import TypeDefinition++main :: IO ()+main =+ -- ingredient: xml runner writes json file of test results (https://github.com/ocharles/tasty-ant-xml/blob/master/Test/Tasty/Runners/AntXML.hs)+ -- rerunningTests allow rerun of failed tests (https://github.com/ocharles/tasty-rerun/blob/master/src/Test/Tasty/Ingredients/Rerun.hs)+ defaultMainWithIngredients+ [antXMLRunner, rerunningTests [listingTests, consoleTestReporter]]+ $ testGroup+ "haskell-language-server"+ [ Class.tests+ , Command.tests+ , Completion.tests+ , Config.tests+ , Deferred.tests+ , Definition.tests+ , Diagnostic.tests+ , Eval.tests+ , Format.tests+ , FunctionalBadProject.tests+ , FunctionalCodeAction.tests+ , FunctionalLiquid.tests+ , HieBios.tests+ , Highlight.tests+ , ModuleName.tests+ , Progress.tests+ , Reference.tests+ , Rename.tests+ , Symbol.tests+ , Tactic.tests+ , TypeDefinition.tests+ ]
+ test/functional/ModuleName.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module ModuleName+ ( tests+ )+where++import Control.Applicative.Combinators (skipManyTill)+import Control.Monad.IO.Class (MonadIO (liftIO))+import qualified Data.Text.IO as T+import Language.Haskell.LSP.Test (anyMessage, documentContents,+ executeCommand, fullCaps,+ getCodeLenses, message,+ openDoc, runSession)+import Language.Haskell.LSP.Types (ApplyWorkspaceEditRequest,+ CodeLens (..))+import System.FilePath ((<.>), (</>))+import Test.Hls.Util (hlsCommand)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests = testGroup+ "moduleName"+ [ testCase "Add module header to empty module" $ goldenTest "TEmptyModule.hs"+ , testCase "Fix wrong module name" $ goldenTest "TWrongModuleName.hs"+ , testCase "Must infer module name as Main, if the file name starts with a lowercase" $ goldenTest "mainlike.hs"+ ]++goldenTest :: FilePath -> IO ()+goldenTest input = runSession hlsCommand fullCaps testdataPath $ do+ doc <- openDoc input "haskell"+ -- getCodeLenses doc >>= liftIO . print . length+ [CodeLens { _command = Just c }] <- getCodeLenses doc+ executeCommand c+ _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message+ edited <- documentContents doc+ -- liftIO $ T.writeFile (testdataPath </> input <.> "expected") edited+ expected <- liftIO $ T.readFile $ testdataPath </> input <.> "expected"+ liftIO $ edited @?= expected++testdataPath :: FilePath+testdataPath = "test/testdata/moduleName"
+ test/functional/Progress.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Progress (tests) where++import Control.Applicative.Combinators+import Control.Lens hiding ((.=))+import Control.Monad.IO.Class+import Data.Aeson (Value, decode, encode, object, toJSON, (.=))+import Data.Default+import Data.List (delete)+import Data.Maybe (fromJust)+import Data.Text (Text, pack)+import Ide.Plugin.Config+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types+import Language.Haskell.LSP.Types.Capabilities+import qualified Language.Haskell.LSP.Types.Lens as L+import System.FilePath ((</>))+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "window/workDoneProgress"+ [ testCase "sends indefinite progress notifications" $+ runSession hlsCommand progressCaps "test/testdata" $ do+ let path = "hlint" </> "ApplyRefact2.hs"+ _ <- openDoc path "haskell"+ expectProgressReports [pack ("Setting up hlint (for " ++ path ++ ")"), "Processing"]+ , testCase "eval plugin sends progress reports" $+ runSession hlsCommand progressCaps "plugins/hls-eval-plugin/test/testdata" $ do+ doc <- openDoc "T1.hs" "haskell"+ expectProgressReports ["Setting up testdata (for T1.hs)", "Processing"]+ [evalLens] <- getCodeLenses doc+ let cmd = evalLens ^?! L.command . _Just+ _ <- sendRequest WorkspaceExecuteCommand $ ExecuteCommandParams (cmd ^. L.command) (decode $ encode $ fromJust $ cmd ^. L.arguments) Nothing+ expectProgressReports ["Evaluating"]+ , testCase "ormolu plugin sends progress notifications" $ do+ runSession hlsCommand progressCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu"))+ doc <- openDoc "Format.hs" "haskell"+ expectProgressReports ["Setting up testdata (for Format.hs)", "Processing"]+ _ <- sendRequest TextDocumentFormatting $ DocumentFormattingParams doc (FormattingOptions 2 True) Nothing+ expectProgressReports ["Formatting Format.hs"]+ , testCase "fourmolu plugin sends progress notifications" $ do+ runSession hlsCommand progressCaps "test/testdata/format" $ do+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "fourmolu"))+ doc <- openDoc "Format.hs" "haskell"+ expectProgressReports ["Setting up testdata (for Format.hs)", "Processing"]+ _ <- sendRequest TextDocumentFormatting $ DocumentFormattingParams doc (FormattingOptions 2 True) Nothing+ expectProgressReports ["Formatting Format.hs"]+ , ignoreTestBecause "no liquid Haskell support" $+ testCase "liquid haskell plugin sends progress notifications" $ do+ runSession hlsCommand progressCaps "test/testdata" $ do+ doc <- openDoc "liquid/Evens.hs" "haskell"+ let config = def{liquidOn = True, hlintOn = False}+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))+ sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)+ expectProgressReports ["Running Liquid Haskell on Evens.hs"]+ ]++formatLspConfig :: Value -> Value+formatLspConfig provider = object ["haskell" .= object ["formattingProvider" .= (provider :: Value)]]++progressCaps :: ClientCapabilities+progressCaps = fullCaps{_window = Just (WindowClientCapabilities (Just True))}++data CollectedProgressNotification+ = CreateM WorkDoneProgressCreateRequest+ | BeginM WorkDoneProgressBeginNotification+ | ProgressM WorkDoneProgressReportNotification+ | EndM WorkDoneProgressEndNotification++{- | Test that the server is correctly producing a sequence of progress related+ messages. Each create must be pair with a corresponding begin and end,+ optionally with some progress in between. Tokens must match. The begin+ messages have titles describing the work that is in-progress, we check that+ the titles we see are those we expect.+-}+expectProgressReports :: [Text] -> Session ()+expectProgressReports = expectProgressReports' []+ where+ expectProgressReports' [] [] = return ()+ expectProgressReports' tokens expectedTitles =+ do+ skipManyTill anyMessage (create <|> begin <|> progress <|> end)+ >>= \case+ CreateM msg ->+ expectProgressReports' (token msg : tokens) expectedTitles+ BeginM msg -> do+ liftIO $ title msg `expectElem` expectedTitles+ liftIO $ token msg `expectElem` tokens+ expectProgressReports' tokens (delete (title msg) expectedTitles)+ ProgressM msg -> do+ liftIO $ token msg `expectElem` tokens+ expectProgressReports' tokens expectedTitles+ EndM msg -> do+ liftIO $ token msg `expectElem` tokens+ expectProgressReports' (delete (token msg) tokens) expectedTitles+ title msg = msg ^. L.params ^. L.value ^. L.title+ token msg = msg ^. L.params ^. L.token+ create = CreateM <$> message+ begin = BeginM <$> message+ progress = ProgressM <$> message+ end = EndM <$> message+ expectElem a as = a `elem` as @? "Unexpected " ++ show a
+ test/functional/Reference.hs view
@@ -0,0 +1,35 @@+module Reference (tests) where++import Control.Lens+import Control.Monad.IO.Class+import Data.List+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types+import Language.Haskell.LSP.Types.Lens+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+import Test.Tasty.HUnit++tests :: TestTree+tests = testGroup "references" [+ ignoreTestBecause "Broken" $ testCase "works with definitions" $ runSession hlsCommand fullCaps "test/testdata" $ do+ doc <- openDoc "References.hs" "haskell"+ let pos = Position 2 7 -- foo = bar <--+ refs <- getReferences doc pos True+ liftIO $ map (Location (doc ^. uri)) [+ mkRange 4 0 4 3+ , mkRange 8 11 8 14+ , mkRange 7 7 7 10+ , mkRange 4 14 4 17+ , mkRange 4 0 4 3+ , mkRange 2 6 2 9+ ] `isInfixOf` refs @? "Contains references"+ -- TODO: Respect withDeclaration parameter+ -- ignoreTestBecause "Broken" $ testCase "works without definitions" $ runSession hlsCommand fullCaps "test/testdata" $ do+ -- doc <- openDoc "References.hs" "haskell"+ -- let pos = Position 2 7 -- foo = bar <--+ -- refs <- getReferences doc pos False+ -- liftIO $ refs `shouldNotContain` [Location (doc ^. uri) (mkRange 4 0 4 3)]+ ]+ where mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
+ test/functional/Rename.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+module Rename (tests) where++-- import Control.Monad.IO.Class+-- import Language.Haskell.LSP.Test+-- import Language.Haskell.LSP.Types+-- import Test.Hls.Util+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests = testGroup "rename" [+ testCase "works" $ True @?= True+ -- pendingWith "removed because of HaRe"+ -- runSession hlsCommand fullCaps "test/testdata" $ do+ -- doc <- openDoc "Rename.hs" "haskell"+ -- rename doc (Position 3 1) "baz" -- foo :: Int -> Int+ -- documentContents doc >>= liftIO . flip shouldBe expected+ -- where+ -- expected =+ -- "main = do\n\+ -- \ x <- return $ baz 42\n\+ -- \ return (baz x)\n\+ -- \baz :: Int -> Int\n\+ -- \baz x = x + 1\n\+ -- \bar = (+ 1) . baz\n"+ ]
+ test/functional/Symbol.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE OverloadedStrings #-}+module Symbol (tests) where++import Control.Lens (to, ix, (^?), _Just)+import Control.Monad.IO.Class+import Data.List+import Language.Haskell.LSP.Test as Test+import Language.Haskell.LSP.Types+import qualified Language.Haskell.LSP.Types.Lens as L+import Language.Haskell.LSP.Types.Capabilities+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+import Test.Tasty.HUnit++tests :: TestTree+tests = testGroup "document symbols" [+ pre310Tests+ , v310Tests+ ]++v310Tests :: TestTree+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++ let myData = DocumentSymbol "MyData" Nothing SkStruct Nothing myDataR myDataSR (Just (List [a, b]))+ a = DocumentSymbol "A" Nothing SkConstructor Nothing aR aSR Nothing+ b = DocumentSymbol "B" Nothing SkConstructor Nothing bR bSR Nothing+ let myData' = symbs ^? ix 0 . L.children . _Just .to fromList . 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++ let foo = DocumentSymbol "foo" Nothing SkFunction Nothing fooR fooSR (Just (List [bar]))+ bar = DocumentSymbol "bar" Nothing SkFunction Nothing barR barSR (Just (List [dog, cat]))+ dog = DocumentSymbol "dog" Nothing SkVariable Nothing dogR dogSR (Just mempty)+ cat = DocumentSymbol "cat" Nothing SkVariable Nothing catR catSR (Just mempty)+ let foo' = symbs ^? ix 0 . L.children . _Just .to fromList . 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++ let testPattern = DocumentSymbol "TestPattern"+ Nothing SkFunction Nothing testPatternR testPatternSR (Just mempty)+ let testPattern' = symbs ^? ix 0 . L.children . _Just .to fromList . 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++ let imports = DocumentSymbol "imports" Nothing SkModule Nothing importsR importsSR (Just (List [importDataMaybe]))+ importDataMaybe = DocumentSymbol "import Data.Maybe" Nothing SkModule Nothing importDataMaybeR importDataMaybeSR Nothing+ let imports' = symbs ^? ix 0 . L.children . _Just .to fromList . ix 0++ liftIO $ Just imports == imports' @? "Contains symbol"+ ]++pre310Tests :: TestTree+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++ let myData = SymbolInformation "MyData" SkStruct Nothing (Location testUri myDataR) (Just "Symbols")+ a = SymbolInformation "A" SkConstructor Nothing (Location testUri aR) (Just "MyData")+ b = SymbolInformation "B" SkConstructor Nothing (Location testUri bR) (Just "MyData")++ 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++ let foo = SymbolInformation "foo" SkFunction Nothing (Location testUri fooR) (Just "Symbols")+ bar = SymbolInformation "bar" SkFunction Nothing (Location testUri barR) (Just "foo")+ dog = SymbolInformation "dog" SkVariable Nothing (Location testUri dogR) (Just "bar")+ cat = SymbolInformation "cat" SkVariable Nothing (Location testUri catR) (Just "bar")++ -- 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++ let testPattern = SymbolInformation "TestPattern"+ SkFunction Nothing (Location testUri testPatternR) (Just "Symbols")++ 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++ let imports = SymbolInformation "imports" SkModule Nothing (Location testUri importsR) (Just "Symbols")+ importDataMaybe = SymbolInformation "import Data.Maybe" SkModule Nothing (Location testUri importDataMaybeR) (Just "imports")++ 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+importsR = Range (Position 3 0) (Position 3 17)+importsSR :: Range+importsSR = Range (Position 3 0) (Position 3 17)+importDataMaybeR :: Range+importDataMaybeR = Range (Position 3 0) (Position 3 17)+importDataMaybeSR :: Range+importDataMaybeSR = Range (Position 3 0) (Position 3 17)+fooSR :: Range+fooSR = Range (Position 5 0) (Position 7 43)+fooR :: Range+fooR = Range (Position 5 0) (Position 7 43)+barSR :: Range+barSR = Range (Position 6 8) (Position 6 11)+barR :: Range+barR = Range (Position 6 8) (Position 7 43)+dogSR :: Range+dogSR = Range (Position 7 17) (Position 7 20)+dogR :: Range+dogR = Range (Position 7 16) (Position 7 43)+catSR :: Range+catSR = Range (Position 7 22) (Position 7 25)+catR :: Range+catR = Range (Position 7 16) (Position 7 43)+myDataSR :: Range+myDataSR = Range (Position 9 0) (Position 10 22)+myDataR :: Range+myDataR = Range (Position 9 0) (Position 10 22)+aSR :: Range+aSR = Range (Position 9 14) (Position 9 15)+aR :: Range+aR = Range (Position 9 14) (Position 9 19)+bSR :: Range+bSR = Range (Position 10 14) (Position 10 15)+bR :: Range+bR = Range (Position 10 14) (Position 10 22)+testPatternSR :: Range+testPatternSR = Range (Position 13 8) (Position 13 19)+testPatternR :: Range+testPatternR = Range (Position 13 0) (Position 13 27)
+ test/functional/Tactic.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++module Tactic+ ( tests+ )+where++import Control.Applicative.Combinators ( skipManyTill )+import Control.Lens hiding ((<.>))+import Control.Monad (unless)+import Control.Monad.IO.Class+import Data.Aeson+import Data.Either (isLeft)+import Data.Foldable+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Ide.Plugin.Tactic.TestTypes+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types (ExecuteCommandParams(ExecuteCommandParams), ClientMethod (..), Command, ExecuteCommandResponse, ResponseMessage (..), ApplyWorkspaceEditRequest, Position(..) , Range(..) , CAResult(..) , CodeAction(..))+import Language.Haskell.LSP.Types.Lens hiding (id, capabilities, message, executeCommand, applyEdit, rename)+import System.Directory (doesFileExist)+import System.FilePath+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTestBecause)+import Test.Tasty.HUnit+++------------------------------------------------------------------------------+-- | Get a range at the given line and column corresponding to having nothing+-- selected.+--+-- NB: These coordinates are in "file space", ie, 1-indexed.+pointRange :: Int -> Int -> Range+pointRange+ (subtract 1 -> line)+ (subtract 1 -> col) =+ Range (Position line col) (Position line $ col + 1)+++------------------------------------------------------------------------------+-- | Get the title of a code action.+codeActionTitle :: CAResult -> Maybe Text+codeActionTitle CACommand{} = Nothing+codeActionTitle (CACodeAction(CodeAction title _ _ _ _)) = Just title+++tests :: TestTree+tests = testGroup+ "tactic"+ [ mkTest+ "Produces intros code action"+ "T1.hs" 2 14+ [ (id, Intros, "")+ ]+ , mkTest+ "Produces destruct and homomorphism code actions"+ "T2.hs" 2 21+ [ (id, Destruct, "eab")+ , (id, Homomorphism, "eab")+ ]+ , mkTest+ "Won't suggest homomorphism on the wrong type"+ "T2.hs" 8 8+ [ (not, Homomorphism, "global")+ ]+ , mkTest+ "Won't suggest intros on the wrong type"+ "T2.hs" 8 8+ [ (not, Intros, "")+ ]+ , mkTest+ "Produces (homomorphic) lambdacase code actions"+ "T3.hs" 4 24+ [ (id, HomomorphismLambdaCase, "")+ , (id, DestructLambdaCase, "")+ ]+ , mkTest+ "Produces lambdacase code actions"+ "T3.hs" 7 13+ [ (id, DestructLambdaCase, "")+ ]+ , mkTest+ "Doesn't suggest lambdacase without -XLambdaCase"+ "T2.hs" 11 25+ [ (not, DestructLambdaCase, "")+ ]+ , goldenTest "GoldenIntros.hs" 2 8 Intros ""+ , goldenTest "GoldenEitherAuto.hs" 2 11 Auto ""+ , goldenTest "GoldenJoinCont.hs" 4 12 Auto ""+ , goldenTest "GoldenIdentityFunctor.hs" 3 11 Auto ""+ , goldenTest "GoldenIdTypeFam.hs" 7 11 Auto ""+ , goldenTest "GoldenEitherHomomorphic.hs" 2 15 Auto ""+ , goldenTest "GoldenNote.hs" 2 8 Auto ""+ , goldenTest "GoldenPureList.hs" 2 12 Auto ""+ , goldenTest "GoldenListFmap.hs" 2 12 Auto ""+ , goldenTest "GoldenFromMaybe.hs" 2 13 Auto ""+ , goldenTest "GoldenFoldr.hs" 2 10 Auto ""+ , goldenTest "GoldenSwap.hs" 2 8 Auto ""+ , goldenTest "GoldenFmapTree.hs" 4 11 Auto ""+ , goldenTest "GoldenGADTDestruct.hs" 7 17 Destruct "gadt"+ , goldenTest "GoldenGADTDestructCoercion.hs" 8 17 Destruct "gadt"+ , goldenTest "GoldenGADTAuto.hs" 7 13 Auto ""+ , goldenTest "GoldenSwapMany.hs" 2 12 Auto ""+ , goldenTest "GoldenBigTuple.hs" 4 12 Auto ""+ , goldenTest "GoldenShow.hs" 2 10 Auto ""+ , goldenTest "GoldenShowCompose.hs" 2 15 Auto ""+ , goldenTest "GoldenShowMapChar.hs" 2 8 Auto ""+ , goldenTest "GoldenSuperclass.hs" 7 8 Auto ""+ , ignoreTestBecause "It is unreliable in circleci builds"+ $ goldenTest "GoldenApplicativeThen.hs" 2 11 Auto ""+ , goldenTest "GoldenSafeHead.hs" 2 12 Auto ""+ , expectFail "GoldenFish.hs" 5 18 Auto ""+ , goldenTest "GoldenArbitrary.hs" 25 13 Auto ""+ ]+++------------------------------------------------------------------------------+-- | Make a tactic unit test.+mkTest+ :: Foldable t+ => String -- ^ The test name+ -> FilePath -- ^ The file to load+ -> Int -- ^ Cursor line+ -> Int -- ^ Cursor columnn+ -> t ( Bool -> Bool -- Use 'not' for actions that shouldnt be present+ , TacticCommand -- An expected command ...+ , Text -- ... for this variable+ ) -- ^ A collection of (un)expected code actions.+ -> TestTree+mkTest name fp line col ts =+ testCase name $ do+ runSession hlsCommand fullCaps tacticPath $ do+ doc <- openDoc fp "haskell"+ _ <- waitForDiagnostics+ actions <- getCodeActions doc $ pointRange line col+ let titles = mapMaybe codeActionTitle actions+ for_ ts $ \(f, tc, var) -> do+ let title = tacticTitle tc var+ liftIO $+ f (elem title titles)+ @? ("Expected a code action with title " <> T.unpack title)+++goldenTest :: FilePath -> Int -> Int -> TacticCommand -> Text -> TestTree+goldenTest input line col tc occ =+ testCase (input <> " (golden)") $ do+ runSession hlsCommand fullCaps tacticPath $ do+ doc <- openDoc input "haskell"+ _ <- waitForDiagnostics+ actions <- getCodeActions doc $ pointRange line col+ Just (CACodeAction (CodeAction {_command = Just c}))+ <- pure $ find ((== Just (tacticTitle tc occ)) . codeActionTitle) actions+ executeCommand c+ _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message+ edited <- documentContents doc+ let expected_name = tacticPath </> input <.> "expected"+ -- Write golden tests if they don't already exist+ liftIO $ (doesFileExist expected_name >>=) $ flip unless $ do+ T.writeFile expected_name edited+ expected <- liftIO $ T.readFile expected_name+ liftIO $ edited @?= expected+++expectFail :: FilePath -> Int -> Int -> TacticCommand -> Text -> TestTree+expectFail input line col tc occ =+ testCase (input <> " (golden)") $ do+ runSession hlsCommand fullCaps tacticPath $ do+ doc <- openDoc input "haskell"+ _ <- waitForDiagnostics+ actions <- getCodeActions doc $ pointRange line col+ Just (CACodeAction (CodeAction {_command = Just c}))+ <- pure $ find ((== Just (tacticTitle tc occ)) . codeActionTitle) actions+ resp <- executeCommandWithResp c+ liftIO $ unless (isLeft $ _result resp) $+ assertFailure "didn't fail, but expected one"+++tacticPath :: FilePath+tacticPath = "test/testdata/tactic"+++executeCommandWithResp :: Command -> Session ExecuteCommandResponse+executeCommandWithResp cmd = do+ let args = decode $ encode $ fromJust $ cmd ^. arguments+ execParams = ExecuteCommandParams (cmd ^. command) args Nothing+ request WorkspaceExecuteCommand execParams+
+ test/functional/TypeDefinition.hs view
@@ -0,0 +1,55 @@+module TypeDefinition (tests) where++import Control.Lens ((^.))+import Control.Monad.IO.Class+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types+import qualified Language.Haskell.LSP.Types.Lens as L+import System.Directory+import System.FilePath ((</>))+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests = testGroup "type definitions" [+ testCase "finds local definition of record variable"+ $ getTypeDefinitionTest' (11, 23) 8+ , testCase "finds local definition of newtype variable"+ $ getTypeDefinitionTest' (16, 21) 13+ , testCase "finds local definition of sum type variable"+ $ getTypeDefinitionTest' (21, 13) 18+ , knownBrokenForGhcVersions [GHC88] "Definition of sum type not found from data constructor in GHC 8.8.x" $+ testCase "finds local definition of sum type constructor"+ $ getTypeDefinitionTest' (24, 7) 18+ , testCase "finds non-local definition of type def"+ $ getTypeDefinitionTest' (30, 17) 27+ , testCase "find local definition of type def"+ $ getTypeDefinitionTest' (35, 16) 32+ , testCase "find type-definition of type def in component"+ $ getTypeDefinitionTest "src/Lib2.hs" (13, 20) "src/Lib.hs" 8+ , testCase "find definition of parameterized data type"+ $ getTypeDefinitionTest' (40, 19) 37+ ]++getTypeDefinitionTest :: String -> (Int, Int) -> String -> Int -> Assertion+getTypeDefinitionTest symbolFile symbolPosition definitionFile definitionLine =+ failIfSessionTimeout . runSession hlsCommand fullCaps "test/testdata/gototest" $ do+ doc <- openDoc symbolFile "haskell"+ _ <- openDoc definitionFile "haskell"+ defs <- getTypeDefinitions doc $ toPos symbolPosition+ fp <- liftIO $ canonicalizePath $ "test/testdata/gototest" </> definitionFile+ liftIO $ do+ length defs == 1 @? "Expecting a list containing one location, but got: " ++ show defs+ let [def] = defs+ def ^. L.uri @?= filePathToUri fp+ def ^. L.range . L.start . L.line @?= definitionLine - 1+ def ^. L.range . L.end . L.line @?= definitionLine - 1++getTypeDefinitionTest' :: (Int, Int) -> Int -> Assertion+getTypeDefinitionTest' symbolPosition definitionLine =+ getTypeDefinitionTest "src/Lib.hs" symbolPosition "src/Lib.hs" definitionLine++--NOTE: copied from Haskell.Ide.Engine.ArtifactMap+toPos :: (Int,Int) -> Position+toPos (l,c) = Position (l-1) (c-1)
+ test/utils/Test/Hls/Util.hs view
@@ -0,0 +1,425 @@+{-# LANGUAGE CPP, OverloadedStrings, NamedFieldPuns, MultiParamTypeClasses #-}+module Test.Hls.Util+ (+ codeActionSupportCaps+ , dummyLspFuncs+ , expectCodeAction+ , expectDiagnostic+ , expectNoMoreDiagnostics+ , failIfSessionTimeout+ , flushStackEnvironment+ , fromAction+ , fromCommand+ , getHspecFormattedConfig+ , ghcVersion, GhcVersion(..)+ , hlsCommand+ , hlsCommandExamplePlugin+ , hlsCommandVomit+ , ignoreForGhcVersions+ , inspectCodeAction+ , inspectCommand+ , inspectDiagnostic+ , knownBrokenForGhcVersions+ , logConfig+ , logFilePath+ , noLogConfig+ , setupBuildToolFiles+ , waitForDiagnosticsFrom+ , waitForDiagnosticsFromSource+ , waitForDiagnosticsFromSourceWithTimeout+ , withFileLogging+ , withCurrentDirectoryInTmp+ )+where++import Control.Exception (throwIO, catch)+import Control.Monad+import Control.Monad.IO.Class+import Control.Applicative.Combinators (skipManyTill, (<|>))+import Control.Lens ((^.))+import Data.Default+import Data.List (intercalate)+import Data.List.Extra (find)+import Data.Maybe+import qualified Data.Text as T+import Language.Haskell.LSP.Core+import Language.Haskell.LSP.Messages (FromServerMessage(NotLogMessage))+import Language.Haskell.LSP.Types+import qualified Language.Haskell.LSP.Test as Test+import qualified Language.Haskell.LSP.Types.Lens as L+import qualified Language.Haskell.LSP.Types.Capabilities as C+import System.Directory+import System.Environment+import System.Time.Extra (Seconds, sleep)+import System.FilePath+import qualified System.Log.Logger as L+import System.IO.Temp+import System.IO.Unsafe+import Test.Hspec.Runner+import Test.Hspec.Core.Formatters hiding (Seconds)+import Test.Tasty (TestTree)+import Test.Tasty.ExpectedFailure (ignoreTestBecause, expectFailBecause)+import Test.Tasty.HUnit (assertFailure)+import Text.Blaze.Renderer.String (renderMarkup)+import Text.Blaze.Internal hiding (null)+++noLogConfig :: Test.SessionConfig+noLogConfig = Test.defaultConfig { Test.logMessages = False }++logConfig :: Test.SessionConfig+logConfig = Test.defaultConfig { Test.logMessages = True }++codeActionSupportCaps :: C.ClientCapabilities+codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps }+ where+ textDocumentCaps = def { C._codeAction = Just codeActionCaps }+ codeActionCaps = C.CodeActionClientCapabilities (Just True) (Just literalSupport)+ literalSupport = C.CodeActionLiteralSupport def++withFileLogging :: FilePath -> IO a -> IO a+withFileLogging logFile f = do+ let logDir = "./test-logs"+ logPath = logDir </> logFile++ dirExists <- doesDirectoryExist logDir+ unless dirExists $ createDirectory logDir++ exists <- doesFileExist logPath+ when exists $ removeFile logPath++ setupLogger (Just logPath) ["hie"] L.DEBUG++ f++-- ---------------------------------------------------------------------++setupBuildToolFiles :: IO ()+setupBuildToolFiles = do+ forM_ files setupDirectFilesIn++setupDirectFilesIn :: FilePath -> IO ()+setupDirectFilesIn f =+ writeFile (f ++ "hie.yaml") hieYamlCradleDirectContents+++-- ---------------------------------------------------------------------++files :: [FilePath]+files =+ [ "./test/testdata/"+ -- , "./test/testdata/addPackageTest/cabal-exe/"+ -- , "./test/testdata/addPackageTest/hpack-exe/"+ -- , "./test/testdata/addPackageTest/cabal-lib/"+ -- , "./test/testdata/addPackageTest/hpack-lib/"+ -- , "./test/testdata/addPragmas/"+ -- , "./test/testdata/badProjects/cabal/"+ -- , "./test/testdata/completion/"+ -- , "./test/testdata/definition/"+ -- , "./test/testdata/gototest/"+ -- , "./test/testdata/redundantImportTest/"+ -- , "./test/testdata/wErrorTest/"+ ]++data GhcVersion+ = GHC810+ | GHC88+ | GHC86+ | GHC84+ deriving (Eq,Show)++ghcVersion :: GhcVersion+#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)))+ghcVersion = GHC810+#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,8,0,0)))+ghcVersion = GHC88+#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)))+ghcVersion = GHC86+#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0)))+ghcVersion = GHC84+#endif++knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree+knownBrokenForGhcVersions vers reason+ | ghcVersion `elem` vers = expectFailBecause reason+ | otherwise = id++ignoreForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree+ignoreForGhcVersions vers reason+ | ghcVersion `elem` vers = ignoreTestBecause reason+ | otherwise = id++logFilePath :: String+logFilePath = "hls-" ++ show ghcVersion ++ ".log"++-- | The command to execute the version of hls for the current compiler.+--+-- Both @stack test@ and @cabal new-test@ setup the environment so @hls@ is+-- on PATH. Cabal seems to respond to @build-tool-depends@ specifically while+-- stack just puts all project executables on PATH.+hlsCommand :: String+hlsCommand = unsafePerformIO $ do+ testExe <- fromMaybe "haskell-language-server" <$> lookupEnv "HLS_TEST_EXE"+ pure $ testExe ++ " --lsp -d -j2 -l test-logs/" ++ logFilePath++hlsCommandVomit :: String+hlsCommandVomit = hlsCommand ++ " --vomit"++hlsCommandExamplePlugin :: String+hlsCommandExamplePlugin = hlsCommand ++ " --example"++-- ---------------------------------------------------------------------++hieYamlCradleDirectContents :: String+hieYamlCradleDirectContents = unlines+ [ "# WARNING: THIS FILE IS AUTOGENERATED IN test/utils/TestUtils.hs. IT WILL BE OVERWRITTEN ON EVERY TEST RUN"+ , "cradle:"+ , " direct:"+ , " arguments:"+ , " - -i."+ ]+++-- ---------------------------------------------------------------------++getHspecFormattedConfig :: String -> IO Config+getHspecFormattedConfig name = do+ -- https://circleci.com/docs/2.0/env-vars/#built-in-environment-variables+ isCI <- isJust <$> lookupEnv "CI"++ -- Only use the xml formatter on CI since it hides console output+ if isCI+ then do+ let subdir = "test-results" </> name+ createDirectoryIfMissing True subdir++ return $ defaultConfig { configFormatter = Just xmlFormatter+ , configOutputFile = Right $ subdir </> "results.xml"+ }+ else return defaultConfig++-- | A Hspec formatter for CircleCI.+-- Originally from https://github.com/LeastAuthority/hspec-jenkins+xmlFormatter :: Formatter+xmlFormatter = silent {+ headerFormatter = do+ writeLine "<?xml version='1.0' encoding='UTF-8'?>"+ writeLine "<testsuite>"+ , exampleSucceeded+ , exampleFailed+ , examplePending+ , footerFormatter = writeLine "</testsuite>"+ }+ where++#if MIN_VERSION_hspec(2,5,0)+ exampleSucceeded path _ =+#else+ exampleSucceeded path =+#endif+ writeLine $ renderMarkup $ testcase path ""++#if MIN_VERSION_hspec(2,5,0)+ exampleFailed path _ err =+#else+ exampleFailed path (Left err) =+ writeLine $ renderMarkup $ testcase path $+ failure ! message (show err) $ ""+ exampleFailed path (Right err) =+#endif+ writeLine $ renderMarkup $ testcase path $+ failure ! message (reasonAsString err) $ ""++#if MIN_VERSION_hspec(2,5,0)+ examplePending path _ reason =+#else+ examplePending path reason =+#endif+ writeLine $ renderMarkup $ testcase path $+ case reason of+ Just desc -> skipped ! message desc $ ""+ Nothing -> skipped ""++ failure, skipped :: Markup -> Markup+ failure = customParent "failure"+ skipped = customParent "skipped"++ name, className, message :: String -> Attribute+ name = customAttribute "name" . stringValue+ className = customAttribute "classname" . stringValue+ message = customAttribute "message" . stringValue++ testcase :: Path -> Markup -> Markup+ testcase (xs,x) = customParent "testcase" ! name x ! className (intercalate "." xs)++ reasonAsString :: FailureReason -> String+ reasonAsString NoReason = "no reason given"+ reasonAsString (Reason x) = x+ reasonAsString (ExpectedButGot Nothing expected got) = "Expected " ++ expected ++ " but got " ++ got+ reasonAsString (ExpectedButGot (Just src) expected got) = src ++ " expected " ++ expected ++ " but got " ++ got+#if MIN_VERSION_hspec(2,5,0)+ reasonAsString (Error Nothing err ) = show err+ reasonAsString (Error (Just s) err) = s ++ show err+#endif++-- ---------------------------------------------------------------------++flushStackEnvironment :: IO ()+flushStackEnvironment = do+ -- We need to clear these environment variables to prevent+ -- collisions with stack usages+ -- See https://github.com/commercialhaskell/stack/issues/4875+ unsetEnv "GHC_PACKAGE_PATH"+ unsetEnv "GHC_ENVIRONMENT"+ unsetEnv "HASKELL_PACKAGE_SANDBOX"+ unsetEnv "HASKELL_PACKAGE_SANDBOXES"++-- ---------------------------------------------------------------------++dummyLspFuncs :: Default a => LspFuncs a+dummyLspFuncs = LspFuncs { clientCapabilities = def+ , config = return (Just def)+ , sendFunc = const (return ())+ , getVirtualFileFunc = const (return Nothing)+ , persistVirtualFileFunc = \uri -> return (uriToFilePath (fromNormalizedUri uri))+ , reverseFileMapFunc = return id+ , publishDiagnosticsFunc = mempty+ , flushDiagnosticsBySourceFunc = mempty+ , getNextReqId = pure (IdInt 0)+ , rootPath = Nothing+ , getWorkspaceFolders = return Nothing+ , withProgress = \_ _ f -> f (const (return ()))+ , withIndefiniteProgress = \_ _ f -> f+ }++-- | Like 'withCurrentDirectory', but will copy the directory over to the system+-- temporary directory first to avoid haskell-language-server's source tree from+-- interfering with the cradle+withCurrentDirectoryInTmp :: FilePath -> IO a -> IO a+withCurrentDirectoryInTmp dir f =+ withTempCopy dir $ \newDir ->+ withCurrentDirectory newDir f++withTempCopy :: FilePath -> (FilePath -> IO a) -> IO a+withTempCopy srcDir f = do+ withSystemTempDirectory "hls-test" $ \newDir -> do+ copyDir srcDir newDir+ f newDir++copyDir :: FilePath -> FilePath -> IO ()+copyDir src dst = do+ cnts <- listDirectory src+ forM_ cnts $ \file -> do+ unless (file `elem` ignored) $ do+ let srcFp = src </> file+ dstFp = dst </> file+ isDir <- doesDirectoryExist srcFp+ if isDir+ then createDirectory dstFp >> copyDir srcFp dstFp+ else copyFile srcFp dstFp+ where ignored = ["dist", "dist-newstyle", ".stack-work"]++fromAction :: CAResult -> CodeAction+fromAction (CACodeAction action) = action+fromAction _ = error "Not a code action"++fromCommand :: CAResult -> Command+fromCommand (CACommand command) = command+fromCommand _ = error "Not a command"++onMatch :: [a] -> (a -> Bool) -> String -> IO a+onMatch as predicate err = maybe (fail err) return (find predicate as)++inspectDiagnostic :: [Diagnostic] -> [T.Text] -> IO Diagnostic+inspectDiagnostic diags s = onMatch diags (\ca -> all (`T.isInfixOf` (ca ^. L.message)) s) err+ where err = "expected diagnostic matching '" ++ show s ++ "' but did not find one"++expectDiagnostic :: [Diagnostic] -> [T.Text] -> IO ()+expectDiagnostic diags s = void $ inspectDiagnostic diags s++inspectCodeAction :: [CAResult] -> [T.Text] -> IO CodeAction+inspectCodeAction cars s = fromAction <$> onMatch cars predicate err+ where predicate (CACodeAction ca) = all (`T.isInfixOf` (ca ^. L.title)) s+ predicate _ = False+ err = "expected code action matching '" ++ show s ++ "' but did not find one"++expectCodeAction :: [CAResult] -> [T.Text] -> IO ()+expectCodeAction cars s = void $ inspectCodeAction cars s++inspectCommand :: [CAResult] -> [T.Text] -> IO Command+inspectCommand cars s = fromCommand <$> onMatch cars predicate err+ where predicate (CACommand command) = all (`T.isInfixOf` (command ^. L.title)) s+ predicate _ = False+ err = "expected code action matching '" ++ show s ++ "' but did not find one"++waitForDiagnosticsFrom :: TextDocumentIdentifier -> Test.Session [Diagnostic]+waitForDiagnosticsFrom doc = do+ diagsNot <- skipManyTill Test.anyMessage Test.message :: Test.Session PublishDiagnosticsNotification+ let (List diags) = diagsNot ^. L.params . L.diagnostics+ if doc ^. L.uri /= diagsNot ^. L.params . L.uri+ then waitForDiagnosticsFrom doc+ else return diags++waitForDiagnosticsFromSource :: TextDocumentIdentifier -> String -> Test.Session [Diagnostic]+waitForDiagnosticsFromSource doc src = do+ diagsNot <- skipManyTill Test.anyMessage Test.message :: Test.Session PublishDiagnosticsNotification+ let (List diags) = diagsNot ^. L.params . L.diagnostics+ let res = filter matches diags+ if doc ^. L.uri /= diagsNot ^. L.params . L.uri || null res+ then waitForDiagnosticsFromSource doc src+ else return res+ where+ matches :: Diagnostic -> Bool+ matches d = d ^. L.source == Just (T.pack src)++-- | wait for @timeout@ seconds and report an assertion failure+-- if any diagnostic messages arrive in that period+expectNoMoreDiagnostics :: Seconds -> TextDocumentIdentifier -> String -> Test.Session ()+expectNoMoreDiagnostics timeout doc src = do+ diags <- waitForDiagnosticsFromSourceWithTimeout timeout doc src+ unless (null diags) $+ liftIO $ assertFailure $+ "Got unexpected diagnostics for " <> show (doc ^. L.uri) <>+ " got " <> show diags++-- | wait for @timeout@ seconds and return diagnostics for the given @document and @source.+-- If timeout is 0 it will wait until the session timeout+waitForDiagnosticsFromSourceWithTimeout :: Seconds -> TextDocumentIdentifier -> String -> Test.Session [Diagnostic]+waitForDiagnosticsFromSourceWithTimeout timeout document source = do+ when (timeout > 0) $ do+ -- Give any further diagnostic messages time to arrive.+ liftIO $ sleep timeout+ -- Send a dummy message to provoke a response from the server.+ -- This guarantees that we have at least one message to+ -- process, so message won't block or timeout.+ void $ Test.sendRequest (CustomClientMethod "non-existent-method") ()+ handleMessages+ where+ matches :: Diagnostic -> Bool+ matches d = d ^. L.source == Just (T.pack source)++ handleMessages = handleDiagnostic <|> handleCustomMethodResponse <|> ignoreOthers+ handleDiagnostic = do+ diagsNot <- Test.message :: Test.Session PublishDiagnosticsNotification+ let fileUri = diagsNot ^. L.params . L.uri+ (List diags) = diagsNot ^. L.params . L.diagnostics+ res = filter matches diags+ if fileUri == document ^. L.uri && not (null res)+ then return diags else handleMessages+ handleCustomMethodResponse =+ -- the CustomClientMethod triggers a RspCustomServer+ -- handle that and then exit+ void (Test.satisfyMaybe responseForNonExistentMethod) >> return []++ responseForNonExistentMethod notif+ | NotLogMessage logMsg <- notif,+ "non-existent-method" `T.isInfixOf` (logMsg ^. L.params . L.message) = Just notif+ | otherwise = Nothing++ ignoreOthers = void Test.anyMessage >> handleMessages++failIfSessionTimeout :: IO a -> IO a+failIfSessionTimeout action = action `catch` errorHandler+ where errorHandler :: Test.SessionException -> IO a+ errorHandler e@(Test.Timeout _) = assertFailure $ show e+ errorHandler e = throwIO e
+ test/wrapper/Main.hs view
@@ -0,0 +1,39 @@+import Data.Char+import Data.List+import Data.Maybe+import Test.Hls.Util+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.Ingredients.Rerun+import Test.Tasty.Runners ( listingTests, consoleTestReporter)+import System.Process+import System.Environment++main :: IO ()+main = do+ flushStackEnvironment+ defaultMainWithIngredients+ [rerunningTests [listingTests, consoleTestReporter]] $+ testGroup "haskell-language-server-wrapper" [projectGhcVersionTests]++projectGhcVersionTests :: TestTree+projectGhcVersionTests = testGroup "--project-ghc-version"+ [ testCase "stack with ghc 8.10.1" $+ testDir "test/wrapper/testdata/stack-8.10.1" "8.10.1"+ , testCase "stack with ghc 8.8.3" $+ testDir "test/wrapper/testdata/stack-8.8.3" "8.8.3"+ , testCase "cabal with global ghc" $ do+ ghcVer <- trim <$> readProcess "ghc" ["--numeric-version"] ""+ testDir "test/wrapper/testdata/cabal-cur-ver" ghcVer+ ]++testDir :: FilePath -> String -> Assertion+testDir dir expectedVer =+ withCurrentDirectoryInTmp dir $ do+ testExe <- fromMaybe "haskell-language-server-wrapper"+ <$> lookupEnv "HLS_WRAPPER_TEST_EXE"+ actualVer <- trim <$> readProcess testExe ["--project-ghc-version"] ""+ actualVer @?= expectedVer++trim :: String -> String+trim = dropWhileEnd isSpace