diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,217 @@ # Changelog for haskell-language-server +## 1.2.0 + +We have finally released a new version of Haskell Language Server! +Thanks for all contributors, many bugs has been fixed, and many features has landed. +Here are the summary of changes: + +- Basic support for GHC 9.0.1 is added. + It does not support all plugins yet, but core GHCIDE features will work. For the detailed information that which plugins work, please refer [this list](https://github.com/haskell/haskell-language-server/issues/297#issuecomment-855522891). +- Support for GHC 8.10.5 is added. + Note that macOS version is unfortunately not included in this release because of [a GHC issue with `network` package](https://gitlab.haskell.org/ghc/ghc/-/issues/19968). +- HLS wrapper and GHCIDE session loader uses the same logic with implicit-hie. + This fixes [a build issue](https://github.com/haskell/haskell-language-server/issues/1782) of a stack project with implicit `hie.yaml` . +- Wingman plugin has added numerous features and fixed many bugs: + - It now supports tactic metaprogramming! + For list of commands, see [this document](https://github.com/haskell/haskell-language-server/blob/master/plugins/hls-tactics-plugin/COMMANDS.md#wingman-metaprogram-command-reference). + ![https://github.com/haskell/haskell-language-server/blob/master/plugins/hls-tactics-plugin/COMMANDS.md#wingman-metaprogram-command-reference](https://user-images.githubusercontent.com/307223/118190278-bdf24f80-b3f7-11eb-8838-b08a2582d7f1.gif) + - "Refine hole" and "Split all function arguments" code actions are publicly opened. + - "Empty case split" code lens is added. + - The name generator is fixed [to avoid dangerous summon rituals](https://github.com/haskell/haskell-language-server/pull/1760). + - Many bugs related to type families and GADTs are fixed. +- We support [nix flake](https://nixos.wiki/wiki/Flakes), an upcoming way to manage dependencies in nix. +- Every plugin (other than example plugins) now lives in its own package. + +### Pull requests merged for 1.2.0 + +- Cleanup stack build output in circleci +([#1905](https://github.com/haskell/haskell-language-server/pull/1905)) by @jhrcek +- Remove FeatureSet +([#1902](https://github.com/haskell/haskell-language-server/pull/1902)) by @isovector +- Correct a typo in ConfigUtils.hs +([#1900](https://github.com/haskell/haskell-language-server/pull/1900)) by @felixonmars +- Add GHC 8.10.5 support +([#1899](https://github.com/haskell/haskell-language-server/pull/1899)) by @Ailrun +- Fix getCurrentDirectory calls in ghcide +([#1897](https://github.com/haskell/haskell-language-server/pull/1897)) by @pepeiborra +- Wingman: FIx evidence when using GADT constructors +([#1889](https://github.com/haskell/haskell-language-server/pull/1889)) by @isovector +- [explicit-imports] Take in a predicate to filter modules +([#1888](https://github.com/haskell/haskell-language-server/pull/1888)) by @pepeiborra +- Fix unification pertaining to evidence +([#1885](https://github.com/haskell/haskell-language-server/pull/1885)) by @isovector +- Let Wingman peek through type families +([#1881](https://github.com/haskell/haskell-language-server/pull/1881)) by @isovector +- Use file watches for all workspace files +([#1880](https://github.com/haskell/haskell-language-server/pull/1880)) by @pepeiborra +- Update IRC details in README.md +([#1877](https://github.com/haskell/haskell-language-server/pull/1877)) by @fendor +- Fix nix build for #1858 +([#1870](https://github.com/haskell/haskell-language-server/pull/1870)) by @berberman +- Wingman metaprogram command documentation +([#1867](https://github.com/haskell/haskell-language-server/pull/1867)) by @isovector +- Catamorphism and collapse tactics +([#1865](https://github.com/haskell/haskell-language-server/pull/1865)) by @isovector +- Fix condition of nix build job +([#1864](https://github.com/haskell/haskell-language-server/pull/1864)) by @berberman +- Technology preview: Keep track of changes to minimize rebuilds +([#1862](https://github.com/haskell/haskell-language-server/pull/1862)) by @pepeiborra +- Trace more Shake evaluation details +([#1861](https://github.com/haskell/haskell-language-server/pull/1861)) by @pepeiborra +- No need to delete the same key twice +([#1860](https://github.com/haskell/haskell-language-server/pull/1860)) by @pepeiborra +- Use cabal-install if nix is failing in CI +([#1859](https://github.com/haskell/haskell-language-server/pull/1859)) by @berberman +- Use last apply-refact and several stack.yaml updates +([#1858](https://github.com/haskell/haskell-language-server/pull/1858)) by @jneira +- Split ghcide actions into different descriptors +([#1857](https://github.com/haskell/haskell-language-server/pull/1857)) by @berberman +- Allow module-local and imported functions in Wingman metaprograms +([#1856](https://github.com/haskell/haskell-language-server/pull/1856)) by @isovector +- Update mergify.yml +([#1853](https://github.com/haskell/haskell-language-server/pull/1853)) by @Ailrun +- Fix flake compat +([#1852](https://github.com/haskell/haskell-language-server/pull/1852)) by @berberman +- Fix record layout +([#1851](https://github.com/haskell/haskell-language-server/pull/1851)) by @isovector +- Avoid package-qualified import in Fourmolu plugin +([#1848](https://github.com/haskell/haskell-language-server/pull/1848)) by @georgefst +- Skip cachix jobs if token is unset +([#1845](https://github.com/haskell/haskell-language-server/pull/1845)) by @berberman +- Refine should either do intros or split, not both +([#1842](https://github.com/haskell/haskell-language-server/pull/1842)) by @isovector +- Add hspec upper bound +([#1837](https://github.com/haskell/haskell-language-server/pull/1837)) by @jneira +- Extract last 2 plugins and clean up others +([#1836](https://github.com/haskell/haskell-language-server/pull/1836)) by @Ailrun +- Extract pragmas plugin +([#1833](https://github.com/haskell/haskell-language-server/pull/1833)) by @Ailrun +- Extract floskell plugin as a standalone plugin +([#1829](https://github.com/haskell/haskell-language-server/pull/1829)) by @Ailrun +- nix: refactor with flakes +([#1827](https://github.com/haskell/haskell-language-server/pull/1827)) by @berberman +- Bump up hls-splice-plugin to 1.0.0.2 (backport #1825) +([#1826](https://github.com/haskell/haskell-language-server/pull/1826)) by @mergify[bot] +- Bump up hls-splice-plugin to 1.0.0.2 +([#1825](https://github.com/haskell/haskell-language-server/pull/1825)) by @jneira +- Apply formats again +([#1824](https://github.com/haskell/haskell-language-server/pull/1824)) by @Ailrun +- Extract fourmolu plugin into a standalone package +([#1823](https://github.com/haskell/haskell-language-server/pull/1823)) by @gustavoavena +- Ignore filemode in diff +([#1819](https://github.com/haskell/haskell-language-server/pull/1819)) by @Ailrun +- ghc-api cleanups cleanup +([#1816](https://github.com/haskell/haskell-language-server/pull/1816)) by @pepeiborra +- Add a hook for modifying the dynflags from a plugin +([#1814](https://github.com/haskell/haskell-language-server/pull/1814)) by @isovector +- Prepare ghcide release v1.3.0.0 +([#1811](https://github.com/haskell/haskell-language-server/pull/1811)) by @pepeiborra +- Remove hls-ghc-x.y from install script and wrapper +([#1805](https://github.com/haskell/haskell-language-server/pull/1805)) by @berberman +- Fix unwanted import refinement +([#1801](https://github.com/haskell/haskell-language-server/pull/1801)) by @rayshih +- Canonicalize hiedb path before comparing +([#1800](https://github.com/haskell/haskell-language-server/pull/1800)) by @pepeiborra +- Pin nix-pre-commit-hooks (backport #1780) +([#1798](https://github.com/haskell/haskell-language-server/pull/1798)) by @mergify[bot] +- Add upper bound to hlint (backport #1795) +([#1797](https://github.com/haskell/haskell-language-server/pull/1797)) by @mergify[bot] +- Add bounds for base in hls-stylish-haskell-plugin (backport #1794) +([#1796](https://github.com/haskell/haskell-language-server/pull/1796)) by @mergify[bot] +- Add upper bound to hlint +([#1795](https://github.com/haskell/haskell-language-server/pull/1795)) by @jneira +- Add bounds for base in hls-stylish-haskell-plugin +([#1794](https://github.com/haskell/haskell-language-server/pull/1794)) by @berberman +- Add bounds for base in hls-test-utils (backport #1791) +([#1793](https://github.com/haskell/haskell-language-server/pull/1793)) by @mergify[bot] +- Replace faulty signature test +([#1792](https://github.com/haskell/haskell-language-server/pull/1792)) by @kderme +- Add bounds for base in hls-test-utils +([#1791](https://github.com/haskell/haskell-language-server/pull/1791)) by @berberman +- Fix backport conflict of refine-import plugin +([#1790](https://github.com/haskell/haskell-language-server/pull/1790)) by @Ailrun +- Fix progress counting +([#1789](https://github.com/haskell/haskell-language-server/pull/1789)) by @pepeiborra +- Loosen dependency bounds (backport #1787) +([#1788](https://github.com/haskell/haskell-language-server/pull/1788)) by @mergify[bot] +- Loosen dependency bounds +([#1787](https://github.com/haskell/haskell-language-server/pull/1787)) by @berberman +- clean up ghc-api pragmas +([#1785](https://github.com/haskell/haskell-language-server/pull/1785)) by @pepeiborra +- Progress reporting improvements +([#1784](https://github.com/haskell/haskell-language-server/pull/1784)) by @pepeiborra +- Unify session loading using implicit-hie +([#1783](https://github.com/haskell/haskell-language-server/pull/1783)) by @fendor +- Pin nix-pre-commit-hooks +([#1780](https://github.com/haskell/haskell-language-server/pull/1780)) by @Ailrun +- Replace the unsafe getmodtime with safe posix calls +([#1778](https://github.com/haskell/haskell-language-server/pull/1778)) by @pepeiborra +- Tactic metaprogramming +([#1776](https://github.com/haskell/haskell-language-server/pull/1776)) by @isovector +- Fix wrong extend import while type constuctor and data constructor have the same name +([#1775](https://github.com/haskell/haskell-language-server/pull/1775)) by @July541 +- Add codetriage badge +([#1772](https://github.com/haskell/haskell-language-server/pull/1772)) by @jneira +- Wingman: configurable auto search depth +([#1771](https://github.com/haskell/haskell-language-server/pull/1771)) by @isovector +- Prevent accidental Cthulhu summons +([#1760](https://github.com/haskell/haskell-language-server/pull/1760)) by @isovector +- Delay the Shake session setup until the Initialized handler +([#1754](https://github.com/haskell/haskell-language-server/pull/1754)) by @pepeiborra +- Wrap the Shake functions with newtypes +([#1753](https://github.com/haskell/haskell-language-server/pull/1753)) by @ndmitchell +- Fix reduction depth +([#1751](https://github.com/haskell/haskell-language-server/pull/1751)) by @pepeiborra +- Add hls-graph abstracting over shake +([#1748](https://github.com/haskell/haskell-language-server/pull/1748)) by @ndmitchell +- Explicitly import liftIO if you need it, rather than getting it from Shake +([#1747](https://github.com/haskell/haskell-language-server/pull/1747)) by @ndmitchell +- Tease apart the custom SYB from ExactPrint +([#1746](https://github.com/haskell/haskell-language-server/pull/1746)) by @isovector +- Remove unnecessary Shake dependencies +([#1745](https://github.com/haskell/haskell-language-server/pull/1745)) by @ndmitchell +- Delete an unused import +([#1744](https://github.com/haskell/haskell-language-server/pull/1744)) by @ndmitchell +- Improve vscode extension schema generation +([#1742](https://github.com/haskell/haskell-language-server/pull/1742)) by @berberman +- Fix class method completion +([#1741](https://github.com/haskell/haskell-language-server/pull/1741)) by @July541 +- Add heralds to Wingman's use of runAction +([#1740](https://github.com/haskell/haskell-language-server/pull/1740)) by @isovector +- Wingman: case split on punned record fields +([#1739](https://github.com/haskell/haskell-language-server/pull/1739)) by @isovector +- Wingman feature release +([#1735](https://github.com/haskell/haskell-language-server/pull/1735)) by @isovector +- Add haskell-language-server Homebrew installation instructions +([#1734](https://github.com/haskell/haskell-language-server/pull/1734)) by @kret +- Add a "Split using NamedFieldPuns" code action +([#1733](https://github.com/haskell/haskell-language-server/pull/1733)) by @isovector +- Insert pragmas after shebang or to existing pragma list +([#1731](https://github.com/haskell/haskell-language-server/pull/1731)) by @OliverMadine +- Add executable stanza in hls-install.cabal. +([#1730](https://github.com/haskell/haskell-language-server/pull/1730)) by @arrowd +- Add installation instructions for FreeBSD. +([#1729](https://github.com/haskell/haskell-language-server/pull/1729)) by @arrowd +- HLint: Pass options through user config +([#1724](https://github.com/haskell/haskell-language-server/pull/1724)) by @rmehri01 +- Prepare ghcide 1.2.0.2 and HLS 1.1.0 +([#1722](https://github.com/haskell/haskell-language-server/pull/1722)) by @berberman +- Wingman: Destruct on empty case +([#1721](https://github.com/haskell/haskell-language-server/pull/1721)) by @isovector +- Fix: #1690 - Infix typed holes are now filled using infix notation +([#1708](https://github.com/haskell/haskell-language-server/pull/1708)) by @OliverMadine +- Implement refine imports +([#1686](https://github.com/haskell/haskell-language-server/pull/1686)) by @rayshih +- Ghc 9.0.1 support for ghcide +([#1649](https://github.com/haskell/haskell-language-server/pull/1649)) by @anka-213 +- hie-compat: Add basic support for ghc 9.0.1 +([#1635](https://github.com/haskell/haskell-language-server/pull/1635)) by @anka-213 +- Fix remove constraint +([#1578](https://github.com/haskell/haskell-language-server/pull/1578)) by @kderme +- Limit CodeActions within passed range +([#1442](https://github.com/haskell/haskell-language-server/pull/1442)) by @aufarg + ## 1.1.0 Haskell Language Server 1.1.0 has finally come! Many thanks to all contributors -- since the last release, we have merged over 100 PRs! diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -7,6 +7,7 @@ [![CircleCI][badge-circleci]][circleci] ![Github Testing Workflow](https://github.com/haskell/haskell-language-server/workflows/Testing/badge.svg) ![Github Nix Workflow](https://github.com/haskell/haskell-language-server/workflows/Nix/badge.svg) +[![codetriage][badge-codetriage]][codetriage] [logo]: ./docs/logos/logo-256.png [badge-license]: https://img.shields.io/badge/license-Apache2-green.svg?dummy @@ -15,6 +16,8 @@ [circleci]: https://circleci.com/gh/haskell/haskell-language-server/ [badge-hackage]: https://img.shields.io/hackage/v/haskell-language-server.svg?logo=haskell [hackage]: https://hackage.haskell.org/package/haskell-language-server +[badge-codetriage]: https://www.codetriage.com/haskell/haskell-language-server/badges/users.svg +[codetriage]:https://www.codetriage.com/haskell/haskell-language-server Integration point for [ghcide](https://github.com/haskell/ghcide) and [haskell-ide-engine](https://github.com/haskell/haskell-ide-engine). One IDE to rule them all. Read the [project's @@ -28,6 +31,7 @@ - [Visual Studio Code](#visual-studio-code) - [Pre-built binaries](#pre-built-binaries) - [Arch Linux](#arch-linux) + - [FreeBSD](#freebsd) - [Installation from source](#installation-from-source) - [Common pre-requirements](#common-pre-requirements) - [Linux-specific pre-requirements](#linux-specific-pre-requirements) @@ -37,6 +41,7 @@ - [Install via cabal](#install-via-cabal) - [Install specific GHC Version](#install-specific-ghc-version) - [Installation from Hackage](#installation-from-hackage) + - [Installation via Homebrew](#installation-via-homebrew) - [Configuring `haskell-language-server`](#configuring-haskell-language-server) - [Generic server options](#generic-server-options) - [Generic editor options](#generic-editor-options) @@ -73,6 +78,7 @@ - [Using Cabal](#using-cabal) - [Using Stack](#using-stack) - [Using Nix](#using-nix) + - [Flakes support](#flakes-support) - [Introduction tutorial](#introduction-tutorial) - [Test your hacked HLS in your editor](#test-your-hacked-hls-in-your-editor) - [Adding support for a new editor](#adding-support-for-a-new-editor) @@ -155,6 +161,17 @@ In this case, `haskell-language-server` is compiled against the GHC distributed to Arch Linux, so you will need maintain a system wide Haskell development environment, and install GHC from `pacman` as well. See [ArchWiki](https://wiki.archlinux.org/index.php/Haskell) for the details of Haskell infrastructure on Arch Linux. +### FreeBSD + +HLS is available for installation from official binary packages. Use + +``` +pkg install hs-haskell-language-server +``` + +to install it. At the moment, HLS installed this way only supports the same GHC +version as the ports one. + ### Installation from source #### Common pre-requirements @@ -305,6 +322,18 @@ The package can be found here on Hackage: +### Installation via Homebrew + +Homebrew users can install `haskell-language-server` using the following command: + +```bash +brew install haskell-language-server +``` + +This formula contains HLS binaries compiled with GHC versions available via Homebrew; at the moment those are: 8.6.5, 8.8.4, 8.10.4. + +You need to provide your own GHC/Cabal/Stack as required by your project, possibly via Homebrew. + ## Configuring `haskell-language-server` Language servers like `haskell-language-server` expose most of their configuration via the client (i.e. the editor). @@ -731,8 +760,7 @@ :heart: The Haskell tooling dream is near, we need your help! :heart: -- Join [our IRC channel](https://webchat.freenode.net/?channels=haskell-language-server) at `#haskell-language-server` on `freenode`. -- Fork this repo and [ghcide](https://github.com/haskell/ghcide) and hack as much as you can. +- Join [our IRC channel](https://web.libera.chat/?channels=#haskell-language-server) at `#haskell-language-server` on [`libera`](https://libera.chat/). ### Style guidelines @@ -779,7 +807,26 @@ $ cabal build ``` +##### Flakes support + +If you are using nix 2.4 style command (enabled by `experimental-features = nix-command`), +you can use `nix develop` instead of `nix-shell` to enter the development shell. To enter the shell with specific GHC versions: + +* `nix develop` or `nix develop .#haskell-language-server-dev` - default GHC version +* `nix develop .#haskell-language-server-8104-dev` - GHC 8.10.4 +* `nix develop .#haskell-language-server-884-dev` - GHC 8.8.4 +* `nix develop .#haskell-language-server-901-dev` - GHC 9.0.1 + If you are looking for a Nix expression to create haskell-language-server binaries, see https://github.com/haskell/haskell-language-server/issues/122 + +To create binaries: + +* `nix build` or `nix build .#haskell-language-server` - default GHC version +* `nix build .#haskell-language-server-8104` - GHC 8.10.4 +* `nix build .#haskell-language-server-884` - GHC 8.8.4 +* `nix build .#haskell-language-server-901` - GHC 9.0.1 + +GHC 8.6.5 is not supported here because `nixpkgs-unstable` no longer maintains the corresponding packages set. #### Introduction tutorial diff --git a/exe/Plugins.hs b/exe/Plugins.hs --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -29,6 +29,10 @@ import Ide.Plugin.ExplicitImports as ExplicitImports #endif +#if refineImports +import Ide.Plugin.RefineImports as RefineImports +#endif + #if retrie import Ide.Plugin.Retrie as Retrie #endif @@ -124,6 +128,9 @@ #endif #if importLens ExplicitImports.descriptor "importLens" : +#endif +#if refineImports + RefineImports.descriptor "refineImports" : #endif #if moduleName ModuleName.descriptor "moduleName" : diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -8,9 +8,8 @@ import Data.Foldable import Data.List import Data.Void -import Development.IDE.Session (findCradle) -import HIE.Bios hiding (findCradle) -import HIE.Bios.Environment +import qualified Development.IDE.Session as Session +import qualified HIE.Bios.Environment as HieBios import HIE.Bios.Types import Ide.Arguments import Ide.Version @@ -44,6 +43,9 @@ VersionMode PrintNumericVersion -> putStrLn haskellLanguageServerNumericVersion + BiosMode PrintCradleType -> + print =<< findProjectCradle + _ -> launchHaskellLanguageServer args launchHaskellLanguageServer :: Arguments -> IO () @@ -54,8 +56,10 @@ d <- getCurrentDirectory - -- Get the cabal directory from the cradle - cradle <- findLocalCradle (d "a") + -- search for the project cradle type + cradle <- findProjectCradle + + -- Get the root directory from the cradle setCurrentDirectory $ cradleRootDir cradle case parsedArgs of @@ -84,11 +88,7 @@ let hlsBin = "haskell-language-server-" ++ ghcVersion - backupHlsBin = - case dropWhileEnd (/='.') ghcVersion of - [] -> "haskell-language-server" - xs -> "haskell-language-server-" ++ init xs - candidates' = [hlsBin, backupHlsBin, "haskell-language-server"] + candidates' = [hlsBin, "haskell-language-server"] candidates = map (++ exeExtension) candidates' hPutStrLn stderr $ "haskell-language-server exe candidates: " ++ show candidates @@ -114,7 +114,7 @@ Direct -> checkToolExists "ghc" _ -> pure () - ghcVersionRes <- getRuntimeGhcVersion cradle + ghcVersionRes <- HieBios.getRuntimeGhcVersion cradle case ghcVersionRes of CradleSuccess ver -> do return ver @@ -129,23 +129,16 @@ die $ "Cradle requires " ++ exe ++ " but couldn't find it" ++ "\n" ++ show cradle --- | Find the cradle that the given File belongs to. --- --- First looks for a "hie.yaml" file in the directory of the file --- or one of its parents. If this file is found, the cradle --- is read from the config. If this config does not comply to the "hie.yaml" --- specification, an error is raised. --- --- If no "hie.yaml" can be found, the implicit config is used. --- The implicit config uses different heuristics to determine the type --- of the project that may or may not be accurate. -findLocalCradle :: FilePath -> IO (Cradle Void) -findLocalCradle fp = do - cradleConf <- findCradle def fp - crdl <- case cradleConf of - Just yaml -> do - hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ fp ++ "\"" - loadCradle yaml - Nothing -> loadImplicitCradle fp - hPutStrLn stderr $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl - return crdl +findProjectCradle :: IO (Cradle Void) +findProjectCradle = do + d <- getCurrentDirectory + + let initialFp = d "a" + hieYaml <- Session.findCradle def initialFp + + -- Some log messages + case hieYaml of + Just yaml -> hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ initialFp ++ "\"" + Nothing -> hPutStrLn stderr "No 'hie.yaml' found. Try to discover the project type!" + + Session.loadCradle def hieYaml d 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.1.0.0 +version: 1.2.0.0 synopsis: LSP server for GHC description: Please see the README on GitHub at @@ -14,11 +14,10 @@ license: Apache-2.0 license-file: LICENSE build-type: Simple -tested-with: GHC == 8.6.4 || == 8.6.5 || == 8.8.2 || == 8.8.3 || == 8.8.4 || == 8.10.2 || == 8.10.3 || == 8.10.4 +tested-with: GHC == 8.6.4 || == 8.6.5 || == 8.8.2 || == 8.8.3 || == 8.8.4 || == 8.10.2 || == 8.10.3 || == 8.10.4 || == 8.10.5 extra-source-files: README.md ChangeLog.md - include/ghc-api-version.h test/testdata/**/*.project test/testdata/**/*.cabal test/testdata/**/*.yaml @@ -26,7 +25,6 @@ test/testdata/hlint/ignore/.hlint.yaml test/testdata/**/*.h test/testdata/**/*.hs - test/testdata/**/*.expected flag pedantic description: Enable -Werror @@ -63,7 +61,7 @@ , cryptohash-sha1 , data-default , ghc - , ghcide ^>=1.2 + , ghcide ^>=1.4 , gitrev , lsp , hie-bios @@ -73,7 +71,7 @@ , optparse-applicative , optparse-simple , process - , shake + , hls-graph , safe-exceptions , sqlite-simple , unordered-containers @@ -123,6 +121,11 @@ default: True manual: True +flag refineImports + description: Enable refineImports plugin + default: True + manual: True + flag retrie description: Enable retrie plugin default: True @@ -205,6 +208,11 @@ build-depends: hls-explicit-imports-plugin ^>= 1.0.0.1 cpp-options: -DimportLens +common refineImports + if flag(refineImports) || flag(all-plugins) + build-depends: hls-refine-imports-plugin + cpp-options: -DrefineImports + common retrie if flag(retrie) || flag(all-plugins) build-depends: hls-retrie-plugin ^>= 1.0.0.1 @@ -212,7 +220,7 @@ common tactic if flag(tactic) || flag(all-plugins) - build-depends: hls-tactics-plugin ^>= 1.1.0.0 + build-depends: hls-tactics-plugin ^>= 1.2.0.0 cpp-options: -Dtactic common hlint @@ -222,15 +230,12 @@ common moduleName if flag(moduleName) || flag(all-plugins) - hs-source-dirs: plugins/default/src - other-modules: Ide.Plugin.ModuleName + build-depends: hls-module-name-plugin ^>= 1.0.0.0 cpp-options: -DmoduleName common pragmas if flag(pragmas) || flag(all-plugins) - hs-source-dirs: plugins/default/src - build-depends: fuzzy - other-modules: Ide.Plugin.Pragmas + build-depends: hls-pragmas-plugin ^>= 1.0.0.0 cpp-options: -Dpragmas common splice @@ -242,23 +247,17 @@ common floskell if flag(floskell) || flag(all-formatters) - hs-source-dirs: plugins/default/src - other-modules: Ide.Plugin.Floskell - build-depends: floskell ^>=0.10 + build-depends: hls-floskell-plugin ^>=1.0.0.0 cpp-options: -Dfloskell common fourmolu if flag(fourmolu) || flag(all-formatters) - hs-source-dirs: plugins/default/src - other-modules: Ide.Plugin.Fourmolu - build-depends: fourmolu ^>=0.3 + build-depends: hls-fourmolu-plugin ^>= 1.0.0.0 cpp-options: -Dfourmolu common ormolu if flag(ormolu) || flag(all-formatters) - hs-source-dirs: plugins/default/src - other-modules: Ide.Plugin.Ormolu - build-depends: ormolu ^>=0.1.2 + build-depends: hls-ormolu-plugin ^>= 1.0.0.0 cpp-options: -Dormolu common stylishHaskell @@ -279,6 +278,7 @@ , haddockComments , eval , importLens + , refineImports , retrie , tactic , hlint @@ -316,6 +316,7 @@ , cryptohash-sha1 , deepseq , ghc + , ghc-api-compat , ghc-boot-th , ghcide , hashable @@ -332,13 +333,12 @@ , mtl , regex-tdfa , safe-exceptions - , shake + , hls-graph , sqlite-simple , temporary , transformers , unordered-containers - include-dirs: include default-language: Haskell2010 default-extensions: DataKinds, TypeOperators @@ -411,13 +411,13 @@ FunctionalLiquid HieBios Highlight - ModuleName Progress Reference Rename Symbol TypeDefinition Test.Hls.Command + Test.Hls.Flags default-extensions: OverloadedStrings ghc-options: @@ -426,10 +426,44 @@ if flag(pedantic) ghc-options: -Werror -Wredundant-constraints + if flag(class) || flag(all-plugins) + cpp-options: -Dclass + if flag(haddockComments) || flag(all-plugins) + cpp-options: -DhaddockComments + if flag(eval) || flag(all-plugins) + cpp-options: -Deval + if flag(importLens) || flag(all-plugins) + cpp-options: -DimportLens + if flag(retrie) || flag(all-plugins) + cpp-options: -Dretrie + if flag(tactic) || flag(all-plugins) + cpp-options: -Dtactic + if flag(hlint) || flag(all-plugins) + cpp-options: -Dhlint + if flag(moduleName) || flag(all-plugins) + cpp-options: -DmoduleName + if flag(pragmas) || flag(all-plugins) + cpp-options: -Dpragmas + if flag(splice) || flag(all-plugins) + cpp-options: -Dsplice + +-- formatters + if flag(floskell) || flag(all-formatters) + cpp-options: -Dfloskell + if flag(fourmolu) || flag(all-formatters) + cpp-options: -Dfourmolu + if flag(ormolu) || flag(all-formatters) + cpp-options: -Dormolu + if flag(stylishHaskell) || flag(all-formatters) + cpp-options: -DstylishHaskell + if (flag(brittany) || flag(all-formatters)) + cpp-options: -Dbrittany + test-suite wrapper-test type: exitcode-stdio-1.0 build-tool-depends: - haskell-language-server:haskell-language-server-wrapper -any + haskell-language-server:haskell-language-server-wrapper -any, + haskell-language-server:haskell-language-server -any default-language: Haskell2010 build-depends: diff --git a/include/ghc-api-version.h b/include/ghc-api-version.h deleted file mode 100644 --- a/include/ghc-api-version.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef GHC_API_VERSION_H -#define GHC_API_VERSION_H - -#ifdef GHC_LIB -#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc_lib(x,y,z) -#else -#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc(x,y,z) -#endif - -#endif 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 @@ -77,7 +77,7 @@ return ([diag], Just ()) action $ do - files <- getFilesOfInterest + files <- getFilesOfInterestUntracked void $ uses Example $ Map.keys files mkDiag :: NormalizedFilePath 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 @@ -75,7 +75,7 @@ return ([diag], Just ()) action $ do - files <- getFilesOfInterest + files <- getFilesOfInterestUntracked void $ uses Example2 $ Map.keys files mkDiag :: NormalizedFilePath diff --git a/plugins/default/src/Ide/Plugin/Floskell.hs b/plugins/default/src/Ide/Plugin/Floskell.hs deleted file mode 100644 --- a/plugins/default/src/Ide/Plugin/Floskell.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Ide.Plugin.Floskell - ( - descriptor - , provider - ) -where - -import Control.Monad.IO.Class -import qualified Data.ByteString.Lazy as BS -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Development.IDE as D hiding (pluginHandlers) -import Floskell -import Ide.PluginUtils -import Ide.Types -import Language.LSP.Types -import Text.Regex.TDFA.Text () - --- --------------------------------------------------------------------- - -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = (defaultPluginDescriptor plId) - { pluginHandlers = mkFormattingHandlers provider - } - --- --------------------------------------------------------------------- - --- | Format provider of Floskell. --- Formats the given source in either a given Range or the whole Document. --- If the provider fails an error is returned that can be displayed to the user. -provider :: FormattingHandler IdeState -provider _ideState typ contents fp _ = liftIO $ do - let file = fromNormalizedFilePath fp - config <- findConfigOrDefault file - let (range, selectedContents) = case typ of - FormatText -> (fullRange contents, contents) - FormatRange r -> (r, extractRange r contents) - result = reformat config (Just file) (BS.fromStrict (T.encodeUtf8 selectedContents)) - case result of - Left err -> return $ Left $ responseError (T.pack $ "floskellCmd: " ++ err) - Right new -> return $ Right $ List [TextEdit range (T.decodeUtf8 (BS.toStrict new))] - --- | Find Floskell Config, user and system wide or provides a default style. --- Every directory of the filepath will be searched to find a user configuration. --- Also looks into places such as XDG_CONFIG_DIRECTORY. --- This function may not throw an exception and returns a default config. -findConfigOrDefault :: FilePath -> IO AppConfig -findConfigOrDefault file = do - mbConf <- findAppConfigIn file - case mbConf of - Just confFile -> readAppConfig confFile - Nothing -> - let gibiansky = head (filter (\s -> styleName s == "gibiansky") styles) - in return $ defaultAppConfig { appStyle = gibiansky } - --- --------------------------------------------------------------------- diff --git a/plugins/default/src/Ide/Plugin/Fourmolu.hs b/plugins/default/src/Ide/Plugin/Fourmolu.hs deleted file mode 100644 --- a/plugins/default/src/Ide/Plugin/Fourmolu.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE TypeApplications #-} - -module Ide.Plugin.Fourmolu ( - descriptor, - provider, -) where - -import Control.Exception -import Data.Either.Extra -import System.FilePath - -import Control.Lens ((^.)) -import qualified Data.Text as T -import Development.IDE as D hiding (pluginHandlers) -import qualified DynFlags as D -import qualified EnumSet as S -import GHC (DynFlags, moduleNameString) -import GHC.LanguageExtensions.Type (Extension (Cpp)) -import GhcPlugins (HscEnv (hsc_dflags)) -import Ide.PluginUtils (makeDiffTextEdit) - -import Control.Monad.IO.Class -import Ide.Types -import Language.LSP.Server hiding (defaultConfig) -import Language.LSP.Types -import Language.LSP.Types.Lens -import "fourmolu" Ormolu - --- --------------------------------------------------------------------- - -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = - (defaultPluginDescriptor plId) - { pluginHandlers = mkFormattingHandlers provider - } - --- --------------------------------------------------------------------- - -provider :: FormattingHandler IdeState -provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do - ghc <- liftIO $ runAction "Fourmolu" ideState $ use GhcSession fp - fileOpts <- case hsc_dflags . hscEnv <$> ghc of - Nothing -> return [] - Just df -> liftIO $ convertDynFlags df - - let format printerOpts = - mapLeft (responseError . ("Fourmolu: " <>) . T.pack . show) - <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents)) - where - config = - defaultConfig - { cfgDynOptions = fileOpts - , cfgRegion = region - , cfgDebug = True - , cfgPrinterOpts = - fillMissingPrinterOpts - (printerOpts <> lspPrinterOpts) - defaultPrinterOpts - } - - liftIO (loadConfigFile fp') >>= \case - ConfigLoaded file opts -> liftIO $ do - putStrLn $ "Loaded Fourmolu config from: " <> file - format opts - ConfigNotFound searchDirs -> liftIO $ do - putStrLn - . unlines - $ ("No " ++ show configFileName ++ " found in any of:") : - map (" " ++) searchDirs - format mempty - ConfigParseError f (_, err) -> do - sendNotification SWindowShowMessage $ - ShowMessageParams - { _xtype = MtError - , _message = errorMessage - } - return . Left $ responseError errorMessage - where - errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err - where - fp' = fromNormalizedFilePath fp - title = "Formatting " <> T.pack (takeFileName fp') - lspPrinterOpts = mempty{poIndentation = Just $ fo ^. tabSize} - region = case typ of - FormatText -> - RegionIndices Nothing Nothing - FormatRange (Range (Position sl _) (Position el _)) -> - RegionIndices (Just $ sl + 1) (Just $ el + 1) - -convertDynFlags :: DynFlags -> IO [DynOption] -convertDynFlags df = - let pp = ["-pgmF=" <> p | not (null p)] - p = D.sPgm_F $ D.settings df - pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df - ex = map showExtension $ S.toList $ D.extensionFlags df - showExtension = \case - Cpp -> "-XCPP" - x -> "-X" ++ show x - in return $ map DynOption $ pp <> pm <> ex diff --git a/plugins/default/src/Ide/Plugin/ModuleName.hs b/plugins/default/src/Ide/Plugin/ModuleName.hs deleted file mode 100644 --- a/plugins/default/src/Ide/Plugin/ModuleName.hs +++ /dev/null @@ -1,157 +0,0 @@ -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wall -Wwarn -fno-warn-type-defaults -fno-warn-unused-binds -fno-warn-unused-imports -Wno-unticked-promoted-constructors #-} - -{- | Keep the module name in sync with its file path. - -Provide CodeLenses to: -* Add a module header ("module /moduleName/ where") to empty Haskell files -* Fix the module name if incorrect --} -module Ide.Plugin.ModuleName ( - descriptor, -) where - -import Control.Monad -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Data.Aeson (ToJSON (toJSON), Value (Null)) -import Data.Char (isLower) -import qualified Data.HashMap.Strict as Map -import Data.List (find, intercalate, isPrefixOf) -import Data.Maybe (maybeToList) -import Data.String (IsString) -import Data.Text (Text, pack) -import qualified Data.Text as T --- import Debug.Trace (trace) -import Development.IDE (GetParsedModule (GetParsedModule), - GhcSession (GhcSession), HscEnvEq, - IdeState, List (..), - NormalizedFilePath, - Position (Position), Range (Range), - evalGhcEnv, hscEnvWithImportPaths, - realSrcSpanToRange, runAction, - toNormalizedUri, uriToFilePath', use, - use_) -import GHC (DynFlags (importPaths), GenLocated (L), - HsModule (hsmodName), - ParsedModule (pm_parsed_source), - SrcSpan (RealSrcSpan), - getSessionDynFlags, unLoc) -import Ide.PluginUtils (getProcessID, mkLspCmdId) -import Ide.Types -import Language.LSP.Server -import Language.LSP.Types -import Language.LSP.VFS (virtualFileText) -import System.Directory (canonicalizePath) -import System.FilePath (dropExtension, splitDirectories, - takeFileName) - --- |Plugin descriptor -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = - (defaultPluginDescriptor plId) - { pluginHandlers = mkPluginHandler STextDocumentCodeLens codeLens - , pluginCommands = [PluginCommand editCommandName editCommandName command] - } - -editCommandName :: IsString p => p -editCommandName = "edit" - -asCodeLens :: Text -> Action -> CodeLens -asCodeLens cid Replace{..} = - CodeLens - aRange - (Just $ Command aTitle cid (Just (List [toJSON aUri]))) - Nothing - --- | Generate code lenses -codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens -codeLens state pluginId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do - do - pid <- liftIO $ pack . show <$> getProcessID - Right . List . maybeToList . (asCodeLens (mkLspCmdId pid pluginId editCommandName) <$>) <$> action state uri - --- | (Quasi) Idempotent command execution: recalculate action to execute on command request -command :: CommandFunction IdeState Uri -command state uri = do - actMaybe <- action state uri - case actMaybe of - Nothing -> pure () - Just act -> void $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing (asEdit act)) (\_ -> pure ()) - return (Right Null) - --- | A source code change -data Action = Replace {aUri :: Uri, aRange :: Range, aTitle :: Text, aCode :: Text} deriving (Show) - --- | Convert an Action to the corresponding edit operation -asEdit :: Action -> WorkspaceEdit -asEdit act@Replace{..} = - WorkspaceEdit (Just $ Map.singleton aUri $ List (asTextEdits act)) Nothing Nothing - -asTextEdits :: Action -> [TextEdit] -asTextEdits Replace{..} = [TextEdit aRange aCode] - --- | Required action (that can be converted to either CodeLenses or CodeActions) -action :: IdeState -> Uri -> LspM c (Maybe Action) -action state uri = - traceAs "action" <$> do - let Just nfp = uriToNormalizedFilePath $ toNormalizedUri uri - let Just fp = uriToFilePath' uri - - contents <- getVirtualFile $ toNormalizedUri uri - let emptyModule = maybe True (T.null . T.strip . virtualFileText) contents - - correctNameMaybe <- liftIO $ traceAs "correctName" <$> pathModuleName state nfp fp - statedNameMaybe <- liftIO $ traceAs "statedName" <$> codeModuleName state nfp - - let act = Replace uri - let todo = case (correctNameMaybe, statedNameMaybe) of - (Just correctName, Just (nameRange, statedName)) - | correctName /= statedName -> - Just $ - act - nameRange - ("Set module name to " <> correctName) - correctName - (Just correctName, _) - | emptyModule -> - let code = T.unwords ["module", correctName, "where\n"] - in Just $ act (Range (Position 0 0) (Position 0 0)) code code - _ -> Nothing - return todo - --- | The module name, as derived by the position of the module in its source directory -pathModuleName :: IdeState -> NormalizedFilePath -> String -> IO (Maybe Text) -pathModuleName state normFilePath filePath - | isLower (head $ takeFileName filePath) = return $ Just "Main" - | otherwise = do - session :: HscEnvEq <- runAction "ModuleName.ghcSession" state $ use_ GhcSession normFilePath - srcPaths <- evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags - paths <- mapM canonicalizePath srcPaths - mdlPath <- canonicalizePath filePath - let maybePrefix = find (`isPrefixOf` mdlPath) paths - - let maybeMdlName = - ( \prefix -> - intercalate "." - . splitDirectories - . drop (length prefix + 1) - $ dropExtension mdlPath - ) - <$> maybePrefix - return $ T.pack <$> maybeMdlName - --- | The module name, as stated in the module -codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, Text)) -codeModuleName state nfp = - ((\(L (RealSrcSpan l) m) -> (realSrcSpanToRange l, T.pack . show $ m)) <$>) - . ((hsmodName . unLoc . pm_parsed_source) =<<) - <$> runAction "ModuleName.GetParsedModule" state (use GetParsedModule nfp) - --- traceAs :: Show a => String -> a -> a --- traceAs lbl a = trace (lbl ++ " = " ++ show a) a - -traceAs :: b -> a -> a -traceAs _ a = a diff --git a/plugins/default/src/Ide/Plugin/Ormolu.hs b/plugins/default/src/Ide/Plugin/Ormolu.hs deleted file mode 100644 --- a/plugins/default/src/Ide/Plugin/Ormolu.hs +++ /dev/null @@ -1,80 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} - -module Ide.Plugin.Ormolu - ( - descriptor - , provider - ) -where - -import Control.Exception -import Control.Monad.IO.Class -import qualified Data.Text as T -import Development.IDE hiding (pluginHandlers) -import qualified DynFlags as D -import qualified EnumSet as S -import GHC -import GHC.LanguageExtensions.Type -import GhcPlugins (HscEnv (hsc_dflags)) -import Ide.PluginUtils -import Ide.Types -import Language.LSP.Server hiding (defaultConfig) -import Language.LSP.Types -import "ormolu" Ormolu -import System.FilePath (takeFileName) -import Text.Regex.TDFA.Text () - --- --------------------------------------------------------------------- - -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = (defaultPluginDescriptor plId) - { pluginHandlers = mkFormattingHandlers provider - } - --- --------------------------------------------------------------------- - -provider :: FormattingHandler IdeState -provider ideState typ contents fp _ = withIndefiniteProgress title Cancellable $ liftIO $ do - let - fromDyn :: DynFlags -> IO [DynOption] - fromDyn df = - let - pp = - let p = D.sPgm_F $ D.settings df - in ["-pgmF=" <> p | not (null p)] - pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df - ex = map showExtension $ S.toList $ D.extensionFlags df - in - return $ map DynOption $ pp <> pm <> ex - - ghc <- runAction "Ormolu" ideState $ use GhcSession fp - let df = hsc_dflags . hscEnv <$> ghc - fileOpts <- case df of - Nothing -> return [] - Just df -> fromDyn df - - let - fullRegion = RegionIndices Nothing Nothing - rangeRegion s e = RegionIndices (Just $ s + 1) (Just $ e + 1) - mkConf o region = defaultConfig { cfgDynOptions = o, cfgRegion = region } - fmt :: T.Text -> Config RegionIndices -> IO (Either OrmoluException T.Text) - fmt cont conf = - try @OrmoluException (ormolu conf (fromNormalizedFilePath fp) $ T.unpack cont) - - case typ of - FormatText -> ret <$> fmt contents (mkConf fileOpts fullRegion) - FormatRange (Range (Position sl _) (Position el _)) -> - ret <$> fmt contents (mkConf fileOpts (rangeRegion sl el)) - where - title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp) - ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit) - ret (Left err) = Left - (responseError (T.pack $ "ormoluCmd: " ++ show err) ) - ret (Right new) = Right (makeDiffTextEdit contents new) - -showExtension :: Extension -> String -showExtension Cpp = "-XCPP" -showExtension other = "-X" ++ show other diff --git a/plugins/default/src/Ide/Plugin/Pragmas.hs b/plugins/default/src/Ide/Plugin/Pragmas.hs deleted file mode 100644 --- a/plugins/default/src/Ide/Plugin/Pragmas.hs +++ /dev/null @@ -1,191 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} - --- | Provides code actions to add missing pragmas (whenever GHC suggests to) -module Ide.Plugin.Pragmas (descriptor) where - -import Control.Applicative ((<|>)) -import Control.Lens hiding (List) -import Control.Monad (join) -import Control.Monad.IO.Class -import qualified Data.HashMap.Strict as H -import Data.List.Extra (nubOrdOn) -import Data.Maybe (catMaybes, listToMaybe) -import qualified Data.Text as T -import Development.IDE as D -import Development.IDE.GHC.Compat -import Ide.Types -import qualified Language.LSP.Server as LSP -import Language.LSP.Types -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J -import qualified Language.LSP.VFS as VFS -import qualified Text.Fuzzy as Fuzzy - --- --------------------------------------------------------------------- - -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = (defaultPluginDescriptor plId) - { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider - <> mkPluginHandler STextDocumentCompletion completion - } - --- --------------------------------------------------------------------- - --- | Title and pragma -type PragmaEdit = (T.Text, Pragma) - -data Pragma = LangExt T.Text | OptGHC T.Text - deriving (Show, Eq, Ord) - -codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction -codeActionProvider state _plId (CodeActionParams _ _ docId _ (J.CodeActionContext (J.List diags) _monly)) = do - let mFile = docId ^. J.uri & uriToFilePath <&> toNormalizedFilePath' - uri = docId ^. J.uri - pm <- liftIO $ fmap join $ runAction "Pragmas.GetParsedModule" state $ getParsedModule `traverse` mFile - let dflags = ms_hspp_opts . pm_mod_summary <$> pm - insertRange = maybe (Range (Position 0 0) (Position 0 0)) endOfModuleHeader pm - pedits = nubOrdOn snd . concat $ suggest dflags <$> diags - return $ Right $ List $ pragmaEditToAction uri insertRange <$> pedits - --- | Add a Pragma to the given URI at the top of the file. --- It is assumed that the pragma name is a valid pragma, --- thus, not validated. -pragmaEditToAction :: Uri -> Range -> PragmaEdit -> (Command |? CodeAction) -pragmaEditToAction uri range (title, p) = - InR $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing Nothing (Just edit) Nothing Nothing - where - render (OptGHC x) = "{-# OPTIONS_GHC -Wno-" <> x <> " #-}\n" - render (LangExt x) = "{-# LANGUAGE " <> x <> " #-}\n" - textEdits = J.List [J.TextEdit range $ render p] - edit = - J.WorkspaceEdit - (Just $ H.singleton uri textEdits) - Nothing - Nothing - -suggest :: Maybe DynFlags -> Diagnostic -> [PragmaEdit] -suggest dflags diag = - suggestAddPragma dflags diag - ++ suggestDisableWarning diag - --- --------------------------------------------------------------------- - -suggestDisableWarning :: Diagnostic -> [PragmaEdit] -suggestDisableWarning Diagnostic {_code} - | Just (InR (T.stripPrefix "-W" -> Just w)) <- _code = - pure ("Disable \"" <> w <> "\" warnings", OptGHC w) - | otherwise = [] - --- --------------------------------------------------------------------- - --- | Offer to add a missing Language Pragma to the top of a file. --- Pragmas are defined by a curated list of known pragmas, see 'possiblePragmas'. -suggestAddPragma :: Maybe DynFlags -> Diagnostic -> [PragmaEdit] -suggestAddPragma mDynflags Diagnostic {_message} = genPragma _message - where - genPragma target = - [("Add \"" <> r <> "\"", LangExt r) | r <- findPragma target, r `notElem` disabled] - disabled - | Just dynFlags <- mDynflags = - -- GHC does not export 'OnOff', so we have to view it as string - catMaybes $ T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags - | otherwise = - -- When the module failed to parse, we don't have access to its - -- dynFlags. In that case, simply don't disable any pragmas. - [] - --- | Find all Pragmas are an infix of the search term. -findPragma :: T.Text -> [T.Text] -findPragma str = concatMap check possiblePragmas - where - check p = [p | T.isInfixOf p str] - - -- We exclude the Strict extension as it causes many false positives, see - -- the discussion at https://github.com/haskell/ghcide/pull/638 - -- - -- We don't include the No- variants, as GHC never suggests disabling an - -- extension in an error message. - possiblePragmas :: [T.Text] - possiblePragmas = - [ name - | FlagSpec{flagSpecName = T.pack -> name} <- xFlags - , "Strict" /= name - ] - --- | All language pragmas, including the No- variants -allPragmas :: [T.Text] -allPragmas = - concat - [ [name, "No" <> name] - | FlagSpec{flagSpecName = T.pack -> name} <- xFlags - ] - <> - -- These pragmas are not part of xFlags as they are not reversable - -- by prepending "No". - [ -- Safe Haskell - "Unsafe" - , "Trustworthy" - , "Safe" - - -- Language Version Extensions - , "Haskell98" - , "Haskell2010" - -- Maybe, GHC 2021 after its release? - ] - --- --------------------------------------------------------------------- - -completion :: PluginMethodHandler IdeState TextDocumentCompletion -completion _ide _ complParams = do - let (TextDocumentIdentifier uri) = complParams ^. J.textDocument - position = complParams ^. J.position - contents <- LSP.getVirtualFile $ toNormalizedUri uri - fmap (Right . InL) $ case (contents, uriToFilePath' uri) of - (Just cnts, Just _path) -> - result <$> VFS.getCompletionPrefix position cnts - where - result (Just pfix) - | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix - = List $ map buildCompletion - (Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas) - | otherwise - = List [] - result Nothing = List [] - buildCompletion p = - CompletionItem - { _label = p, - _kind = Just CiKeyword, - _tags = Nothing, - _detail = Nothing, - _documentation = Nothing, - _deprecated = Nothing, - _preselect = Nothing, - _sortText = Nothing, - _filterText = Nothing, - _insertText = Nothing, - _insertTextFormat = Nothing, - _insertTextMode = Nothing, - _textEdit = Nothing, - _additionalTextEdits = Nothing, - _commitCharacters = Nothing, - _command = Nothing, - _xdata = Nothing - } - _ -> return $ List [] - --- --------------------------------------------------------------------- - --- | Find the first non-blank line before the first of (module name / imports / declarations). --- Useful for inserting pragmas. -endOfModuleHeader :: ParsedModule -> Range -endOfModuleHeader pm = - let mod = unLoc $ pm_parsed_source pm - modNameLoc = getLoc <$> hsmodName mod - firstImportLoc = getLoc <$> listToMaybe (hsmodImports mod) - firstDeclLoc = getLoc <$> listToMaybe (hsmodDecls mod) - line = maybe 0 (_line . _start) (modNameLoc <|> firstImportLoc <|> firstDeclLoc >>= srcSpanToRange) - loc = Position line 0 - in Range loc loc diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs --- a/src/Ide/Arguments.hs +++ b/src/Ide/Arguments.hs @@ -10,6 +10,7 @@ ( Arguments(..) , GhcideArguments(..) , PrintVersion(..) + , BiosAction(..) , getArguments , haskellLanguageServerVersion , haskellLanguageServerNumericVersion @@ -27,6 +28,7 @@ data Arguments = VersionMode PrintVersion | ProbeToolsMode + | BiosMode BiosAction | Ghcide GhcideArguments | VSCodeExtensionSchemaMode | DefaultConfigurationMode @@ -50,12 +52,17 @@ | PrintNumericVersion deriving (Show, Eq, Ord) +data BiosAction + = PrintCradleType + deriving (Show, Eq, Ord) + getArguments :: String -> IO Arguments getArguments exeName = execParser opts where opts = info (( VersionMode <$> printVersionParser exeName <|> probeToolsParser exeName + <|> BiosMode <$> biosParser <|> Ghcide <$> arguments <|> vsCodeExtensionSchemaModeParser <|> defaultConfigurationModeParser) @@ -71,6 +78,11 @@ <|> 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 = diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -15,11 +15,12 @@ import Data.Default import qualified Data.Text as T import Development.IDE.Core.Rules +import Development.IDE.Graph (ShakeOptions (shakeThreads)) import Development.IDE.Main (isLSP) import qualified Development.IDE.Main as Main +import qualified Development.IDE.Session as Session import Development.IDE.Types.Logger as G import qualified Development.IDE.Types.Options as Ghcide -import Development.Shake (ShakeOptions (shakeThreads)) import Ide.Arguments import Ide.Logger import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, @@ -49,6 +50,12 @@ VersionMode PrintNumericVersion -> putStrLn haskellLanguageServerNumericVersion + + BiosMode PrintCradleType -> do + dir <- IO.getCurrentDirectory + hieYaml <- Session.findCradle def dir + cradle <- Session.loadCradle def hieYaml dir + print cradle Ghcide ghcideArgs -> do {- see WARNING above -} diff --git a/src/Ide/Version.hs b/src/Ide/Version.hs --- a/src/Ide/Version.hs +++ b/src/Ide/Version.hs @@ -43,9 +43,9 @@ showProgramVersionOfInterest :: ProgramsOfInterest -> String showProgramVersionOfInterest ProgramsOfInterest {..} = unlines - [ concat ["cabal:\t\t", showVersionWithDefault cabalVersion] - , concat ["stack:\t\t", showVersionWithDefault stackVersion] - , concat ["ghc:\t\t", showVersionWithDefault ghcVersion] + [ "cabal:\t\t" ++ showVersionWithDefault cabalVersion + , "stack:\t\t" ++ showVersionWithDefault stackVersion + , "ghc:\t\t" ++ showVersionWithDefault ghcVersion ] where showVersionWithDefault :: Maybe Version -> String diff --git a/test/functional/Command.hs b/test/functional/Command.hs --- a/test/functional/Command.hs +++ b/test/functional/Command.hs @@ -8,6 +8,7 @@ import Language.LSP.Types.Lens as LSP import Test.Hls import Test.Hls.Command +import Test.Hls.Flags (requiresEvalPlugin) tests :: TestTree tests = testGroup "commands" [ @@ -19,7 +20,7 @@ liftIO $ do all f cmds @? "All prefixed" not (null cmds) @? "Commands aren't empty" - , testCase "get de-prefixed" $ + , requiresEvalPlugin $ testCase "get de-prefixed" $ runSession hlsCommand fullCaps "test/testdata/" $ do ResponseMessage _ _ (Left err) <- request SWorkspaceExecuteCommand diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -76,108 +76,6 @@ item ^. detail @?= Just "Data.List" item ^. kind @?= Just CiModule - , testCase "completes language extensions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - - _ <- waitForDiagnostics - - let te = TextEdit (Range (Position 0 24) (Position 0 31)) "" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 24) - let item = head $ filter ((== "OverloadedStrings") . (^. label)) compls - liftIO $ do - item ^. label @?= "OverloadedStrings" - item ^. kind @?= Just CiKeyword - - , testCase "completes the Strict language extension" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - - _ <- waitForDiagnostics - - let te = TextEdit (Range (Position 0 13) (Position 0 31)) "Str" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 16) - let item = head $ filter ((== "Strict") . (^. label)) compls - liftIO $ do - item ^. label @?= "Strict" - item ^. kind @?= Just CiKeyword - - , testCase "completes No- language extensions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - - _ <- waitForDiagnostics - - let te = TextEdit (Range (Position 0 13) (Position 0 31)) "NoOverload" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 23) - let item = head $ filter ((== "NoOverloadedStrings") . (^. label)) compls - liftIO $ do - item ^. label @?= "NoOverloadedStrings" - item ^. kind @?= Just CiKeyword - - , testCase "completes pragmas" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - - _ <- waitForDiagnostics - - let te = TextEdit (Range (Position 0 4) (Position 0 34)) "" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 4) - let item = head $ filter ((== "LANGUAGE") . (^. label)) compls - liftIO $ do - item ^. label @?= "LANGUAGE" - item ^. kind @?= Just CiKeyword - item ^. insertTextFormat @?= Just Snippet - item ^. insertText @?= Just "LANGUAGE ${1:extension} #-}" - - , testCase "completes pragmas no close" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - - let te = TextEdit (Range (Position 0 4) (Position 0 24)) "" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 4) - let item = head $ filter ((== "LANGUAGE") . (^. label)) compls - liftIO $ do - item ^. label @?= "LANGUAGE" - item ^. kind @?= Just CiKeyword - item ^. insertTextFormat @?= Just Snippet - item ^. insertText @?= Just "LANGUAGE ${1:extension}" - - , testCase "completes options pragma" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - - _ <- waitForDiagnostics - - let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 4) - let item = head $ filter ((== "OPTIONS_GHC") . (^. label)) compls - liftIO $ do - item ^. label @?= "OPTIONS_GHC" - item ^. kind @?= Just CiKeyword - item ^. insertTextFormat @?= Just Snippet - item ^. insertText @?= Just "OPTIONS_GHC -${1:option} #-}" - - , testCase "completes ghc options pragma values" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - - let te = TextEdit (Range (Position 0 0) (Position 0 0)) "{-# OPTIONS_GHC -Wno-red #-}\n" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 24) - let item = head $ filter ((== "Wno-redundant-constraints") . (^. label)) compls - liftIO $ do - item ^. label @?= "Wno-redundant-constraints" - item ^. kind @?= Just CiKeyword - item ^. insertTextFormat @?= Nothing - item ^. insertText @?= Nothing - , testCase "completes with no prefix" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" diff --git a/test/functional/Config.hs b/test/functional/Config.hs --- a/test/functional/Config.hs +++ b/test/functional/Config.hs @@ -2,12 +2,13 @@ module Config (tests) where -import Control.Lens hiding (List) +import Control.Lens hiding (List, (.=)) import Control.Monad import Data.Aeson import qualified Data.Map as Map import qualified Data.Text as T import Ide.Plugin.Config +import qualified Ide.Plugin.Config as Plugin import Language.LSP.Test as Test import qualified Language.LSP.Types.Lens as L import System.FilePath (()) @@ -55,6 +56,38 @@ liftIO $ noHlintDiagnostics diags' + , testCase "adding hlint flags to plugin configuration removes hlint diagnostics" $ runHlintSession "" $ do + let config = def { hlintOn = True } + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + doc <- openDoc "ApplyRefact2.hs" "haskell" + testHlintDiagnostics doc + + let config' = hlintConfigWithFlags ["--ignore=Redundant id", "--hint=test-hlint-config.yaml"] + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config')) + + diags' <- waitForDiagnosticsFrom doc + + liftIO $ noHlintDiagnostics diags' + + , testCase "adding hlint flags to plugin configuration adds hlint diagnostics" $ runHlintSession "" $ do + let config = def { hlintOn = True } + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + doc <- openDoc "ApplyRefact7.hs" "haskell" + + expectNoMoreDiagnostics 3 doc "hlint" + + let config' = hlintConfigWithFlags ["--with-group=generalise"] + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config')) + + diags' <- waitForDiagnosticsFromSource doc "hlint" + d <- liftIO $ inspectDiagnostic diags' ["Use <>"] + + liftIO $ do + length diags' @?= 1 + d ^. L.range @?= Range (Position 1 10) (Position 1 21) + d ^. L.severity @?= Just DsInfo ] where runHlintSession :: FilePath -> Session a -> IO a @@ -94,3 +127,14 @@ where pluginConfig = def { plcGlobalOn = state } config' = def { plugins = Map.insert pid pluginConfig (plugins config) } + +hlintConfigWithFlags :: [T.Text] -> Config +hlintConfigWithFlags flags = + def + { hlintOn = True + , Plugin.plugins = Map.fromList [("hlint", + def { Plugin.plcConfig = unObject $ object ["flags" .= flags] } + )] } + where + unObject (Object obj) = obj + unObject _ = undefined diff --git a/test/functional/Format.hs b/test/functional/Format.hs --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -13,25 +13,25 @@ import qualified Language.LSP.Types.Lens as LSP import Test.Hls import Test.Hls.Command +import Test.Hls.Flags (requiresFloskellPlugin, + requiresOrmoluPlugin) tests :: TestTree tests = testGroup "format document" [ - goldenGitDiff "works" "test/testdata/format/Format.formatted_document.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do + requiresOrmoluPlugin $ goldenGitDiff "works" "test/testdata/format/Format.formatted_document.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do doc <- openDoc "Format.hs" "haskell" formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) BS.fromStrict . T.encodeUtf8 <$> documentContents doc - , goldenGitDiff "works with custom tab size" "test/testdata/format/Format.formatted_document_with_tabsize.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do + , requiresOrmoluPlugin $ goldenGitDiff "works with custom tab size" "test/testdata/format/Format.formatted_document_with_tabsize.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do doc <- openDoc "Format.hs" "haskell" formatDoc doc (FormattingOptions 5 True Nothing Nothing Nothing) BS.fromStrict . T.encodeUtf8 <$> documentContents doc , rangeTests , providerTests - , ormoluTests - , fourmoluTests ] rangeTests :: TestTree -rangeTests = testGroup "format range" [ +rangeTests = requiresOrmoluPlugin $ testGroup "format range" [ goldenGitDiff "works" "test/testdata/format/Format.formatted_range.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do doc <- openDoc "Format.hs" "haskell" formatRange doc (FormattingOptions 2 True Nothing Nothing Nothing) (Range (Position 5 0) (Position 7 10)) @@ -49,13 +49,7 @@ resp <- request STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) liftIO $ resp ^. LSP.result @?= Left (ResponseError InvalidRequest "No plugin enabled for STextDocumentFormatting, available: []" Nothing) - , testCase "respects initial" $ runSessionWithConfig (formatConfig "floskell") hlsCommand fullCaps "test/testdata/format" $ do - doc <- openDoc "Format.hs" "haskell" - formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.initial.hs" - formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) - documentContents doc >>= liftIO . (@?= formattedFloskell) - - , testCase "can change on the fly" $ runSession hlsCommand fullCaps "test/testdata/format" $ do + , requiresOrmoluPlugin . requiresFloskellPlugin $ testCase "can change on the fly" $ runSession hlsCommand fullCaps "test/testdata/format" $ do formattedOrmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu.formatted.hs" formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.formatted.hs" formattedOrmoluPostFloskell <- liftIO $ T.readFile "test/testdata/format/Format.ormolu_post_floskell.formatted.hs" @@ -73,7 +67,7 @@ sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) documentContents doc >>= liftIO . (@?= formattedOrmoluPostFloskell) - , testCase "supports both new and old configuration sections" $ runSession hlsCommand fullCaps "test/testdata/format" $ do + , requiresOrmoluPlugin . requiresFloskellPlugin $ testCase "supports both new and old configuration sections" $ runSession hlsCommand fullCaps "test/testdata/format" $ do formattedOrmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu.formatted.hs" formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.formatted.hs" @@ -87,35 +81,6 @@ formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) documentContents doc >>= liftIO . (@?= formattedFloskell) ] - - -ormoluTests :: TestTree -ormoluTests = testGroup "ormolu" - [ goldenGitDiff "formats correctly" "test/testdata/format/Format.ormolu.formatted.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do - sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) - doc <- openDoc "Format.hs" "haskell" - formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) - BS.fromStrict . T.encodeUtf8 <$> documentContents doc - , goldenGitDiff "formats imports correctly" "test/testdata/format/Format2.ormolu.formatted.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do - sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) - doc <- openDoc "Format2.hs" "haskell" - formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) - BS.fromStrict . T.encodeUtf8 <$> documentContents doc - ] - -fourmoluTests :: TestTree -fourmoluTests = testGroup "fourmolu" - [ goldenGitDiff "formats correctly" "test/testdata/format/Format.fourmolu.formatted.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do - sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "fourmolu")) - doc <- openDoc "Format.hs" "haskell" - formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) - BS.fromStrict . T.encodeUtf8 <$> documentContents doc - , goldenGitDiff "formats imports correctly" "test/testdata/format/Format2.fourmolu.formatted.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do - sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "fourmolu")) - doc <- openDoc "Format2.hs" "haskell" - formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) - BS.fromStrict . T.encodeUtf8 <$> documentContents doc - ] formatLspConfig :: Value -> Value formatLspConfig provider = object [ "haskell" .= object ["formattingProvider" .= (provider :: Value)] ] diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -1,7 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module FunctionalCodeAction (tests) where @@ -21,7 +19,6 @@ import Test.Hspec.Expectations import System.FilePath (()) -import System.IO.Extra (withTempDir) import Test.Hls.Command {-# ANN module ("HLint: ignore Reduce duplication"::String) #-} @@ -30,8 +27,6 @@ tests = testGroup "code actions" [ hlintTests , importTests - , missingPragmaTests - , disableWarningTests , packageTests , redundantImportTests , renameTests @@ -163,6 +158,22 @@ , testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do testRefactor "ApplyRefact6.hs" "Redundant bracket" expectedComments + + , testCase "applyAll is shown only when there is at least one diagnostic in range" $ runHlintSession "" $ do + doc <- openDoc "ApplyRefact8.hs" "haskell" + _ <- waitForDiagnosticsFromSource doc "hlint" + + firstLine <- map fromAction <$> getCodeActions doc (mkRange 0 0 0 0) + secondLine <- map fromAction <$> getCodeActions doc (mkRange 1 0 1 0) + thirdLine <- map fromAction <$> getCodeActions doc (mkRange 2 0 2 0) + multiLine <- map fromAction <$> getCodeActions doc (mkRange 0 0 2 0) + + let hasApplyAll = isJust . find (\ca -> "Apply all hints" `T.isSuffixOf` (ca ^. L.title)) + + liftIO $ hasApplyAll firstLine @? "Missing apply all code action" + liftIO $ hasApplyAll secondLine @? "Missing apply all code action" + liftIO $ not (hasApplyAll thirdLine) @? "Unexpected apply all code action" + liftIO $ hasApplyAll multiLine @? "Missing apply all code action" ] where runHlintSession :: FilePath -> Session a -> IO a @@ -460,184 +471,6 @@ liftIO $ T.lines contents @?= expected ] -missingPragmaTests :: TestTree -missingPragmaTests = testGroup "missing pragma warning code actions" [ - testCase "Adds TypeSynonymInstances pragma" $ do - runSession hlsCommand fullCaps "test/testdata/addPragmas" $ do - doc <- openDoc "NeedsPragmas.hs" "haskell" - - _ <- waitForDiagnosticsFromSource doc "typecheck" - cas <- map fromAction <$> getAllCodeActions doc - - liftIO $ "Add \"TypeSynonymInstances\"" `elem` map (^. L.title) cas @? "Contains TypeSynonymInstances code action" - liftIO $ "Add \"FlexibleInstances\"" `elem` map (^. L.title) cas @? "Contains FlexibleInstances code action" - - executeCodeAction $ head cas - - contents <- documentContents doc - - let expected = [ "{-# LANGUAGE TypeSynonymInstances #-}" - , "module NeedsPragmas where" - , "" - , "import GHC.Generics" - , "" - , "main = putStrLn \"hello\"" - , "" - , "type Foo = Int" - , "" - , "instance Show Foo where" - , " show x = undefined" - , "" - , "instance Show (Int,String) where" - , " show = undefined" - , "" - , "data FFF a = FFF Int String a" - , " deriving (Generic,Functor,Traversable)" - ] - - liftIO $ T.lines contents @?= expected - - , testCase "Adds TypeApplications pragma" $ do - runSession hlsCommand fullCaps "test/testdata/addPragmas" $ do - doc <- openDoc "TypeApplications.hs" "haskell" - - _ <- waitForDiagnosticsFrom doc - cas <- map fromAction <$> getAllCodeActions doc - - liftIO $ "Add \"TypeApplications\"" `elem` map (^. L.title) cas @? "Contains TypeApplications code action" - - executeCodeAction $ head cas - - contents <- documentContents doc - - let expected = --- TODO: Why CPP??? -#if __GLASGOW_HASKELL__ < 810 - [ "{-# LANGUAGE ScopedTypeVariables #-}" - , "{-# LANGUAGE TypeApplications #-}" -#else - [ "{-# LANGUAGE TypeApplications #-}" - , "{-# LANGUAGE ScopedTypeVariables #-}" -#endif - , "module TypeApplications where" - , "" - , "foo :: forall a. a -> a" - , "foo = id @a" - ] - - liftIO $ T.lines contents @?= expected - , testCase "No duplication" $ do - runSession hlsCommand fullCaps "test/testdata/addPragmas" $ do - doc <- openDoc "NamedFieldPuns.hs" "haskell" - - _ <- waitForDiagnosticsFrom doc - cas <- map fromAction <$> getCodeActions doc (Range (Position 8 9) (Position 8 9)) - - liftIO $ length cas == 1 @? "Expected one code action, but got: " <> show cas - let ca = head cas - - liftIO $ (ca ^. L.title == "Add \"NamedFieldPuns\"") @? "NamedFieldPuns code action" - - executeCodeAction ca - - contents <- documentContents doc - - let expected = - [ "{-# LANGUAGE NamedFieldPuns #-}" - , "module NamedFieldPuns where" - , "" - , "data Record = Record" - , " { a :: Int," - , " b :: Double," - , " c :: String" - , " }" - , "" - , "f Record{a, b} = a" - ] - liftIO $ T.lines contents @?= expected - , testCase "After Shebang" $ do - runSession hlsCommand fullCaps "test/testdata/addPragmas" $ do - doc <- openDoc "AfterShebang.hs" "haskell" - - _ <- waitForDiagnosticsFrom doc - cas <- map fromAction <$> getAllCodeActions doc - - liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action" - - executeCodeAction $ head cas - - contents <- documentContents doc - - let expected = - [ "#! /usr/bin/env nix-shell" - , "#! nix-shell --pure -i runghc -p \"haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])\"" - , "" - , "{-# LANGUAGE NamedFieldPuns #-}" - , "module AfterShebang where" - , "" - , "data Record = Record" - , " { a :: Int," - , " b :: Double," - , " c :: String" - , " }" - , "" - , "f Record{a, b} = a" - ] - - liftIO $ T.lines contents @?= expected - ] - -disableWarningTests :: TestTree -disableWarningTests = - testGroup "disable warnings" $ - [ - ( "missing-signatures" - , T.unlines - [ "{-# OPTIONS_GHC -Wall #-}" - , "main = putStrLn \"hello\"" - ] - , T.unlines - [ "{-# OPTIONS_GHC -Wall #-}" - , "{-# OPTIONS_GHC -Wno-missing-signatures #-}" - , "main = putStrLn \"hello\"" - ] - ) - , - ( "unused-imports" - , T.unlines - [ "{-# OPTIONS_GHC -Wall #-}" - , "" - , "" - , "module M where" - , "" - , "import Data.Functor" - ] - , T.unlines - [ "{-# OPTIONS_GHC -Wall #-}" - , "" - , "" - , "{-# OPTIONS_GHC -Wno-unused-imports #-}" - , "module M where" - , "" - , "import Data.Functor" - ] - ) - ] - <&> \(warning, initialContent, expectedContent) -> testSession (T.unpack warning) $ do - doc <- createDoc "Module.hs" "haskell" initialContent - _ <- waitForDiagnostics - codeActs <- mapMaybe caResultToCodeAct <$> getAllCodeActions doc - case find (\CodeAction{_title} -> _title == "Disable \"" <> warning <> "\" warnings") codeActs of - Nothing -> liftIO $ assertFailure "No code action with expected title" - Just action -> do - executeCodeAction action - contentAfterAction <- documentContents doc - liftIO $ expectedContent @=? contentAfterAction - where - caResultToCodeAct = \case - InL _ -> Nothing - InR c -> Just c - unusedTermTests :: TestTree unusedTermTests = testGroup "unused term code actions" [ ignoreTestBecause "no support for prefixing unused names with _" $ testCase "Prefixes with '_'" $ @@ -694,7 +527,3 @@ where textDocumentCaps = def { C._codeAction = Just codeActionCaps } codeActionCaps = CodeActionClientCapabilities (Just True) Nothing Nothing Nothing Nothing Nothing Nothing - -testSession :: String -> Session () -> TestTree -testSession name s = testCase name $ withTempDir $ \dir -> - runSession hlsCommand fullCaps dir s diff --git a/test/functional/Main.hs b/test/functional/Main.hs --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -12,7 +12,6 @@ import FunctionalLiquid import HieBios import Highlight -import ModuleName import Progress import Reference import Rename @@ -36,7 +35,6 @@ , FunctionalLiquid.tests , HieBios.tests , Highlight.tests - , ModuleName.tests , Progress.tests , Reference.tests , Rename.tests diff --git a/test/functional/ModuleName.hs b/test/functional/ModuleName.hs deleted file mode 100644 --- a/test/functional/ModuleName.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module ModuleName - ( tests - ) -where - -import qualified Data.Text.IO as T -import System.FilePath ((<.>), ()) -import Test.Hls -import Test.Hls.Command - -tests :: TestTree -tests = testGroup - "moduleName" - [ testCase "Add module header to empty module" $ goldenTest "TEmptyModule.hs" - , testCase "Fix wrong module name" $ goldenTest "TWrongModuleName.hs" - , testCase "Must infer module name as Main, if the file name starts with a lowercase" $ goldenTest "mainlike.hs" - ] - -goldenTest :: FilePath -> IO () -goldenTest input = runSession hlsCommand fullCaps testdataPath $ do - doc <- openDoc input "haskell" - -- getCodeLenses doc >>= liftIO . print . length - [CodeLens { _command = Just c }] <- getCodeLenses doc - executeCommand c - _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) - edited <- documentContents doc - -- liftIO $ T.writeFile (testdataPath input <.> "expected") edited - expected <- liftIO $ T.readFile $ testdataPath input <.> "expected" - liftIO $ edited @?= expected - -testdataPath :: FilePath -testdataPath = "test/testdata/moduleName" diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -19,6 +19,7 @@ import System.FilePath (()) import Test.Hls import Test.Hls.Command +import Test.Hls.Flags tests :: TestTree tests = @@ -29,7 +30,7 @@ let path = "hlint" "ApplyRefact2.hs" _ <- openDoc path "haskell" expectProgressReports [pack ("Setting up hlint (for " ++ path ++ ")"), "Processing", "Indexing"] - , testCase "eval plugin sends progress reports" $ + , 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"] @@ -37,14 +38,14 @@ let cmd = evalLens ^?! L.command . _Just _ <- sendRequest SWorkspaceExecuteCommand $ ExecuteCommandParams Nothing (cmd ^. L.command) (decode $ encode $ fromJust $ cmd ^. L.arguments) expectProgressReports ["Evaluating"] - , testCase "ormolu plugin sends progress notifications" $ do + , requiresOrmoluPlugin $ testCase "ormolu plugin sends progress notifications" $ do runSession hlsCommand progressCaps "test/testdata/format" $ do sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) doc <- openDoc "Format.hs" "haskell" expectProgressReports ["Setting up testdata (for Format.hs)", "Processing", "Indexing"] _ <- sendRequest STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) expectProgressReports ["Formatting Format.hs"] - , testCase "fourmolu plugin sends progress notifications" $ do + , requiresFourmoluPlugin $ testCase "fourmolu plugin sends progress notifications" $ do runSession hlsCommand progressCaps "test/testdata/format" $ do sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "fourmolu")) doc <- openDoc "Format.hs" "haskell" diff --git a/test/testdata/addPragmas/AfterShebang.hs b/test/testdata/addPragmas/AfterShebang.hs deleted file mode 100644 --- a/test/testdata/addPragmas/AfterShebang.hs +++ /dev/null @@ -1,12 +0,0 @@ -#! /usr/bin/env nix-shell -#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" - -module AfterShebang where - -data Record = Record - { a :: Int, - b :: Double, - c :: String - } - -f Record{a, b} = a diff --git a/test/testdata/addPragmas/NamedFieldPuns.hs b/test/testdata/addPragmas/NamedFieldPuns.hs deleted file mode 100644 --- a/test/testdata/addPragmas/NamedFieldPuns.hs +++ /dev/null @@ -1,9 +0,0 @@ -module NamedFieldPuns where - -data Record = Record - { a :: Int, - b :: Double, - c :: String - } - -f Record{a, b} = a diff --git a/test/testdata/addPragmas/NeedsPragmas.hs b/test/testdata/addPragmas/NeedsPragmas.hs deleted file mode 100644 --- a/test/testdata/addPragmas/NeedsPragmas.hs +++ /dev/null @@ -1,16 +0,0 @@ -module NeedsPragmas where - -import GHC.Generics - -main = putStrLn "hello" - -type Foo = Int - -instance Show Foo where - show x = undefined - -instance Show (Int,String) where - show = undefined - -data FFF a = FFF Int String a - deriving (Generic,Functor,Traversable) diff --git a/test/testdata/addPragmas/TypeApplications.hs b/test/testdata/addPragmas/TypeApplications.hs deleted file mode 100644 --- a/test/testdata/addPragmas/TypeApplications.hs +++ /dev/null @@ -1,5 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -module TypeApplications where - -foo :: forall a. a -> a -foo = id @a diff --git a/test/testdata/addPragmas/hie.yaml b/test/testdata/addPragmas/hie.yaml deleted file mode 100644 --- a/test/testdata/addPragmas/hie.yaml +++ /dev/null @@ -1,6 +0,0 @@ -cradle: - direct: - arguments: - - "NeedsPragmas" - - "TypeApplications" - - "NamedFieldPuns" diff --git a/test/testdata/eval/dist-newstyle/build/x86_64-osx/ghc-8.10.2/test-0.1.0.0/build/autogen/Paths_test.hs b/test/testdata/eval/dist-newstyle/build/x86_64-osx/ghc-8.10.2/test-0.1.0.0/build/autogen/Paths_test.hs new file mode 100644 --- /dev/null +++ b/test/testdata/eval/dist-newstyle/build/x86_64-osx/ghc-8.10.2/test-0.1.0.0/build/autogen/Paths_test.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoRebindableSyntax #-} +{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} +module Paths_test ( + version, + getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, + getDataFileName, getSysconfDir + ) where + +import qualified Control.Exception as Exception +import Data.Version (Version(..)) +import System.Environment (getEnv) +import Prelude + +#if defined(VERSION_base) + +#if MIN_VERSION_base(4,0,0) +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#else +catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a +#endif + +#else +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#endif +catchIO = Exception.catch + +version :: Version +version = Version [0,1,0,0] [] +bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath + +bindir = "/Users/pepeiborra/.cabal/bin" +libdir = "/Users/pepeiborra/.cabal/lib/x86_64-osx-ghc-8.10.2/test-0.1.0.0-inplace" +dynlibdir = "/Users/pepeiborra/.cabal/lib/x86_64-osx-ghc-8.10.2" +datadir = "/Users/pepeiborra/.cabal/share/x86_64-osx-ghc-8.10.2/test-0.1.0.0" +libexecdir = "/Users/pepeiborra/.cabal/libexec/x86_64-osx-ghc-8.10.2/test-0.1.0.0" +sysconfdir = "/Users/pepeiborra/.cabal/etc" + +getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath +getBinDir = catchIO (getEnv "test_bindir") (\_ -> return bindir) +getLibDir = catchIO (getEnv "test_libdir") (\_ -> return libdir) +getDynLibDir = catchIO (getEnv "test_dynlibdir") (\_ -> return dynlibdir) +getDataDir = catchIO (getEnv "test_datadir") (\_ -> return datadir) +getLibexecDir = catchIO (getEnv "test_libexecdir") (\_ -> return libexecdir) +getSysconfDir = catchIO (getEnv "test_sysconfdir") (\_ -> return sysconfdir) + +getDataFileName :: FilePath -> IO FilePath +getDataFileName name = do + dir <- getDataDir + return (dir ++ "/" ++ name) diff --git a/test/testdata/eval/dist-newstyle/build/x86_64-osx/ghc-8.10.2/test-0.1.0.0/build/autogen/cabal_macros.h b/test/testdata/eval/dist-newstyle/build/x86_64-osx/ghc-8.10.2/test-0.1.0.0/build/autogen/cabal_macros.h new file mode 100644 --- /dev/null +++ b/test/testdata/eval/dist-newstyle/build/x86_64-osx/ghc-8.10.2/test-0.1.0.0/build/autogen/cabal_macros.h @@ -0,0 +1,143 @@ +/* DO NOT EDIT: This file is automatically generated by Cabal */ + +/* package test-0.1.0.0 */ +#ifndef VERSION_test +#define VERSION_test "0.1.0.0" +#endif /* VERSION_test */ +#ifndef MIN_VERSION_test +#define MIN_VERSION_test(major1,major2,minor) (\ + (major1) < 0 || \ + (major1) == 0 && (major2) < 1 || \ + (major1) == 0 && (major2) == 1 && (minor) <= 0) +#endif /* MIN_VERSION_test */ + +/* package QuickCheck-2.13.2 */ +#ifndef VERSION_QuickCheck +#define VERSION_QuickCheck "2.13.2" +#endif /* VERSION_QuickCheck */ +#ifndef MIN_VERSION_QuickCheck +#define MIN_VERSION_QuickCheck(major1,major2,minor) (\ + (major1) < 2 || \ + (major1) == 2 && (major2) < 13 || \ + (major1) == 2 && (major2) == 13 && (minor) <= 2) +#endif /* MIN_VERSION_QuickCheck */ + +/* package base-4.14.1.0 */ +#ifndef VERSION_base +#define VERSION_base "4.14.1.0" +#endif /* VERSION_base */ +#ifndef MIN_VERSION_base +#define MIN_VERSION_base(major1,major2,minor) (\ + (major1) < 4 || \ + (major1) == 4 && (major2) < 14 || \ + (major1) == 4 && (major2) == 14 && (minor) <= 1) +#endif /* MIN_VERSION_base */ + +/* tool cpphs-1.20.9 */ +#ifndef TOOL_VERSION_cpphs +#define TOOL_VERSION_cpphs "1.20.9" +#endif /* TOOL_VERSION_cpphs */ +#ifndef MIN_TOOL_VERSION_cpphs +#define MIN_TOOL_VERSION_cpphs(major1,major2,minor) (\ + (major1) < 1 || \ + (major1) == 1 && (major2) < 20 || \ + (major1) == 1 && (major2) == 20 && (minor) <= 9) +#endif /* MIN_TOOL_VERSION_cpphs */ + +/* tool gcc-4.2.1 */ +#ifndef TOOL_VERSION_gcc +#define TOOL_VERSION_gcc "4.2.1" +#endif /* TOOL_VERSION_gcc */ +#ifndef MIN_TOOL_VERSION_gcc +#define MIN_TOOL_VERSION_gcc(major1,major2,minor) (\ + (major1) < 4 || \ + (major1) == 4 && (major2) < 2 || \ + (major1) == 4 && (major2) == 2 && (minor) <= 1) +#endif /* MIN_TOOL_VERSION_gcc */ + +/* tool ghc-8.10.2 */ +#ifndef TOOL_VERSION_ghc +#define TOOL_VERSION_ghc "8.10.2" +#endif /* TOOL_VERSION_ghc */ +#ifndef MIN_TOOL_VERSION_ghc +#define MIN_TOOL_VERSION_ghc(major1,major2,minor) (\ + (major1) < 8 || \ + (major1) == 8 && (major2) < 10 || \ + (major1) == 8 && (major2) == 10 && (minor) <= 2) +#endif /* MIN_TOOL_VERSION_ghc */ + +/* tool ghc-pkg-8.10.2 */ +#ifndef TOOL_VERSION_ghc_pkg +#define TOOL_VERSION_ghc_pkg "8.10.2" +#endif /* TOOL_VERSION_ghc_pkg */ +#ifndef MIN_TOOL_VERSION_ghc_pkg +#define MIN_TOOL_VERSION_ghc_pkg(major1,major2,minor) (\ + (major1) < 8 || \ + (major1) == 8 && (major2) < 10 || \ + (major1) == 8 && (major2) == 10 && (minor) <= 2) +#endif /* MIN_TOOL_VERSION_ghc_pkg */ + +/* tool haddock-2.24.0 */ +#ifndef TOOL_VERSION_haddock +#define TOOL_VERSION_haddock "2.24.0" +#endif /* TOOL_VERSION_haddock */ +#ifndef MIN_TOOL_VERSION_haddock +#define MIN_TOOL_VERSION_haddock(major1,major2,minor) (\ + (major1) < 2 || \ + (major1) == 2 && (major2) < 24 || \ + (major1) == 2 && (major2) == 24 && (minor) <= 0) +#endif /* MIN_TOOL_VERSION_haddock */ + +/* tool hpc-0.68 */ +#ifndef TOOL_VERSION_hpc +#define TOOL_VERSION_hpc "0.68" +#endif /* TOOL_VERSION_hpc */ +#ifndef MIN_TOOL_VERSION_hpc +#define MIN_TOOL_VERSION_hpc(major1,major2,minor) (\ + (major1) < 0 || \ + (major1) == 0 && (major2) < 68 || \ + (major1) == 0 && (major2) == 68 && (minor) <= 0) +#endif /* MIN_TOOL_VERSION_hpc */ + +/* tool hsc2hs-0.68.7 */ +#ifndef TOOL_VERSION_hsc2hs +#define TOOL_VERSION_hsc2hs "0.68.7" +#endif /* TOOL_VERSION_hsc2hs */ +#ifndef MIN_TOOL_VERSION_hsc2hs +#define MIN_TOOL_VERSION_hsc2hs(major1,major2,minor) (\ + (major1) < 0 || \ + (major1) == 0 && (major2) < 68 || \ + (major1) == 0 && (major2) == 68 && (minor) <= 7) +#endif /* MIN_TOOL_VERSION_hsc2hs */ + +/* tool hscolour-1.24 */ +#ifndef TOOL_VERSION_hscolour +#define TOOL_VERSION_hscolour "1.24" +#endif /* TOOL_VERSION_hscolour */ +#ifndef MIN_TOOL_VERSION_hscolour +#define MIN_TOOL_VERSION_hscolour(major1,major2,minor) (\ + (major1) < 1 || \ + (major1) == 1 && (major2) < 24 || \ + (major1) == 1 && (major2) == 24 && (minor) <= 0) +#endif /* MIN_TOOL_VERSION_hscolour */ + +/* tool runghc-8.10.2 */ +#ifndef TOOL_VERSION_runghc +#define TOOL_VERSION_runghc "8.10.2" +#endif /* TOOL_VERSION_runghc */ +#ifndef MIN_TOOL_VERSION_runghc +#define MIN_TOOL_VERSION_runghc(major1,major2,minor) (\ + (major1) < 8 || \ + (major1) == 8 && (major2) < 10 || \ + (major1) == 8 && (major2) == 10 && (minor) <= 2) +#endif /* MIN_TOOL_VERSION_runghc */ + +#ifndef CURRENT_PACKAGE_KEY +#define CURRENT_PACKAGE_KEY "test-0.1.0.0-inplace" +#endif /* CURRENT_PACKAGE_KEY */ +#ifndef CURRENT_COMPONENT_ID +#define CURRENT_COMPONENT_ID "test-0.1.0.0-inplace" +#endif /* CURRENT_COMPONENT_ID */ +#ifndef CURRENT_PACKAGE_VERSION +#define CURRENT_PACKAGE_VERSION "0.1.0.0" +#endif /* CURRENT_PACKAGE_VERSION */ diff --git a/test/testdata/format/Format.floskell.initial.hs b/test/testdata/format/Format.floskell.initial.hs deleted file mode 100644 --- a/test/testdata/format/Format.floskell.initial.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Format where - -import Data.List -import Prelude -import Data.Int - -foo :: Int -> Int -foo 3 = 2 -foo x = x - -bar :: String -> IO String -bar s = do - x <- return "hello" - return "asdf" - -data Baz = Baz { a :: Int, b :: String } - diff --git a/test/testdata/format/Format.fourmolu.formatted.hs b/test/testdata/format/Format.fourmolu.formatted.hs deleted file mode 100644 --- a/test/testdata/format/Format.fourmolu.formatted.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Format where - -import Data.List - -import Data.Int -import Prelude - -foo :: Int -> Int -foo 3 = 2 -foo x = x -bar :: String -> IO String -bar s = do - x <- return "hello" - return "asdf" - -data Baz = Baz {a :: Int, b :: String} diff --git a/test/testdata/format/Format2.fourmolu.formatted.hs b/test/testdata/format/Format2.fourmolu.formatted.hs deleted file mode 100644 --- a/test/testdata/format/Format2.fourmolu.formatted.hs +++ /dev/null @@ -1,5 +0,0 @@ -import Data.Bool -import Data.Char -import Data.Data -import Data.Either -import Data.Int diff --git a/test/testdata/format/Format2.hs b/test/testdata/format/Format2.hs deleted file mode 100644 --- a/test/testdata/format/Format2.hs +++ /dev/null @@ -1,5 +0,0 @@ -import Data.Char -import Data.Either -import Data.Int -import Data.Data -import Data.Bool diff --git a/test/testdata/format/Format2.ormolu.formatted.hs b/test/testdata/format/Format2.ormolu.formatted.hs deleted file mode 100644 --- a/test/testdata/format/Format2.ormolu.formatted.hs +++ /dev/null @@ -1,5 +0,0 @@ -import Data.Bool -import Data.Char -import Data.Data -import Data.Either -import Data.Int diff --git a/test/testdata/hlint/ApplyRefact7.hs b/test/testdata/hlint/ApplyRefact7.hs new file mode 100644 --- /dev/null +++ b/test/testdata/hlint/ApplyRefact7.hs @@ -0,0 +1,2 @@ +main = undefined +foo x y = [x, x] ++ y diff --git a/test/testdata/hlint/ApplyRefact8.hs b/test/testdata/hlint/ApplyRefact8.hs new file mode 100644 --- /dev/null +++ b/test/testdata/hlint/ApplyRefact8.hs @@ -0,0 +1,3 @@ +f = (1) +g = (1) + diff --git a/test/testdata/hlint/test-hlint-config.yaml b/test/testdata/hlint/test-hlint-config.yaml new file mode 100644 --- /dev/null +++ b/test/testdata/hlint/test-hlint-config.yaml @@ -0,0 +1,1 @@ +- ignore: { name: Eta reduce } diff --git a/test/testdata/moduleName/TEmptyModule.hs b/test/testdata/moduleName/TEmptyModule.hs deleted file mode 100644 --- a/test/testdata/moduleName/TEmptyModule.hs +++ /dev/null @@ -1,2 +0,0 @@ - - diff --git a/test/testdata/moduleName/TEmptyModule.hs.expected b/test/testdata/moduleName/TEmptyModule.hs.expected deleted file mode 100644 --- a/test/testdata/moduleName/TEmptyModule.hs.expected +++ /dev/null @@ -1,3 +0,0 @@ -module TEmptyModule where - - diff --git a/test/testdata/moduleName/TWrongModuleName.hs b/test/testdata/moduleName/TWrongModuleName.hs deleted file mode 100644 --- a/test/testdata/moduleName/TWrongModuleName.hs +++ /dev/null @@ -1,7 +0,0 @@ -module BadName - ( x - ) -where - -x :: Integer -x = 11 diff --git a/test/testdata/moduleName/TWrongModuleName.hs.expected b/test/testdata/moduleName/TWrongModuleName.hs.expected deleted file mode 100644 --- a/test/testdata/moduleName/TWrongModuleName.hs.expected +++ /dev/null @@ -1,7 +0,0 @@ -module TWrongModuleName - ( x - ) -where - -x :: Integer -x = 11 diff --git a/test/testdata/moduleName/hie.yaml b/test/testdata/moduleName/hie.yaml deleted file mode 100644 --- a/test/testdata/moduleName/hie.yaml +++ /dev/null @@ -1,1 +0,0 @@ -cradle: { direct: { arguments: ["TEmptyModule", "TWrongModuleName", "mainlike"] } } diff --git a/test/testdata/moduleName/mainlike.hs b/test/testdata/moduleName/mainlike.hs deleted file mode 100644 --- a/test/testdata/moduleName/mainlike.hs +++ /dev/null diff --git a/test/testdata/moduleName/mainlike.hs.expected b/test/testdata/moduleName/mainlike.hs.expected deleted file mode 100644 --- a/test/testdata/moduleName/mainlike.hs.expected +++ /dev/null @@ -1,1 +0,0 @@ -module Main where diff --git a/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.2/test-0.1.0.0/build/autogen/Paths_test.hs b/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.2/test-0.1.0.0/build/autogen/Paths_test.hs deleted file mode 100644 --- a/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.2/test-0.1.0.0/build/autogen/Paths_test.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} -module Paths_test ( - version, - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, - getDataFileName, getSysconfDir - ) where - -import qualified Control.Exception as Exception -import Data.Version (Version(..)) -import System.Environment (getEnv) -import Prelude - -#if defined(VERSION_base) - -#if MIN_VERSION_base(4,0,0) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#else -catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a -#endif - -#else -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#endif -catchIO = Exception.catch - -version :: Version -version = Version [0,1,0,0] [] -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath - -bindir = "/home/berberman/.cabal/bin" -libdir = "/home/berberman/.cabal/lib/x86_64-linux-ghc-8.10.2/test-0.1.0.0-inplace" -dynlibdir = "/home/berberman/.cabal/lib/x86_64-linux-ghc-8.10.2" -datadir = "/home/berberman/.cabal/share/x86_64-linux-ghc-8.10.2/test-0.1.0.0" -libexecdir = "/home/berberman/.cabal/libexec/x86_64-linux-ghc-8.10.2/test-0.1.0.0" -sysconfdir = "/home/berberman/.cabal/etc" - -getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath -getBinDir = catchIO (getEnv "test_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "test_libdir") (\_ -> return libdir) -getDynLibDir = catchIO (getEnv "test_dynlibdir") (\_ -> return dynlibdir) -getDataDir = catchIO (getEnv "test_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "test_libexecdir") (\_ -> return libexecdir) -getSysconfDir = catchIO (getEnv "test_sysconfdir") (\_ -> return sysconfdir) - -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir ++ "/" ++ name) diff --git a/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.2/test-0.1.0.0/build/autogen/cabal_macros.h b/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.2/test-0.1.0.0/build/autogen/cabal_macros.h deleted file mode 100644 --- a/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.2/test-0.1.0.0/build/autogen/cabal_macros.h +++ /dev/null @@ -1,143 +0,0 @@ -/* DO NOT EDIT: This file is automatically generated by Cabal */ - -/* package test-0.1.0.0 */ -#ifndef VERSION_test -#define VERSION_test "0.1.0.0" -#endif /* VERSION_test */ -#ifndef MIN_VERSION_test -#define MIN_VERSION_test(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 1 || \ - (major1) == 0 && (major2) == 1 && (minor) <= 0) -#endif /* MIN_VERSION_test */ - -/* package base-4.14.1.0 */ -#ifndef VERSION_base -#define VERSION_base "4.14.1.0" -#endif /* VERSION_base */ -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(major1,major2,minor) (\ - (major1) < 4 || \ - (major1) == 4 && (major2) < 14 || \ - (major1) == 4 && (major2) == 14 && (minor) <= 1) -#endif /* MIN_VERSION_base */ - -/* tool cpphs-1.20.9 */ -#ifndef TOOL_VERSION_cpphs -#define TOOL_VERSION_cpphs "1.20.9" -#endif /* TOOL_VERSION_cpphs */ -#ifndef MIN_TOOL_VERSION_cpphs -#define MIN_TOOL_VERSION_cpphs(major1,major2,minor) (\ - (major1) < 1 || \ - (major1) == 1 && (major2) < 20 || \ - (major1) == 1 && (major2) == 20 && (minor) <= 9) -#endif /* MIN_TOOL_VERSION_cpphs */ - -/* tool gcc-9.3.0 */ -#ifndef TOOL_VERSION_gcc -#define TOOL_VERSION_gcc "9.3.0" -#endif /* TOOL_VERSION_gcc */ -#ifndef MIN_TOOL_VERSION_gcc -#define MIN_TOOL_VERSION_gcc(major1,major2,minor) (\ - (major1) < 9 || \ - (major1) == 9 && (major2) < 3 || \ - (major1) == 9 && (major2) == 3 && (minor) <= 0) -#endif /* MIN_TOOL_VERSION_gcc */ - -/* tool ghc-8.10.2 */ -#ifndef TOOL_VERSION_ghc -#define TOOL_VERSION_ghc "8.10.2" -#endif /* TOOL_VERSION_ghc */ -#ifndef MIN_TOOL_VERSION_ghc -#define MIN_TOOL_VERSION_ghc(major1,major2,minor) (\ - (major1) < 8 || \ - (major1) == 8 && (major2) < 10 || \ - (major1) == 8 && (major2) == 10 && (minor) <= 2) -#endif /* MIN_TOOL_VERSION_ghc */ - -/* tool ghc-pkg-8.10.2 */ -#ifndef TOOL_VERSION_ghc_pkg -#define TOOL_VERSION_ghc_pkg "8.10.2" -#endif /* TOOL_VERSION_ghc_pkg */ -#ifndef MIN_TOOL_VERSION_ghc_pkg -#define MIN_TOOL_VERSION_ghc_pkg(major1,major2,minor) (\ - (major1) < 8 || \ - (major1) == 8 && (major2) < 10 || \ - (major1) == 8 && (major2) == 10 && (minor) <= 2) -#endif /* MIN_TOOL_VERSION_ghc_pkg */ - -/* tool haddock-2.24.0 */ -#ifndef TOOL_VERSION_haddock -#define TOOL_VERSION_haddock "2.24.0" -#endif /* TOOL_VERSION_haddock */ -#ifndef MIN_TOOL_VERSION_haddock -#define MIN_TOOL_VERSION_haddock(major1,major2,minor) (\ - (major1) < 2 || \ - (major1) == 2 && (major2) < 24 || \ - (major1) == 2 && (major2) == 24 && (minor) <= 0) -#endif /* MIN_TOOL_VERSION_haddock */ - -/* tool hpc-0.68 */ -#ifndef TOOL_VERSION_hpc -#define TOOL_VERSION_hpc "0.68" -#endif /* TOOL_VERSION_hpc */ -#ifndef MIN_TOOL_VERSION_hpc -#define MIN_TOOL_VERSION_hpc(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 68 || \ - (major1) == 0 && (major2) == 68 && (minor) <= 0) -#endif /* MIN_TOOL_VERSION_hpc */ - -/* tool hsc2hs-0.68.7 */ -#ifndef TOOL_VERSION_hsc2hs -#define TOOL_VERSION_hsc2hs "0.68.7" -#endif /* TOOL_VERSION_hsc2hs */ -#ifndef MIN_TOOL_VERSION_hsc2hs -#define MIN_TOOL_VERSION_hsc2hs(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 68 || \ - (major1) == 0 && (major2) == 68 && (minor) <= 7) -#endif /* MIN_TOOL_VERSION_hsc2hs */ - -/* tool hscolour-1.24 */ -#ifndef TOOL_VERSION_hscolour -#define TOOL_VERSION_hscolour "1.24" -#endif /* TOOL_VERSION_hscolour */ -#ifndef MIN_TOOL_VERSION_hscolour -#define MIN_TOOL_VERSION_hscolour(major1,major2,minor) (\ - (major1) < 1 || \ - (major1) == 1 && (major2) < 24 || \ - (major1) == 1 && (major2) == 24 && (minor) <= 0) -#endif /* MIN_TOOL_VERSION_hscolour */ - -/* tool runghc-8.10.2 */ -#ifndef TOOL_VERSION_runghc -#define TOOL_VERSION_runghc "8.10.2" -#endif /* TOOL_VERSION_runghc */ -#ifndef MIN_TOOL_VERSION_runghc -#define MIN_TOOL_VERSION_runghc(major1,major2,minor) (\ - (major1) < 8 || \ - (major1) == 8 && (major2) < 10 || \ - (major1) == 8 && (major2) == 10 && (minor) <= 2) -#endif /* MIN_TOOL_VERSION_runghc */ - -/* tool strip-2.31 */ -#ifndef TOOL_VERSION_strip -#define TOOL_VERSION_strip "2.31" -#endif /* TOOL_VERSION_strip */ -#ifndef MIN_TOOL_VERSION_strip -#define MIN_TOOL_VERSION_strip(major1,major2,minor) (\ - (major1) < 2 || \ - (major1) == 2 && (major2) < 31 || \ - (major1) == 2 && (major2) == 31 && (minor) <= 0) -#endif /* MIN_TOOL_VERSION_strip */ - -#ifndef CURRENT_PACKAGE_KEY -#define CURRENT_PACKAGE_KEY "test-0.1.0.0-inplace" -#endif /* CURRENT_PACKAGE_KEY */ -#ifndef CURRENT_COMPONENT_ID -#define CURRENT_COMPONENT_ID "test-0.1.0.0-inplace" -#endif /* CURRENT_COMPONENT_ID */ -#ifndef CURRENT_PACKAGE_VERSION -#define CURRENT_PACKAGE_VERSION "0.1.0.0" -#endif /* CURRENT_PACKAGE_VERSION */ diff --git a/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/Paths_test.hs b/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/Paths_test.hs deleted file mode 100644 --- a/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/Paths_test.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} -module Paths_test ( - version, - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, - getDataFileName, getSysconfDir - ) where - -import qualified Control.Exception as Exception -import Data.Version (Version(..)) -import System.Environment (getEnv) -import Prelude - -#if defined(VERSION_base) - -#if MIN_VERSION_base(4,0,0) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#else -catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a -#endif - -#else -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#endif -catchIO = Exception.catch - -version :: Version -version = Version [0,1,0,0] [] -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath - -bindir = "/home/berberman/.cabal/bin" -libdir = "/home/berberman/.cabal/lib/x86_64-linux-ghc-8.10.3/test-0.1.0.0-inplace" -dynlibdir = "/home/berberman/.cabal/lib/x86_64-linux-ghc-8.10.3" -datadir = "/home/berberman/.cabal/share/x86_64-linux-ghc-8.10.3/test-0.1.0.0" -libexecdir = "/home/berberman/.cabal/libexec/x86_64-linux-ghc-8.10.3/test-0.1.0.0" -sysconfdir = "/home/berberman/.cabal/etc" - -getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath -getBinDir = catchIO (getEnv "test_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "test_libdir") (\_ -> return libdir) -getDynLibDir = catchIO (getEnv "test_dynlibdir") (\_ -> return dynlibdir) -getDataDir = catchIO (getEnv "test_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "test_libexecdir") (\_ -> return libexecdir) -getSysconfDir = catchIO (getEnv "test_sysconfdir") (\_ -> return sysconfdir) - -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir ++ "/" ++ name) diff --git a/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/cabal_macros.h b/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/cabal_macros.h deleted file mode 100644 --- a/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/cabal_macros.h +++ /dev/null @@ -1,143 +0,0 @@ -/* DO NOT EDIT: This file is automatically generated by Cabal */ - -/* package test-0.1.0.0 */ -#ifndef VERSION_test -#define VERSION_test "0.1.0.0" -#endif /* VERSION_test */ -#ifndef MIN_VERSION_test -#define MIN_VERSION_test(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 1 || \ - (major1) == 0 && (major2) == 1 && (minor) <= 0) -#endif /* MIN_VERSION_test */ - -/* package base-4.14.1.0 */ -#ifndef VERSION_base -#define VERSION_base "4.14.1.0" -#endif /* VERSION_base */ -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(major1,major2,minor) (\ - (major1) < 4 || \ - (major1) == 4 && (major2) < 14 || \ - (major1) == 4 && (major2) == 14 && (minor) <= 1) -#endif /* MIN_VERSION_base */ - -/* tool cpphs-1.20.9 */ -#ifndef TOOL_VERSION_cpphs -#define TOOL_VERSION_cpphs "1.20.9" -#endif /* TOOL_VERSION_cpphs */ -#ifndef MIN_TOOL_VERSION_cpphs -#define MIN_TOOL_VERSION_cpphs(major1,major2,minor) (\ - (major1) < 1 || \ - (major1) == 1 && (major2) < 20 || \ - (major1) == 1 && (major2) == 20 && (minor) <= 9) -#endif /* MIN_TOOL_VERSION_cpphs */ - -/* tool gcc-10.2.0 */ -#ifndef TOOL_VERSION_gcc -#define TOOL_VERSION_gcc "10.2.0" -#endif /* TOOL_VERSION_gcc */ -#ifndef MIN_TOOL_VERSION_gcc -#define MIN_TOOL_VERSION_gcc(major1,major2,minor) (\ - (major1) < 10 || \ - (major1) == 10 && (major2) < 2 || \ - (major1) == 10 && (major2) == 2 && (minor) <= 0) -#endif /* MIN_TOOL_VERSION_gcc */ - -/* tool ghc-8.10.3 */ -#ifndef TOOL_VERSION_ghc -#define TOOL_VERSION_ghc "8.10.3" -#endif /* TOOL_VERSION_ghc */ -#ifndef MIN_TOOL_VERSION_ghc -#define MIN_TOOL_VERSION_ghc(major1,major2,minor) (\ - (major1) < 8 || \ - (major1) == 8 && (major2) < 10 || \ - (major1) == 8 && (major2) == 10 && (minor) <= 3) -#endif /* MIN_TOOL_VERSION_ghc */ - -/* tool ghc-pkg-8.10.3 */ -#ifndef TOOL_VERSION_ghc_pkg -#define TOOL_VERSION_ghc_pkg "8.10.3" -#endif /* TOOL_VERSION_ghc_pkg */ -#ifndef MIN_TOOL_VERSION_ghc_pkg -#define MIN_TOOL_VERSION_ghc_pkg(major1,major2,minor) (\ - (major1) < 8 || \ - (major1) == 8 && (major2) < 10 || \ - (major1) == 8 && (major2) == 10 && (minor) <= 3) -#endif /* MIN_TOOL_VERSION_ghc_pkg */ - -/* tool haddock-2.24.0 */ -#ifndef TOOL_VERSION_haddock -#define TOOL_VERSION_haddock "2.24.0" -#endif /* TOOL_VERSION_haddock */ -#ifndef MIN_TOOL_VERSION_haddock -#define MIN_TOOL_VERSION_haddock(major1,major2,minor) (\ - (major1) < 2 || \ - (major1) == 2 && (major2) < 24 || \ - (major1) == 2 && (major2) == 24 && (minor) <= 0) -#endif /* MIN_TOOL_VERSION_haddock */ - -/* tool hpc-0.68 */ -#ifndef TOOL_VERSION_hpc -#define TOOL_VERSION_hpc "0.68" -#endif /* TOOL_VERSION_hpc */ -#ifndef MIN_TOOL_VERSION_hpc -#define MIN_TOOL_VERSION_hpc(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 68 || \ - (major1) == 0 && (major2) == 68 && (minor) <= 0) -#endif /* MIN_TOOL_VERSION_hpc */ - -/* tool hsc2hs-0.68.7 */ -#ifndef TOOL_VERSION_hsc2hs -#define TOOL_VERSION_hsc2hs "0.68.7" -#endif /* TOOL_VERSION_hsc2hs */ -#ifndef MIN_TOOL_VERSION_hsc2hs -#define MIN_TOOL_VERSION_hsc2hs(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 68 || \ - (major1) == 0 && (major2) == 68 && (minor) <= 7) -#endif /* MIN_TOOL_VERSION_hsc2hs */ - -/* tool hscolour-1.24 */ -#ifndef TOOL_VERSION_hscolour -#define TOOL_VERSION_hscolour "1.24" -#endif /* TOOL_VERSION_hscolour */ -#ifndef MIN_TOOL_VERSION_hscolour -#define MIN_TOOL_VERSION_hscolour(major1,major2,minor) (\ - (major1) < 1 || \ - (major1) == 1 && (major2) < 24 || \ - (major1) == 1 && (major2) == 24 && (minor) <= 0) -#endif /* MIN_TOOL_VERSION_hscolour */ - -/* tool runghc-8.10.3 */ -#ifndef TOOL_VERSION_runghc -#define TOOL_VERSION_runghc "8.10.3" -#endif /* TOOL_VERSION_runghc */ -#ifndef MIN_TOOL_VERSION_runghc -#define MIN_TOOL_VERSION_runghc(major1,major2,minor) (\ - (major1) < 8 || \ - (major1) == 8 && (major2) < 10 || \ - (major1) == 8 && (major2) == 10 && (minor) <= 3) -#endif /* MIN_TOOL_VERSION_runghc */ - -/* tool strip-2.34 */ -#ifndef TOOL_VERSION_strip -#define TOOL_VERSION_strip "2.34" -#endif /* TOOL_VERSION_strip */ -#ifndef MIN_TOOL_VERSION_strip -#define MIN_TOOL_VERSION_strip(major1,major2,minor) (\ - (major1) < 2 || \ - (major1) == 2 && (major2) < 34 || \ - (major1) == 2 && (major2) == 34 && (minor) <= 0) -#endif /* MIN_TOOL_VERSION_strip */ - -#ifndef CURRENT_PACKAGE_KEY -#define CURRENT_PACKAGE_KEY "test-0.1.0.0-inplace" -#endif /* CURRENT_PACKAGE_KEY */ -#ifndef CURRENT_COMPONENT_ID -#define CURRENT_COMPONENT_ID "test-0.1.0.0-inplace" -#endif /* CURRENT_COMPONENT_ID */ -#ifndef CURRENT_PACKAGE_VERSION -#define CURRENT_PACKAGE_VERSION "0.1.0.0" -#endif /* CURRENT_PACKAGE_VERSION */ 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 -j2 -l test-logs/" ++ logFilePath + pure $ testExe ++ " --lsp -d -j4 -l test-logs/" ++ logFilePath hlsCommandVomit :: String hlsCommandVomit = hlsCommand ++ " --vomit" diff --git a/test/utils/Test/Hls/Flags.hs b/test/utils/Test/Hls/Flags.hs new file mode 100644 --- /dev/null +++ b/test/utils/Test/Hls/Flags.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +-- | Module for disabling tests if their plugins are disabled +module Test.Hls.Flags where + +import Test.Hls (TestTree, ignoreTestBecause) + +-- * Plugin dependent tests + +-- | Disable test unless the class flag is set +requiresClassPlugin :: TestTree -> TestTree +#if class +requiresClassPlugin = id +#else +requiresClassPlugin = ignoreTestBecause "Class plugin disabled" +#endif + +-- | Disable test unless the haddockComments flag is set +requiresHaddockCommentsPlugin :: TestTree -> TestTree +#if haddockComments +requiresHaddockCommentsPlugin = id +#else +requiresHaddockCommentsPlugin = ignoreTestBecause "HaddockComments plugin disabled" +#endif + +-- | Disable test unless the eval flag is set +requiresEvalPlugin :: TestTree -> TestTree +#if eval +requiresEvalPlugin = id +#else +requiresEvalPlugin = ignoreTestBecause "Eval plugin disabled" +#endif + +-- | Disable test unless the importLens flag is set +requiresImportLensPlugin :: TestTree -> TestTree +#if importLens +requiresImportLensPlugin = id +#else +requiresImportLensPlugin = ignoreTestBecause "ImportLens plugin disabled" +#endif + +-- | Disable test unless the retrie flag is set +requiresRetriePlugin :: TestTree -> TestTree +#if retrie +requiresRetriePlugin = id +#else +requiresRetriePlugin = ignoreTestBecause "Retrie plugin disabled" +#endif + +-- | Disable test unless the tactic flag is set +requiresTacticPlugin :: TestTree -> TestTree +#if tactic +requiresTacticPlugin = id +#else +requiresTacticPlugin = ignoreTestBecause "Tactic plugin disabled" +#endif + +-- | Disable test unless the hlint flag is set +requiresHlintPlugin :: TestTree -> TestTree +#if hlint +requiresHlintPlugin = id +#else +requiresHlintPlugin = ignoreTestBecause "Hlint plugin disabled" +#endif + +-- | Disable test unless the moduleName flag is set +requiresModuleNamePlugin :: TestTree -> TestTree +#if moduleName +requiresModuleNamePlugin = id +#else +requiresModuleNamePlugin = ignoreTestBecause "ModuleName plugin disabled" +#endif + +-- | Disable test unless the pragmas flag is set +requiresPragmasPlugin :: TestTree -> TestTree +#if pragmas +requiresPragmasPlugin = id +#else +requiresPragmasPlugin = ignoreTestBecause "Pragmas plugin disabled" +#endif + +-- | Disable test unless the splice flag is set +requiresSplicePlugin :: TestTree -> TestTree +#if splice +requiresSplicePlugin = id +#else +requiresSplicePlugin = ignoreTestBecause "Splice plugin disabled" +#endif + + +-- * Formatters +-- | Disable test unless the floskell flag is set +requiresFloskellPlugin :: TestTree -> TestTree +#if floskell +requiresFloskellPlugin = id +#else +requiresFloskellPlugin = ignoreTestBecause "Floskell plugin disabled" +#endif + +-- | Disable test unless the fourmolu flag is set +requiresFourmoluPlugin :: TestTree -> TestTree +#if fourmolu +requiresFourmoluPlugin = id +#else +requiresFourmoluPlugin = ignoreTestBecause "Fourmolu plugin disabled" +#endif + +-- | Disable test unless the ormolu flag is set +requiresOrmoluPlugin :: TestTree -> TestTree +#if ormolu +requiresOrmoluPlugin = id +#else +requiresOrmoluPlugin = ignoreTestBecause "Ormolu plugin disabled" +#endif + +-- | Disable test unless the stylishHaskell flag is set +requiresStylishHaskellPlugin :: TestTree -> TestTree +#if stylishHaskell +requiresStylishHaskellPlugin = id +#else +requiresStylishHaskellPlugin = ignoreTestBecause "StylishHaskell plugin disabled" +#endif + +-- | Disable test unless the brittany flag is set +requiresBrittanyPlugin :: TestTree -> TestTree +#if brittany +requiresBrittanyPlugin = id +#else +requiresBrittanyPlugin = ignoreTestBecause "Brittany plugin disabled" +#endif + diff --git a/test/wrapper/Main.hs b/test/wrapper/Main.hs --- a/test/wrapper/Main.hs +++ b/test/wrapper/Main.hs @@ -1,4 +1,4 @@ -import Data.List.Extra (trimEnd) +import Data.List.Extra (isInfixOf, trimEnd) import Data.Maybe import System.Environment import System.Process @@ -18,6 +18,11 @@ , testCase "cabal with global ghc" $ do ghcVer <- trimEnd <$> readProcess "ghc" ["--numeric-version"] "" testDir "test/wrapper/testdata/cabal-cur-ver" ghcVer + , testCase "stack with existing cabal build artifact" $ do + -- Should report cabal as existing build artifacts are more important than + -- the existence of 'stack.yaml' + testProjectType "test/wrapper/testdata/stack-with-dist-newstyle" + ("cradleOptsProg = CradleAction: Cabal" `isInfixOf`) ] testDir :: FilePath -> String -> Assertion @@ -27,3 +32,15 @@ <$> lookupEnv "HLS_WRAPPER_TEST_EXE" actualVer <- trimEnd <$> readProcess testExe ["--project-ghc-version"] "" actualVer @?= expectedVer + +testProjectType :: FilePath -> (String -> Bool) -> Assertion +testProjectType dir matcher = + withCurrentDirectoryInTmp' [".stack-work", "dist"] dir $ do + wrapperTestExe <- fromMaybe "haskell-language-server-wrapper" + <$> lookupEnv "HLS_WRAPPER_TEST_EXE" + hlsTestExe <- fromMaybe "haskell-language-server" + <$> lookupEnv "HLS_TEST_EXE" + actualWrapperCradle <- trimEnd <$> readProcess wrapperTestExe ["--print-cradle"] "" + actualHlsCradle <- trimEnd <$> readProcess hlsTestExe ["--print-cradle"] "" + matcher actualWrapperCradle @? "Wrapper reported wrong project type: " ++ actualWrapperCradle + matcher actualHlsCradle @? "HLS reported wrong project type: " ++ actualHlsCradle