packages feed

haskell-language-server 1.5.1.0 → 1.6.0.0

raw patch · 20 files changed

+835/−452 lines, 20 filesdep +githashdep +hls-alternate-number-format-plugindep +hls-qualify-imported-names-plugindep ~basedep ~ghcidedep ~hls-plugin-apiPVP ok

version bump matches the API change (PVP)

Dependencies added: githash, hls-alternate-number-format-plugin, hls-qualify-imported-names-plugin, hls-selection-range-plugin, lens-aeson, stm

Dependency ranges changed: base, ghcide, hls-plugin-api, hls-tactics-plugin, hls-test-utils

API changes (from Hackage documentation)

Files

ChangeLog.md view
@@ -1,5 +1,293 @@ # Changelog for haskell-language-server +## 1.6.0++Time for a new and exciting hls release:++- It includes *three* brand new plugins:+  - [Alternate number literals](https://haskell-language-server.readthedocs.io/en/latest/features.html#convert-numbers-to-alternative-formats) thanks to @drsooch+  - [Qualify imported names](https://haskell-language-server.readthedocs.io/en/latest/features.html#qualify-imported-names) thanks to @eddiemundo+  - New plugin to support [selection range](https://haskell-language-server.readthedocs.io/en/latest/features.html#selection-range) (aka double click text selection) thanks to @kokobd+- Finally hls [supports *ghc 9.2.1*](https://github.com/haskell/haskell-language-server/issues/2179)+  - Including core features and [many plugins](https://haskell-language-server.readthedocs.io/en/latest/supported-versions.html#plugins-support-by-ghc-version))+  - Thanks to a great collective effort coordinated by @pepeiborra and with the help of @wz1000, @mpickering and @alanz among others+- Hls now also [supports *ghc 9.0.2*](https://github.com/haskell/haskell-language-server/issues/297) with all plugins but the stylish-haskell formatter+  - Including the [wingman plugin](https://github.com/haskell/haskell-language-server/tree/master/plugins/hls-tactics-plugin) thanks to @isovector and @anka-213+- And many many fixes and performance improvements, thanks to all contributors!++### Deprecation notice for 1.6.0++- As we noted in the previous release we have dropped support for ghc versions 8.10.5 and 8.8.3 in *this release*+  - We recommend upgrading ghc to the last minor version: 8.8.4 or 8.10.7+  - You can read more about ghc deprecation policy and schedule [here](https://haskell-language-server.readthedocs.io/en/latest/supported-versions.html)+- *After this release*:+  - [We will remove all project stack.yaml's](https://github.com/haskell/haskell-language-server/issues/2533) but two: one for last lts and other for nightly. Temporary we could keep one more stack yaml when nightly upgrades the ghc version, to help in the transition+  - [We will remove the install script](https://github.com/haskell/haskell-language-server/issues/2491) which lives [here](https://github.com/haskell/haskell-language-server/tree/master/install)+    - If you want to install hls from source we recommend using `ghcup`. Download it and run `ghcup compile hls --help` to get more info about.++### Pull requests merged for 1.6.0++- Implement stripPrefix via T.stripPrefix+([#2645](https://github.com/haskell/haskell-language-server/pull/2645)) by @Bodigrim+- Change Type Family Export pattern+([#2643](https://github.com/haskell/haskell-language-server/pull/2643)) by @drsooch+- Disable alpine build by default+([#2638](https://github.com/haskell/haskell-language-server/pull/2638)) by @jneira+- Use T.decodeUtf8 + BS.readFile instead of T.readFile+([#2637](https://github.com/haskell/haskell-language-server/pull/2637)) by @Bodigrim+- Add ghc 9.2.1 to gitlab ci+([#2636](https://github.com/haskell/haskell-language-server/pull/2636)) by @jneira+- Specialize ghcide indent style to .hs+([#2631](https://github.com/haskell/haskell-language-server/pull/2631)) by @mrgutkun+- Fix off by one indexing error in openingBacktick+([#2629](https://github.com/haskell/haskell-language-server/pull/2629)) by @pepeiborra+- Drop bytestring-encoding+([#2628](https://github.com/haskell/haskell-language-server/pull/2628)) by @pepeiborra+- fix positionInRange+([#2625](https://github.com/haskell/haskell-language-server/pull/2625)) by @kokobd+- Fix #2612 - hlint plugin - Apply fixities to parsed source before sending to apply-refact+([#2624](https://github.com/haskell/haskell-language-server/pull/2624)) by @eddiemundo+- Flake ghc 92+([#2621](https://github.com/haskell/haskell-language-server/pull/2621)) by @guibou+- Use ghc+integer-gmp for alpine linux build release+([#2615](https://github.com/haskell/haskell-language-server/pull/2615)) by @jneira+- Use helpers from lsp to do code action prefixing+([#2614](https://github.com/haskell/haskell-language-server/pull/2614)) by @michaelpj+- Wingman: Fix fundeps+([#2611](https://github.com/haskell/haskell-language-server/pull/2611)) by @isovector+- Wingman idioms+([#2607](https://github.com/haskell/haskell-language-server/pull/2607)) by @isovector+- Make work stack-9.2.1.yaml and enable `pedantic` (`-WError`) for cabal+([#2606](https://github.com/haskell/haskell-language-server/pull/2606)) by @jneira+- Improve qualified import plugin readme+([#2605](https://github.com/haskell/haskell-language-server/pull/2605)) by @eddiemundo+- Correct typo in Ide.Arguments:listPluginsParser+([#2604](https://github.com/haskell/haskell-language-server/pull/2604)) by @tombusby+- Rework features documentation+([#2603](https://github.com/haskell/haskell-language-server/pull/2603)) by @michaelpj+- [ghc-9.2] Fix refine-imports plugin+([#2601](https://github.com/haskell/haskell-language-server/pull/2601)) by @mrgutkun+- [ghc-9.2] Fix qualify-imported-names plugin+([#2600](https://github.com/haskell/haskell-language-server/pull/2600)) by @mrgutkun+- Correct issues with pre-commit hook+([#2597](https://github.com/haskell/haskell-language-server/pull/2597)) by @bradrn+- Fix some import module completions being dropped (and fix flaky test too)+([#2595](https://github.com/haskell/haskell-language-server/pull/2595)) by @eddiemundo+- Fix module-name plugin on ghc-9.2.1+([#2594](https://github.com/haskell/haskell-language-server/pull/2594)) by @mrgutkun+- [ghc-9.2] Fix rename plugin+([#2593](https://github.com/haskell/haskell-language-server/pull/2593)) by @pepeiborra+- Fix progress eval test randomly failing+([#2590](https://github.com/haskell/haskell-language-server/pull/2590)) by @eddiemundo+- More work around next ghc-9.2.1 support+([#2587](https://github.com/haskell/haskell-language-server/pull/2587)) by @jneira+- Post ghc-9.2.1 config cleanup+([#2582](https://github.com/haskell/haskell-language-server/pull/2582)) by @jneira+- GHC-9.0 support for hls-tactics-plugin+([#2581](https://github.com/haskell/haskell-language-server/pull/2581)) by @isovector+- Wingman: Fix TODO(sandy) when performing subsequent actions+([#2580](https://github.com/haskell/haskell-language-server/pull/2580)) by @isovector+- Bump Ormolu and Fourmolu to GHC-9.2-compatible versions+([#2579](https://github.com/haskell/haskell-language-server/pull/2579)) by @georgefst+- test: Add regression tests for #2403+([#2576](https://github.com/haskell/haskell-language-server/pull/2576)) by @guibou+- Fix crash on completion with type family+([#2569](https://github.com/haskell/haskell-language-server/pull/2569)) by @guibou+- Add support for ghc 9.0.2+([#2567](https://github.com/haskell/haskell-language-server/pull/2567)) by @jneira+- support selection range lsp feature+([#2565](https://github.com/haskell/haskell-language-server/pull/2565)) by @kokobd+- Reuse build setup using a dedicated github action+([#2563](https://github.com/haskell/haskell-language-server/pull/2563)) by @jneira+- Fix ci update hackage index+([#2562](https://github.com/haskell/haskell-language-server/pull/2562)) by @jneira+- Enable `aarch64-darwin` in `flake.nix`+([#2561](https://github.com/haskell/haskell-language-server/pull/2561)) by @Gabriel439+- Fix freeze cache key correctly+([#2560](https://github.com/haskell/haskell-language-server/pull/2560)) by @jneira+- Fix nix flake by explicit version for `lsp-xxx` packages+([#2557](https://github.com/haskell/haskell-language-server/pull/2557)) by @guibou+- Apply missing update for stack-9.0.1.yaml+([#2556](https://github.com/haskell/haskell-language-server/pull/2556)) by @Ailrun+- doc: Enable relative links with anchors+([#2555](https://github.com/haskell/haskell-language-server/pull/2555)) by @sir4ur0n+- Fix space leak where EPS retained HPTs from old HscEnv+([#2553](https://github.com/haskell/haskell-language-server/pull/2553)) by @mpickering+- Remove cabal.project.freeze files in workflows after computing the cache key+([#2552](https://github.com/haskell/haskell-language-server/pull/2552)) by @jneira+- Add support for brittany (needs aeson-2) and floskell with ghc-9.0.1+([#2551](https://github.com/haskell/haskell-language-server/pull/2551)) by @jneira+- Restore TemplateHaskell pragma in hls-graph+([#2549](https://github.com/haskell/haskell-language-server/pull/2549)) by @pepeiborra+- Add space after comma when exporting a name+([#2547](https://github.com/haskell/haskell-language-server/pull/2547)) by @sergv+- Set an unique name for Hlint job+([#2544](https://github.com/haskell/haskell-language-server/pull/2544)) by @jneira+- Fix ghcide handling project root+([#2543](https://github.com/haskell/haskell-language-server/pull/2543)) by @drsooch+- CI: linting+([#2538](https://github.com/haskell/haskell-language-server/pull/2538)) by @Anton-Latukha+- CI: add hlint workflow+([#2537](https://github.com/haskell/haskell-language-server/pull/2537)) by @Anton-Latukha+- CI: caching: closer match work/CI guarantees+([#2536](https://github.com/haskell/haskell-language-server/pull/2536)) by @Anton-Latukha+- CI: caching: keep-going+([#2535](https://github.com/haskell/haskell-language-server/pull/2535)) by @Anton-Latukha+- CI: {caching,test,bench}: mk cache aware of package dep versions+([#2532](https://github.com/haskell/haskell-language-server/pull/2532)) by @Anton-Latukha+- Test hls-pragmas-plugin in ci+([#2530](https://github.com/haskell/haskell-language-server/pull/2530)) by @jneira+- Enable manual run for caching, hackage and build workflows+([#2528](https://github.com/haskell/haskell-language-server/pull/2528)) by @jneira+- Fix random SQLite busy database is locked errors+([#2527](https://github.com/haskell/haskell-language-server/pull/2527)) by @eddiemundo+- Fix some hlint warnings+([#2523](https://github.com/haskell/haskell-language-server/pull/2523)) by @jhrcek+- Improve action for fixing import typo+([#2522](https://github.com/haskell/haskell-language-server/pull/2522)) by @jhrcek+- CI: caching: fix early termination expression check & cabal.project replacement+([#2520](https://github.com/haskell/haskell-language-server/pull/2520)) by @Anton-Latukha+- Solve crash with module name plugin under certain circumstances+([#2518](https://github.com/haskell/haskell-language-server/pull/2518)) by @ttylec+- Rework troubleshooting section, add basic explainer+([#2517](https://github.com/haskell/haskell-language-server/pull/2517)) by @michaelpj+- Refactor collectLiterals in AlternateNumberFormat.+([#2516](https://github.com/haskell/haskell-language-server/pull/2516)) by @drsooch+- cabal-*.project: index-state +1s+([#2515](https://github.com/haskell/haskell-language-server/pull/2515)) by @Anton-Latukha+- Bump up retrie+([#2513](https://github.com/haskell/haskell-language-server/pull/2513)) by @jneira+- Sort out some compatibility issues+([#2511](https://github.com/haskell/haskell-language-server/pull/2511)) by @alanz+- Fix ci cache for windows+([#2507](https://github.com/haskell/haskell-language-server/pull/2507)) by @jneira+- CI: caching: add early termination & run check on schedule+([#2506](https://github.com/haskell/haskell-language-server/pull/2506)) by @Anton-Latukha+- Fix tracing of recordDirtyKeys+([#2505](https://github.com/haskell/haskell-language-server/pull/2505)) by @pepeiborra+- Unhandled exceptions fixed+([#2504](https://github.com/haskell/haskell-language-server/pull/2504)) by @pepeiborra+- Build with GHC 9.2+([#2503](https://github.com/haskell/haskell-language-server/pull/2503)) by @pepeiborra+- Ignore stack.yamls in test cabal workflow+([#2502](https://github.com/haskell/haskell-language-server/pull/2502)) by @jneira+- small stack yaml updates to ease maintenance+([#2501](https://github.com/haskell/haskell-language-server/pull/2501)) by @simonmichael+- Automatically read in the doc version from the cabal file+([#2500](https://github.com/haskell/haskell-language-server/pull/2500)) by @michaelpj+- Disable alternate numbers format plugin temporary+([#2498](https://github.com/haskell/haskell-language-server/pull/2498)) by @jneira+- Revert "Send unhandled exceptions to the user (#2484)"+([#2497](https://github.com/haskell/haskell-language-server/pull/2497)) by @jneira+- Upgrade to new version of lsp libraries+([#2494](https://github.com/haskell/haskell-language-server/pull/2494)) by @michaelpj+- Fail if main or pre jobs are cancelled+([#2493](https://github.com/haskell/haskell-language-server/pull/2493)) by @jneira+- stack-9.0.1: update/cleanup+([#2489](https://github.com/haskell/haskell-language-server/pull/2489)) by @simonmichael+- Correctly handle LSP shutdown/exit+([#2486](https://github.com/haskell/haskell-language-server/pull/2486)) by @pepeiborra+- Fix hls-graph ide build with embed-files+([#2485](https://github.com/haskell/haskell-language-server/pull/2485)) by @pepeiborra+- Send unhandled exceptions to the user+([#2484](https://github.com/haskell/haskell-language-server/pull/2484)) by @pepeiborra+- Fix redundant import actions for names starting with _+([#2483](https://github.com/haskell/haskell-language-server/pull/2483)) by @Ailrun+- Update flake to use fourmolu plugin in GHC 9+([#2482](https://github.com/haskell/haskell-language-server/pull/2482)) by @Ailrun+- Delete some dead or deprecated settings+([#2481](https://github.com/haskell/haskell-language-server/pull/2481)) by @michaelpj+- Class plugin bump up+([#2475](https://github.com/haskell/haskell-language-server/pull/2475)) by @Ailrun+- Fix some pragma completion cases+([#2474](https://github.com/haskell/haskell-language-server/pull/2474)) by @Ailrun+- Minor org to contribution doc+([#2472](https://github.com/haskell/haskell-language-server/pull/2472)) by @Anton-Latukha+- Warn if TH and Mac and static binary+([#2470](https://github.com/haskell/haskell-language-server/pull/2470)) by @pepeiborra+- Lock-less debouncer (minimal change)+([#2469](https://github.com/haskell/haskell-language-server/pull/2469)) by @pepeiborra+- Handle re-exported modules when constructing ExportsMap+([#2468](https://github.com/haskell/haskell-language-server/pull/2468)) by @jhrcek+- Caching process update+([#2467](https://github.com/haskell/haskell-language-server/pull/2467)) by @Anton-Latukha+- #2418 Also use .hlint.yaml fixity rules when HLINT_ON_LIB_GHC not defined+([#2464](https://github.com/haskell/haskell-language-server/pull/2464)) by @eddiemundo+- Build linux binaries in alpine container+([#2463](https://github.com/haskell/haskell-language-server/pull/2463)) by @pepeiborra+- Lockless iorefs+([#2460](https://github.com/haskell/haskell-language-server/pull/2460)) by @pepeiborra+- Join nested IO actions of the form `IO (IO ())`+([#2459](https://github.com/haskell/haskell-language-server/pull/2459)) by @fendor+- #600 Code action to ignore hlint hints module wide+([#2458](https://github.com/haskell/haskell-language-server/pull/2458)) by @eddiemundo+- lock-less progress-reporting+([#2453](https://github.com/haskell/haskell-language-server/pull/2453)) by @pepeiborra+- Fix the nix build+([#2452](https://github.com/haskell/haskell-language-server/pull/2452)) by @michaelpj+- Fix rerun log cache handling+([#2450](https://github.com/haskell/haskell-language-server/pull/2450)) by @jneira+- Make heavy use of common sections+([#2447](https://github.com/haskell/haskell-language-server/pull/2447)) by @fendor+- CI: organizing bootstraping+([#2446](https://github.com/haskell/haskell-language-server/pull/2446)) by @Anton-Latukha+- Describe hls installed binaries+([#2445](https://github.com/haskell/haskell-language-server/pull/2445)) by @jneira+- Remove support for ghc 8.8.3/8.10.5+([#2444](https://github.com/haskell/haskell-language-server/pull/2444)) by @jneira+- CI: cabal 3.6 use & clean-up 8.10.5 builds+([#2443](https://github.com/haskell/haskell-language-server/pull/2443)) by @Anton-Latukha+- Lockless FileExistsMap and position mapping+([#2442](https://github.com/haskell/haskell-language-server/pull/2442)) by @pepeiborra+- Fix regression in Eval plugin and add test+([#2441](https://github.com/haskell/haskell-language-server/pull/2441)) by @pepeiborra+- Makes local record field completion respects the fields sharing one single type signature+([#2439](https://github.com/haskell/haskell-language-server/pull/2439)) by @konn+- Enable top-level hover signature test+([#2435](https://github.com/haskell/haskell-language-server/pull/2435)) by @jneira+- Lockless diagnostics+([#2434](https://github.com/haskell/haskell-language-server/pull/2434)) by @pepeiborra+- Move Common Plugin Functions into PluginUtils+([#2433](https://github.com/haskell/haskell-language-server/pull/2433)) by @drsooch+- lock-less Values state+([#2429](https://github.com/haskell/haskell-language-server/pull/2429)) by @pepeiborra+- Extract the pre-decl pragma parsing to its own module+([#2428](https://github.com/haskell/haskell-language-server/pull/2428)) by @eddiemundo+- CI: cache-deps: rm pull request hook+([#2426](https://github.com/haskell/haskell-language-server/pull/2426)) by @Anton-Latukha+- Add known broken tests for import placement+([#2425](https://github.com/haskell/haskell-language-server/pull/2425)) by @nini-faroux+- Use stm-stats to reduce contention in hls-graph+([#2421](https://github.com/haskell/haskell-language-server/pull/2421)) by @pepeiborra+- Build on FreeBSD12 only+([#2420](https://github.com/haskell/haskell-language-server/pull/2420)) by @hasufell+- Centralized caching workflow+([#2419](https://github.com/haskell/haskell-language-server/pull/2419)) by @Anton-Latukha+- Configuration docs: Typo+([#2417](https://github.com/haskell/haskell-language-server/pull/2417)) by @andys8+- Use dependent-sum from hackage+([#2412](https://github.com/haskell/haskell-language-server/pull/2412)) by @jneira+- Lock-less hls-graph+([#2411](https://github.com/haskell/haskell-language-server/pull/2411)) by @pepeiborra+- hls-graph.cabal: link to actual readme+([#2404](https://github.com/haskell/haskell-language-server/pull/2404)) by @juhp+- Disable check project in the ghcide test suite+([#2397](https://github.com/haskell/haskell-language-server/pull/2397)) by @pepeiborra+- Add modern issue templates+([#2394](https://github.com/haskell/haskell-language-server/pull/2394)) by @jneira+- Fix extension pragma inserted below ghc options pragma #2364+([#2392](https://github.com/haskell/haskell-language-server/pull/2392)) by @eddiemundo+- Avoid unnecessary Target canonicalisation in Session setup+([#2359](https://github.com/haskell/haskell-language-server/pull/2359)) by @fendor+- Decrease contention in Progress reporting+([#2357](https://github.com/haskell/haskell-language-server/pull/2357)) by @pepeiborra+- Qualify imported names plugin+([#2355](https://github.com/haskell/haskell-language-server/pull/2355)) by @eddiemundo+- HLS Plugin to provide Alternate Literal Formats.+([#2350](https://github.com/haskell/haskell-language-server/pull/2350)) by @drsooch+- Log live_bytes and heap_size as reported by GHC.Stats+([#1508](https://github.com/haskell/haskell-language-server/pull/1508)) by @mpickering+ ## 1.5.1  This is a bug fix release for two regressions found after releasing 1.5.0:
exe/Plugins.hs view
@@ -12,6 +12,9 @@ import           Ide.Plugin.Example2               as Example2  -- haskell-language-server optional plugins+#if qualifyImportedNames+import           Ide.Plugin.QualifyImportedNames   as QualifyImportedNames+#endif  #if callHierarchy import           Ide.Plugin.CallHierarchy          as CallHierarchy@@ -65,6 +68,14 @@ import           Ide.Plugin.Splice                 as Splice #endif +#if alternateNumberFormat+import           Ide.Plugin.AlternateNumberFormat  as AlternateNumberFormat+#endif++#if selectionRange+import           Ide.Plugin.SelectionRange         as SelectionRange+#endif+ -- formatters  #if floskell@@ -143,6 +154,9 @@ #if importLens       ExplicitImports.descriptor "importLens" : #endif+#if qualifyImportedNames+      QualifyImportedNames.descriptor "qualifyImportedNames" :+#endif #if refineImports       RefineImports.descriptor "refineImports" : #endif@@ -154,6 +168,12 @@ #endif #if splice       Splice.descriptor "splice" :+#endif+#if alternateNumberFormat+      AlternateNumberFormat.descriptor "alternateNumberFormat" :+#endif+#if selectionRange+      SelectionRange.descriptor "selectionRange" : #endif     -- The ghcide descriptors should come last so that the notification handlers     -- (which restart the Shake build) run after everything else
haskell-language-server.cabal view
@@ -1,7 +1,7 @@ cabal-version:      2.4 category:           Development name:               haskell-language-server-version:            1.5.1.0+version:            1.6.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.5 || == 8.8.3 || == 8.8.4 || == 8.10.5 || == 8.10.6 || == 8.10.7 || == 9.0.1+tested-with:        GHC == 8.6.5 || == 8.8.4 || == 8.10.6 || == 8.10.7 || == 9.0.1 || == 9.0.2 || == 9.2.1 extra-source-files:   README.md   ChangeLog.md@@ -40,8 +40,20 @@     , filepath     , text +-- Default warnings in HLS+common warnings+  ghc-options: -Wall -Wredundant-constraints -Wno-name-shadowing -Wno-unticked-promoted-constructors++-- Allow compiling in pedantic mode+common pedantic+  if flag(pedantic)+    ghc-options: -Werror+ library   import:           common-deps+                    -- configuration+                  , warnings+                  , pedantic   exposed-modules:     Ide.Arguments     Ide.Main@@ -58,12 +70,12 @@     , cryptohash-sha1     , data-default     , ghc-    , ghcide                ^>=1.4 || ^>=1.5-    , gitrev+    , ghcide                ^>=1.6+    , githash     , lsp     , hie-bios     , hiedb-    , hls-plugin-api        ^>=1.2+    , hls-plugin-api        ^>=1.3     , hslogger     , optparse-applicative     , optparse-simple@@ -74,11 +86,6 @@     , unordered-containers     , aeson-pretty -  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 @@ -86,6 +93,9 @@ -- - Bulk flags should be default:False -- - Individual flags should be default:True +-- The intent of this flag is being able to keep the ghc condition for hackage+-- but skip it via flags in cabal.project as plugins for new ghcs usually+-- are buildable using cabal.project tweaks flag ignore-plugins-ghc-bounds   description: Force the inclusion of plugins even if they are not buildable by default with a specific ghc version   default:     False@@ -156,6 +166,21 @@   default:     True   manual:      True +flag alternateNumberFormat+  description: Enable Alternate Number Format plugin+  default:     True+  manual:      True++flag qualifyImportedNames+  description: Enable qualifyImportedNames plugin+  default:     True+  manual:      True++flag selectionRange+  description: Enable selectionRange plugin+  default:     True+  manual:      True+ -- formatters  flag floskell@@ -189,12 +214,12 @@                  Ide.Plugin.Example2  common class-  if flag(class) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds))+  if flag(class) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))     build-depends: hls-class-plugin ^>=1.0.0.1     cpp-options: -Dclass  common callHierarchy-  if flag(callHierarchy) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))+  if flag(callHierarchy)     build-depends: hls-call-hierarchy-plugin ^>=1.0.0.0     cpp-options: -DcallHierarchy @@ -214,7 +239,7 @@     cpp-options: -DimportLens  common refineImports-  if flag(refineImports) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))+  if flag(refineImports)     build-depends: hls-refine-imports-plugin ^>=1.0.0.0     cpp-options: -DrefineImports @@ -230,11 +255,11 @@  common tactic   if flag(tactic) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds))-    build-depends: hls-tactics-plugin >=1.2.0.0 && <1.6+    build-depends: hls-tactics-plugin >=1.2.0.0 && <1.7     cpp-options: -Dtactic  common hlint-  if flag(hlint)+  if flag(hlint) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))     build-depends: hls-hlint-plugin ^>=1.0.0.2     cpp-options: -Dhlint @@ -253,15 +278,30 @@     build-depends: hls-splice-plugin ^>=1.0.0.1     cpp-options: -Dsplice +common alternateNumberFormat+  if flag(alternateNumberFormat)+    build-depends: hls-alternate-number-format-plugin ^>=1.0.0.0+    cpp-options: -DalternateNumberFormat++common qualifyImportedNames+  if flag(qualifyImportedNames)+    build-depends: hls-qualify-imported-names-plugin ^>=1.0.0.0+    cpp-options: -DqualifyImportedNames++common selectionRange+  if flag(selectionRange)+    build-depends: hls-selection-range-plugin ^>=1.0.0.0+    cpp-options: -DselectionRange+ -- formatters  common floskell-  if flag(floskell) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds))+  if flag(floskell)     build-depends: hls-floskell-plugin ^>=1.0.0.0     cpp-options: -Dfloskell  common fourmolu-  if flag(fourmolu) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))+  if flag(fourmolu)     build-depends: hls-fourmolu-plugin ^>=1.0.0.0     cpp-options: -Dfourmolu @@ -276,12 +316,15 @@     cpp-options: -DstylishHaskell  common brittany-  if flag(brittany) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds))+  if flag(brittany) && (impl(ghc < 9.0.2) || flag(ignore-plugins-ghc-bounds))     build-depends: hls-brittany-plugin ^>=1.0.0.1     cpp-options: -Dbrittany  executable haskell-language-server   import:             common-deps+                    -- configuration+                    , warnings+                    , pedantic                     -- plugins                     , example-plugins                     , callHierarchy@@ -297,6 +340,9 @@                     , moduleName                     , pragmas                     , splice+                    , alternateNumberFormat+                    , qualifyImportedNames+                    , selectionRange                     , floskell                     , fourmolu                     , ormolu@@ -308,12 +354,13 @@   other-modules:    Plugins    ghc-options:-    -threaded -Wall -Wno-name-shadowing -Wredundant-constraints+    -threaded     -- allow user RTS overrides     -rtsopts     -- disable idle GC     -- increase nursery size-    "-with-rtsopts=-I0 -A128M"+    -- Enable collection of heap statistics+    "-with-rtsopts=-I0 -A128M -T"     -Wno-unticked-promoted-constructors   if flag(pedantic)     ghc-options: -Werror@@ -346,6 +393,7 @@     , safe-exceptions     , hls-graph     , sqlite-simple+    , stm     , temporary     , transformers     , unordered-containers@@ -355,19 +403,19 @@  executable haskell-language-server-wrapper   import:           common-deps+                  , warnings+                  , pedantic   main-is:          Wrapper.hs   hs-source-dirs:   exe   other-modules:    Paths_haskell_language_server   autogen-modules:  Paths_haskell_language_server   ghc-options:-    -threaded -Wall -Wno-name-shadowing -Wredundant-constraints+    -threaded     -- allow user RTS overrides     -rtsopts     -- disable idle GC     -- increase nursery size     "-with-rtsopts=-I0 -A128M"-  if flag(pedantic)-    ghc-options: -Werror    build-depends:     , data-default@@ -386,6 +434,8 @@  test-suite func-test   import:             common-deps+                    , warnings+                    , pedantic   type:               exitcode-stdio-1.0   default-language:   Haskell2010   build-tool-depends:@@ -397,8 +447,9 @@     , data-default     , hspec-expectations     , lens+    , lens-aeson     , ghcide-    , hls-test-utils ^>= 1.1.0.0+    , hls-test-utils ^>=1.2     , lsp-types     , aeson     , hls-plugin-api@@ -419,7 +470,6 @@     Format     FunctionalBadProject     FunctionalCodeAction-    FunctionalLiquid     HieBios     Highlight     Progress@@ -431,23 +481,23 @@    default-extensions: OverloadedStrings   ghc-options:-    -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N -Wno-unticked-promoted-constructors--  if flag(pedantic)-    ghc-options: -Werror -Wredundant-constraints+    -threaded -rtsopts -with-rtsopts=-N  -- Duplicating inclusion plugin conditions until tests are moved to their own packages   if flag(eval)     cpp-options: -Deval -- formatters-  if flag(floskell) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds))+  if flag(floskell) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))     cpp-options: -Dfloskell-  if flag(fourmolu) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))+  if flag(fourmolu)     cpp-options: -Dfourmolu   if flag(ormolu)     cpp-options: -Dormolu  test-suite wrapper-test+  import:             common-deps+                    , warnings+                    , pedantic   type:               exitcode-stdio-1.0   build-tool-depends:     haskell-language-server:haskell-language-server-wrapper -any,@@ -455,12 +505,8 @@    default-language:   Haskell2010   build-depends:-    , base-    , directory-    , process+      process     , hls-test-utils-    , extra    hs-source-dirs:     test/wrapper   main-is:            Main.hs-  ghc-options:        -Wall
plugins/default/src/Ide/Plugin/Example.hs view
@@ -14,6 +14,7 @@     descriptor   ) where +import           Control.Concurrent.STM import           Control.DeepSeq            (NFData) import           Control.Monad.IO.Class import           Control.Monad.Trans.Maybe@@ -26,7 +27,7 @@ import           Development.IDE            as D import           Development.IDE.Core.Shake (getDiagnostics,                                              getHiddenDiagnostics)-import           Development.IDE.GHC.Compat (ParsedModule (ParsedModule))+import           Development.IDE.GHC.Compat import           GHC.Generics import           Ide.PluginUtils import           Ide.Types@@ -108,15 +109,18 @@ -- | 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 Nothing-    pure $ Right $ List-        [ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing]+    let mbnfp = uriToNormalizedFilePath $ toNormalizedUri uri+    case mbnfp of+      Just nfp -> do+        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 Nothing+        pure $ Right $ List+            [ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing]+      Nothing -> error $ "Unable to get a normalized file path from the uri: " ++ show uri  -- --------------------------------------------------------------------- @@ -126,8 +130,8 @@     case uriToFilePath' uri of       Just (toNormalizedFilePath -> filePath) -> do         _ <- runIdeAction "Example.codeLens" (shakeExtras ideState) $ runMaybeT $ useE TypeCheck filePath-        _diag <- getDiagnostics ideState-        _hDiag <- getHiddenDiagnostics ideState+        _diag <- atomically $ getDiagnostics ideState+        _hDiag <- atomically $ getHiddenDiagnostics ideState         let           title = "Add TODO Item via Code Lens"           -- tedit = [TextEdit (Range (Position 3 0) (Position 3 0))
plugins/default/src/Ide/Plugin/Example2.hs view
@@ -14,6 +14,7 @@     descriptor   ) where +import           Control.Concurrent.STM import           Control.DeepSeq            (NFData) import           Control.Monad.IO.Class import           Control.Monad.Trans.Maybe@@ -116,8 +117,8 @@     case uriToFilePath' uri of       Just (toNormalizedFilePath -> filePath) -> do         _ <- runIdeAction (fromNormalizedFilePath filePath) (shakeExtras ideState) $ runMaybeT $ useE TypeCheck filePath-        _diag <- getDiagnostics ideState-        _hDiag <- getHiddenDiagnostics ideState+        _diag <- atomically $ getDiagnostics ideState+        _hDiag <- atomically $ getHiddenDiagnostics ideState         let           title = "Add TODO2 Item via Code Lens"           range = Range (Position 3 0) (Position 4 0)
src/Ide/Arguments.hs view
@@ -1,151 +1,151 @@--- Copyright (c) 2019 The DAML Authors. All rights reserved.--- SPDX-License-Identifier: Apache-2.0-{-# LANGUAGE CPP             #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections   #-}-{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above--module Ide.Arguments-  ( Arguments(..)-  , GhcideArguments(..)-  , PrintVersion(..)-  , BiosAction(..)-  , getArguments-  , haskellLanguageServerVersion-  , haskellLanguageServerNumericVersion-  ) where--import           Data.Version-import           Development.GitRev-import           Development.IDE               (IdeState)-import           Development.IDE.Main          (Command (..), commandP)-import           Ide.Types                     (IdePlugins)-import           Options.Applicative-import           Paths_haskell_language_server-import           System.Environment---- -----------------------------------------------------------------------data Arguments-  = VersionMode PrintVersion-  | ProbeToolsMode-  | ListPluginsMode-  | BiosMode BiosAction-  | Ghcide GhcideArguments-  | VSCodeExtensionSchemaMode-  | DefaultConfigurationMode--data GhcideArguments = GhcideArguments-    {argsCommand            :: Command-    ,argsCwd                :: Maybe FilePath-    ,argsShakeProfiling     :: Maybe FilePath-    ,argsTesting            :: Bool-    ,argsExamplePlugin      :: Bool-    -- These next two are for compatibility with existing hie clients, allowing-    -- them to just change the name of the exe and still work.-    , argsDebugOn           :: Bool-    , argsLogFile           :: Maybe String-    , argsThreads           :: Int-    , argsProjectGhcVersion :: Bool-    } deriving Show--data PrintVersion-  = PrintVersion-  | PrintNumericVersion-  deriving (Show, Eq, Ord)--data BiosAction-  = PrintCradleType-  deriving (Show, Eq, Ord)--getArguments :: String -> IdePlugins IdeState -> IO Arguments-getArguments exeName plugins = execParser opts-  where-    opts = info ((-      VersionMode <$> printVersionParser exeName-      <|> probeToolsParser exeName-      <|> listPluginsParser-      <|> BiosMode <$> biosParser-      <|> Ghcide <$> arguments plugins-      )-      <**> 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))--biosParser :: Parser BiosAction-biosParser =-  flag' PrintCradleType-    (long "print-cradle" <> help "Print the project cradle type")--probeToolsParser :: String -> Parser Arguments-probeToolsParser exeName =-  flag' ProbeToolsMode-    (long "probe-tools" <> help ("Show " ++ exeName  ++ " version and other tools of interest"))--listPluginsParser :: Parser Arguments-listPluginsParser =-  flag' ListPluginsMode-    (long "list-plugins" <> help "List all avaliable plugins")--arguments :: IdePlugins IdeState -> Parser GhcideArguments-arguments plugins = GhcideArguments-      <$> (commandP plugins <|> lspCommand <|> checkCommand)-      <*> optional (strOption $ long "cwd" <> metavar "DIR"-                  <> help "Change to this directory")-      <*> 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")-    where-        lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP server")-        checkCommand = Check <$> many (argument str (metavar "FILES/DIRS..."))---- -----------------------------------------------------------------------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             #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections   #-}
+{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above
+
+module Ide.Arguments
+  ( Arguments(..)
+  , GhcideArguments(..)
+  , PrintVersion(..)
+  , BiosAction(..)
+  , getArguments
+  , haskellLanguageServerVersion
+  , haskellLanguageServerNumericVersion
+  ) where
+
+import           Data.Version
+import           Development.IDE               (IdeState)
+import           Development.IDE.Main          (Command (..), commandP)
+import           GitHash                       (giHash, tGitInfoCwdTry)
+import           Ide.Types                     (IdePlugins)
+import           Options.Applicative
+import           Paths_haskell_language_server
+import           System.Environment
+
+-- ---------------------------------------------------------------------
+
+data Arguments
+  = VersionMode PrintVersion
+  | ProbeToolsMode
+  | ListPluginsMode
+  | BiosMode BiosAction
+  | Ghcide GhcideArguments
+  | VSCodeExtensionSchemaMode
+  | DefaultConfigurationMode
+
+data GhcideArguments = GhcideArguments
+    {argsCommand            :: Command
+    ,argsCwd                :: Maybe FilePath
+    ,argsShakeProfiling     :: Maybe FilePath
+    ,argsTesting            :: Bool
+    ,argsExamplePlugin      :: Bool
+    -- These next two are for compatibility with existing hie clients, allowing
+    -- them to just change the name of the exe and still work.
+    , argsDebugOn           :: Bool
+    , argsLogFile           :: Maybe String
+    , argsThreads           :: Int
+    , argsProjectGhcVersion :: Bool
+    } deriving Show
+
+data PrintVersion
+  = PrintVersion
+  | PrintNumericVersion
+  deriving (Show, Eq, Ord)
+
+data BiosAction
+  = PrintCradleType
+  deriving (Show, Eq, Ord)
+
+getArguments :: String -> IdePlugins IdeState -> IO Arguments
+getArguments exeName plugins = execParser opts
+  where
+    opts = info ((
+      VersionMode <$> printVersionParser exeName
+      <|> probeToolsParser exeName
+      <|> listPluginsParser
+      <|> BiosMode <$> biosParser
+      <|> Ghcide <$> arguments plugins
+      )
+      <**> 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))
+
+biosParser :: Parser BiosAction
+biosParser =
+  flag' PrintCradleType
+    (long "print-cradle" <> help "Print the project cradle type")
+
+probeToolsParser :: String -> Parser Arguments
+probeToolsParser exeName =
+  flag' ProbeToolsMode
+    (long "probe-tools" <> help ("Show " ++ exeName  ++ " version and other tools of interest"))
+
+listPluginsParser :: Parser Arguments
+listPluginsParser =
+  flag' ListPluginsMode
+    (long "list-plugins" <> help "List all available plugins")
+
+arguments :: IdePlugins IdeState -> Parser GhcideArguments
+arguments plugins = GhcideArguments
+      <$> (commandP plugins <|> lspCommand <|> checkCommand)
+      <*> optional (strOption $ long "cwd" <> metavar "DIR"
+                  <> help "Change to this directory")
+      <*> 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")
+    where
+        lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP server")
+        checkCommand = Check <$> many (argument str (metavar "FILES/DIRS..."))
+
+-- ---------------------------------------------------------------------
+
+haskellLanguageServerNumericVersion :: String
+haskellLanguageServerNumericVersion = showVersion version
+
+haskellLanguageServerVersion :: IO String
+haskellLanguageServerVersion = do
+  path <- getExecutablePath
+  let gi = $$tGitInfoCwdTry
+      gitHashSection = case gi of
+        Right gi -> " (GIT hash: " <> giHash gi <> ")"
+        Left _   -> ""
+  return $ "haskell-language-server version: " <> haskellLanguageServerNumericVersion
+             <> " (GHC: " <> VERSION_ghc
+             <> ") (PATH: " <> path <> ")"
+             <> gitHashSection
src/Ide/Version.hs view
@@ -1,79 +1,82 @@-{-# LANGUAGE CPP               #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TemplateHaskell   #-}--- | Information and display strings for HIE's version--- and the current project's version-module Ide.Version where--import           Data.Maybe                    (listToMaybe)-import           Data.Version-import           Development.GitRev            (gitCommitCount)-import           Options.Applicative.Simple    (simpleVersion)-import qualified Paths_haskell_language_server as Meta-import           System.Directory-import           System.Exit-import           System.Info-import           System.Process-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-    [ "cabal:\t\t" ++ showVersionWithDefault cabalVersion-    , "stack:\t\t" ++ showVersionWithDefault stackVersion-    , "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 CPP               #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
+-- | Information and display strings for HIE's version
+-- and the current project's version
+module Ide.Version where
+
+import           Data.Maybe                    (listToMaybe)
+import           Data.Version
+import           GitHash                       (giCommitCount, tGitInfoCwdTry)
+import           Options.Applicative.Simple    (simpleVersion)
+import qualified Paths_haskell_language_server as Meta
+import           System.Directory
+import           System.Exit
+import           System.Info
+import           System.Process
+import           Text.ParserCombinators.ReadP
+
+-- >>> hlsVersion
+hlsVersion :: String
+hlsVersion =
+  let gi = $$tGitInfoCwdTry
+      commitCount = case gi of
+        Right gi -> show $ giCommitCount gi
+        Left _   -> "UNKNOWN"
+  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
+    [ "cabal:\t\t" ++ showVersionWithDefault cabalVersion
+    , "stack:\t\t" ++ showVersionWithDefault stackVersion
+    , "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/Completion.hs view
@@ -37,19 +37,20 @@          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}"+         let eResolved = resolvedRes ^. result+         case eResolved of+             Right 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}"+             _ -> error $ "Unexpected resolved value: " ++ show eResolved -     , testCase "completes imports" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+     , testCase "completes imports" $ runSession (hlsCommand <> " --test") fullCaps "test/testdata/completion" $ do          doc <- openDoc "Completion.hs" "haskell" -         _ <- waitForDiagnostics+         waitForKickDone           let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M"          _ <- applyEdit doc te@@ -61,10 +62,10 @@              item ^. detail @?= Just "Data.Maybe"              item ^. kind @?= Just CiModule -     , testCase "completes qualified imports" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+     , testCase "completes qualified imports" $ runSession (hlsCommand <> " --test") fullCaps "test/testdata/completion" $ do          doc <- openDoc "Completion.hs" "haskell" -         _ <- waitForDiagnostics+         _ <- waitForKickDone           let te = TextEdit (Range (Position 2 17) (Position 2 25)) "Data.L"          _ <- applyEdit doc te@@ -94,7 +95,6 @@          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" @@ -261,6 +261,17 @@         doc <- openDoc "Completion.hs" "haskell"          checkNoSnippets doc+    , testCase "works for record fields sharing the single signature" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+         doc <- openDoc "FieldsSharingSignature.hs" "haskell"++         let te = TextEdit (Range (Position 1 0) (Position 1 2)) "MkF"+         _ <- applyEdit doc te++         compls <- getCompletions doc (Position 1 6)+         let item = head $ filter (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls+         liftIO $ do+            item ^. insertTextFormat @?= Just Snippet+            item ^. insertText @?= Just "MkFoo {arg1=${1:_arg1}, arg2=${2:_arg2}, arg3=${3:_arg3}, arg4=${4:_arg4}, arg5=${5:_arg5}}"     ]     where         checkNoSnippets doc = do
test/functional/Diagnostic.hs view
@@ -3,9 +3,6 @@ module Diagnostic (tests) where  import           Control.Lens            hiding (List)-import           Data.Aeson              (toJSON)-import qualified Data.Default-import           Ide.Plugin.Config import qualified Language.LSP.Types.Lens as LSP import           Test.Hls import           Test.Hls.Command@@ -15,7 +12,6 @@ tests :: TestTree tests = testGroup "diagnostics providers" [         basicTests-        , saveTests         , warningTests     ] @@ -41,24 +37,3 @@             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-            sendConfigurationChanged (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/FunctionalCodeAction.hs view
@@ -4,17 +4,17 @@  module FunctionalCodeAction (tests) where -import           Control.Lens                    hiding (List)+import           Control.Lens            hiding (List) import           Control.Monad import           Data.Aeson-import qualified Data.HashMap.Strict             as HM+import           Data.Aeson.Lens         (_Object) import           Data.List-import qualified Data.Map                        as M+import qualified Data.Map                as M import           Data.Maybe-import qualified Data.Text                       as T+import qualified Data.Text               as T import           Ide.Plugin.Config-import           Language.LSP.Test               as Test-import qualified Language.LSP.Types.Lens         as L+import           Language.LSP.Test       as Test+import qualified Language.LSP.Types.Lens as L import           Test.Hls import           Test.Hspec.Expectations @@ -56,11 +56,13 @@              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"+            let mbArgs = cmd ^. L.arguments+            case mbArgs of+                Just (List [args]) -> liftIO $ do+                    let editParams = args ^. ix "fallbackWorkspaceEdit" . _Object+                    (editParams & has (ix "changes"))  @? "Contains changes"+                    not (editParams & has (ix "documentChanges")) @? "Doesn't contain documentChanges"+                _ -> error $ "Unexpected arguments: " ++ show mbArgs              executeCommand cmd             _ <- anyRequest@@ -115,14 +117,16 @@                 in liftIO $ any (`T.isPrefixOf` (diag ^. L.message)) prefixes @? "Contains prefix"              acts <- getAllCodeActions doc-            let (InR action:_) = acts+            case acts of+                (InR action:_) -> do+                    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" -            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 -            executeCodeAction action+                _ -> error $ "Unexpected code actions: " ++ show acts              contents <- skipManyTill anyMessage $ getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal"             liftIO $@@ -175,15 +179,19 @@              liftIO $ actionTitles `shouldContain` ["Remove import", "Remove all redundant imports"] -            let Just removeAction = find (\x -> x ^. L.title == "Remove import") allActions+            let mbRemoveAction = 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"+            case mbRemoveAction of+                Just removeAction -> do+                    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+                    executeCodeAction removeAction +                Nothing -> error $ "Unexpected code actions: " ++ show allActions+             -- No command/applyworkspaceedit should be here, since action             -- provides workspace edit property which skips round trip to             -- the server@@ -231,7 +239,7 @@                     , "foo x = maxBound"                     ] -      , expectFailIfGhc9 "The wingman plugin doesn't yet compile in GHC9" $+      , expectFailIfGhc92 "The wingman plugin doesn't yet compile in GHC92" $         testCase "doesn't work when wingman is active" $         runSession hlsCommand fullCaps "test/testdata" $ do             doc <- openDoc "TypedHoles.hs" "haskell"@@ -266,8 +274,8 @@                         , "    stuff (A a) = A (a + 1)"                         ] -      , expectFailIfGhc9 "The wingman plugin doesn't yet compile in GHC9" $-        testCase "doesnt show more suggestions when wingman is active" $+      , expectFailIfGhc92 "The wingman plugin doesn't yet compile in GHC92" $+          testCase "doesnt show more suggestions when wingman is active" $             runSession hlsCommand fullCaps "test/testdata" $ do                 doc <- openDoc "TypedHoles2.hs" "haskell"                 _ <- waitForDiagnosticsFromSource doc "typecheck"@@ -344,21 +352,19 @@         liftIO $ do             let cas = map fromAction res                 kinds = map (^. L.kind) cas-            nub kinds @?= [Just CodeActionRefactorInline, Just CodeActionRefactorExtract, Just CodeActionQuickFix]+            assertBool "Test precondition failed" $ Just CodeActionQuickFix `elem` kinds         -- Verify that that when we set the only parameter, we only get actions         -- of the right kind.         ResponseMessage _ _ (Right (List res)) <- request STextDocumentCodeAction params         liftIO $ do             let cas = map fromAction res                 kinds = map (^. L.kind) cas-            nub kinds @?= nub [Just CodeActionRefactorInline, Just CodeActionRefactorExtract]+            assertBool "Quick fixes should have been filtered out"+              $ Just CodeActionQuickFix `notElem` kinds     ] -expectFailIfGhc9 :: String -> TestTree -> TestTree-expectFailIfGhc9 reason =-  case ghcVersion of-    GHC90 -> expectFailBecause reason-    _     -> id+expectFailIfGhc92 :: String -> TestTree -> TestTree+expectFailIfGhc92 = knownBrokenForGhcVersions [GHC92]  disableWingman :: Session () disableWingman =
− test/functional/FunctionalLiquid.hs
@@ -1,31 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module FunctionalLiquid (tests) where--import           Control.Lens            hiding (List)-import           Data.Aeson-import           Ide.Plugin.Config-import           Language.LSP.Types.Lens as LSP hiding (contents)-import           Test.Hls-import           Test.Hls.Command---- -----------------------------------------------------------------------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 }-            sendConfigurationChanged (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/HieBios.hs view
@@ -17,9 +17,12 @@         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"+            let hoverContents = mainHoverText ^. L.contents+            case hoverContents of+                 (HoverContents (MarkupContent _ x)) -> do+                    liftIO $ "main :: IO ()" `T.isInfixOf` x+                            @? "found hover text for main"+                 _ -> error $ "Unexpected hover contents: " ++ show hoverContents      , testCase "reports errors in hie.yaml" $ do         writeFile (hieBiosErrorPath </> "hie.yaml") ""
test/functional/Main.hs view
@@ -9,7 +9,6 @@ import           Format import           FunctionalBadProject import           FunctionalCodeAction-import           FunctionalLiquid import           HieBios import           Highlight import           Progress@@ -28,10 +27,9 @@             , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Tests gets stuck in ci" $ Deferred.tests             , Definition.tests             , Diagnostic.tests-            , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Tests gets stuck in ci" $ Format.tests+            , ignoreInEnv [HostOS Windows, GhcVer GHC90, GhcVer GHC92] "Tests gets stuck in ci" $ Format.tests             , FunctionalBadProject.tests             , FunctionalCodeAction.tests-            , FunctionalLiquid.tests             , HieBios.tests             , Highlight.tests             , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Tests gets stuck in ci" $ Progress.tests
test/functional/Progress.hs view
@@ -4,16 +4,18 @@ {-# LANGUAGE GADTs                 #-} {-# LANGUAGE LambdaCase            #-} {-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE PolyKinds             #-}  module Progress (tests) where +import           Control.Exception               (throw) import           Control.Lens                    hiding ((.=)) import           Data.Aeson                      (Value, decode, encode, object,-                                                  toJSON, (.=))+                                                  (.=)) import           Data.List                       (delete) import           Data.Maybe                      (fromJust) import           Data.Text                       (Text, pack)-import           Ide.Plugin.Config+import qualified Language.LSP.Types              as LSP import           Language.LSP.Types.Capabilities import qualified Language.LSP.Types.Lens         as L import           System.FilePath                 ((</>))@@ -21,6 +23,7 @@ import           Test.Hls.Command import           Test.Hls.Flags + tests :: TestTree tests =     testGroup@@ -29,86 +32,138 @@             runSession hlsCommand progressCaps "test/testdata" $ do                 let path = "diagnostics" </> "Foo.hs"                 _ <- openDoc path "haskell"-                expectProgressReports [pack ("Setting up testdata (for " ++ path ++ ")"), "Processing", "Indexing"]+                expectProgressMessages [pack ("Setting up testdata (for " ++ path ++ ")"), "Processing", "Indexing"] []         , requiresEvalPlugin $ 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", "Indexing"]-                [evalLens] <- getCodeLenses doc-                let cmd = evalLens ^?! L.command . _Just-                _ <- sendRequest SWorkspaceExecuteCommand $ ExecuteCommandParams Nothing (cmd ^. L.command) (decode $ encode $ fromJust $ cmd ^. L.arguments)-                expectProgressReports ["Evaluating"]+              doc <- openDoc "T1.hs" "haskell"+              lspId <- sendRequest STextDocumentCodeLens (CodeLensParams Nothing Nothing doc)++              (codeLensResponse, activeProgressTokens) <- expectProgressMessagesTill+                (responseForId STextDocumentCodeLens lspId)+                ["Setting up testdata (for T1.hs)", "Processing", "Indexing"]+                []++              -- this is a test so exceptions result in fails+              let response = getResponseResult codeLensResponse+              case response of+                  LSP.List [evalLens] -> do+                      let command = evalLens ^?! L.command . _Just++                      _ <- sendRequest SWorkspaceExecuteCommand $+                          ExecuteCommandParams+                          Nothing+                          (command ^. L.command)+                          (decode $ encode $ fromJust $ command ^. L.arguments)++                      expectProgressMessages ["Evaluating"] activeProgressTokens+                  _ -> error $ "Unexpected response result: " ++ show response         , requiresOrmoluPlugin $ testCase "ormolu plugin sends progress notifications" $ do             runSession hlsCommand progressCaps "test/testdata/format" $ do                 sendConfigurationChanged (formatLspConfig "ormolu")                 doc <- openDoc "Format.hs" "haskell"-                expectProgressReports ["Setting up testdata (for Format.hs)", "Processing", "Indexing"]+                expectProgressMessages ["Setting up testdata (for Format.hs)", "Processing", "Indexing"] []                 _ <- sendRequest STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing)-                expectProgressReports ["Formatting Format.hs"]+                expectProgressMessages ["Formatting Format.hs"] []         , requiresFourmoluPlugin $ testCase "fourmolu plugin sends progress notifications" $ do             runSession hlsCommand progressCaps "test/testdata/format" $ do                 sendConfigurationChanged (formatLspConfig "fourmolu")                 doc <- openDoc "Format.hs" "haskell"-                expectProgressReports ["Setting up testdata (for Format.hs)", "Processing", "Indexing"]+                expectProgressMessages ["Setting up testdata (for Format.hs)", "Processing", "Indexing"] []                 _ <- 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}-                    sendConfigurationChanged (toJSON config)-                    sendNotification STextDocumentDidSave (DidSaveTextDocumentParams doc Nothing)-                    expectProgressReports ["Running Liquid Haskell on Evens.hs"]+                expectProgressMessages ["Formatting Format.hs"] []         ]  formatLspConfig :: Value -> Value formatLspConfig provider = object ["haskell" .= object ["formattingProvider" .= (provider :: Value)]]  progressCaps :: ClientCapabilities-progressCaps = fullCaps{_window = Just (WindowClientCapabilities (Just True))}+progressCaps = fullCaps{_window = Just (WindowClientCapabilities (Just True) Nothing Nothing)} -data CollectedProgressNotification-    = CreateM WorkDoneProgressCreateParams-    | BeginM (ProgressParams WorkDoneProgressBeginParams)-    | ProgressM (ProgressParams WorkDoneProgressReportParams)-    | EndM (ProgressParams WorkDoneProgressEndParams)+data ProgressMessage+  = ProgressCreate WorkDoneProgressCreateParams+  | ProgressBegin (ProgressParams WorkDoneProgressBeginParams)+  | ProgressReport (ProgressParams WorkDoneProgressReportParams)+  | ProgressEnd (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+data InterestingMessage a+  = InterestingMessage a+  | ProgressMessage ProgressMessage++progressMessage :: Session ProgressMessage+progressMessage =+  progressCreate <|> progressBegin <|> progressReport <|> progressEnd   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 $ 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+    progressCreate = ProgressCreate . view L.params <$> message SWindowWorkDoneProgressCreate+    progressBegin = ProgressBegin <$> satisfyMaybe (\case       FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (Begin x))) -> Just (ProgressParams t x)       _ -> Nothing)-    progress = ProgressM <$> satisfyMaybe (\case+    progressReport = ProgressReport <$> satisfyMaybe (\case       FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (Report x))) -> Just (ProgressParams t x)       _ -> Nothing)-    end = EndM <$> satisfyMaybe (\case+    progressEnd = ProgressEnd <$> satisfyMaybe (\case       FromServerMess SProgress (NotificationMessage _ _ (ProgressParams t (End x))) -> Just (ProgressParams t x)       _ -> Nothing)-    expectElem a as = a `elem` as @? "Unexpected " ++ show a++interestingMessage :: Session a -> Session (InterestingMessage a)+interestingMessage theMessage =+  fmap InterestingMessage theMessage <|> fmap ProgressMessage progressMessage++expectProgressMessagesTill :: Session a -> [Text] -> [ProgressToken] -> Session (a, [ProgressToken])+expectProgressMessagesTill stopMessage expectedTitles activeProgressTokens = do+  message <- skipManyTill anyMessage (interestingMessage stopMessage)+  case message of+    InterestingMessage a -> do+      liftIO $ null expectedTitles @? "Expected titles not empty " <> show expectedTitles+      pure (a, activeProgressTokens)+    ProgressMessage progressMessage ->+      updateExpectProgressStateAndRecurseWith+        (expectProgressMessagesTill stopMessage)+        progressMessage+        expectedTitles+        activeProgressTokens++{- | 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.+-}+expectProgressMessages :: [Text] -> [ProgressToken] -> Session ()+expectProgressMessages [] [] = pure ()+expectProgressMessages expectedTitles activeProgressTokens = do+  message <- skipManyTill anyMessage progressMessage+  updateExpectProgressStateAndRecurseWith expectProgressMessages message expectedTitles activeProgressTokens++updateExpectProgressStateAndRecurseWith :: ([Text] -> [ProgressToken] -> Session a)+                                        -> ProgressMessage+                                        -> [Text]+                                        -> [ProgressToken]+                                        -> Session a+updateExpectProgressStateAndRecurseWith f progressMessage expectedTitles activeProgressTokens = do+  case progressMessage of+    ProgressCreate params -> do+      f expectedTitles (getToken params : activeProgressTokens)+    ProgressBegin params -> do+      liftIO $ getToken params `expectedIn` activeProgressTokens+      f (delete (getTitle params) expectedTitles) activeProgressTokens+    ProgressReport params -> do+      liftIO $ getToken params `expectedIn` activeProgressTokens+      f expectedTitles activeProgressTokens+    ProgressEnd params -> do+      liftIO $ getToken params `expectedIn` activeProgressTokens+      f expectedTitles (delete (getToken params) activeProgressTokens)++getTitle :: (L.HasValue s a1, L.HasTitle a1 a2) => s -> a2+getTitle msg = msg ^. L.value . L.title++getToken :: L.HasToken s a => s -> a+getToken msg = msg ^. L.token++expectedIn :: (Foldable t, Eq a, Show a) => a -> t a -> Assertion+expectedIn a as = a `elem` as @? "Unexpected " ++ show a++getResponseResult :: ResponseMessage m -> ResponseResult m+getResponseResult rsp =+  case rsp ^. L.result of+    Right x -> x+    Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) err
test/functional/TypeDefinition.hs view
@@ -37,7 +37,7 @@         InL defs <- getTypeDefinitions doc $ Position symbolLine symbolCol         liftIO $ defs `expectSameLocations` map (first3 (definitionsPath </>)) definitionLocations -getTypeDefinitionTest' :: Int -> Int -> Int -> Int -> Assertion+getTypeDefinitionTest' :: UInt -> UInt -> UInt -> UInt -> Assertion getTypeDefinitionTest' symbolLine symbolCol definitionLine definitionCol =     getTypeDefinitionTest ("src/Lib.hs", symbolLine, symbolCol)                           [("src/Lib.hs", definitionLine, definitionCol)]
+ test/testdata/completion/FieldsSharingSignature.hs view
@@ -0,0 +1,1 @@+data Foo = MkFoo { arg1, arg2, arg3 :: Int, arg4 :: Int, arg5 :: Double }
test/testdata/completion/hie.yaml view
@@ -4,3 +4,4 @@       - "Completion"       - "Context"       - "DupRecFields"+      - "FieldsSharingSignature"
test/testdata/hie.yaml view
@@ -1,6 +1,7 @@ cradle:   direct:     arguments:+      - "-Wmissing-signatures"       - "CodeActionImport"       - "CodeActionOnly"       - "CodeActionRename"
test/utils/Test/Hls/Command.hs view
@@ -23,7 +23,7 @@ {-# NOINLINE hlsCommand #-} hlsCommand = unsafePerformIO $ do   testExe <- fromMaybe "haskell-language-server" <$> lookupEnv "HLS_TEST_EXE"-  pure $ testExe ++ " --lsp -d -j4 -l test-logs/" ++ logFilePath+  pure $ testExe ++ " --lsp -d -j4"  hlsCommandVomit :: String hlsCommandVomit = hlsCommand ++ " --vomit"
test/wrapper/Main.hs view
@@ -11,10 +11,8 @@  projectGhcVersionTests :: TestTree projectGhcVersionTests = testGroup "--project-ghc-version"-  [ testCase "stack with ghc 8.10.7" $-      testDir "test/wrapper/testdata/stack-8.10.7" "8.10.7"-  , testCase "stack with ghc 8.8.3" $-      testDir "test/wrapper/testdata/stack-8.8.3" "8.8.3"+  [ stackTest "8.10.7"+  , stackTest "8.8.4"   , testCase "cabal with global ghc" $ do       ghcVer <- trimEnd <$> readProcess "ghc" ["--numeric-version"] ""       testDir "test/wrapper/testdata/cabal-cur-ver" ghcVer@@ -24,6 +22,9 @@       testProjectType "test/wrapper/testdata/stack-with-dist-newstyle"         ("cradleOptsProg = CradleAction: Cabal" `isInfixOf`)   ]+  where+      stackTest ghcVer= testCase ("stack with ghc " ++ ghcVer) $+        testDir ("test/wrapper/testdata/stack-" ++ ghcVer) ghcVer  testDir :: FilePath -> String -> Assertion testDir dir expectedVer =