diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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: diff --git a/exe/Plugins.hs b/exe/Plugins.hs --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -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 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1,7 +1,7 @@ cabal-version: 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 @@ -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 diff --git a/plugins/default/src/Ide/Plugin/Example.hs b/plugins/default/src/Ide/Plugin/Example.hs --- a/plugins/default/src/Ide/Plugin/Example.hs +++ b/plugins/default/src/Ide/Plugin/Example.hs @@ -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)) diff --git a/plugins/default/src/Ide/Plugin/Example2.hs b/plugins/default/src/Ide/Plugin/Example2.hs --- a/plugins/default/src/Ide/Plugin/Example2.hs +++ b/plugins/default/src/Ide/Plugin/Example2.hs @@ -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) diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs --- a/src/Ide/Arguments.hs +++ b/src/Ide/Arguments.hs @@ -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 diff --git a/src/Ide/Version.hs b/src/Ide/Version.hs --- a/src/Ide/Version.hs +++ b/src/Ide/Version.hs @@ -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 diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -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 diff --git a/test/functional/Diagnostic.hs b/test/functional/Diagnostic.hs --- a/test/functional/Diagnostic.hs +++ b/test/functional/Diagnostic.hs @@ -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 - ] diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -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 = diff --git a/test/functional/FunctionalLiquid.hs b/test/functional/FunctionalLiquid.hs deleted file mode 100644 --- a/test/functional/FunctionalLiquid.hs +++ /dev/null @@ -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 - ] diff --git a/test/functional/HieBios.hs b/test/functional/HieBios.hs --- a/test/functional/HieBios.hs +++ b/test/functional/HieBios.hs @@ -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") "" diff --git a/test/functional/Main.hs b/test/functional/Main.hs --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -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 diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -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 diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs --- a/test/functional/TypeDefinition.hs +++ b/test/functional/TypeDefinition.hs @@ -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)] diff --git a/test/testdata/completion/FieldsSharingSignature.hs b/test/testdata/completion/FieldsSharingSignature.hs new file mode 100644 --- /dev/null +++ b/test/testdata/completion/FieldsSharingSignature.hs @@ -0,0 +1,1 @@ +data Foo = MkFoo { arg1, arg2, arg3 :: Int, arg4 :: Int, arg5 :: Double } diff --git a/test/testdata/completion/hie.yaml b/test/testdata/completion/hie.yaml --- a/test/testdata/completion/hie.yaml +++ b/test/testdata/completion/hie.yaml @@ -4,3 +4,4 @@ - "Completion" - "Context" - "DupRecFields" + - "FieldsSharingSignature" diff --git a/test/testdata/hie.yaml b/test/testdata/hie.yaml --- a/test/testdata/hie.yaml +++ b/test/testdata/hie.yaml @@ -1,6 +1,7 @@ cradle: direct: arguments: + - "-Wmissing-signatures" - "CodeActionImport" - "CodeActionOnly" - "CodeActionRename" diff --git a/test/utils/Test/Hls/Command.hs b/test/utils/Test/Hls/Command.hs --- a/test/utils/Test/Hls/Command.hs +++ b/test/utils/Test/Hls/Command.hs @@ -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" diff --git a/test/wrapper/Main.hs b/test/wrapper/Main.hs --- a/test/wrapper/Main.hs +++ b/test/wrapper/Main.hs @@ -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 =