haskell-language-server 0.9.0.0 → 1.0.0.0
raw patch · 50 files changed
+7557/−7272 lines, 50 filesdep +asyncdep +base16-bytestringdep +cryptohash-sha1dep −haskell-lspdep ~ghcidedep ~hls-class-plugindep ~hls-eval-pluginsetup-changednew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: async, base16-bytestring, cryptohash-sha1, hiedb, lsp, megaparsec, sqlite-simple
Dependencies removed: haskell-lsp
Dependency ranges changed: ghcide, hls-class-plugin, hls-eval-plugin, hls-explicit-imports-plugin, hls-haddock-comments-plugin, hls-hlint-plugin, hls-plugin-api, hls-retrie-plugin, hls-splice-plugin, hls-tactics-plugin, lsp-test
API changes (from Hackage documentation)
- Ide.Arguments: instance GHC.Show.Show Ide.Arguments.Arguments
+ Ide.Arguments: DbCmd :: Options -> Command -> Arguments
Files
- ChangeLog.md +1048/−851
- LICENSE +201/−201
- README.md +767/−762
- Setup.hs +2/−2
- exe/Main.hs +22/−22
- exe/Plugins.hs +142/−142
- exe/Wrapper.hs +151/−146
- haskell-language-server.cabal +42/−22
- include/ghc-api-version.h +10/−10
- plugins/default/src/Ide/Plugin/Brittany.hs +118/−104
- plugins/default/src/Ide/Plugin/Example.hs +234/−230
- plugins/default/src/Ide/Plugin/Example2.hs +228/−224
- plugins/default/src/Ide/Plugin/Floskell.hs +59/−58
- plugins/default/src/Ide/Plugin/Fourmolu.hs +103/−110
- plugins/default/src/Ide/Plugin/ModuleName.hs +178/−204
- plugins/default/src/Ide/Plugin/Ormolu.hs +80/−80
- plugins/default/src/Ide/Plugin/Pragmas.hs +189/−174
- plugins/default/src/Ide/Plugin/StylishHaskell.hs +82/−59
- plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs +162/−0
- plugins/hls-eval-plugin/test/Eval.hs +229/−217
- plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs +54/−54
- plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/TestTypes.hs +0/−27
- src/Ide/Arguments.hs +130/−127
- src/Ide/Main.hs +106/−198
- src/Ide/Version.hs +79/−79
- test/functional/Class.hs +82/−81
- test/functional/Command.hs +34/−34
- test/functional/Completion.hs +410/−410
- test/functional/Config.hs +101/−78
- test/functional/Deferred.hs +176/−176
- test/functional/Definition.hs +69/−69
- test/functional/Diagnostic.hs +82/−82
- test/functional/Format.hs +185/−184
- test/functional/FunctionalBadProject.hs +40/−40
- test/functional/FunctionalCodeAction.hs +678/−578
- test/functional/FunctionalLiquid.hs +37/−37
- test/functional/HaddockComments.hs +79/−76
- test/functional/HieBios.hs +35/−35
- test/functional/Highlight.hs +26/−26
- test/functional/Main.hs +63/−65
- test/functional/ModuleName.hs +44/−44
- test/functional/Progress.hs +120/−111
- test/functional/Reference.hs +36/−35
- test/functional/Rename.hs +28/−28
- test/functional/Splice.hs +134/−139
- test/functional/Symbol.hs +157/−157
- test/functional/Tactic.hs +0/−191
- test/functional/TypeDefinition.hs +47/−55
- test/utils/Test/Hls/Util.hs +443/−399
- test/wrapper/Main.hs +35/−39
ChangeLog.md view
@@ -1,851 +1,1048 @@-# Changelog for haskell-language-server--## 0.9.0--This release includes lot of refactorings and bug fixes over existing features, hlint and eval plugins among others.-It contains a fix for a bug in ghcide involving stale diagnostics (#1204).--The list of contributors continues to show healthy growth, many thanks to you all!--And remember, we have a new brand logo, courtesy of @Ailrun :slightly_smiling_face:----### Pull requests merged for 0.9.0--- Do not error out on failed rewrite-([#1269)](https://github.com/haskell/haskell-language-server/pull/1269) by @pepeiborra-- Tighten dependency on apply-refact-([#1268)](https://github.com/haskell/haskell-language-server/pull/1268) by @hololeap-- Add the new logos-([#1267)](https://github.com/haskell/haskell-language-server/pull/1267) by @Ailrun-- Fix a bug in completions-([#1265)](https://github.com/haskell/haskell-language-server/pull/1265) by @pepeiborra-- Produce heap profiles the old fashioned way, from .hp files-([#1261)](https://github.com/haskell/haskell-language-server/pull/1261) by @pepeiborra-- Break down ghcide functionality in HLS plugins-([#1257)](https://github.com/haskell/haskell-language-server/pull/1257) by @pepeiborra-- Enforce max completions over all plugins-([#1256)](https://github.com/haskell/haskell-language-server/pull/1256) by @pepeiborra-- Reorder code actions to put remove redundant imports first-([#1255)](https://github.com/haskell/haskell-language-server/pull/1255) by @pepeiborra-- Update bench.yml to include all the relevant artifacts-([#1254)](https://github.com/haskell/haskell-language-server/pull/1254) by @pepeiborra-- Benchmarks: generate heap profiles-([#1253)](https://github.com/haskell/haskell-language-server/pull/1253) by @pepeiborra-- Add gh workflows badges-([#1251)](https://github.com/haskell/haskell-language-server/pull/1251) by @jneira-- Add dynamic linking common issue-([#1249)](https://github.com/haskell/haskell-language-server/pull/1249) by @jneira-- Add license for hls-tactics-plugin-([#1248)](https://github.com/haskell/haskell-language-server/pull/1248) by @isovector-- Use exact print to extend import lists-([#1246)](https://github.com/haskell/haskell-language-server/pull/1246) by @berberman-- Test apply-refact with TypeApplications-([#1244)](https://github.com/haskell/haskell-language-server/pull/1244) by @jneira-- Add non reversable pragma completion-([#1243)](https://github.com/haskell/haskell-language-server/pull/1243) by @Ailrun-- Delete redundant "category: Development".-([#1241)](https://github.com/haskell/haskell-language-server/pull/1241) by @peterwicksstringfield-- Complete the No- variants of language extensions and Strict extension-([#1238)](https://github.com/haskell/haskell-language-server/pull/1238) by @mrBliss-- Add code actions for disabling a warning in the current file-([#1235)](https://github.com/haskell/haskell-language-server/pull/1235) by @georgefst-- Change packages metadata and rename tactics subfolder-([#1234)](https://github.com/haskell/haskell-language-server/pull/1234) by @jneira-- Fix the bug that generating comments would duplicate existing comments-([#1233)](https://github.com/haskell/haskell-language-server/pull/1233) by @berberman-- Delete global hie.yaml config-([#1230)](https://github.com/haskell/haskell-language-server/pull/1230) by @jneira-- Easy hlint fixes-([#1226)](https://github.com/haskell/haskell-language-server/pull/1226) by @peterwicksstringfield-- Use the runtime ghc libdir for ghc-exactprint-([#1225)](https://github.com/haskell/haskell-language-server/pull/1225) by @jneira-- Add note in README/Tutorial regarding CPP support-([#1224)](https://github.com/haskell/haskell-language-server/pull/1224) by @tittoassini-- Test and fix for issue 1213-([#1223)](https://github.com/haskell/haskell-language-server/pull/1223) by @tittoassini-- Add traces for HLS providers-([#1222)](https://github.com/haskell/haskell-language-server/pull/1222) by @pepeiborra-- Use exact print for suggest missing constraint code actions-([#1221)](https://github.com/haskell/haskell-language-server/pull/1221) by @pepeiborra-- Fix changelog dates-([#1220)](https://github.com/haskell/haskell-language-server/pull/1220) by @pepeiborra-- Ignore .shake folder-([#1219)](https://github.com/haskell/haskell-language-server/pull/1219) by @pepeiborra-- Limit completions to top 40-([#1218)](https://github.com/haskell/haskell-language-server/pull/1218) by @pepeiborra-- Parenthesise type operators when extending import lists-([#1212)](https://github.com/haskell/haskell-language-server/pull/1212) by @mrBliss-- Expose shake options used-([#1209)](https://github.com/haskell/haskell-language-server/pull/1209) by @pepeiborra-- Prepare ghcide release v0.7.1-([#1207)](https://github.com/haskell/haskell-language-server/pull/1207) by @pepeiborra-- Documentation for the Eval Plugin-([#1206)](https://github.com/haskell/haskell-language-server/pull/1206) by @tittoassini-- Stale diagnostics fix-([#1204)](https://github.com/haskell/haskell-language-server/pull/1204) by @pepeiborra-- Extract Development.IDE.GHC.ExactPrint-([#1203)](https://github.com/haskell/haskell-language-server/pull/1203) by @pepeiborra-- Fix bug in Retrie "fold/unfold in local file" commands-([#1202)](https://github.com/haskell/haskell-language-server/pull/1202) by @pepeiborra-- Minor eval plugin fixes-([#1199)](https://github.com/haskell/haskell-language-server/pull/1199) by @tittoassini-- Disable win 8.6.4 job-([#1198)](https://github.com/haskell/haskell-language-server/pull/1198) by @jneira-- Add custom cache layer for session loading-([#1197)](https://github.com/haskell/haskell-language-server/pull/1197) by @fendor-- Use completionSnippetsOn flag-([#1195)](https://github.com/haskell/haskell-language-server/pull/1195) by @takoeight0821-- Remove runs dropped by #1173-([#1194)](https://github.com/haskell/haskell-language-server/pull/1194) by @jneira-- Remove undefined exports suggestions-([#1193)](https://github.com/haskell/haskell-language-server/pull/1193) by @kderme-- Update nixpkgs to ghc 8.10.3-([#1191)](https://github.com/haskell/haskell-language-server/pull/1191) by @pepeiborra-- Do not disable parallel GC-([#1190)](https://github.com/haskell/haskell-language-server/pull/1190) by @pepeiborra-- Switch module outline to useWtihStale-([#1189)](https://github.com/haskell/haskell-language-server/pull/1189) by @pepeiborra-- Fix sticky diagnostics-([#1188)](https://github.com/haskell/haskell-language-server/pull/1188) by @pepeiborra-- Fix class plugin cabal-([#1186)](https://github.com/haskell/haskell-language-server/pull/1186) by @Ailrun-- Update package description of haddock comments plugin-([#1185)](https://github.com/haskell/haskell-language-server/pull/1185) by @berberman-- Installation from Hackage - add README section-([#1183)](https://github.com/haskell/haskell-language-server/pull/1183) by @pepeiborra-- Preparation for Uploading Splice Plugin to Hackage-([#1182)](https://github.com/haskell/haskell-language-server/pull/1182) by @konn-- Preparation for uploading `hls-exactprint-utils`-([#1181)](https://github.com/haskell/haskell-language-server/pull/1181) by @konn-- Complete hls-hlint-plugin package metadata-([#1180)](https://github.com/haskell/haskell-language-server/pull/1180) by @jneira-- Benchmark improvements-([#1178)](https://github.com/haskell/haskell-language-server/pull/1178) by @pepeiborra-- Make adding missing constraint work in presence of 'forall' (fixes #1164)-([#1177)](https://github.com/haskell/haskell-language-server/pull/1177) by @jhrcek-- Prepare for Hackage-([#1176)](https://github.com/haskell/haskell-language-server/pull/1176) by @pepeiborra-- Test only last ghc minor version and fix windows cache-([#1173)](https://github.com/haskell/haskell-language-server/pull/1173) by @jneira-- Fix toMethodName bug of the Class plugin-([#1170)](https://github.com/haskell/haskell-language-server/pull/1170) by @Ailrun-- Quick fix for #1158-([#1166)](https://github.com/haskell/haskell-language-server/pull/1166) by @Ailrun-- Suggest adding pragmas for parse errors too-([#1165)](https://github.com/haskell/haskell-language-server/pull/1165) by @mrBliss-- Fix wrong component name of splice plugin in hie.yaml-([#1162)](https://github.com/haskell/haskell-language-server/pull/1162) by @berberman-- Revert "Auto cancel redundant workflows (attempt #2)"-([#1156)](https://github.com/haskell/haskell-language-server/pull/1156) by @pepeiborra-- Auto cancel redundant workflows (attempt #2)-([#1154)](https://github.com/haskell/haskell-language-server/pull/1154) by @pepeiborra-- Prepare 0.8.0 (versions)-([#1153)](https://github.com/haskell/haskell-language-server/pull/1153) by @jneira-- Streamline CircleCI jobs-([#1152)](https://github.com/haskell/haskell-language-server/pull/1152) by @pepeiborra-- Mergify: create configuration-([#1151)](https://github.com/haskell/haskell-language-server/pull/1151) by @jneira-- Bump haskell-lsp to 0.23-([#1146)](https://github.com/haskell/haskell-language-server/pull/1146) by @berberman-- Remove no longer needed git submodule update-([#1145)](https://github.com/haskell/haskell-language-server/pull/1145) by @jhrcek-- Enable more tests-([#1143)](https://github.com/haskell/haskell-language-server/pull/1143) by @peterwicksstringfield-- Update links to issues/PRs in ghcide tests.-([#1142)](https://github.com/haskell/haskell-language-server/pull/1142) by @peterwicksstringfield-- Fix #723 (Instance declarations in hs-boot files result in GHC errors)-([#781)](https://github.com/haskell/haskell-language-server/pull/781) by @nitros12-- Also suggest importing methods without parent class-([#766)](https://github.com/haskell/haskell-language-server/pull/766) by @mrBliss-- Delete unused utilities for controlling logging.-([#764)](https://github.com/haskell/haskell-language-server/pull/764) by @peterwicksstringfield-- Delete unused testdata-([#763)](https://github.com/haskell/haskell-language-server/pull/763) by @peterwicksstringfield-- Fix suggestAddTypeAnnotation regex-([#760)](https://github.com/haskell/haskell-language-server/pull/760) by @kderme-- Splice Plugin: expands TH splices and QuasiQuotes-([#759)](https://github.com/haskell/haskell-language-server/pull/759) by @konn-- Haddock comments plugin-([#673)](https://github.com/haskell/haskell-language-server/pull/673) by @berberman-- Leverage last apply-refact improvements in hlint plugin (include getParsedModuleWithComments in ghcide)-([#635)](https://github.com/haskell/haskell-language-server/pull/635) by @jneira--## 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.+# Changelog for haskell-language-server + +## 1.0.0 + +This is the celebratory release of Haskell Language Server 1.0.0! +This release includes a lot of internal changes, bug fixes, leaks plugged, and performance improvements, thanks to all our contributors. +Among others, +- We added the support for GHC 8.10.4, and removed the support for GHC 8.10.1 + Afterward, we will support upmost 3 patch versions for each minor version of GHC, if no special situation happens. +- As by hie-bios >= 0.7.3, we use (`${XDG_CACHE_HOME}`)[https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html]`/hie-bios/...` (or similar depends on OS) as a build directory for Cabal. +- Now Eval plugin uses the parsing mechanism of GHC and becomes more stable. +- We supports a code action to disambiguate the same identifiers from multiple imports. +  +- We supports a code action to hide shadowed identifiers from import. +  +- HIE DB is now integrated. This means we now support `find-references`, `workspace-symbol`. `find-definition` is also improved in a project with multiple components. +- Brittany and Stylish-haskell plugins now load language extensions from the ghc session. +- Tactic plugin supports eta-reduction and Agda-like split tactic and can create a function with piecewise definitions. +  + +### Pull requests merged for 1.0.0 + +- Correctly split non-varpats in tactics +([#1427](https://github.com/haskell/haskell-language-server/pull/1427)) by @isovector +- Move tactics tests to be standalone +([#1425](https://github.com/haskell/haskell-language-server/pull/1425)) by @isovector +- Fix the handling of default HLS config again +([#1419](https://github.com/haskell/haskell-language-server/pull/1419)) by @pepeiborra +- Patch pre-commit-hook to work with GHCIDE/hls-plugin-api codes +([#1418](https://github.com/haskell/haskell-language-server/pull/1418)) by @Ailrun +- Refactor pragmas plugin +([#1417](https://github.com/haskell/haskell-language-server/pull/1417)) by @berberman +- Add a test for #1376 +([#1414](https://github.com/haskell/haskell-language-server/pull/1414)) by @pepeiborra +- Reenable HLS example benchmark +([#1412](https://github.com/haskell/haskell-language-server/pull/1412)) by @pepeiborra +- Fix pre-commit-hook +([#1411](https://github.com/haskell/haskell-language-server/pull/1411)) by @Ailrun +- Plugin Config: Add maxCompletions to JSON instance +([#1407](https://github.com/haskell/haskell-language-server/pull/1407)) by @andys8 +- Remove custom 'trim' implementation +([#1406](https://github.com/haskell/haskell-language-server/pull/1406)) by @fendor +- Update to hie-bios 0.7.4 +([#1405](https://github.com/haskell/haskell-language-server/pull/1405)) by @fendor +- Prepare 1.0.0 release +([#1402](https://github.com/haskell/haskell-language-server/pull/1402)) by @Ailrun +- Fix install script after hlint fixes +([#1400](https://github.com/haskell/haskell-language-server/pull/1400)) by @jhrcek +- Use last with-utf8 to fix #1372 +([#1399](https://github.com/haskell/haskell-language-server/pull/1399)) by @jneira +- Implement Tactic Featuresets +([#1398](https://github.com/haskell/haskell-language-server/pull/1398)) by @isovector +- Update hie-bios +([#1397](https://github.com/haskell/haskell-language-server/pull/1397)) by @Ailrun +- Bump plugins versions +([#1392](https://github.com/haskell/haskell-language-server/pull/1392)) by @pepeiborra +- Split main Tactics module +([#1391](https://github.com/haskell/haskell-language-server/pull/1391)) by @isovector +- Prepare ghcide release 0.7.5 +([#1389](https://github.com/haskell/haskell-language-server/pull/1389)) by @pepeiborra +- Disable HLS benchmark example +([#1388](https://github.com/haskell/haskell-language-server/pull/1388)) by @pepeiborra +- Fix GenChangelog script format +([#1387](https://github.com/haskell/haskell-language-server/pull/1387)) by @Ailrun +- Tone down some logInfos to logDebug +([#1385](https://github.com/haskell/haskell-language-server/pull/1385)) by @pepeiborra +- Add a pre commit hook for code formatting +([#1384](https://github.com/haskell/haskell-language-server/pull/1384)) by @Ailrun +- remove unsafePerformIO +([#1383](https://github.com/haskell/haskell-language-server/pull/1383)) by @pepeiborra +- Use object code for TH+UnboxedTuples/Sums +([#1382](https://github.com/haskell/haskell-language-server/pull/1382)) by @wz1000 +- Update stack resolvers 8.10.3/8.10.4 +([#1380](https://github.com/haskell/haskell-language-server/pull/1380)) by @jneira +- Agda-style case splitting for tactics +([#1379](https://github.com/haskell/haskell-language-server/pull/1379)) by @isovector +- Configuration for initial ghc lib dir +([#1378](https://github.com/haskell/haskell-language-server/pull/1378)) by @pepeiborra +- Use lsp-1.1.1 +([#1377](https://github.com/haskell/haskell-language-server/pull/1377)) by @wz1000 +- use implicit-hie cradle from setInitialDynFlags +([#1375](https://github.com/haskell/haskell-language-server/pull/1375)) by @wz1000 +- Add test for multi-component goto def and make runLanguageServer responsible for hiedb +([#1373](https://github.com/haskell/haskell-language-server/pull/1373)) by @wz1000 +- Show window message when auto extending import lists +([#1371](https://github.com/haskell/haskell-language-server/pull/1371)) by @berberman +- Another extension that Brittany cannot parse +([#1369](https://github.com/haskell/haskell-language-server/pull/1369)) by @pepeiborra +- Clean dependency data structures and speed up GetDependencies +([#1368](https://github.com/haskell/haskell-language-server/pull/1368)) by @pepeiborra +- Catch GHC errors in listing module names +([#1367](https://github.com/haskell/haskell-language-server/pull/1367)) by @berberman +- Lose the ghc-lib flag +([#1366](https://github.com/haskell/haskell-language-server/pull/1366)) by @pepeiborra +- Make StylishHaskell plugin recognize extensions from DynFlags +([#1364](https://github.com/haskell/haskell-language-server/pull/1364)) by @Ailrun +- Pass language extensions to Brittany +([#1362](https://github.com/haskell/haskell-language-server/pull/1362)) by @pepeiborra +- Sanitize the setup of the default Ide.Config +([#1361](https://github.com/haskell/haskell-language-server/pull/1361)) by @pepeiborra +- Fix completion snippets on DuplicateRecordFields +([#1360](https://github.com/haskell/haskell-language-server/pull/1360)) by @berberman +- Index files on first open +([#1358](https://github.com/haskell/haskell-language-server/pull/1358)) by @wz1000 +- Make find-definition work better with multi-components +([#1357](https://github.com/haskell/haskell-language-server/pull/1357)) by @wz1000 +- Construct record datacons in tactics +([#1356](https://github.com/haskell/haskell-language-server/pull/1356)) by @isovector +- Don't insert parentheses for top-level tactics holes +([#1352](https://github.com/haskell/haskell-language-server/pull/1352)) by @isovector +- Simplify extracts after running tactics +([#1351](https://github.com/haskell/haskell-language-server/pull/1351)) by @isovector +- Fix code actions regression +([#1349](https://github.com/haskell/haskell-language-server/pull/1349)) by @pepeiborra +- Refactor the hypothesis type in hls-tactics-plugin +([#1347](https://github.com/haskell/haskell-language-server/pull/1347)) by @isovector +- Fix the Eval plugin sporadic exceptions +([#1345](https://github.com/haskell/haskell-language-server/pull/1345)) by @pepeiborra +- Eval Plugin: Proper handling of flags in `:set` +([#1343](https://github.com/haskell/haskell-language-server/pull/1343)) by @konn +- Cancel earlier queued benchmarks +([#1339](https://github.com/haskell/haskell-language-server/pull/1339)) by @pepeiborra +- Default main for ghcide +([#1338](https://github.com/haskell/haskell-language-server/pull/1338)) by @pepeiborra +- Fix duplication of code actions for adding NamedFieldPuns +([#1334](https://github.com/haskell/haskell-language-server/pull/1334)) by @berberman +- Bump explicit-imports plugin +([#1333](https://github.com/haskell/haskell-language-server/pull/1333)) by @pepeiborra +- Add support for ghc-8.10.4 and drop it for ghc-8.10.1 +([#1331](https://github.com/haskell/haskell-language-server/pull/1331)) by @jneira +- Prepare ghcide v0.7.4 release +([#1328](https://github.com/haskell/haskell-language-server/pull/1328)) by @pepeiborra +- Add a new benchmark example to characterise multi-component performance +([#1326](https://github.com/haskell/haskell-language-server/pull/1326)) by @pepeiborra +- [shake-bench] extract project dependencies action (for the HEAD binary) +([#1325](https://github.com/haskell/haskell-language-server/pull/1325)) by @pepeiborra +- [shake-bench] collect eventlogs +([#1324](https://github.com/haskell/haskell-language-server/pull/1324)) by @pepeiborra +- [benchmark] add warmups +([#1323](https://github.com/haskell/haskell-language-server/pull/1323)) by @pepeiborra +- Add code action for hiding shadowed identifiers from imports +([#1322](https://github.com/haskell/haskell-language-server/pull/1322)) by @berberman +- Parallelize benchmark CI +([#1320](https://github.com/haskell/haskell-language-server/pull/1320)) by @pepeiborra +- Fix space leak on cradle reloads +([#1316](https://github.com/haskell/haskell-language-server/pull/1316)) by @pepeiborra +- [benchmarks] speed up CI +([#1315](https://github.com/haskell/haskell-language-server/pull/1315)) by @pepeiborra +- [benchmark] check digests for input files only +([#1314](https://github.com/haskell/haskell-language-server/pull/1314)) by @pepeiborra +- Add link to hackage package to readme +([#1313](https://github.com/haskell/haskell-language-server/pull/1313)) by @expipiplus1 +- Splice Plugin: preparatory version bump for the next (not 0.9.0) HLS release +([#1312](https://github.com/haskell/haskell-language-server/pull/1312)) by @konn +- hls-splice-plugin-0.3.0.0-prepare +([#1311](https://github.com/haskell/haskell-language-server/pull/1311)) by @konn +- Trigger extending import only when the item is not in scope +([#1309](https://github.com/haskell/haskell-language-server/pull/1309)) by @berberman +- Bum up hls-eval-plugin to 0.2 +([#1305](https://github.com/haskell/haskell-language-server/pull/1305)) by @jneira +- Don't extend import list with child if the parent has been imported as (..) +([#1302](https://github.com/haskell/haskell-language-server/pull/1302)) by @berberman +- Prepare hls hlint plugin 0.2.0 +([#1296](https://github.com/haskell/haskell-language-server/pull/1296)) by @jneira +- Import disambiguation: Corrects handling of fully-applied and one-sided sectioned operators in qualifying strategy +([#1294](https://github.com/haskell/haskell-language-server/pull/1294)) by @konn +- hls-splice-plugin-0.2.0.0 +([#1293](https://github.com/haskell/haskell-language-server/pull/1293)) by @konn +- Bump haddock comments plugin to 0.1.1 +([#1292](https://github.com/haskell/haskell-language-server/pull/1292)) by @berberman +- FindImports typo (minor) +([#1291](https://github.com/haskell/haskell-language-server/pull/1291)) by @andys8 +- Bump up hls-plugin-api to 0.7.0 +([#1290](https://github.com/haskell/haskell-language-server/pull/1290)) by @jneira +- Prepare ghcide v0.7.3 release +([#1289](https://github.com/haskell/haskell-language-server/pull/1289)) by @pepeiborra +- hls-retrie-plugin 0.1.1.0 +([#1288](https://github.com/haskell/haskell-language-server/pull/1288)) by @pepeiborra +- Upgrade to lsp-1.0 +([#1284](https://github.com/haskell/haskell-language-server/pull/1284)) by @wz1000 +- Update IRC Name in README +([#1275](https://github.com/haskell/haskell-language-server/pull/1275)) by @fendor +- Restore code actions order +([#1273](https://github.com/haskell/haskell-language-server/pull/1273)) by @pepeiborra +- Prepare 0.9.0 +([#1271](https://github.com/haskell/haskell-language-server/pull/1271)) by @jneira +- Reenable auto extend imports and drop snippets for infix completions +([#1266](https://github.com/haskell/haskell-language-server/pull/1266)) by @pepeiborra +- ghcide: Implements a CodeAction to disambiguate ambiguous symbols +([#1264](https://github.com/haskell/haskell-language-server/pull/1264)) by @konn +- Doctest comment parsing using module annotations in Eval Plugin +([#1232](https://github.com/haskell/haskell-language-server/pull/1232)) by @konn +- Apply some hlint suggestions, silence some others. +([#1227](https://github.com/haskell/haskell-language-server/pull/1227)) by @peterwicksstringfield +- References via `hiedb` +([#704](https://github.com/haskell/haskell-language-server/pull/704)) by @wz1000 +- Use default config on missing configuration section +([#459](https://github.com/haskell/haskell-language-server/pull/459)) by @aufarg + +## 0.9.0 + +This release includes lot of refactorings and bug fixes over existing features, hlint and eval plugins among others. +It contains a fix for a bug in ghcide involving stale diagnostics (#1204). + +The list of contributors continues to show healthy growth, many thanks to you all! + +And remember, we have a new brand logo, courtesy of @Ailrun :slightly_smiling_face: + + + +### Pull requests merged for 0.9.0 + +- Do not error out on failed rewrite +([#1269](https://github.com/haskell/haskell-language-server/pull/1269)) by @pepeiborra +- Tighten dependency on apply-refact +([#1268](https://github.com/haskell/haskell-language-server/pull/1268)) by @hololeap +- Add the new logos +([#1267](https://github.com/haskell/haskell-language-server/pull/1267)) by @Ailrun +- Fix a bug in completions +([#1265](https://github.com/haskell/haskell-language-server/pull/1265)) by @pepeiborra +- Produce heap profiles the old fashioned way, from .hp files +([#1261](https://github.com/haskell/haskell-language-server/pull/1261)) by @pepeiborra +- Break down ghcide functionality in HLS plugins +([#1257](https://github.com/haskell/haskell-language-server/pull/1257)) by @pepeiborra +- Enforce max completions over all plugins +([#1256](https://github.com/haskell/haskell-language-server/pull/1256)) by @pepeiborra +- Reorder code actions to put remove redundant imports first +([#1255](https://github.com/haskell/haskell-language-server/pull/1255)) by @pepeiborra +- Update bench.yml to include all the relevant artifacts +([#1254](https://github.com/haskell/haskell-language-server/pull/1254)) by @pepeiborra +- Benchmarks: generate heap profiles +([#1253](https://github.com/haskell/haskell-language-server/pull/1253)) by @pepeiborra +- Add gh workflows badges +([#1251](https://github.com/haskell/haskell-language-server/pull/1251)) by @jneira +- Add dynamic linking common issue +([#1249](https://github.com/haskell/haskell-language-server/pull/1249)) by @jneira +- Add license for hls-tactics-plugin +([#1248](https://github.com/haskell/haskell-language-server/pull/1248)) by @isovector +- Use exact print to extend import lists +([#1246](https://github.com/haskell/haskell-language-server/pull/1246)) by @berberman +- Test apply-refact with TypeApplications +([#1244](https://github.com/haskell/haskell-language-server/pull/1244)) by @jneira +- Add non reversable pragma completion +([#1243](https://github.com/haskell/haskell-language-server/pull/1243)) by @Ailrun +- Delete redundant "category: Development". +([#1241](https://github.com/haskell/haskell-language-server/pull/1241)) by @peterwicksstringfield +- Complete the No- variants of language extensions and Strict extension +([#1238](https://github.com/haskell/haskell-language-server/pull/1238)) by @mrBliss +- Add code actions for disabling a warning in the current file +([#1235](https://github.com/haskell/haskell-language-server/pull/1235)) by @georgefst +- Change packages metadata and rename tactics subfolder +([#1234](https://github.com/haskell/haskell-language-server/pull/1234)) by @jneira +- Fix the bug that generating comments would duplicate existing comments +([#1233](https://github.com/haskell/haskell-language-server/pull/1233)) by @berberman +- Delete global hie.yaml config +([#1230](https://github.com/haskell/haskell-language-server/pull/1230)) by @jneira +- Easy hlint fixes +([#1226](https://github.com/haskell/haskell-language-server/pull/1226)) by @peterwicksstringfield +- Use the runtime ghc libdir for ghc-exactprint +([#1225](https://github.com/haskell/haskell-language-server/pull/1225)) by @jneira +- Add note in README/Tutorial regarding CPP support +([#1224](https://github.com/haskell/haskell-language-server/pull/1224)) by @tittoassini +- Test and fix for issue 1213 +([#1223](https://github.com/haskell/haskell-language-server/pull/1223)) by @tittoassini +- Add traces for HLS providers +([#1222](https://github.com/haskell/haskell-language-server/pull/1222)) by @pepeiborra +- Use exact print for suggest missing constraint code actions +([#1221](https://github.com/haskell/haskell-language-server/pull/1221)) by @pepeiborra +- Fix changelog dates +([#1220](https://github.com/haskell/haskell-language-server/pull/1220)) by @pepeiborra +- Ignore .shake folder +([#1219](https://github.com/haskell/haskell-language-server/pull/1219)) by @pepeiborra +- Limit completions to top 40 +([#1218](https://github.com/haskell/haskell-language-server/pull/1218)) by @pepeiborra +- Parenthesise type operators when extending import lists +([#1212](https://github.com/haskell/haskell-language-server/pull/1212)) by @mrBliss +- Expose shake options used +([#1209](https://github.com/haskell/haskell-language-server/pull/1209)) by @pepeiborra +- Prepare ghcide release v0.7.1 +([#1207](https://github.com/haskell/haskell-language-server/pull/1207)) by @pepeiborra +- Documentation for the Eval Plugin +([#1206](https://github.com/haskell/haskell-language-server/pull/1206)) by @tittoassini +- Stale diagnostics fix +([#1204](https://github.com/haskell/haskell-language-server/pull/1204)) by @pepeiborra +- Extract Development.IDE.GHC.ExactPrint +([#1203](https://github.com/haskell/haskell-language-server/pull/1203)) by @pepeiborra +- Fix bug in Retrie "fold/unfold in local file" commands +([#1202](https://github.com/haskell/haskell-language-server/pull/1202)) by @pepeiborra +- Minor eval plugin fixes +([#1199](https://github.com/haskell/haskell-language-server/pull/1199)) by @tittoassini +- Disable win 8.6.4 job +([#1198](https://github.com/haskell/haskell-language-server/pull/1198)) by @jneira +- Add custom cache layer for session loading +([#1197](https://github.com/haskell/haskell-language-server/pull/1197)) by @fendor +- Use completionSnippetsOn flag +([#1195](https://github.com/haskell/haskell-language-server/pull/1195)) by @takoeight0821 +- Remove runs dropped by #1173 +([#1194](https://github.com/haskell/haskell-language-server/pull/1194)) by @jneira +- Remove undefined exports suggestions +([#1193](https://github.com/haskell/haskell-language-server/pull/1193)) by @kderme +- Update nixpkgs to ghc 8.10.3 +([#1191](https://github.com/haskell/haskell-language-server/pull/1191)) by @pepeiborra +- Do not disable parallel GC +([#1190](https://github.com/haskell/haskell-language-server/pull/1190)) by @pepeiborra +- Switch module outline to useWtihStale +([#1189](https://github.com/haskell/haskell-language-server/pull/1189)) by @pepeiborra +- Fix sticky diagnostics +([#1188](https://github.com/haskell/haskell-language-server/pull/1188)) by @pepeiborra +- Fix class plugin cabal +([#1186](https://github.com/haskell/haskell-language-server/pull/1186)) by @Ailrun +- Update package description of haddock comments plugin +([#1185](https://github.com/haskell/haskell-language-server/pull/1185)) by @berberman +- Installation from Hackage - add README section +([#1183](https://github.com/haskell/haskell-language-server/pull/1183)) by @pepeiborra +- Preparation for Uploading Splice Plugin to Hackage +([#1182](https://github.com/haskell/haskell-language-server/pull/1182)) by @konn +- Preparation for uploading `hls-exactprint-utils` +([#1181](https://github.com/haskell/haskell-language-server/pull/1181)) by @konn +- Complete hls-hlint-plugin package metadata +([#1180](https://github.com/haskell/haskell-language-server/pull/1180)) by @jneira +- Benchmark improvements +([#1178](https://github.com/haskell/haskell-language-server/pull/1178)) by @pepeiborra +- Make adding missing constraint work in presence of 'forall' (fixes #1164) +([#1177](https://github.com/haskell/haskell-language-server/pull/1177)) by @jhrcek +- Prepare for Hackage +([#1176](https://github.com/haskell/haskell-language-server/pull/1176)) by @pepeiborra +- Test only last ghc minor version and fix windows cache +([#1173](https://github.com/haskell/haskell-language-server/pull/1173)) by @jneira +- Fix toMethodName bug of the Class plugin +([#1170](https://github.com/haskell/haskell-language-server/pull/1170)) by @Ailrun +- Quick fix for #1158 +([#1166](https://github.com/haskell/haskell-language-server/pull/1166)) by @Ailrun +- Suggest adding pragmas for parse errors too +([#1165](https://github.com/haskell/haskell-language-server/pull/1165)) by @mrBliss +- Fix wrong component name of splice plugin in hie.yaml +([#1162](https://github.com/haskell/haskell-language-server/pull/1162)) by @berberman +- Revert "Auto cancel redundant workflows (attempt #2)" +([#1156](https://github.com/haskell/haskell-language-server/pull/1156)) by @pepeiborra +- Auto cancel redundant workflows (attempt #2) +([#1154](https://github.com/haskell/haskell-language-server/pull/1154)) by @pepeiborra +- Prepare 0.8.0 (versions) +([#1153](https://github.com/haskell/haskell-language-server/pull/1153)) by @jneira +- Streamline CircleCI jobs +([#1152](https://github.com/haskell/haskell-language-server/pull/1152)) by @pepeiborra +- Mergify: create configuration +([#1151](https://github.com/haskell/haskell-language-server/pull/1151)) by @jneira +- Bump haskell-lsp to 0.23 +([#1146](https://github.com/haskell/haskell-language-server/pull/1146)) by @berberman +- Remove no longer needed git submodule update +([#1145](https://github.com/haskell/haskell-language-server/pull/1145)) by @jhrcek +- Enable more tests +([#1143](https://github.com/haskell/haskell-language-server/pull/1143)) by @peterwicksstringfield +- Update links to issues/PRs in ghcide tests. +([#1142](https://github.com/haskell/haskell-language-server/pull/1142)) by @peterwicksstringfield +- Fix #723 (Instance declarations in hs-boot files result in GHC errors) +([#781](https://github.com/haskell/haskell-language-server/pull/781)) by @nitros12 +- Also suggest importing methods without parent class +([#766](https://github.com/haskell/haskell-language-server/pull/766)) by @mrBliss +- Delete unused utilities for controlling logging. +([#764](https://github.com/haskell/haskell-language-server/pull/764)) by @peterwicksstringfield +- Delete unused testdata +([#763](https://github.com/haskell/haskell-language-server/pull/763)) by @peterwicksstringfield +- Fix suggestAddTypeAnnotation regex +([#760](https://github.com/haskell/haskell-language-server/pull/760)) by @kderme +- Splice Plugin: expands TH splices and QuasiQuotes +([#759](https://github.com/haskell/haskell-language-server/pull/759)) by @konn +- Haddock comments plugin +([#673](https://github.com/haskell/haskell-language-server/pull/673)) by @berberman +- Leverage last apply-refact improvements in hlint plugin (include getParsedModuleWithComments in ghcide) +([#635](https://github.com/haskell/haskell-language-server/pull/635)) by @jneira + +## 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
@@ -1,201 +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.+ 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
@@ -1,762 +1,767 @@-# haskell-language-server--![haskell-language-server][logo]--[![License Apache 2.0][badge-license]][license]-[![CircleCI][badge-circleci]][circleci]----[logo]: ./docs/logos/logo-256.png-[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 ([Tutorial](plugins/hls-eval-plugin/README.md)):-- --- 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-- 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-- Max completions (`haskell.maxCompletions`, default 40): maximum number of completions sent to the LSP client.--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.--#### Problems with dynamic linking--As haskell-language-server prebuilt binaries are statically linked, they don't play well with projects using dynamic linking.-An usual symptom is the presence of errors containing `unknown symbol` and it is typical in arch linux, where a dynamically linked version of ghc is used. --The workaround is to use a version of haskell-language-server compiled from source with `-dynamic` enabled`. See more details [here](https://github.com/haskell/haskell-language-server/issues/1160#issuecomment-756566273).--### 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.+# haskell-language-server + +![haskell-language-server][logo] + +[![Hackage][badge-hackage]][hackage] +[![License Apache 2.0][badge-license]][license] +[![CircleCI][badge-circleci]][circleci] + + + +[logo]: ./docs/logos/logo-256.png +[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/ +[badge-hackage]: https://img.shields.io/hackage/v/haskell-language-server.svg?logo=haskell +[hackage]: https://hackage.haskell.org/package/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 ([Tutorial](plugins/hls-eval-plugin/README.md)): + +  + +- 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. + +The package can be found here on Hackage: https://hackage.haskell.org/package/haskell-language-server + +## 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 +- 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 +- Max completions (`haskell.maxCompletions`, default 40): maximum number of completions sent to the LSP client. + +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. + +#### Problems with dynamic linking + +As haskell-language-server prebuilt binaries are statically linked, they don't play well with projects using dynamic linking. +An usual symptom is the presence of errors containing `unknown symbol` and it is typical in arch linux, where a dynamically linked version of ghc is used. + +The workaround is to use a version of haskell-language-server compiled from source with `-dynamic` enabled`. See more details [here](https://github.com/haskell/haskell-language-server/issues/1160#issuecomment-756566273). + +### 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-language-server) at `#haskell-language-server` 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
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
exe/Main.hs view
@@ -1,22 +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)+-- 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
@@ -1,142 +1,142 @@-{-# 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 haddockComments-import Ide.Plugin.HaddockComments as HaddockComments-#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--#if splice-import Ide.Plugin.Splice as Splice-#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.descriptors ++-#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 haddockComments- HaddockComments.descriptor "haddockComments" :-#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-#if splice- Splice.descriptor "splice" :-#endif- []- examplePlugins =- [Example.descriptor "eg"- ,Example2.descriptor "eg2"- ]+{-# 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 haddockComments +import Ide.Plugin.HaddockComments as HaddockComments +#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 + +#if splice +import Ide.Plugin.Splice as Splice +#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.descriptors ++ +#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 haddockComments + HaddockComments.descriptor "haddockComments" : +#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 +#if splice + Splice.descriptor "splice" : +#endif + [] + examplePlugins = + [Example.descriptor "eg" + ,Example2.descriptor "eg2" + ]
exe/Wrapper.hs view
@@ -1,146 +1,151 @@-{-# 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+{-# 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.Default +import Data.Foldable +import Data.List +import Data.Void +import Development.IDE.Session (findCradle) +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 + + _ -> launchHaskellLanguageServer args + +launchHaskellLanguageServer :: Arguments -> IO () +launchHaskellLanguageServer parsedArgs = do + case parsedArgs of + LspMode LspArguments{..} -> whenJust argsCwd setCurrentDirectory + _ -> pure () + + d <- getCurrentDirectory + + -- Get the cabal directory from the cradle + cradle <- findLocalCradle (d </> "a") + setCurrentDirectory $ cradleRootDir cradle + + case parsedArgs of + LspMode LspArguments{..} -> + when argsProjectGhcVersion $ getRuntimeGhcVersion' cradle >>= putStrLn >> exitSuccess + _ -> pure () + + 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 def 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
@@ -1,7 +1,7 @@ cabal-version: 2.2 category: Development name: haskell-language-server-version: 0.9.0.0+version: 1.0.0.0 synopsis: LSP server for GHC description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -14,7 +14,7 @@ license: Apache-2.0 license-file: LICENSE build-type: Simple-tested-with: GHC == 8.6.4 || == 8.6.5 || == 8.8.2 || == 8.8.3 || == 8.8.4 || == 8.10.1 || == 8.10.2 || == 8.10.3+tested-with: GHC == 8.6.4 || == 8.6.5 || == 8.8.2 || == 8.8.3 || == 8.8.4 || == 8.10.2 || == 8.10.3 || == 8.10.4 extra-source-files: README.md ChangeLog.md@@ -57,26 +57,35 @@ autogen-modules: Paths_haskell_language_server hs-source-dirs: src build-depends:+ , async+ , base16-bytestring+ , bytestring , containers+ , cryptohash-sha1 , data-default , ghc- , ghcide >=0.7+ , ghcide ^>= 1.0.0.0 , gitrev- , haskell-lsp ^>=0.23- , hls-plugin-api >=0.6+ , lsp+ , hie-bios+ , hiedb+ , hls-plugin-api ^>= 1.0.0.0 , hslogger , optparse-applicative , optparse-simple , process , shake+ , safe-exceptions+ , sqlite-simple , unordered-containers - ghc-options: -Wall -Wredundant-constraints -Wno-name-shadowing+ ghc-options: -Wall -Wredundant-constraints -Wno-name-shadowing -Wno-unticked-promoted-constructors if flag(pedantic) ghc-options: -Werror default-language: Haskell2010+ default-extensions: DataKinds, TypeOperators -- Plugin flags are designed for 'cabal install haskell-language-server': -- - Packaged plugins should be manual:False@@ -178,37 +187,37 @@ common class if flag(class) || flag(all-plugins)- build-depends: hls-class-plugin+ build-depends: hls-class-plugin ^>= 1.0.0.0 cpp-options: -Dclass common haddockComments if flag(haddockComments) || flag(all-plugins)- build-depends: hls-haddock-comments-plugin+ build-depends: hls-haddock-comments-plugin ^>= 1.0.0.0 cpp-options: -DhaddockComments common eval if flag(eval) || flag(all-plugins)- build-depends: hls-eval-plugin+ build-depends: hls-eval-plugin ^>= 1.0.0.0 cpp-options: -Deval common importLens if flag(importLens) || flag(all-plugins)- build-depends: hls-explicit-imports-plugin+ build-depends: hls-explicit-imports-plugin ^>= 1.0.0.0 cpp-options: -DimportLens common retrie if flag(retrie) || flag(all-plugins)- build-depends: hls-retrie-plugin+ build-depends: hls-retrie-plugin ^>= 1.0.0.0 cpp-options: -Dretrie common tactic if flag(tactic) || flag(all-plugins)- build-depends: hls-tactics-plugin+ build-depends: hls-tactics-plugin ^>= 1.0.0.0 cpp-options: -Dtactic common hlint if flag(hlint) || flag(all-plugins)- build-depends: hls-hlint-plugin+ build-depends: hls-hlint-plugin ^>= 1.0.0.0 cpp-options: -Dhlint common moduleName@@ -226,7 +235,7 @@ common splice if flag(splice) || flag(all-plugins)- build-depends: hls-splice-plugin+ build-depends: hls-splice-plugin ^>= 1.0.0.0 cpp-options: -Dsplice -- formatters@@ -298,21 +307,27 @@ -- disable idle GC -- increase nursery size "-with-rtsopts=-I0 -A128M"+ -Wno-unticked-promoted-constructors if flag(pedantic) ghc-options: -Werror build-depends: , aeson+ , async+ , base16-bytestring , binary , bytestring , containers+ , cryptohash-sha1 , deepseq , ghc , ghc-boot-th , ghcide , hashable , haskell-language-server- , haskell-lsp ^>=0.23+ , lsp+ , hie-bios+ , hiedb , lens , regex-tdfa , hslogger@@ -323,6 +338,7 @@ , regex-tdfa , safe-exceptions , shake >=0.17.5+ , sqlite-simple , temporary , transformers , unordered-containers@@ -330,6 +346,7 @@ include-dirs: include default-language: Haskell2010+ default-extensions: DataKinds, TypeOperators executable haskell-language-server-wrapper import: agpl, common-deps@@ -348,6 +365,7 @@ ghc-options: -Werror build-depends:+ , data-default , ghc , ghc-paths , ghcide@@ -372,14 +390,14 @@ , blaze-markup , containers , data-default- , haskell-lsp+ , lsp , hie-bios- , hls-plugin-api >=0.6+ , hls-plugin-api ^>= 1.0.0.0 , hslogger , hspec , hspec-core , lens- , lsp-test >=0.11.0.6+ , lsp-test == 0.13.0.0 , stm , tasty-expected-failure , tasty-hunit@@ -412,9 +430,11 @@ , tasty-ant-xml >=1.1.6 , tasty-golden , tasty-rerun+ , megaparsec+ , deepseq , ghcide - hs-source-dirs: test/functional plugins/hls-tactics-plugin/src plugins/hls-eval-plugin/test plugins/hls-splice-plugin/src+ hs-source-dirs: test/functional plugins/hls-eval-plugin/test plugins/hls-splice-plugin/src plugins/hls-eval-plugin/src main-is: Main.hs other-modules:@@ -438,14 +458,14 @@ Rename Symbol TypeDefinition- Tactic Splice HaddockComments Ide.Plugin.Splice.Types- Ide.Plugin.Tactic.TestTypes+ Ide.Plugin.Eval.Types + default-extensions: OverloadedStrings ghc-options:- -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N+ -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N -Wno-unticked-promoted-constructors if flag(pedantic) ghc-options: -Werror -Wredundant-constraints
include/ghc-api-version.h view
@@ -1,10 +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+#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
@@ -1,104 +1,118 @@-module Ide.Plugin.Brittany where--import Control.Exception (bracket_)-import Control.Lens-import Control.Monad.IO.Class-import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)-import Data.Coerce-import Data.Maybe (maybeToList)-import Data.Semigroup-import Data.Text (Text)-import qualified Data.Text as T-import Development.IDE-import Development.IDE.GHC.Compat (topDir, ModSummary(ms_hspp_opts))-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 System.Environment (setEnv, unsetEnv)--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 ide typ contents nfp opts = do--- text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do- confFile <- liftIO $ getConfFile nfp- let (range, selectedContents) = case typ of- FormatText -> (fullRange contents, contents)- FormatRange r -> (normalize r, extractRange r contents)- (modsum, _) <- runAction "brittany" ide $ use_ GetModSummary nfp- let dflags = ms_hspp_opts modsum- let withRuntimeLibdir = bracket_ (setEnv key $ topDir dflags) (unsetEnv key)- where key = "GHC_EXACTPRINT_GHC_LIBDIR"- res <- withRuntimeLibdir $ 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"+{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module Ide.Plugin.Brittany where + +import Control.Exception (bracket_) +import Control.Lens +import Control.Monad.IO.Class +import Control.Monad.Trans.Maybe (MaybeT, runMaybeT) +import Data.Coerce +import Data.Maybe (mapMaybe, maybeToList) +import Data.Semigroup +import Data.Text (Text) +import qualified Data.Text as T +import Development.IDE hiding (pluginHandlers) +import Development.IDE.GHC.Compat (topDir, ModSummary(ms_hspp_opts)) +import qualified DynFlags as D +import qualified EnumSet as S +import GHC.LanguageExtensions.Type +import Language.Haskell.Brittany +import Language.LSP.Types as J +import qualified Language.LSP.Types.Lens as J +import Ide.PluginUtils +import Ide.Types +import System.FilePath +import System.Environment (setEnv, unsetEnv) + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) + { pluginHandlers = mkFormattingHandlers 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 :: FormattingHandler IdeState +provider ide typ contents nfp opts = liftIO $ do + confFile <- getConfFile nfp + let (range, selectedContents) = case typ of + FormatText -> (fullRange contents, contents) + FormatRange r -> (normalize r, extractRange r contents) + (modsum, _) <- runAction "brittany" ide $ use_ GetModSummary nfp + let dflags = ms_hspp_opts modsum + let withRuntimeLibdir = bracket_ (setEnv key $ topDir dflags) (unsetEnv key) + where key = "GHC_EXACTPRINT_GHC_LIBDIR" + res <- withRuntimeLibdir $ formatText dflags 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 + => D.DynFlags + -> 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 df confFile opts text = + liftIO $ runBrittany tabSize df 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 + -> D.DynFlags + -> Maybe FilePath -- ^ local config file + -> Text -- ^ text to format + -> IO (Either [BrittanyError] Text) +runBrittany tabSize df confPath text = do + let cfg = mempty + { _conf_layout = + mempty { _lconfig_indentAmount = opt (coerce tabSize) + } + , _conf_forward = + (mempty :: CForwardOptions Option) + { _options_ghc = opt (getExtensions df) + } + } + + 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" + +showExtension :: Extension -> Maybe String +showExtension Cpp = Just "-XCPP" +-- Brittany chokes on parsing extensions that produce warnings +showExtension DatatypeContexts = Nothing +showExtension RecordPuns = Just "-XNamedFieldPuns" +showExtension other = Just $ "-X" ++ show other + +getExtensions :: D.DynFlags -> [String] +getExtensions = mapMaybe showExtension . S.toList . D.extensionFlags
plugins/default/src/Ide/Plugin/Example.hs view
@@ -1,230 +1,234 @@-{-# 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 = Nothing- 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---- ---------------------------------------------------------------------+{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RecordWildCards #-} + +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.LSP.Types +import Language.LSP.Server +import Text.Regex.TDFA.Text() +import Control.Monad.IO.Class + +-- --------------------------------------------------------------------- + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) + { pluginRules = exampleRules + , pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd] + , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction + <> mkPluginHandler STextDocumentCodeLens codeLens + <> mkPluginHandler STextDocumentHover hover + <> mkPluginHandler STextDocumentDocumentSymbol symbols + <> mkPluginHandler STextDocumentCompletion completion + } + +-- --------------------------------------------------------------------- + +hover :: PluginMethodHandler IdeState TextDocumentHover +hover ide _ HoverParams{..} = liftIO $ request "Hover" blah (Right Nothing) foundHover ide TextDocumentPositionParams{..} + +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 :: PluginMethodHandler IdeState TextDocumentCodeAction +codeAction state _pid (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs}) = liftIO $ 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 + [ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing] + +-- --------------------------------------------------------------------- + +codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens +codeLens ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ 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 _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 + _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing res) (\_ -> pure ()) + return $ Right Null + +-- --------------------------------------------------------------------- + +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 :: PluginMethodHandler IdeState TextDocumentDocumentSymbol +symbols _ide _pid (DocumentSymbolParams _ _ _doc) + = pure $ Right $ InL $ List [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 :: PluginMethodHandler IdeState TextDocumentCompletion +completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt) + = pure $ Right $ InL $ 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 = Nothing + 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
@@ -1,224 +1,228 @@-{-# 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 = Nothing- 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---- ---------------------------------------------------------------------+{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RecordWildCards #-} + +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.LSP.Types +import Language.LSP.Server +import Text.Regex.TDFA.Text() +import Control.Monad.IO.Class + +-- --------------------------------------------------------------------- + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) + { pluginRules = exampleRules + , pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd] + , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction + <> mkPluginHandler STextDocumentCodeLens codeLens + <> mkPluginHandler STextDocumentHover hover + <> mkPluginHandler STextDocumentDocumentSymbol symbols + <> mkPluginHandler STextDocumentCompletion completion + } + +-- --------------------------------------------------------------------- + +hover :: PluginMethodHandler IdeState TextDocumentHover +hover ide _ HoverParams{..} = liftIO $ request "Hover" blah (Right Nothing) foundHover ide TextDocumentPositionParams{..} + +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 :: PluginMethodHandler IdeState TextDocumentCodeAction +codeAction _state _pid (CodeActionParams _ _ (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 + [ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing ] + +-- --------------------------------------------------------------------- + +codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens +codeLens ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ 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 _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 + _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing res) (\_ -> pure ()) + return $ Right Null + +-- --------------------------------------------------------------------- + +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 :: PluginMethodHandler IdeState TextDocumentDocumentSymbol +symbols _ide _ (DocumentSymbolParams _ _ _doc) + = pure $ Right $ InL $ List [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 :: PluginMethodHandler IdeState TextDocumentCompletion +completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt) + = pure $ Right $ InL $ 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 = Nothing + 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
@@ -1,58 +1,59 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--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 }---- ---------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +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 hiding (pluginHandlers) +import Floskell +import Ide.PluginUtils +import Ide.Types +import Language.LSP.Types +import Text.Regex.TDFA.Text() +import Control.Monad.IO.Class + +-- --------------------------------------------------------------------- + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) + { pluginHandlers = mkFormattingHandlers 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 :: FormattingHandler IdeState +provider _ideState typ contents fp _ = liftIO $ 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
@@ -1,110 +1,103 @@-{-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# 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+{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# 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 hiding (pluginHandlers) +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 (makeDiffTextEdit) + +import Ide.Types +import Language.LSP.Server +import Language.LSP.Types +import Language.LSP.Types.Lens +import "fourmolu" Ormolu +import Control.Monad.IO.Class + +-- --------------------------------------------------------------------- + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = + (defaultPluginDescriptor plId) + { pluginHandlers = mkFormattingHandlers provider + } + +-- --------------------------------------------------------------------- + +provider :: FormattingHandler IdeState +provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do + ghc <- liftIO $ runAction "Fourmolu" ideState $ use GhcSession fp + fileOpts <- case hsc_dflags . hscEnv <$> ghc of + Nothing -> return [] + Just df -> liftIO $ 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 + } + + liftIO (loadConfigFile fp') >>= \case + ConfigLoaded file opts -> liftIO $ do + putStrLn $ "Loaded Fourmolu config from: " <> file + format opts + ConfigNotFound searchDirs -> liftIO $ do + putStrLn + . unlines + $ ("No " ++ show configFileName ++ " found in any of:") : + map (" " ++) searchDirs + format mempty + ConfigParseError f (_, err) -> do + sendNotification SWindowShowMessage $ + ShowMessageParams + { _xtype = MtError + , _message = errorMessage + } + 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 = ["-pgmF=" <> p | not (null 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
@@ -1,204 +1,178 @@-{-# 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+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# OPTIONS_GHC -Wall -Wwarn -fno-warn-type-defaults -fno-warn-unused-binds -fno-warn-unused-imports -Wno-unticked-promoted-constructors #-} + +{- | 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 Control.Monad +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 +import Language.LSP.Server +import Language.LSP.Types +import Language.LSP.VFS (virtualFileText) +import System.Directory (canonicalizePath) +import System.FilePath ( + dropExtension, + splitDirectories, + takeFileName, + ) + +-- |Plugin descriptor +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = + (defaultPluginDescriptor plId) + { pluginHandlers = mkPluginHandler STextDocumentCodeLens 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 :: PluginMethodHandler IdeState TextDocumentCodeLens +codeLens state pluginId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do + do + pid <- liftIO $ pack . show <$> getProcessID + Right . List . maybeToList . (asCodeLens (mkLspCmdId pid pluginId editCommandName) <$>) <$> action state uri + +-- | (Quasi) Idempotent command execution: recalculate action to execute on command request +command :: CommandFunction IdeState Uri +command state uri = do + actMaybe <- action state uri + case actMaybe of + Nothing -> pure () + Just act -> void $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing (asEdit act)) (\_ -> pure ()) + return (Right Null) + +-- | 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 :: IdeState -> Uri -> LspM c (Maybe Action) +action state uri = + traceAs "action" <$> do + let Just nfp = uriToNormalizedFilePath $ toNormalizedUri uri + let Just fp = uriToFilePath' uri + + contents <- getVirtualFile $ toNormalizedUri uri + let emptyModule = maybe True (T.null . T.strip . virtualFileText) contents + + correctNameMaybe <- liftIO $ traceAs "correctName" <$> pathModuleName state nfp fp + statedNameMaybe <- liftIO $ 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
@@ -1,80 +1,80 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# 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+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Ide.Plugin.Ormolu + ( + descriptor + , provider + ) +where + +import Control.Exception +import qualified Data.Text as T +import Development.IDE hiding (pluginHandlers) +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.LSP.Server +import Language.LSP.Types +import "ormolu" Ormolu +import System.FilePath (takeFileName) +import Text.Regex.TDFA.Text () +import Control.Monad.IO.Class + +-- --------------------------------------------------------------------- + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) + { pluginHandlers = mkFormattingHandlers provider + } + +-- --------------------------------------------------------------------- + +provider :: FormattingHandler IdeState +provider ideState typ contents fp _ = withIndefiniteProgress title Cancellable $ liftIO $ do + let + fromDyn :: DynFlags -> IO [DynOption] + fromDyn df = + let + pp = + let p = D.sPgm_F $ D.settings df + in ["-pgmF=" <> p | not (null 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
@@ -1,174 +1,189 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}---- | Provides code actions to add missing pragmas (whenever GHC suggests to)-module Ide.Plugin.Pragmas- (- descriptor- ) 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-import qualified Text.Fuzzy as Fuzzy---- -----------------------------------------------------------------------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- -- Get all potential Pragmas for all diagnostics.- pragmas = concatMap (\d -> genPragma dflags (d ^. J.message)) diags- 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 =- [ r | r <- findPragma target, r `notElem` disabled]- where- disabled- | Just dynFlags <- mDynflags- -- GHC does not export 'OnOff', so we have to view it as string- = [ e | Just e <- T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags]- | otherwise- -- When the module failed to parse, we don't have access to its- -- dynFlags. In that case, simply don't disable any pragmas.- = []---- ------------------------------------------------------------------------- | 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]-- -- We exclude the Strict extension as it causes many false positives, see- -- the discussion at https://github.com/haskell/ghcide/pull/638- --- -- We don't include the No- variants, as GHC never suggests disabling an- -- extension in an error message.- possiblePragmas :: [T.Text]- possiblePragmas =- [ name- | FlagSpec{flagSpecName = T.pack -> name} <- xFlags- , "Strict" /= name- ]---- ------------------------------------------------------------------------- | All language pragmas, including the No- variants-allPragmas :: [T.Text]-allPragmas =- concat- [ [name, "No" <> name]- | FlagSpec{flagSpecName = T.pack -> name} <- xFlags- ]- <>- -- These pragmas are not part of xFlags as they are not reversable- -- by prepending "No".- [ -- Safe Haskell- "Unsafe"- , "Trustworthy"- , "Safe"-- -- Language Version Extensions- , "Haskell98"- , "Haskell2010"- -- Maybe, GHC 2021 after its release?- ]---- -----------------------------------------------------------------------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) ->- result <$> VFS.getCompletionPrefix position cnts- where- result (Just pfix)- | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix- = Completions $ List $ map buildCompletion- (Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas)- | otherwise- = Completions $ List []- result Nothing = Completions $ List []- buildCompletion p =- CompletionItem- { _label = p,- _kind = Just CiKeyword,- _tags = Nothing,- _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 []+{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +-- | Provides code actions to add missing pragmas (whenever GHC suggests to) +module Ide.Plugin.Pragmas (descriptor) where + +import Control.Applicative ((<|>)) +import Control.Lens hiding (List) +import Control.Monad (join) +import Control.Monad.IO.Class +import qualified Data.HashMap.Strict as H +import Data.List.Extra (nubOrdOn) +import Data.Maybe (catMaybes, listToMaybe) +import qualified Data.Text as T +import Development.IDE as D +import Development.IDE.GHC.Compat +import Ide.Types +import qualified Language.LSP.Server as LSP +import Language.LSP.Types +import qualified Language.LSP.Types as J +import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.VFS as VFS +import qualified Text.Fuzzy as Fuzzy + +-- --------------------------------------------------------------------- + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) + { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider + <> mkPluginHandler STextDocumentCompletion completion + } + +-- --------------------------------------------------------------------- + +-- | Title and pragma +type PragmaEdit = (T.Text, Pragma) + +data Pragma = LangExt T.Text | OptGHC T.Text + deriving (Show, Eq, Ord) + +codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction +codeActionProvider state _plId (CodeActionParams _ _ docId _ (J.CodeActionContext (J.List diags) _monly)) = do + let mFile = docId ^. J.uri & uriToFilePath <&> toNormalizedFilePath' + uri = docId ^. J.uri + pm <- liftIO $ fmap join $ runAction "Pragmas.GetParsedModule" state $ getParsedModule `traverse` mFile + let dflags = ms_hspp_opts . pm_mod_summary <$> pm + insertRange = maybe (Range (Position 0 0) (Position 0 0)) endOfModuleHeader pm + pedits = nubOrdOn snd . concat $ suggest dflags <$> diags + return $ Right $ List $ pragmaEditToAction uri insertRange <$> pedits + +-- | Add a Pragma to the given URI at the top of the file. +-- It is assumed that the pragma name is a valid pragma, +-- thus, not validated. +pragmaEditToAction :: Uri -> Range -> PragmaEdit -> (Command |? CodeAction) +pragmaEditToAction uri range (title, p) = + InR $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing Nothing (Just edit) Nothing + where + render (OptGHC x) = "{-# OPTIONS_GHC -Wno-" <> x <> " #-}\n" + render (LangExt x) = "{-# LANGUAGE " <> x <> " #-}\n" + textEdits = J.List [J.TextEdit range $ render p] + edit = + J.WorkspaceEdit + (Just $ H.singleton uri textEdits) + Nothing + +suggest :: Maybe DynFlags -> Diagnostic -> [PragmaEdit] +suggest dflags diag = + suggestAddPragma dflags diag + ++ suggestDisableWarning diag + +-- --------------------------------------------------------------------- + +suggestDisableWarning :: Diagnostic -> [PragmaEdit] +suggestDisableWarning Diagnostic {_code} + | Just (InR (T.stripPrefix "-W" -> Just w)) <- _code = + pure ("Disable \"" <> w <> "\" warnings", OptGHC w) + | otherwise = [] + +-- --------------------------------------------------------------------- + +-- | 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'. +suggestAddPragma :: Maybe DynFlags -> Diagnostic -> [PragmaEdit] +suggestAddPragma mDynflags Diagnostic {_message} = genPragma _message + where + genPragma target = + [("Add \"" <> r <> "\"", LangExt r) | r <- findPragma target, r `notElem` disabled] + disabled + | Just dynFlags <- mDynflags = + -- GHC does not export 'OnOff', so we have to view it as string + catMaybes $ T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags + | otherwise = + -- When the module failed to parse, we don't have access to its + -- dynFlags. In that case, simply don't disable any pragmas. + [] + +-- | 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] + + -- We exclude the Strict extension as it causes many false positives, see + -- the discussion at https://github.com/haskell/ghcide/pull/638 + -- + -- We don't include the No- variants, as GHC never suggests disabling an + -- extension in an error message. + possiblePragmas :: [T.Text] + possiblePragmas = + [ name + | FlagSpec{flagSpecName = T.pack -> name} <- xFlags + , "Strict" /= name + ] + +-- | All language pragmas, including the No- variants +allPragmas :: [T.Text] +allPragmas = + concat + [ [name, "No" <> name] + | FlagSpec{flagSpecName = T.pack -> name} <- xFlags + ] + <> + -- These pragmas are not part of xFlags as they are not reversable + -- by prepending "No". + [ -- Safe Haskell + "Unsafe" + , "Trustworthy" + , "Safe" + + -- Language Version Extensions + , "Haskell98" + , "Haskell2010" + -- Maybe, GHC 2021 after its release? + ] + +-- --------------------------------------------------------------------- + +completion :: PluginMethodHandler IdeState TextDocumentCompletion +completion _ide _ complParams = do + let (TextDocumentIdentifier uri) = complParams ^. J.textDocument + position = complParams ^. J.position + contents <- LSP.getVirtualFile $ toNormalizedUri uri + fmap (Right . InL) $ case (contents, uriToFilePath' uri) of + (Just cnts, Just _path) -> + result <$> VFS.getCompletionPrefix position cnts + where + result (Just pfix) + | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix + = List $ map buildCompletion + (Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas) + | otherwise + = List [] + result Nothing = List [] + buildCompletion p = + CompletionItem + { _label = p, + _kind = Just CiKeyword, + _tags = Nothing, + _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 $ List [] + +-- --------------------------------------------------------------------- + +-- | Find the first non-blank line before the first of (module name / imports / declarations). +-- Useful for inserting pragmas. +endOfModuleHeader :: ParsedModule -> Range +endOfModuleHeader pm = + let mod = unLoc $ pm_parsed_source pm + modNameLoc = getLoc <$> hsmodName mod + firstImportLoc = getLoc <$> listToMaybe (hsmodImports mod) + firstDeclLoc = getLoc <$> listToMaybe (hsmodDecls mod) + line = maybe 0 (_line . _start) (modNameLoc <|> firstImportLoc <|> firstDeclLoc >>= srcSpanToRange) + loc = Position line 0 + in Range loc loc
plugins/default/src/Ide/Plugin/StylishHaskell.hs view
@@ -1,59 +1,82 @@-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+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +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 hiding (pluginHandlers) +import Development.IDE.GHC.Compat (ModSummary (ms_hspp_opts)) +import qualified DynFlags as D +import qualified EnumSet as ES +import GHC.LanguageExtensions.Type +import Ide.PluginUtils +import Ide.Types +import Language.Haskell.Stylish +import Language.LSP.Types as J + +import System.Directory +import System.FilePath + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) + { pluginHandlers = mkFormattingHandlers 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 :: FormattingHandler IdeState +provider ide typ contents fp _opts = do + (ms_hspp_opts -> dyn, _) <- liftIO $ runAction "stylish-haskell" ide $ use_ GetModSummary fp + let file = fromNormalizedFilePath fp + config <- liftIO $ loadConfigFrom file + mergedConfig <- liftIO $ getMergedConfig dyn config + let (range, selectedContents) = case typ of + FormatText -> (fullRange contents, contents) + FormatRange r -> (normalize r, extractRange r contents) + result = runStylishHaskell file mergedConfig selectedContents + case result of + Left err -> return $ Left $ responseError $ T.pack $ "stylishHaskellCmd: " ++ err + Right new -> return $ Right $ J.List [TextEdit range new] + where + getMergedConfig dyn config + | null (configLanguageExtensions config) + = do + logInfo (ideLogger ide) "stylish-haskell uses the language extensions from DynFlags" + pure + $ config + { configLanguageExtensions = getExtensions dyn } + | otherwise + = pure config + + getExtensions = map showExtension . ES.toList . D.extensionFlags + + showExtension Cpp = "CPP" + showExtension other = show other + +-- | 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 + pure 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/src/Ide/Plugin/Eval/Types.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wwarn #-} + +module Ide.Plugin.Eval.Types + ( locate, + locate0, + Test (..), + isProperty, + Format (..), + Language (..), + Section (..), + Sections (..), + hasTests, + hasPropertyTest, + splitSections, + Loc, + Located (..), + Comments (..), + RawBlockComment (..), + RawLineComment (..), + unLoc, + Txt, + EvalParams(..), + ) +where + +import Control.DeepSeq (NFData (rnf), deepseq) +import Data.Aeson (FromJSON, ToJSON) +import Data.List (partition) +import Data.List.NonEmpty (NonEmpty) +import Data.Map.Strict (Map) +import Data.String (IsString (..)) +import Development.IDE (Range) +import GHC.Generics (Generic) +import qualified Text.Megaparsec as P +import Language.LSP.Types (TextDocumentIdentifier) + +-- | A thing with a location attached. +data Located l a = Located {location :: l, located :: a} + deriving (Eq, Show, Ord, Functor, Generic, FromJSON, ToJSON) + +-- | Discard location information. +unLoc :: Located l a -> a +unLoc (Located _ a) = a + +instance (NFData l, NFData a) => NFData (Located l a) where + rnf (Located loc a) = loc `deepseq` a `deepseq` () + +type Loc = Located Line + +type Line = Int + +locate :: Loc [a] -> [Loc a] +locate (Located l tst) = zipWith Located [l ..] tst + +locate0 :: [a] -> [Loc a] +locate0 = locate . Located 0 + +type Txt = String + +data Sections = Sections + { nonSetupSections :: [Section] + , setupSections :: [Section] + } + deriving (Show, Eq, Generic) + +data Section = Section + { sectionName :: Txt + , sectionTests :: [Test] + , sectionLanguage :: Language + , sectionFormat :: Format + } + deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData) + +hasTests :: Section -> Bool +hasTests = not . null . sectionTests + +hasPropertyTest :: Section -> Bool +hasPropertyTest = any isProperty . sectionTests + +-- |Split setup and normal sections +splitSections :: [Section] -> ([Section], [Section]) +splitSections = partition ((== "setup") . sectionName) + +data Test + = Example {testLines :: NonEmpty Txt, testOutput :: [Txt], testRange :: Range} + | Property {testline :: Txt, testOutput :: [Txt], testRange :: Range} + deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData) + +data Comments = Comments + { lineComments :: Map Range RawLineComment + , blockComments :: Map Range RawBlockComment + } + deriving (Show, Eq, Ord, Generic) + +newtype RawBlockComment = RawBlockComment {getRawBlockComment :: String} + deriving (Show, Eq, Ord) + deriving newtype + ( IsString + , P.Stream + , P.TraversableStream + , P.VisualStream + , Semigroup + , Monoid + ) + +newtype RawLineComment = RawLineComment {getRawLineComment :: String} + deriving (Show, Eq, Ord) + deriving newtype + ( IsString + , P.Stream + , P.TraversableStream + , P.VisualStream + , Semigroup + , Monoid + ) + +instance Semigroup Comments where + Comments ls bs <> Comments ls' bs' = Comments (ls <> ls') (bs <> bs') + +instance Monoid Comments where + mempty = Comments mempty mempty + +isProperty :: Test -> Bool +isProperty Property {} = True +isProperty _ = False + +data Format + = SingleLine + | -- | @Range@ is that of surrounding entire block comment, not section. + -- Used for detecting no-newline test commands. + MultiLine Range + deriving (Eq, Show, Ord, Generic, FromJSON, ToJSON, NFData) + +data Language = Plain | Haddock deriving (Eq, Show, Generic, Ord, FromJSON, ToJSON, NFData) + +data ExpectedLine = ExpectedLine [LineChunk] | WildCardLine + deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData) + +instance IsString ExpectedLine where + fromString = ExpectedLine . return . LineChunk + +data LineChunk = LineChunk String | WildCardChunk + deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData) + +instance IsString LineChunk where + fromString = LineChunk + +type EvalId = Int + +-- | Specify the test section to execute +data EvalParams = EvalParams + { sections :: [Section] + , module_ :: !TextDocumentIdentifier + , evalId :: !EvalId -- ^ unique group id; for test uses + } + deriving (Eq, Show, Generic, FromJSON, ToJSON)
plugins/hls-eval-plugin/test/Eval.hs view
@@ -1,217 +1,229 @@-{-# 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"- , testCase "Test on last line insert results correctly" $ do- runSession hlsCommand fullCaps evalPath $- liftIO $ do- let mdl = "TLastLine.hs"- -- Write the test file, to make sure that it has no final line return- writeFile (evalPath </> mdl) $ "module TLastLine where\n\n-- >>> take 3 [1..]"- goldenTest mdl-#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 fltr 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 fltr 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 <- T.readFile expectedFile- 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"+{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DuplicateRecordFields #-} + +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.LSP.Test +import Language.LSP.Types +import Language.LSP.Types.Lens (command, title, range) +import Control.Lens (view, _Just, preview) +import System.Directory (doesFileExist) +import System.FilePath ( + (<.>), + (</>), + ) +import Test.Hls.Util (hlsCommand, GhcVersion (GHC84, GHC86), knownBrokenForGhcVersions, knownBrokenInEnv, EnvSpec (HostOS, GhcVer), OS (Windows)) +import Test.Tasty ( + TestTree, + testGroup, + ) +import Test.Tasty.ExpectedFailure ( + expectFailBecause, + ) +import Test.Tasty.HUnit ( + testCase, + (@?=), + ) +import Data.List.Extra (nubOrdOn) +import Ide.Plugin.Eval.Types (EvalParams(..)) +import Data.Aeson (fromJSON) +import Data.Aeson.Types (Result(Success)) + +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 (preview $ command . _Just . title) lenses @?= [Just "Evaluate..."] + , testCase "Produces Refresh code lenses" $ + runSession hlsCommand fullCaps evalPath $ do + doc <- openDoc "T2.hs" "haskell" + lenses <- getEvalCodeLenses doc + liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Refresh..."] + , testCase "Code lenses have ranges" $ + runSession hlsCommand fullCaps evalPath $ do + doc <- openDoc "T1.hs" "haskell" + lenses <- getEvalCodeLenses doc + liftIO $ map (view 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 (view 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 (view 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 + "Multi line comments, with the last test line ends without newline" + $ goldenTest "TEndingMulti.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" + expectFailBecause "Unexplained but minor issue" $ + testCase "Setting language option TupleSections" $ + goldenTest "TLanguageOptionsTupleSections.hs" + , testCase ":set accepts ghci flags" $ + goldenTest "TFlags.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" + , testCase + "Don't panic on {-# UNPACK #-} pragma" + $ goldenTest "TUNPACK.hs" + , testCase + "Can handle eval inside nested comment properly" + $ goldenTest "TNested.hs" + , testCase "Test on last line insert results correctly" $ do + runSession hlsCommand fullCaps evalPath $ + liftIO $ do + let mdl = "TLastLine.hs" + -- Write the test file, to make sure that it has no final line return + writeFile (evalPath </> mdl) "module TLastLine where\n\n-- >>> take 3 [1..]" + goldenTest mdl + , testGroup "with preprocessors" + [ knownBrokenInEnv [HostOS Windows, GhcVer GHC84, GhcVer GHC86] + "CPP eval on Windows and/or GHC <= 8.6 fails for some reasons" $ + testCase "CPP support" $ goldenTest "TCPP.hs" + , knownBrokenForGhcVersions [GHC84, GHC86] + "Preprocessor known to fail on GHC <= 8.6" + $ testCase "Literate Haskell Bird Style" $ goldenTest "TLHS.lhs" + -- , 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 fltr 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 fltr doc + -- liftIO $ print codeLenses + + -- Execute sequentially, nubbing elements to avoid + -- evaluating the same section with multiple tests + -- more than twice + mapM_ executeCmd + $ nubOrdOn actSectionId [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 <- T.readFile expectedFile + edited @?= expected + +actSectionId :: Command -> Int +actSectionId Command{_arguments = Just (List [fromJSON -> Success EvalParams{..}])} = evalId +actSectionId _ = error "Invalid CodeLens" + +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 <- skipManyTill anyMessage (message SWorkspaceApplyEdit) + -- 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/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs view
@@ -1,54 +1,54 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}--module Ide.Plugin.Splice.Types where--import Data.Aeson (FromJSON, ToJSON)-import Development.IDE (Uri)-import GHC.Generics (Generic)-import Development.IDE.GHC.Compat (RealSrcSpan)-import qualified Data.Text as T-import Ide.Types ( CommandId )---- | Parameter for the addMethods PluginCommand.-data ExpandSpliceParams = ExpandSpliceParams- { uri :: Uri- , spliceSpan :: RealSrcSpan- , spliceContext :: SpliceContext- }- deriving (Show, Eq, Generic)- deriving anyclass (ToJSON, FromJSON)---- FIXME: HsDecl needs different treatment of splicing.-data SpliceContext = Expr | HsDecl | Pat | HsType- deriving (Read, Show, Eq, Ord, Generic)- deriving anyclass (ToJSON, FromJSON)--data ExpandStyle = Inplace | Commented- deriving (Read, Show, Eq, Ord, Generic)--expandStyles :: [(ExpandStyle, (T.Text, CommandId))]-expandStyles =- [ (Inplace, (inplaceCmdName, expandInplaceId))- -- , (Commented, commentedCmdName, expandCommentedId)- ]--toExpandCmdTitle :: ExpandStyle -> T.Text-toExpandCmdTitle Inplace = inplaceCmdName-toExpandCmdTitle Commented = commentedCmdName--toCommandId :: ExpandStyle -> CommandId-toCommandId Inplace = expandInplaceId-toCommandId Commented = expandCommentedId--expandInplaceId, expandCommentedId :: CommandId-expandInplaceId = "expandTHSpliceInplace"-expandCommentedId = "expandTHSpliceCommented"--inplaceCmdName :: T.Text-inplaceCmdName = "expand TemplateHaskell Splice (in-place)"--commentedCmdName :: T.Text-commentedCmdName = "expand TemplateHaskell Splice (comented-out)"+{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} + +module Ide.Plugin.Splice.Types where + +import Data.Aeson (FromJSON, ToJSON) +import Development.IDE (Uri) +import GHC.Generics (Generic) +import Development.IDE.GHC.Compat (RealSrcSpan) +import qualified Data.Text as T +import Ide.Types ( CommandId ) + +-- | Parameter for the addMethods PluginCommand. +data ExpandSpliceParams = ExpandSpliceParams + { uri :: Uri + , spliceSpan :: RealSrcSpan + , spliceContext :: SpliceContext + } + deriving (Show, Eq, Generic) + deriving anyclass (ToJSON, FromJSON) + +-- FIXME: HsDecl needs different treatment of splicing. +data SpliceContext = Expr | HsDecl | Pat | HsType + deriving (Read, Show, Eq, Ord, Generic) + deriving anyclass (ToJSON, FromJSON) + +data ExpandStyle = Inplace | Commented + deriving (Read, Show, Eq, Ord, Generic) + +expandStyles :: [(ExpandStyle, (T.Text, CommandId))] +expandStyles = + [ (Inplace, (inplaceCmdName, expandInplaceId)) + -- , (Commented, commentedCmdName, expandCommentedId) + ] + +toExpandCmdTitle :: ExpandStyle -> T.Text +toExpandCmdTitle Inplace = inplaceCmdName +toExpandCmdTitle Commented = commentedCmdName + +toCommandId :: ExpandStyle -> CommandId +toCommandId Inplace = expandInplaceId +toCommandId Commented = expandCommentedId + +expandInplaceId, expandCommentedId :: CommandId +expandInplaceId = "expandTHSpliceInplace" +expandCommentedId = "expandTHSpliceCommented" + +inplaceCmdName :: T.Text +inplaceCmdName = "expand TemplateHaskell Splice (in-place)" + +commentedCmdName :: T.Text +commentedCmdName = "expand TemplateHaskell Splice (comented-out)"
− plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/TestTypes.hs
@@ -1,27 +0,0 @@-{-# 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
@@ -1,127 +1,130 @@--- 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-+-- 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 +import HieDb.Run + +-- --------------------------------------------------------------------- + +data Arguments + = VersionMode PrintVersion + | ProbeToolsMode + | DbCmd Options Command + | LspMode LspArguments + +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 + hieInfo = fullDesc <> progDesc "Query .hie files" + opts = info (( + VersionMode <$> printVersionParser exeName + <|> probeToolsParser exeName + <|> hsubparser (command "hiedb" (info (DbCmd <$> optParser "" True <*> cmdParser <**> helper) hieInfo)) + <|> 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
@@ -1,198 +1,106 @@--- Copyright (c) 2019 The DAML Authors. All rights reserved.--- SPDX-License-Identifier: Apache-2.0-{-# LANGUAGE CPP #-} -- To get precise GHC version-{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above-{-# 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 (ShakeOptions (shakeThreads), 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 = defOptions- { optReportProgress = clientSupportsProgress caps- , optShakeProfiling = argsShakeProfiling- , optTesting = IdeTesting argsTesting- , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}- }- defOptions = defaultIdeOptions sessionLoader- 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+-- Copyright (c) 2019 The DAML Authors. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE CPP #-} -- To get precise GHC version +{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module Ide.Main(defaultMain, runLspMode) where + +import Control.Monad.Extra +import qualified Data.Map.Strict as Map +import qualified Data.Text as T +import Development.IDE.Core.Rules +import Development.IDE.Session (setInitialDynFlags, getHieDbLoc) +import Development.IDE.Types.Logger as G +import qualified Language.LSP.Server as LSP +import Ide.Arguments +import Ide.Logger +import Ide.Version +import Ide.Types (IdePlugins, ipMap) +import qualified System.Directory.Extra as IO +import System.Exit +import System.IO +import qualified System.Log.Logger as L +import HieDb.Run +import qualified Development.IDE.Main as Main +import qualified Development.IDE.Types.Options as Ghcide +import Development.Shake (ShakeOptions(shakeThreads)) +import Data.Default + +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 + + DbCmd opts cmd -> do + dir <- IO.getCurrentDirectory + dbLoc <- getHieDbLoc dir + hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc + mlibdir <- setInitialDynFlags def + case mlibdir of + Nothing -> exitWith $ ExitFailure 1 + Just libdir -> + runCommand libdir opts{database = dbLoc} cmd + + 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 + whenJust argsCwd IO.setCurrentDirectory + dir <- IO.getCurrentDirectory + LSP.setupLogger argsLogFile ["hls", "hie-bios"] + $ if argsDebugOn then L.DEBUG else L.INFO + + when argLSP $ do + 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!" + + Main.defaultMain def + { Main.argFiles = if argLSP then Nothing else Just [] + , Main.argsHlsPlugins = idePlugins + , Main.argsLogger = hlsLogger + , Main.argsIdeOptions = \_config sessionLoader -> + let defOptions = Ghcide.defaultIdeOptions sessionLoader + in defOptions + { Ghcide.optShakeProfiling = argsShakeProfiling + , Ghcide.optTesting = Ghcide.IdeTesting argsTesting + , Ghcide.optShakeOptions = (Ghcide.optShakeOptions defOptions) + {shakeThreads = argsThreads} + } + }
src/Ide/Version.hs view
@@ -1,79 +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+{-# 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
@@ -1,81 +1,82 @@-{-# 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 '/='"- , Just "Disable \"missing-methods\" warnings"- ]- , 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- , glodenTest "Creates a placeholder for a method starting with '_'" "T4" ""- $ \(_fAction:_) -> do- executeCodeAction _fAction- ]--_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 </> fpWithDeco <.> "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- where- fpWithDeco- | deco == "" = fp- | otherwise = fp <.> deco--goldenGitDiff :: FilePath -> FilePath -> [String]-goldenGitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]+{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +module Class + ( tests + ) +where + +import Control.Applicative.Combinators +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.LSP.Test +import Language.LSP.Types hiding (_command, _title) +import qualified Language.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 '/='" + , Just "Disable \"missing-methods\" warnings" + ] + , 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 + , glodenTest "Creates a placeholder for a method starting with '_'" "T4" "" + $ \(_fAction:_) -> do + executeCodeAction _fAction + ] + +_CACodeAction :: Prism' (Command |? CodeAction) CodeAction +_CACodeAction = prism' InR $ \case + InR 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 </> fpWithDeco <.> "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 <$> (skipManyTill anyMessage $ getDocumentEdit doc) + where + fpWithDeco + | deco == "" = fp + | otherwise = fp <.> deco + +goldenGitDiff :: FilePath -> FilePath -> [String] +goldenGitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]
test/functional/Command.hs view
@@ -1,34 +1,34 @@-{-# 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--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"- , testCase "get de-prefixed" $- runSession hlsCommand fullCaps "test/testdata/" $ do- ResponseMessage _ _ (Left err) <- request- WorkspaceExecuteCommand- (ExecuteCommandParams "34133:eval:evalCommand" (Just (List [])) Nothing) :: Session ExecuteCommandResponse- let ResponseError _ msg _ = err- -- We expect an error message about the dud arguments, but we can- -- check that we found the right plugin.- liftIO $ "while parsing args for evalCommand in plugin eval" `T.isInfixOf` msg @? "Has error message"- ]+{-# 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.LSP.Test +import Language.LSP.Types as LSP +import Language.LSP.Types.Lens as LSP +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit + +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" + , testCase "get de-prefixed" $ + runSession hlsCommand fullCaps "test/testdata/" $ do + ResponseMessage _ _ (Left err) <- request + SWorkspaceExecuteCommand + (ExecuteCommandParams Nothing "34133:eval:evalCommand" (Just (List []))) + let ResponseError _ msg _ = err + -- We expect an error message about the dud arguments, but we can + -- check that we found the right plugin. + liftIO $ "while parsing args for evalCommand in plugin eval" `T.isInfixOf` msg @? "Has error message" + ]
test/functional/Completion.hs view
@@ -1,410 +1,410 @@-{-# 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 Data.Default (def)-import Ide.Plugin.Config (Config (maxCompletions))--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"-- _ <- waitForDiagnostics-- let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M"- _ <- applyEdit doc te-- compls <- getCompletions doc (Position 1 23)- 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"-- _ <- waitForDiagnostics-- let te = TextEdit (Range (Position 2 17) (Position 2 25)) "Data.L"- _ <- applyEdit doc te-- compls <- getCompletions doc (Position 2 24)- let item = head $ filter ((== "List") . (^. label)) compls- liftIO $ do- item ^. label @?= "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"-- _ <- waitForDiagnostics-- 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 the Strict language extension" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- _ <- waitForDiagnostics-- let te = TextEdit (Range (Position 0 13) (Position 0 31)) "Str"- _ <- applyEdit doc te-- compls <- getCompletions doc (Position 0 16)- let item = head $ filter ((== "Strict") . (^. label)) compls- liftIO $ do- item ^. label @?= "Strict"- item ^. kind @?= Just CiKeyword-- , testCase "completes No- language extensions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- _ <- waitForDiagnostics-- let te = TextEdit (Range (Position 0 13) (Position 0 31)) "NoOverload"- _ <- applyEdit doc te-- compls <- getCompletions doc (Position 0 23)- let item = head $ filter ((== "NoOverloadedStrings") . (^. label)) compls- liftIO $ do- item ^. label @?= "NoOverloadedStrings"- item ^. kind @?= Just CiKeyword-- , testCase "completes pragmas" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- _ <- waitForDiagnostics-- 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"-- _ <- waitForDiagnostics-- 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 $ assertBool "Expected completions" $ not $ null 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"-- , testCase "maxCompletions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- compls <- getCompletions doc (Position 5 7)- liftIO $ length compls @?= maxCompletions def-- , 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]}"-- , 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 10)- 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+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Completion(tests) where + +import Control.Monad.IO.Class +import Control.Lens hiding ((.=)) +import Data.Aeson (object, (.=)) +import Language.LSP.Test +import Language.LSP.Types +import Language.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 Data.Default (def) +import Ide.Plugin.Config (Config (maxCompletions)) + +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 SCompletionItemResolve item + let Right resolved = 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" + + _ <- waitForDiagnostics + + let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 1 23) + 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" + + _ <- waitForDiagnostics + + let te = TextEdit (Range (Position 2 17) (Position 2 25)) "Data.L" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 2 24) + let item = head $ filter ((== "List") . (^. label)) compls + liftIO $ do + item ^. label @?= "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" + + _ <- waitForDiagnostics + + 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 the Strict language extension" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + + _ <- waitForDiagnostics + + let te = TextEdit (Range (Position 0 13) (Position 0 31)) "Str" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 0 16) + let item = head $ filter ((== "Strict") . (^. label)) compls + liftIO $ do + item ^. label @?= "Strict" + item ^. kind @?= Just CiKeyword + + , testCase "completes No- language extensions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + + _ <- waitForDiagnostics + + let te = TextEdit (Range (Position 0 13) (Position 0 31)) "NoOverload" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 0 23) + let item = head $ filter ((== "NoOverloadedStrings") . (^. label)) compls + liftIO $ do + item ^. label @?= "NoOverloadedStrings" + item ^. kind @?= Just CiKeyword + + , testCase "completes pragmas" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + + _ <- waitForDiagnostics + + 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" + + _ <- waitForDiagnostics + + 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 $ assertBool "Expected completions" $ not $ null 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" + + , testCase "maxCompletions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + + compls <- getCompletions doc (Position 5 7) + liftIO $ length compls @?= maxCompletions def + + , 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 PlainText + item ^. insertText @?= Nothing + + , 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 PlainText + item ^. insertText @?= Nothing + + , 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 PlainText + item ^. insertText @?= Nothing + + , 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 PlainText + item ^. insertText @?= Nothing + + , testCase "respects lsp configuration" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + + let config = object [ "haskell" .= object ["completionSnippetsOn" .= False]] + + sendNotification SWorkspaceDidChangeConfiguration + (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 10) + 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
@@ -1,78 +1,101 @@-{-# 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) }+{-# LANGUAGE OverloadedStrings #-} + +module Config (tests) where + +import Control.Lens hiding (List) +import Control.Applicative.Combinators (skipManyTill) +import Control.Monad +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.LSP.Test as Test +import Language.LSP.Types +import qualified Language.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 + , configTests + ] + +hlintTests :: TestTree +hlintTests = testGroup "hlint plugin enables" [ + + testCase "changing hlintOn configuration enables or disables hlint diagnostics" $ runHlintSession "" $ do + let config = def { hlintOn = True } + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + doc <- openDoc "ApplyRefact2.hs" "haskell" + testHlintDiagnostics doc + + let config' = def { hlintOn = False } + sendNotification SWorkspaceDidChangeConfiguration (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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + doc <- openDoc "ApplyRefact2.hs" "haskell" + testHlintDiagnostics doc + + let config' = pluginGlobalOn config "hlint" False + sendNotification SWorkspaceDidChangeConfiguration (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" + +configTests :: TestTree +configTests = testGroup "config parsing" [ + testCase "empty object as user configuration should not send error logMessage" $ runConfigSession "" $ do + let config = object [] + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + -- Send custom request so server returns a response to prevent blocking + void $ sendNotification (SCustomMethod "non-existent-method") Null + + logNot <- skipManyTill Test.anyMessage (message SWindowLogMessage) + + liftIO $ (logNot ^. L.params . L.xtype) > MtError + || "non-existent-method" `T.isInfixOf` (logNot ^. L.params . L.message) + @? "Server sends logMessage with MessageType = Error" + ] + where + runConfigSession :: FilePath -> Session a -> IO a + runConfigSession subdir = + failIfSessionTimeout . runSession hlsCommand fullCaps ("test/testdata" </> subdir) + +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
@@ -1,176 +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 @?= "[]"- ]+{-# 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.LSP.Test +import Language.LSP.Types +import Language.LSP.Types.Lens hiding (id, message) +-- import qualified Language.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 @?= InR [] + + -- 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 STextDocumentPublishDiagnostics) + diagsRspGhc <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics) + let (List diags) = diagsRspGhc ^. params . diagnostics + + liftIO $ length diags @?= 2 + + _doc2 <- openDoc "HaReRename.hs" "haskell" + _diagsRspHlint2 <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics) + -- errMsg <- skipManyTill anyNotification notification :: Session ShowMessageNotification + diagsRsp2 <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics) + let (List diags2) = diagsRsp2 ^. params . diagnostics + + liftIO $ show diags2 @?= "[]" + ]
test/functional/Definition.hs view
@@ -1,69 +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)+module Definition (tests) where + +import Control.Lens +import Control.Monad.IO.Class +import Language.LSP.Test +import Language.LSP.Types +import Language.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 @?= InL [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 @?= InL [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 @?= InL [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 @?= InL [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 @?= InL [Location (filePathToUri fp) zeroRange] + liftIO $ putStrLn "E" -- AZ + + noDiagnostics + ] + +zeroRange :: Range +zeroRange = Range (Position 0 0) (Position 0 0)
test/functional/Diagnostic.hs view
@@ -1,82 +1,82 @@-{-# 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.Default-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" [- basicTests- , saveTests- , warningTests- ]--basicTests :: TestTree-basicTests = testGroup "Diagnostics work" [- testCase "hlint produces diagnostics" $- runSession hlsCommand fullCaps "test/testdata/hlint" $ do- doc <- openDoc "ApplyRefact2.hs" "haskell"- diags <- waitForDiagnosticsFromSource doc "hlint"- reduceDiag <- liftIO $ inspectDiagnostic diags ["Eta reduce"]- redundantID <- liftIO $ inspectDiagnostic diags ["Redundant id"]- liftIO $ do- length diags @?= 2- reduceDiag ^. LSP.range @?= Range (Position 1 0) (Position 1 12)- reduceDiag ^. LSP.severity @?= Just DsInfo- redundantID ^. LSP.severity @?= Just DsInfo-- , testCase "example plugin produces diagnostics" $- runSession hlsCommandExamplePlugin fullCaps "test/testdata/hlint" $ do- doc <- openDoc "ApplyRefact2.hs" "haskell"- diags <- waitForDiagnosticsFromSource doc "example2"- reduceDiag <- liftIO $ inspectDiagnostic diags ["example2 diagnostic, hello world"]- liftIO $ do- length diags @?= 1- reduceDiag ^. LSP.range @?= Range (Position 0 0) (Position 1 0)- reduceDiag ^. LSP.severity @?= Just DsError- ]--warningTests :: TestTree-warningTests = testGroup "Warnings are warnings" [- testCase "Overrides -Werror" $- runSession hlsCommand fullCaps "test/testdata/wErrorTest" $ do- doc <- openDoc "src/WError.hs" "haskell"- [diag] <- waitForDiagnosticsFrom doc- liftIO $ diag ^. LSP.severity @?= Just DsWarning- ]--saveTests :: TestTree-saveTests = testGroup "only diagnostics on save" [- ignoreTestBecause "diagnosticsOnChange parameter is not supported right now" $ 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 <- waitForDiagnosticsFrom doc-- 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 <- waitForDiagnosticsFrom doc- liftIO $- length diags2 @?= 1- ]+{-# 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.Default +import Ide.Plugin.Config +import Language.LSP.Test hiding (message) +import Language.LSP.Types +import qualified Language.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" [ + basicTests + , saveTests + , warningTests + ] + +basicTests :: TestTree +basicTests = testGroup "Diagnostics work" [ + testCase "hlint produces diagnostics" $ + runSession hlsCommand fullCaps "test/testdata/hlint" $ do + doc <- openDoc "ApplyRefact2.hs" "haskell" + diags <- waitForDiagnosticsFromSource doc "hlint" + reduceDiag <- liftIO $ inspectDiagnostic diags ["Eta reduce"] + redundantID <- liftIO $ inspectDiagnostic diags ["Redundant id"] + liftIO $ do + length diags @?= 2 + reduceDiag ^. LSP.range @?= Range (Position 1 0) (Position 1 12) + reduceDiag ^. LSP.severity @?= Just DsInfo + redundantID ^. LSP.severity @?= Just DsInfo + + , testCase "example plugin produces diagnostics" $ + runSession hlsCommandExamplePlugin fullCaps "test/testdata/hlint" $ do + doc <- openDoc "ApplyRefact2.hs" "haskell" + diags <- waitForDiagnosticsFromSource doc "example2" + reduceDiag <- liftIO $ inspectDiagnostic diags ["example2 diagnostic, hello world"] + liftIO $ do + length diags @?= 1 + reduceDiag ^. LSP.range @?= Range (Position 0 0) (Position 1 0) + reduceDiag ^. LSP.severity @?= Just DsError + ] + +warningTests :: TestTree +warningTests = testGroup "Warnings are warnings" [ + testCase "Overrides -Werror" $ + runSession hlsCommand fullCaps "test/testdata/wErrorTest" $ do + doc <- openDoc "src/WError.hs" "haskell" + [diag] <- waitForDiagnosticsFrom doc + liftIO $ diag ^. LSP.severity @?= Just DsWarning + ] + +saveTests :: TestTree +saveTests = testGroup "only diagnostics on save" [ + ignoreTestBecause "diagnosticsOnChange parameter is not supported right now" $ testCase "Respects diagnosticsOnChange setting" $ + runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do + let config = Data.Default.def { diagnosticsOnChange = False } :: Config + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + doc <- openDoc "Hover.hs" "haskell" + diags <- waitForDiagnosticsFrom doc + + liftIO $ do + length diags @?= 0 + + let te = TextEdit (Range (Position 0 0) (Position 0 13)) "" + _ <- applyEdit doc te + skipManyTill loggingNotification noDiagnostics + + sendNotification STextDocumentDidSave (DidSaveTextDocumentParams doc Nothing) + diags2 <- waitForDiagnosticsFrom doc + liftIO $ + length diags2 @?= 1 + ]
test/functional/Format.hs view
@@ -1,184 +1,185 @@-{-# 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]+{-# 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.LSP.Test +import Language.LSP.Types +import qualified Language.LSP.Types.Lens as LSP +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.Golden +import Test.Tasty.HUnit +import Control.Lens ((^.)) + +#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 Nothing Nothing Nothing) + 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 Nothing Nothing Nothing) + 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 Nothing Nothing Nothing) (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 Nothing Nothing Nothing) (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" + resp <- request STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) + liftIO $ resp ^. LSP.result @?= (Left $ ResponseError InvalidRequest "No plugin enabled for STextDocumentFormatting, available: []" Nothing) + + , testCase "respects initial" $ runSessionWithConfig (formatConfig "floskell") hlsCommand fullCaps "test/testdata/format" $ do + doc <- openDoc "Format.hs" "haskell" + formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.initial.hs" + formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) + documentContents doc >>= liftIO . (@?= formattedFloskell) + + , testCase "can change on the fly" $ runSession hlsCommand fullCaps "test/testdata/format" $ do + formattedOrmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu.formatted.hs" + formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.formatted.hs" + formattedOrmoluPostFloskell <- liftIO $ T.readFile "test/testdata/format/Format.ormolu_post_floskell.formatted.hs" + + doc <- openDoc "Format.hs" "haskell" + + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) + formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) + documentContents doc >>= liftIO . (@?= formattedOrmolu) + + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "floskell")) + formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) + documentContents doc >>= liftIO . (@?= formattedFloskell) + + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) + formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) + documentContents doc >>= liftIO . (@?= formattedOrmoluPostFloskell) + , testCase "supports both new and old configuration sections" $ runSession hlsCommand fullCaps "test/testdata/format" $ do + formattedOrmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu.formatted.hs" + formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.formatted.hs" + + doc <- openDoc "Format.hs" "haskell" + + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfigOld "ormolu")) + formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) + documentContents doc >>= liftIO . (@?= formattedOrmolu) + + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfigOld "floskell")) + formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) + documentContents doc >>= liftIO . (@?= formattedFloskell) + ] + +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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "stylish-haskell")) + doc <- openDoc "StylishHaskell.hs" "haskell" + formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) + 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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "stylish-haskell")) + doc <- openDoc "StylishHaskell.hs" "haskell" + formatRange doc (FormattingOptions 2 True Nothing Nothing Nothing) (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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) + doc <- openDoc "BrittanyLF.hs" "haskell" + formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) + 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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) + doc <- openDoc "BrittanyCRLF.hs" "haskell" + formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) + 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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) + doc <- openDoc "BrittanyLF.hs" "haskell" + let range = Range (Position 1 0) (Position 2 22) + formatRange doc (FormattingOptions 4 True Nothing Nothing Nothing) 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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) + doc <- openDoc "BrittanyCRLF.hs" "haskell" + let range = Range (Position 1 0) (Position 2 22) + formatRange doc (FormattingOptions 4 True Nothing Nothing Nothing) 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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) + doc <- openDoc "Format.hs" "haskell" + formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) + 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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) + doc <- openDoc "Format2.hs" "haskell" + formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) + 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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "fourmolu")) + doc <- openDoc "Format.hs" "haskell" + formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) + 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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "fourmolu")) + doc <- openDoc "Format2.hs" "haskell" + formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) + 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
@@ -1,40 +1,40 @@-{-# 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- -- _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")+{-# LANGUAGE OverloadedStrings #-} + +module FunctionalBadProject (tests) where + +-- import Control.Lens hiding (List) +-- import Control.Monad.IO.Class +-- import qualified Data.Text as T +-- import Language.LSP.Test hiding (message) +-- import Language.LSP.Types as LSP +-- import Language.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 + -- _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
@@ -1,578 +1,678 @@-{-# 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"-- , testCase "changing 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 document contents updates hlint diagnostics" $ runHlintSession "" $ do- doc <- openDoc "ApplyRefact2.hs" "haskell"- testHlintDiagnostics doc-- let change = TextDocumentContentChangeEvent- (Just (Range (Position 1 8) (Position 1 12)))- Nothing "x"- changeDoc doc [change]- expectNoMoreDiagnostics 3 doc "hlint"-- let change' = TextDocumentContentChangeEvent- (Just (Range (Position 1 8) (Position 1 12)))- Nothing "id x"- changeDoc doc [change']- testHlintDiagnostics doc-- , 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-- , testCase "apply-refact works with -XLambdaCase argument (#590)" $ runHlintSession "lambdacase" $ do- testRefactor "ApplyRefact1.hs" "Redundant bracket"- expectedLambdaCase-- , testCase "apply-refact works with -XTypeApplications argument (#1242)" $ runHlintSession "typeapps" $ do- testRefactor "ApplyRefact1.hs" "Redundant bracket"- expectedTypeApp-- , 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"-- , testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do- testRefactor "ApplyRefact6.hs" "Redundant bracket" expectedComments- ]- 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"-- 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", ""- ]- expectedComments = [ "-- comment before header"- , "module ApplyRefact6 where", ""- , "{-# standalone annotation #-}", ""- , "-- standalone comment", ""- , "-- | haddock comment"- , "f = {- inline comment -}{- inline comment inside refactored code -} 1 -- ending comment", ""- , "-- final comment"- ]- expectedTypeApp = [ "module ApplyRefact1 where", ""- , "a = id @Int 1"- ]-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 #-}"- , "module NeedsPragmas where"- , ""- , "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-- , testCase "Adds TypeApplications pragma" $ do- runSession hlsCommand fullCaps "test/testdata/addPragmas" $ do- doc <- openDoc "TypeApplications.hs" "haskell"-- _ <- waitForDiagnosticsFrom doc- cas <- map fromAction <$> getAllCodeActions doc-- liftIO $ "Add \"TypeApplications\"" `elem` map (^. L.title) cas @? "Contains TypeApplications code action"-- executeCodeAction $ head cas-- contents <- documentContents doc-- let expected =- [ "{-# LANGUAGE TypeApplications #-}"- , "{-# LANGUAGE ScopedTypeVariables #-}"- , "module TypeApplications where"- , ""- , "foo :: forall a. a -> a"- , "foo = id @a"- ]-- 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 1 0) (Position 4 0)) caContext Nothing- caContext = CodeActionContext (List diags) (Just (List [CodeActionRefactorInline]))- caContextAllActions = CodeActionContext (List diags) Nothing- -- Verify that we get code actions of at least two different kinds.- ResponseMessage _ _ (Right (List allCodeActions))- <- request TextDocumentCodeAction (params & L.context .~ caContextAllActions)- liftIO $ do- redundantId <- inspectCodeAction allCodeActions ["Redundant id"]- redundantId ^. L.kind @?= Just CodeActionQuickFix- unfoldFoo <- inspectCodeAction allCodeActions ["Unfold foo"]- unfoldFoo ^. L.kind @?= Just CodeActionRefactorInline- -- Verify that that when we set the only parameter, we only get actions- -- of the right kind.- ResponseMessage _ _ (Right (List res)) <- request TextDocumentCodeAction params- let cas = map fromAction res- kinds = map (^. L.kind) cas- liftIO $ do- not (null kinds) @? "We found an action of kind RefactorInline"- 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+{-# LANGUAGE CPP #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# 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.LSP.Test as Test +import Language.LSP.Types +import qualified Language.LSP.Types.Capabilities as C +import qualified Language.LSP.Types.Lens as L +import Test.Hls.Util +import Test.Hspec.Expectations + +import System.FilePath ((</>)) +import System.IO.Extra (withTempDir) +import Test.Tasty +import Test.Tasty.ExpectedFailure (expectFailBecause, + ignoreTestBecause) +import Test.Tasty.HUnit + +{-# ANN module ("HLint: ignore Reduce duplication"::String) #-} + +tests :: TestTree +tests = testGroup "code actions" [ + hlintTests + , importTests + , missingPragmaTests + , disableWarningTests + , 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 (InR "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" + + , testCase "changing configuration enables or disables hlint diagnostics" $ runHlintSession "" $ do + let config = def { hlintOn = True } + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + doc <- openDoc "ApplyRefact2.hs" "haskell" + testHlintDiagnostics doc + + let config' = def { hlintOn = False } + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config')) + + diags' <- waitForDiagnosticsFrom doc + + liftIO $ noHlintDiagnostics diags' + + , testCase "changing document contents updates hlint diagnostics" $ runHlintSession "" $ do + doc <- openDoc "ApplyRefact2.hs" "haskell" + testHlintDiagnostics doc + + let change = TextDocumentContentChangeEvent + (Just (Range (Position 1 8) (Position 1 12))) + Nothing "x" + changeDoc doc [change] + expectNoMoreDiagnostics 3 doc "hlint" + + let change' = TextDocumentContentChangeEvent + (Just (Range (Position 1 8) (Position 1 12))) + Nothing "id x" + changeDoc doc [change'] + testHlintDiagnostics doc + + , 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 + + , testCase "apply-refact works with -XLambdaCase argument (#590)" $ runHlintSession "lambdacase" $ do + testRefactor "ApplyRefact1.hs" "Redundant bracket" + expectedLambdaCase + + , testCase "apply-refact works with -XTypeApplications argument (#1242)" $ runHlintSession "typeapps" $ do + testRefactor "ApplyRefact1.hs" "Redundant bracket" + expectedTypeApp + + , 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" + + , testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do + testRefactor "ApplyRefact6.hs" "Redundant bracket" expectedComments + ] + 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" + + 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 <- skipManyTill anyMessage $ 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", "" + ] + expectedComments = [ "-- comment before header" + , "module ApplyRefact6 where", "" + , "{-# standalone annotation #-}", "" + , "-- standalone comment", "" + , "-- | haddock comment" + , "f = {- inline comment -}{- inline comment inside refactored code -} 1 -- ending comment", "" + , "-- final comment" + ] + expectedTypeApp = [ "module ApplyRefact1 where", "" + , "a = id @Int 1" + ] +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 + _ <- anyRequest + + 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 + _ <- anyRequest + + 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 SWorkspaceDidChangeConfiguration (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 (InR 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" + InL cmd : _ <- getAllCodeActions doc + executeCommand cmd + _ <- anyRequest + 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 #-}" + , "module NeedsPragmas where" + , "" + , "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 + + , testCase "Adds TypeApplications pragma" $ do + runSession hlsCommand fullCaps "test/testdata/addPragmas" $ do + doc <- openDoc "TypeApplications.hs" "haskell" + + _ <- waitForDiagnosticsFrom doc + cas <- map fromAction <$> getAllCodeActions doc + + liftIO $ "Add \"TypeApplications\"" `elem` map (^. L.title) cas @? "Contains TypeApplications code action" + + executeCodeAction $ head cas + + contents <- documentContents doc + + let expected = +-- TODO: Why CPP??? +#if __GLASGOW_HASKELL__ < 810 + [ "{-# LANGUAGE ScopedTypeVariables #-}" + , "{-# LANGUAGE TypeApplications #-}" +#else + [ "{-# LANGUAGE TypeApplications #-}" + , "{-# LANGUAGE ScopedTypeVariables #-}" +#endif + , "module TypeApplications where" + , "" + , "foo :: forall a. a -> a" + , "foo = id @a" + ] + + liftIO $ T.lines contents @?= expected + , testCase "No duplication" $ do + runSession hlsCommand fullCaps "test/testdata/addPragmas" $ do + doc <- openDoc "NamedFieldPuns.hs" "haskell" + + _ <- waitForDiagnosticsFrom doc + cas <- map fromAction <$> getCodeActions doc (Range (Position 8 9) (Position 8 9)) + + liftIO $ length cas == 1 @? "Expected one code action, but got: " <> show cas + let ca = head cas + + liftIO $ (ca ^. L.title == "Add \"NamedFieldPuns\"") @? "NamedFieldPuns code action" + + executeCodeAction ca + + contents <- documentContents doc + + let expected = + [ "{-# LANGUAGE NamedFieldPuns #-}" + , "module NamedFieldPuns where" + , "" + , "data Record = Record" + , " { a :: Int," + , " b :: Double," + , " c :: String" + , " }" + , "" + , "f Record{a, b} = a" + ] + + liftIO $ T.lines contents @?= expected + ] + +disableWarningTests :: TestTree +disableWarningTests = + testGroup "disable warnings" $ + [ + ( "missing-signatures" + , T.unlines + [ "{-# OPTIONS_GHC -Wall #-}" + , "main = putStrLn \"hello\"" + ] + , T.unlines + [ "{-# OPTIONS_GHC -Wall #-}" + , "{-# OPTIONS_GHC -Wno-missing-signatures #-}" + , "main = putStrLn \"hello\"" + ] + ) + , + ( "unused-imports" + , T.unlines + [ "{-# OPTIONS_GHC -Wall #-}" + , "" + , "" + , "module M where" + , "" + , "import Data.Functor" + ] + , T.unlines + [ "{-# OPTIONS_GHC -Wall #-}" + , "" + , "" + , "{-# OPTIONS_GHC -Wno-unused-imports #-}" + , "module M where" + , "" + , "import Data.Functor" + ] + ) + ] + <&> \(warning, initialContent, expectedContent) -> testSession (T.unpack warning) $ do + doc <- createDoc "Module.hs" "haskell" initialContent + _ <- waitForDiagnostics + codeActs <- mapMaybe caResultToCodeAct <$> getCodeActions doc (Range (Position 0 0) (Position 0 0)) + case find (\CodeAction{_title} -> _title == "Disable \"" <> warning <> "\" warnings") codeActs of + Nothing -> liftIO $ assertFailure "No code action with expected title" + Just action -> do + executeCodeAction action + contentAfterAction <- documentContents doc + liftIO $ expectedContent @=? contentAfterAction + where + caResultToCodeAct = \case + InL _ -> Nothing + InR c -> Just c + +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 Nothing Nothing doc (Range (Position 1 0) (Position 4 0)) caContext + caContext = CodeActionContext (List diags) (Just (List [CodeActionRefactorInline])) + caContextAllActions = CodeActionContext (List diags) Nothing + -- Verify that we get code actions of at least two different kinds. + ResponseMessage _ _ (Right (List allCodeActions)) + <- request STextDocumentCodeAction (params & L.context .~ caContextAllActions) + liftIO $ do + redundantId <- inspectCodeAction allCodeActions ["Redundant id"] + redundantId ^. L.kind @?= Just CodeActionQuickFix + unfoldFoo <- inspectCodeAction allCodeActions ["Unfold foo"] + unfoldFoo ^. L.kind @?= Just CodeActionRefactorInline + -- Verify that that when we set the only parameter, we only get actions + -- of the right kind. + ResponseMessage _ _ (Right (List res)) <- request STextDocumentCodeAction params + let cas = map fromAction res + kinds = map (^. L.kind) cas + liftIO $ do + not (null kinds) @? "We found an action of kind RefactorInline" + all (Just CodeActionRefactorInline ==) kinds @? "All CodeActionRefactorInline" + ] + +noLiteralCaps :: C.ClientCapabilities +noLiteralCaps = def { C._textDocument = Just textDocumentCaps } + where + textDocumentCaps = def { C._codeAction = Just codeActionCaps } + codeActionCaps = CodeActionClientCapabilities (Just True) Nothing Nothing + +testSession :: String -> Session () -> TestTree +testSession name s = testCase name $ withTempDir $ \dir -> + runSession hlsCommand fullCaps dir s
test/functional/FunctionalLiquid.hs view
@@ -1,37 +1,37 @@-{-# LANGUAGE OverloadedStrings #-}--module FunctionalLiquid (tests) where--import Control.Lens hiding (List)-import Control.Monad.IO.Class-import Data.Aeson-import Data.Default-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 "no liquid haskell"- $ testCase "liquid haskell generates diagnostics" $- runSession hlsCommand codeActionSupportCaps "test/testdata" $ do- doc <- openDoc "liquid/Evens.hs" "haskell"-- let config = def { liquidOn = True, hlintOn = False }- sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))-- diags <- waitForDiagnosticsFromSource doc "liquid"- d <- liftIO $ inspectDiagnostic diags ["Liquid Type Mismatch"]- liftIO $ do- length diags @?= 1- d ^. range @?= Range (Position 8 0) (Position 8 11)- d ^. severity @?= Just DsError- d ^. code @?= Nothing- ]+{-# LANGUAGE OverloadedStrings #-} + +module FunctionalLiquid (tests) where + +import Control.Lens hiding (List) +import Control.Monad.IO.Class +import Data.Aeson +import Data.Default +import Language.LSP.Test hiding (message) +import Language.LSP.Types as LSP +import Language.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 "no liquid haskell" + $ testCase "liquid haskell generates diagnostics" $ + runSession hlsCommand codeActionSupportCaps "test/testdata" $ do + doc <- openDoc "liquid/Evens.hs" "haskell" + + let config = def { liquidOn = True, hlintOn = False } + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + diags <- waitForDiagnosticsFromSource doc "liquid" + d <- liftIO $ inspectDiagnostic diags ["Liquid Type Mismatch"] + liftIO $ do + length diags @?= 1 + d ^. range @?= Range (Position 8 0) (Position 8 11) + d ^. severity @?= Just DsError + d ^. code @?= Nothing + ]
test/functional/HaddockComments.hs view
@@ -1,76 +1,79 @@-{-# LANGUAGE DisambiguateRecordFields #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}--module HaddockComments- ( tests,- )-where--import Control.Monad.IO.Class (liftIO)-import qualified Data.ByteString.Lazy as LBS-import Data.Foldable (find)-import Data.Maybe (mapMaybe)-import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8)-import Language.Haskell.LSP.Test-import Language.Haskell.LSP.Types-import System.FilePath ((<.>), (</>))-import Test.Hls.Util-import Test.Tasty-import Test.Tasty.Golden-import Test.Tasty.HUnit--tests :: TestTree-tests =- testGroup- "haddock comments"- [ goldenTest "HigherRankFunction" Signature 4 6,- goldenTest "KindSigFunction" Signature 9 10,- goldenTest "MultivariateFunction" Signature 4 8,- goldenTest "QualFunction" Signature 2 10,- goldenTest "Record" Record 7 2,- expectedNothing "ConstFunction" Signature 2 2,- expectedNothing "StaleFunction" Signature 3 3,- expectedNothing "StaleRecord" Record 3 12- ]--goldenTest :: FilePath -> GenCommentsType -> Int -> Int -> TestTree-goldenTest fp (toTitle -> expectedTitle) l c = goldenVsStringDiff (fp <> " (golden)") goldenGitDiff goldenFilePath $- runSession hlsCommand fullCaps haddockCommentsPath $ do- doc <- openDoc hsFilePath "haskell"- _ <- waitForDiagnostics- actions <- getCodeActions doc (Range (Position l c) (Position l $ succ c))- case find ((== Just expectedTitle) . caTitle) actions of- Just (CACodeAction x) -> do- executeCodeAction x- LBS.fromStrict . encodeUtf8 <$> documentContents doc- _ -> liftIO $ assertFailure "Unable to find CodeAction"- where- hsFilePath = fp <.> "hs"- goldenFilePath = haddockCommentsPath </> fp <.> "expected" <.> "hs"--expectedNothing :: FilePath -> GenCommentsType -> Int -> Int -> TestTree-expectedNothing fp (toTitle -> expectedTitle) l c = testCase fp $- runSession hlsCommand fullCaps haddockCommentsPath $ do- doc <- openDoc (fp <.> "hs") "haskell"- _ <- waitForDiagnostics- titles <- mapMaybe caTitle <$> getCodeActions doc (Range (Position l c) (Position l $ succ c))- liftIO $ expectedTitle `notElem` titles @? "Unexpected CodeAction"--data GenCommentsType = Signature | Record--toTitle :: GenCommentsType -> Text-toTitle Signature = "Generate signature comments"-toTitle Record = "Generate fields comments"--caTitle :: CAResult -> Maybe Text-caTitle (CACodeAction CodeAction {_title}) = Just _title-caTitle _ = Nothing--haddockCommentsPath :: String-haddockCommentsPath = "test" </> "testdata" </> "haddockComments"--goldenGitDiff :: FilePath -> FilePath -> [String]-goldenGitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]+{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE GADTs #-} + +module HaddockComments + ( tests, + ) +where + +import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString.Lazy as LBS +import Data.Foldable (find) +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Language.LSP.Test +import Language.LSP.Types +import System.FilePath ((<.>), (</>)) +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.Golden +import Test.Tasty.HUnit + +tests :: TestTree +tests = + testGroup + "haddock comments" + [ goldenTest "HigherRankFunction" Signature 4 6, + goldenTest "KindSigFunction" Signature 9 10, + goldenTest "MultivariateFunction" Signature 4 8, + goldenTest "QualFunction" Signature 2 10, + goldenTest "Record" Record 7 2, + expectedNothing "ConstFunction" Signature 2 2, + expectedNothing "StaleFunction" Signature 3 3, + expectedNothing "StaleRecord" Record 3 12 + ] + +goldenTest :: FilePath -> GenCommentsType -> Int -> Int -> TestTree +goldenTest fp (toTitle -> expectedTitle) l c = goldenVsStringDiff (fp <> " (golden)") goldenGitDiff goldenFilePath $ + runSession hlsCommand fullCaps haddockCommentsPath $ do + doc <- openDoc hsFilePath "haskell" + _ <- waitForDiagnostics + actions <- getCodeActions doc (Range (Position l c) (Position l $ succ c)) + case find ((== Just expectedTitle) . caTitle) actions of + Just (InR x) -> do + executeCodeAction x + LBS.fromStrict . encodeUtf8 <$> documentContents doc + _ -> liftIO $ assertFailure "Unable to find CodeAction" + where + hsFilePath = fp <.> "hs" + goldenFilePath = haddockCommentsPath </> fp <.> "expected" <.> "hs" + +expectedNothing :: FilePath -> GenCommentsType -> Int -> Int -> TestTree +expectedNothing fp (toTitle -> expectedTitle) l c = testCase fp $ + runSession hlsCommand fullCaps haddockCommentsPath $ do + doc <- openDoc (fp <.> "hs") "haskell" + _ <- waitForDiagnostics + titles <- mapMaybe caTitle <$> getCodeActions doc (Range (Position l c) (Position l $ succ c)) + liftIO $ expectedTitle `notElem` titles @? "Unexpected CodeAction" + +data GenCommentsType = Signature | Record + +toTitle :: GenCommentsType -> Text +toTitle Signature = "Generate signature comments" +toTitle Record = "Generate fields comments" + +caTitle :: (Command |? CodeAction) -> Maybe Text +caTitle (InR CodeAction {_title}) = Just _title +caTitle _ = Nothing + +haddockCommentsPath :: String +haddockCommentsPath = "test" </> "testdata" </> "haddockComments" + +goldenGitDiff :: FilePath -> FilePath -> [String] +goldenGitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]
test/functional/HieBios.hs view
@@ -1,35 +1,35 @@-{-# LANGUAGE OverloadedStrings #-}-module HieBios (tests) where--import Control.Lens ((^.))-import Control.Monad.IO.Class-import qualified Data.Text as T-import Language.Haskell.LSP.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--tests :: TestTree-tests = testGroup "hie-bios" [- testCase "loads modules inside main-is" $ do- writeFile (hieBiosErrorPath </> "hie.yaml") ""- runSession hlsCommand fullCaps "test/testdata/hieBiosMainIs" $ do- doc <- openDoc "Main.hs" "haskell"- Just mainHoverText <- getHover doc (Position 3 1)- let (HoverContents (MarkupContent _ x)) = mainHoverText ^. L.contents- liftIO $ "main :: IO ()" `T.isInfixOf` x- @? "found hover text for main"-- , testCase "reports errors in hie.yaml" $ do- writeFile (hieBiosErrorPath </> "hie.yaml") ""- runSession hlsCommand fullCaps hieBiosErrorPath $ do- _ <- openDoc "Foo.hs" "haskell"- (diag:_) <- waitForDiagnostics- liftIO $ "Expected a cradle: key containing the preferences" `T.isInfixOf` (diag ^. L.message)- @? "Error reported"- ]- where- hieBiosErrorPath = "test/testdata/hieBiosError"+{-# LANGUAGE OverloadedStrings #-} +module HieBios (tests) where + +import Control.Lens ((^.)) +import Control.Monad.IO.Class +import qualified Data.Text as T +import Language.LSP.Test +import Language.LSP.Types +import qualified Language.LSP.Types.Lens as L +import System.FilePath ((</>)) +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "hie-bios" [ + testCase "loads modules inside main-is" $ do + writeFile (hieBiosErrorPath </> "hie.yaml") "" + runSession hlsCommand fullCaps "test/testdata/hieBiosMainIs" $ do + doc <- openDoc "Main.hs" "haskell" + Just mainHoverText <- getHover doc (Position 3 1) + let (HoverContents (MarkupContent _ x)) = mainHoverText ^. L.contents + liftIO $ "main :: IO ()" `T.isInfixOf` x + @? "found hover text for main" + + , testCase "reports errors in hie.yaml" $ do + writeFile (hieBiosErrorPath </> "hie.yaml") "" + runSession hlsCommand fullCaps hieBiosErrorPath $ do + _ <- openDoc "Foo.hs" "haskell" + (diag:_) <- waitForDiagnostics + liftIO $ "Expected a cradle: key containing the preferences" `T.isInfixOf` (diag ^. L.message) + @? "Error reported" + ] + where + hieBiosErrorPath = "test/testdata/hieBiosError"
test/functional/Highlight.hs view
@@ -1,26 +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)+{-# LANGUAGE OverloadedStrings #-} +module Highlight (tests) where + +import Control.Monad.IO.Class +import Language.LSP.Test +import Language.LSP.Types +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "highlight" [ + testCase "works" $ runSession (hlsCommand ++ " --test") 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
@@ -1,65 +1,63 @@-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 HaddockComments-import HieBios-import Highlight-import ModuleName-import Progress-import Reference-import Rename-import Symbol-import Splice-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- , Splice.tests- , HaddockComments.tests- ]+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 HaddockComments +import HieBios +import Highlight +import ModuleName +import Progress +import Reference +import Rename +import Symbol +import Splice +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 + , TypeDefinition.tests + , Splice.tests + , HaddockComments.tests + ]
test/functional/ModuleName.hs view
@@ -1,44 +1,44 @@-{-# 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"+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DuplicateRecordFields #-} + +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.LSP.Test (anyMessage, documentContents, + executeCommand, fullCaps, + getCodeLenses, message, + openDoc, runSession) +import Language.LSP.Types +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 <- skipManyTill anyMessage (message SWorkspaceApplyEdit) + 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
@@ -1,111 +1,120 @@-{-# 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+{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} + +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.LSP.Test +import Language.LSP.Types +import Language.LSP.Types.Capabilities +import qualified Language.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 SWorkspaceExecuteCommand $ ExecuteCommandParams Nothing (cmd ^. L.command) (decode $ encode $ fromJust $ cmd ^. L.arguments) + expectProgressReports ["Evaluating"] + , testCase "ormolu plugin sends progress notifications" $ do + runSession hlsCommand progressCaps "test/testdata/format" $ do + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) + doc <- openDoc "Format.hs" "haskell" + expectProgressReports ["Setting up testdata (for Format.hs)", "Processing"] + _ <- sendRequest STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) + expectProgressReports ["Formatting Format.hs"] + , testCase "fourmolu plugin sends progress notifications" $ do + runSession hlsCommand progressCaps "test/testdata/format" $ do + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "fourmolu")) + doc <- openDoc "Format.hs" "haskell" + expectProgressReports ["Setting up testdata (for Format.hs)", "Processing"] + _ <- sendRequest STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing 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 SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + sendNotification STextDocumentDidSave (DidSaveTextDocumentParams doc Nothing) + 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 WorkDoneProgressCreateParams + | BeginM (ProgressParams WorkDoneProgressBeginParams) + | ProgressM (ProgressParams WorkDoneProgressReportParams) + | EndM (ProgressParams WorkDoneProgressEndParams) + +{- | 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 xs = expectProgressReports' [] xs + 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` ("Indexing references from:":xs) + 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.value . L.title + token msg = msg ^. L.token + create = CreateM . view L.params <$> message SWindowWorkDoneProgressCreate + begin = BeginM <$> satisfyMaybe (\case + FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (Begin x))) -> Just (ProgressParams t x) + _ -> Nothing) + progress = ProgressM <$> satisfyMaybe (\case + FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (Report x))) -> Just (ProgressParams t x) + _ -> Nothing) + end = EndM <$> satisfyMaybe (\case + FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (End x))) -> Just (ProgressParams t x) + _ -> Nothing) + expectElem a as = a `elem` as @? "Unexpected " ++ show a
test/functional/Reference.hs view
@@ -1,35 +1,36 @@-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)+module Reference (tests) where + +import Control.Lens +import Control.Monad.IO.Class +import Data.List +import Language.LSP.Test +import Language.LSP.Types +import Language.LSP.Types.Lens +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Data.Coerce + +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` coerce 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
@@ -1,28 +1,28 @@-{-# LANGUAGE OverloadedStrings #-}-module Rename (tests) where--import Control.Monad.IO.Class (liftIO)-import Language.Haskell.LSP.Test-import Language.Haskell.LSP.Types-import Test.Hls.Util-import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.ExpectedFailure (ignoreTestBecause)--tests :: TestTree-tests = testGroup "rename" [- ignoreTestBecause "no symbol renaming (yet!)" $- testCase "works" $- runSession hlsCommand fullCaps "test/testdata/rename" $ do- doc <- openDoc "Rename.hs" "haskell"- rename doc (Position 3 1) "baz" -- foo :: Int -> Int- contents <- documentContents doc- let 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"- liftIO $ contents @?= expected- ]+{-# LANGUAGE OverloadedStrings #-} +module Rename (tests) where + +import Control.Monad.IO.Class (liftIO) +import Language.LSP.Test +import Language.LSP.Types +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.ExpectedFailure (ignoreTestBecause) + +tests :: TestTree +tests = testGroup "rename" [ + ignoreTestBecause "no symbol renaming (yet!)" $ + testCase "works" $ + runSession hlsCommand fullCaps "test/testdata/rename" $ do + doc <- openDoc "Rename.hs" "haskell" + rename doc (Position 3 1) "baz" -- foo :: Int -> Int + contents <- documentContents doc + let 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" + liftIO $ contents @?= expected + ]
test/functional/Splice.hs view
@@ -1,139 +1,134 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE CPP #-}--module Splice (tests) where--import Control.Applicative.Combinators-import Control.Monad-import Control.Monad.IO.Class-import Data.List (find)-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as T-import Ide.Plugin.Splice.Types-import Language.Haskell.LSP.Test-import Language.Haskell.LSP.Types- ( ApplyWorkspaceEditRequest,- CAResult (..),- CodeAction (..),- Position (..),- Range (..),- TextDocumentContentChangeEvent (..),- TextEdit (..),- )-import System.Directory-import System.FilePath-import System.Time.Extra (sleep)-import Test.Hls.Util-import Test.Tasty-import Test.Tasty.HUnit--tests :: TestTree-tests =- testGroup- "splice"- [ goldenTest "TSimpleExp.hs" Inplace 6 15- , goldenTest "TSimpleExp.hs" Inplace 6 24- , goldenTest "TTypeAppExp.hs" Inplace 7 5- , goldenTest "TErrorExp.hs" Inplace 6 15- , goldenTest "TErrorExp.hs" Inplace 6 51- , goldenTest "TQQExp.hs" Inplace 6 17- , goldenTest "TQQExp.hs" Inplace 6 25- , goldenTest "TQQExpError.hs" Inplace 6 13- , goldenTest "TQQExpError.hs" Inplace 6 22- , testGroup "Pattern Splices"- [ goldenTest "TSimplePat.hs" Inplace 6 3- , goldenTest "TSimplePat.hs" Inplace 6 22- , goldenTest "TSimplePat.hs" Inplace 6 3- , goldenTest "TSimplePat.hs" Inplace 6 22- , goldenTest "TErrorPat.hs" Inplace 6 3- , goldenTest "TErrorPat.hs" Inplace 6 18- , goldenTest "TQQPat.hs" Inplace 6 3- , goldenTest "TQQPat.hs" Inplace 6 11- , goldenTest "TQQPatError.hs" Inplace 6 3- , goldenTest "TQQPatError.hs" Inplace 6 11- ]- , goldenTest "TSimpleType.hs" Inplace 5 12- , goldenTest "TSimpleType.hs" Inplace 5 22- , goldenTest "TTypeTypeError.hs" Inplace 7 12- , goldenTest "TTypeTypeError.hs" Inplace 7 52- , goldenTest "TQQType.hs" Inplace 8 19- , goldenTest "TQQType.hs" Inplace 8 28- , goldenTest "TQQTypeTypeError.hs" Inplace 8 19- , goldenTest "TQQTypeTypeError.hs" Inplace 8 28- , goldenTest "TSimpleDecl.hs" Inplace 8 1- , goldenTest "TQQDecl.hs" Inplace 5 1- , goldenTestWithEdit "TTypeKindError.hs" Inplace 7 9- , goldenTestWithEdit "TDeclKindError.hs" Inplace 8 1- ]--goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree-goldenTest input tc line col =- testCase (input <> " (golden)") $ do- runSession hlsCommand fullCaps spliceTestPath $ do- doc <- openDoc input "haskell"- _ <- waitForDiagnostics- actions <- getCodeActions doc $ pointRange line col- case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of- Just (CACodeAction CodeAction {_command = Just c}) -> do- executeCommand c- _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message- edited <- documentContents doc- let expected_name = spliceTestPath </> 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- _ -> liftIO $ assertFailure "No CodeAction detected"--goldenTestWithEdit :: FilePath -> ExpandStyle -> Int -> Int -> TestTree-goldenTestWithEdit input tc line col =- testCase (input <> " (golden)") $ do- runSession hlsCommand fullCaps spliceTestPath $ do- doc <- openDoc input "haskell"- orig <- documentContents doc- let lns = T.lines orig- theRange =- Range- { _start = Position 0 0- , _end = Position (length lns + 1) 1- }- liftIO $ sleep 3- alt <- liftIO $ T.readFile (spliceTestPath </> input <.> "error")- void $ applyEdit doc $ TextEdit theRange alt- changeDoc doc [TextDocumentContentChangeEvent (Just theRange) Nothing alt]- void waitForDiagnostics- actions <- getCodeActions doc $ pointRange line col- case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of- Just (CACodeAction CodeAction {_command = Just c}) -> do- executeCommand c- _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message- edited <- documentContents doc- let expected_name = spliceTestPath </> 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- _ -> liftIO $ assertFailure "No CodeAction detected"--spliceTestPath :: FilePath-spliceTestPath = "test/testdata/splice"--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+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} + +module Splice (tests) where + +import Control.Applicative.Combinators +import Control.Monad +import Control.Monad.IO.Class +import Data.List (find) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Ide.Plugin.Splice.Types +import Language.LSP.Test +import Language.LSP.Types +import System.Directory +import System.FilePath +import System.Time.Extra (sleep) +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = + testGroup + "splice" + [ goldenTest "TSimpleExp.hs" Inplace 6 15 + , goldenTest "TSimpleExp.hs" Inplace 6 24 + , goldenTest "TTypeAppExp.hs" Inplace 7 5 + , goldenTest "TErrorExp.hs" Inplace 6 15 + , goldenTest "TErrorExp.hs" Inplace 6 51 + , goldenTest "TQQExp.hs" Inplace 6 17 + , goldenTest "TQQExp.hs" Inplace 6 25 + , goldenTest "TQQExpError.hs" Inplace 6 13 + , goldenTest "TQQExpError.hs" Inplace 6 22 + , testGroup "Pattern Splices" + [ goldenTest "TSimplePat.hs" Inplace 6 3 + , goldenTest "TSimplePat.hs" Inplace 6 22 + , goldenTest "TSimplePat.hs" Inplace 6 3 + , goldenTest "TSimplePat.hs" Inplace 6 22 + , goldenTest "TErrorPat.hs" Inplace 6 3 + , goldenTest "TErrorPat.hs" Inplace 6 18 + , goldenTest "TQQPat.hs" Inplace 6 3 + , goldenTest "TQQPat.hs" Inplace 6 11 + , goldenTest "TQQPatError.hs" Inplace 6 3 + , goldenTest "TQQPatError.hs" Inplace 6 11 + ] + , goldenTest "TSimpleType.hs" Inplace 5 12 + , goldenTest "TSimpleType.hs" Inplace 5 22 + , goldenTest "TTypeTypeError.hs" Inplace 7 12 + , goldenTest "TTypeTypeError.hs" Inplace 7 52 + , goldenTest "TQQType.hs" Inplace 8 19 + , goldenTest "TQQType.hs" Inplace 8 28 + , goldenTest "TQQTypeTypeError.hs" Inplace 8 19 + , goldenTest "TQQTypeTypeError.hs" Inplace 8 28 + , goldenTest "TSimpleDecl.hs" Inplace 8 1 + , goldenTest "TQQDecl.hs" Inplace 5 1 + , goldenTestWithEdit "TTypeKindError.hs" Inplace 7 9 + , goldenTestWithEdit "TDeclKindError.hs" Inplace 8 1 + ] + +goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree +goldenTest input tc line col = + testCase (input <> " (golden)") $ do + runSession hlsCommand fullCaps spliceTestPath $ do + doc <- openDoc input "haskell" + _ <- waitForDiagnostics + actions <- getCodeActions doc $ pointRange line col + case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of + Just (InR CodeAction {_command = Just c}) -> do + executeCommand c + _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) + edited <- documentContents doc + let expected_name = spliceTestPath </> 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 + _ -> liftIO $ assertFailure "No CodeAction detected" + +goldenTestWithEdit :: FilePath -> ExpandStyle -> Int -> Int -> TestTree +goldenTestWithEdit input tc line col = + testCase (input <> " (golden)") $ do + runSession hlsCommand fullCaps spliceTestPath $ do + doc <- openDoc input "haskell" + orig <- documentContents doc + let lns = T.lines orig + theRange = + Range + { _start = Position 0 0 + , _end = Position (length lns + 1) 1 + } + liftIO $ sleep 3 + alt <- liftIO $ T.readFile (spliceTestPath </> input <.> "error") + void $ applyEdit doc $ TextEdit theRange alt + changeDoc doc [TextDocumentContentChangeEvent (Just theRange) Nothing alt] + void waitForDiagnostics + actions <- getCodeActions doc $ pointRange line col + case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of + Just (InR CodeAction {_command = Just c}) -> do + executeCommand c + _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) + edited <- documentContents doc + let expected_name = spliceTestPath </> 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 + _ -> liftIO $ assertFailure "No CodeAction detected" + +spliceTestPath :: FilePath +spliceTestPath = "test/testdata/splice" + +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 :: (Command |? CodeAction) -> Maybe Text +codeActionTitle InL{} = Nothing +codeActionTitle (InR(CodeAction title _ _ _ _ _ _)) = Just title
test/functional/Symbol.hs view
@@ -1,157 +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)+{-# LANGUAGE OverloadedStrings #-} +module Symbol (tests) where + +import Control.Lens (to, ix, (^?), _Just) +import Control.Monad.IO.Class +import Data.List +import Language.LSP.Test as Test +import Language.LSP.Types +import qualified Language.LSP.Types.Lens as L +import Language.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
@@ -1,191 +0,0 @@-{-# 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
@@ -1,55 +1,47 @@-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)+module TypeDefinition (tests) where + +import Control.Monad.IO.Class +import Data.Tuple.Extra (first3) +import Language.LSP.Test +import Language.LSP.Types +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' 10 23 7 0 + , testCase "finds local definition of newtype variable" + $ getTypeDefinitionTest' 15 21 12 0 + , testCase "finds local definition of sum type variable" + $ getTypeDefinitionTest' 20 13 17 0 + , 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' 23 7 17 0 + , testCase "finds non-local definition of type def" + $ getTypeDefinitionTest' 29 19 26 0 + , testCase "find local definition of type def" + $ getTypeDefinitionTest' 34 16 31 0 + , testCase "find type-definition of type def in component" + $ getTypeDefinitionTest ("src/Lib2.hs", 12, 20) [("src/Lib.hs", 7, 0)] + , testCase "find definition of parameterized data type" + $ getTypeDefinitionTest ("src/Lib.hs", 39, 19) [ ("src/Lib.hs", 36, 0) + , ("src/Lib.hs", 38, 0)] + ] + +definitionsPath :: FilePath +definitionsPath = "test/testdata/gototest" + +getTypeDefinitionTest :: SymbolLocation -> [SymbolLocation] -> Assertion +getTypeDefinitionTest (symbolFile, symbolLine, symbolCol) definitionLocations = + failIfSessionTimeout . runSession (hlsCommand ++ " --test") fullCaps definitionsPath $ do + doc <- openDoc symbolFile "haskell" + InL defs <- getTypeDefinitions doc $ Position symbolLine symbolCol + liftIO $ defs `expectSameLocations` map (first3 (definitionsPath </>)) definitionLocations + +getTypeDefinitionTest' :: Int -> Int -> Int -> Int -> Assertion +getTypeDefinitionTest' symbolLine symbolCol definitionLine definitionCol = + getTypeDefinitionTest ("src/Lib.hs", symbolLine, symbolCol) + [("src/Lib.hs", definitionLine, definitionCol)]
test/utils/Test/Hls/Util.hs view
@@ -1,399 +1,443 @@-{-# 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- , logFilePath- , setupBuildToolFiles- , waitForDiagnosticsFrom- , waitForDiagnosticsFromSource- , waitForDiagnosticsFromSourceWithTimeout- , 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 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)--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---- -----------------------------------------------------------------------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+{-# LANGUAGE CPP, OverloadedStrings, NamedFieldPuns, MultiParamTypeClasses, DuplicateRecordFields, TypeOperators, GADTs #-} +{-# LANGUAGE FlexibleContexts #-} +module Test.Hls.Util + ( + codeActionSupportCaps + , expectCodeAction + , expectDiagnostic + , expectNoMoreDiagnostics + , expectSameLocations + , failIfSessionTimeout + , flushStackEnvironment + , fromAction + , fromCommand + , getHspecFormattedConfig + , ghcVersion, GhcVersion(..) + , hostOS, OS(..) + , matchesCurrentEnv, EnvSpec(..) + , hlsCommand + , hlsCommandExamplePlugin + , hlsCommandVomit + , ignoreForGhcVersions + , ignoreInEnv + , inspectCodeAction + , inspectCommand + , inspectDiagnostic + , knownBrokenOnWindows + , knownBrokenForGhcVersions + , knownBrokenInEnv + , logFilePath + , setupBuildToolFiles + , SymbolLocation + , waitForDiagnosticsFrom + , waitForDiagnosticsFromSource + , waitForDiagnosticsFromSourceWithTimeout + , withCurrentDirectoryInTmp + ) +where + +import qualified Data.Aeson as A +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.Set as Set +import qualified Data.Text as T +import Language.LSP.Types hiding (Reason(..)) +import qualified Language.LSP.Test as Test +import qualified Language.LSP.Types.Lens as L +import qualified Language.LSP.Types.Capabilities as C +import System.Directory +import System.Environment +import System.Time.Extra (Seconds, sleep) +import System.FilePath +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 (Assertion, assertFailure, (@?=)) +import Text.Blaze.Renderer.String (renderMarkup) +import Text.Blaze.Internal hiding (null) +import System.Info.Extra (isWindows, isMac) + +codeActionSupportCaps :: C.ClientCapabilities +codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps } + where + textDocumentCaps = def { C._codeAction = Just codeActionCaps } + codeActionCaps = CodeActionClientCapabilities (Just True) (Just literalSupport) (Just True) + literalSupport = CodeActionLiteralSupport def + +-- --------------------------------------------------------------------- + +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 + +data EnvSpec = HostOS OS | GhcVer GhcVersion + deriving (Show, Eq) + +matchesCurrentEnv :: EnvSpec -> Bool +matchesCurrentEnv (HostOS os) = hostOS == os +matchesCurrentEnv (GhcVer ver) = ghcVersion == ver + +data OS = Windows | MacOS | Linux + deriving (Show, Eq) + +hostOS :: OS +hostOS + | isWindows = Windows + | isMac = MacOS + | otherwise = Linux + +-- | Mark as broken if /any/ of environmental spec mathces the current environment. +knownBrokenInEnv :: [EnvSpec] -> String -> TestTree -> TestTree +knownBrokenInEnv envSpecs reason + | any matchesCurrentEnv envSpecs = expectFailBecause reason + | otherwise = id + +knownBrokenOnWindows :: String -> TestTree -> TestTree +knownBrokenOnWindows reason + | isWindows = expectFailBecause reason + | otherwise = id + +knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree +knownBrokenForGhcVersions vers reason + | ghcVersion `elem` vers = expectFailBecause reason + | otherwise = id + +-- | IgnroeTest if /any/ of environmental spec mathces the current environment. +ignoreInEnv :: [EnvSpec] -> String -> TestTree -> TestTree +ignoreInEnv envSpecs reason + | any matchesCurrentEnv envSpecs = ignoreTestBecause 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 +{-# NOINLINE hlsCommand #-} +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" + +-- --------------------------------------------------------------------- + +-- | 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 :: (Command |? CodeAction) -> CodeAction +fromAction (InR action) = action +fromAction _ = error "Not a code action" + +fromCommand :: (Command |? CodeAction) -> Command +fromCommand (InL 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 :: [Command |? CodeAction] -> [T.Text] -> IO CodeAction +inspectCodeAction cars s = fromAction <$> onMatch cars predicate err + where predicate (InR ca) = all (`T.isInfixOf` (ca ^. L.title)) s + predicate _ = False + err = "expected code action matching '" ++ show s ++ "' but did not find one" + +expectCodeAction :: [Command |? CodeAction] -> [T.Text] -> IO () +expectCodeAction cars s = void $ inspectCodeAction cars s + +inspectCommand :: [Command |? CodeAction] -> [T.Text] -> IO Command +inspectCommand cars s = fromCommand <$> onMatch cars predicate err + where predicate (InL 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 STextDocumentPublishDiagnostics) + 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 STextDocumentPublishDiagnostics) + 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.sendNotification (SCustomMethod "non-existent-method") A.Null + handleMessages + where + matches :: Diagnostic -> Bool + matches d = d ^. L.source == Just (T.pack source) + + handleMessages = handleDiagnostic <|> handleCustomMethodResponse <|> ignoreOthers + handleDiagnostic = do + diagsNot <- Test.message STextDocumentPublishDiagnostics + 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 :: FromServerMessage -> Maybe FromServerMessage + responseForNonExistentMethod notif + | FromServerMess SWindowLogMessage 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 + +-- | To locate a symbol, we provide a path to the file from the HLS root +-- directory, the line number, and the column number. (0 indexed.) +type SymbolLocation = (FilePath, Int, Int) + +expectSameLocations :: [Location] -> [SymbolLocation] -> Assertion +actual `expectSameLocations` expected = do + let actual' = + Set.map (\location -> (location ^. L.uri + , location ^. L.range . L.start . L.line + , location ^. L.range . L.start . L.character)) + $ Set.fromList actual + expected' <- Set.fromList <$> + (forM expected $ \(file, l, c) -> do + fp <- canonicalizePath file + return (filePathToUri fp, l, c)) + actual' @?= expected'
test/wrapper/Main.hs view
@@ -1,39 +1,35 @@-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+import Data.List.Extra (trimEnd) +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.4" $ + testDir "test/wrapper/testdata/stack-8.10.4" "8.10.4" + , 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 <- trimEnd <$> 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 <- trimEnd <$> readProcess testExe ["--project-ghc-version"] "" + actualVer @?= expectedVer