mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-10-26 03:03:07 +03:00
Merge remote-tracking branch 'origin/master' into hie-bios
This commit is contained in:
Matthew Pickering
commit
0f507e607f
@ -40,11 +40,14 @@ defaults: &defaults
|
||||
|
||||
- run:
|
||||
name: Build (we need the exe for tests)
|
||||
command: stack -j 2 --stack-yaml=${STACK_FILE} install
|
||||
command: stack -j 1 --stack-yaml=${STACK_FILE} install
|
||||
# need j1, else ghc-lib-parser triggers OOM
|
||||
no_output_timeout: 30m
|
||||
|
||||
- run:
|
||||
name: Build Testsuite without running it
|
||||
command: stack -j 2 --stack-yaml=${STACK_FILE} build --test --no-run-tests
|
||||
no_output_timeout: 30m
|
||||
|
||||
- store_artifacts:
|
||||
path: ~/.local/bin
|
||||
@ -70,9 +73,7 @@ defaults: &defaults
|
||||
- ~/build/submodules/brittany/.stack-work
|
||||
- ~/build/submodules/ghc-mod/core/.stack-work
|
||||
- ~/build/submodules/ghc-mod/.stack-work
|
||||
- ~/build/submodules/haskell-lsp/.stack-work
|
||||
- ~/build/submodules/cabal-helper/.stack-work
|
||||
- ~/build/submodules/floskell/.stack-work
|
||||
|
||||
- run:
|
||||
name: Test
|
||||
@ -146,6 +147,11 @@ jobs:
|
||||
- STACK_FILE: "stack-8.6.4.yaml"
|
||||
<<: *defaults
|
||||
|
||||
ghc-8.6.5:
|
||||
environment:
|
||||
- STACK_FILE: "stack-8.6.5.yaml"
|
||||
<<: *defaults
|
||||
|
||||
ghc-nightly:
|
||||
environment:
|
||||
- STACK_FILE: "stack.yaml"
|
||||
@ -154,8 +160,7 @@ jobs:
|
||||
cabal:
|
||||
working_directory: ~/build
|
||||
docker:
|
||||
# - image: quay.io/haskell_works/ghc-8.4.3
|
||||
- image: quay.io/haskell_works/ghc-8.6.1
|
||||
- image: quay.io/haskell_works/ghc-8.6.5
|
||||
steps:
|
||||
- checkout
|
||||
- run:
|
||||
@ -178,7 +183,8 @@ jobs:
|
||||
command: cabal new-configure --enable-tests
|
||||
- run:
|
||||
name: Build
|
||||
command: cabal new-build -j2
|
||||
command: cabal new-build -j1 # need j1, else ghc-lib-parser triggers OOM
|
||||
no_output_timeout: 30m
|
||||
- save_cache:
|
||||
key: cabal-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}
|
||||
paths:
|
||||
@ -196,7 +202,8 @@ workflows:
|
||||
- ghc-8.4.4
|
||||
- ghc-8.6.1
|
||||
- ghc-8.6.2
|
||||
- ghc-8.6.3
|
||||
# - ghc-8.6.3
|
||||
- ghc-8.6.4
|
||||
- ghc-8.6.5
|
||||
- ghc-nightly
|
||||
- cabal
|
||||
|
||||
16
.gitmodules
vendored
16
.gitmodules
vendored
@ -28,17 +28,5 @@
|
||||
[submodule "submodules/ghc-mod"]
|
||||
path = submodules/ghc-mod
|
||||
# url = https://github.com/arbor/ghc-mod.git
|
||||
# url = https://github.com/bubba/ghc-mod.git
|
||||
url = https://github.com/mpickering/ghc-mod.git
|
||||
|
||||
|
||||
[submodule "submodules/floskell"]
|
||||
path = submodules/floskell
|
||||
url = https://github.com/ennocramer/floskell
|
||||
# url = https://github.com/alanz/floskell
|
||||
[submodule "haskell-lsp"]
|
||||
path = haskell-lsp
|
||||
url = https://github.com/mpickering/haskell-lsp.git
|
||||
[submodule "lsp-test"]
|
||||
path = lsp-test
|
||||
url = https://github.com/mpickering/lsp-test
|
||||
url = https://github.com/alanz/ghc-mod.git
|
||||
#url = https://github.com/mpickering/ghc-mod.git
|
||||
|
||||
42
Changelog.md
42
Changelog.md
@ -1,3 +1,45 @@
|
||||
# 0.9.0.0
|
||||
|
||||
- GHC 8.6.5 preliminary support added via the nightly build (@alanz)
|
||||
- Resolver bumped, LTS 13.19 for GHC 8.6.4 (@alanz)
|
||||
- Add `diagnosticsOnChange` config parameter, default `True`
|
||||
(preserving prior hie behaviour). Setting it `False` only generates
|
||||
diagnostics on file save. ([#1164](https://github.com/haskell/haskell-ide-engine/pull/1164), @mpickering/@lorenzo)
|
||||
- The `Hsimport` plugin now formats the resulting change using the
|
||||
formatter configured for hie. ([#1167](https://github.com/haskell/haskell-ide-engine/pull/1167),@fendor)
|
||||
- Actually enable type definition requests, if supported by the client
|
||||
(e.g. vscode). ([#1169](https://github.com/haskell/haskell-ide-engine/pull/1169)/@fendor, [#1172](https://github.com/haskell/haskell-ide-engine/pull/1172)/@bubba)
|
||||
- Use LSP MarkupContent for generated documentation ([#1181](https://github.com/haskell/haskell-ide-engine/pull/1181), @alanz)
|
||||
- remove installation of Cabal by cabal ([#1184](https://github.com/haskell/haskell-ide-engine/pull/1184), @power-fungus)
|
||||
- Add EmptyDataDecls to available pragmas, for generating code actions
|
||||
to insert if needed. ([#1187](https://github.com/haskell/haskell-ide-engine/pull/1187),@fendor)
|
||||
- Make sure the end of formatted text is properly indicated for marked
|
||||
up documentation ([#1189](https://github.com/haskell/haskell-ide-engine/pull/1189), @alanz)
|
||||
- Fix some of the tests with cabal new-build ([#1194](https://github.com/haskell/haskell-ide-engine/pull/1194), @michaelpj)
|
||||
- Update build-tool-depends for func-test ([#1198](https://github.com/haskell/haskell-ide-engine/pull/1198), @bubba)
|
||||
- Fix version of lsp-test so `cabal new-build` works ([#1211](https://github.com/haskell/haskell-ide-engine/pull/1211), @power-fungus)
|
||||
- Bump hlint to 2.1.17 ([#1213](https://github.com/haskell/haskell-ide-engine/pull/1213), @alanz)
|
||||
- Use cabal helper that searches with exe extension on windows ([#1217](https://github.com/haskell/haskell-ide-engine/pull/1217), @alanz)
|
||||
|
||||
- Stability improvements
|
||||
- Avoid crash in case of nonsensical hoogle db ([#1174](https://github.com/haskell/haskell-ide-engine/pull/1174), @fendor)
|
||||
- Prevent hie crash if apply-refact crashes ([#1220](https://github.com/haskell/haskell-ide-engine/pull/1220), @Hogeyama)
|
||||
|
||||
- Documentation improvements
|
||||
- Improve code documentation about formatters ([#1165](https://github.com/haskell/haskell-ide-engine/pull/1165),@fendor)
|
||||
- Add code documentation for the Hoogle plugin ([#1173](https://github.com/haskell/haskell-ide-engine/pull/1173),@fendor)
|
||||
- Change 'build-docs' to 'build-doc' in README ([#1185](https://github.com/haskell/haskell-ide-engine/pull/1185), @ajeetdsouza)
|
||||
- README Nix - replace old.postFixup -> postFixup ([#1193](https://github.com/haskell/haskell-ide-engine/pull/1193), @backuitist)
|
||||
- Expand documentation on the build system ([#1200](https://github.com/haskell/haskell-ide-engine/pull/1200), @power-fungus)
|
||||
- Fixed a typo. ([#1212](https://github.com/haskell/haskell-ide-engine/pull/1212), @rashadg1030)
|
||||
- Add documentation about building hie with profiling
|
||||
enabled. ([#1225](https://github.com/haskell/haskell-ide-engine/pull/1225), @skress)
|
||||
- Add Documentation for Pragmas Plugin ([#1222](https://github.com/haskell/haskell-ide-engine/pull/1222), @fendor)
|
||||
|
||||
- Build system improvements
|
||||
- Further improvements and simplification of the `./install.hs`
|
||||
build system ([#1168](https://github.com/haskell/haskell-ide-engine/pull/1168), @power-fungus)
|
||||
|
||||
# 0.8.0.0
|
||||
|
||||
- GHC 8.6.4 support added.
|
||||
|
||||
37
README.md
37
README.md
@ -52,6 +52,9 @@ we talk to clients.__
|
||||
- [Documentation](#documentation)
|
||||
- [Architecture](#architecture)
|
||||
- [Troubleshooting](#troubleshooting)
|
||||
- [Emacs](#emacs)
|
||||
- [Parse errors, file state going out of sync](#parse-errors-file-state-going-out-of-sync)
|
||||
- [`emacs-direnv` loads environment too late](#emacs-direnv-loads-environment-too-late)
|
||||
- [DYLD on macOS](#dyld-on-macos)
|
||||
- [macOS: Got error while installing GHC 8.6.1 or 8.6.2 - dyld: Library not loaded: /usr/local/opt/gmp/lib/libgmp.10.dylib](#macos-got-error-while-installing-ghc-861-or-862---dyld-library-not-loaded-usrlocaloptgmpliblibgmp10dylib)
|
||||
- [macOS: Got error while processing diagnostics: unable to load package `integer-gmp-1.0.2.0`](#macos-got-error-while-processing-diagnostics-unable-to-load-package-integer-gmp-1020)
|
||||
@ -59,6 +62,7 @@ we talk to clients.__
|
||||
- [Is \<package\> base-x?](#is-package-base-x)
|
||||
- [Is there a hash (#) after \<package\>?](#is-there-a-hash--after-package)
|
||||
- [Otherwise](#otherwise)
|
||||
- [Nix: cabal-helper, No such file or directory](#nix-cabal-helper-no-such-file-or-directory)
|
||||
|
||||
## Features
|
||||
|
||||
@ -119,7 +123,7 @@ we talk to clients.__
|
||||
|
||||
### Installation with Nix
|
||||
|
||||
Follow the instructions at https://github.com/domenkozar/hie-nix
|
||||
Follow the instructions at https://github.com/Infinisil/all-hies
|
||||
|
||||
|
||||
### Installation on ArchLinux
|
||||
@ -311,7 +315,7 @@ in
|
||||
packageOverrides = pkgs: rec {
|
||||
|
||||
vscode = pkgs.vscode.overrideDerivation (old: {
|
||||
postFixup = old.postFixup + ''
|
||||
postFixup = ''
|
||||
wrapProgram $out/bin/code --prefix PATH : ${lib.makeBinPath [hie]}
|
||||
'';
|
||||
});
|
||||
@ -558,6 +562,22 @@ Have a look at
|
||||
|
||||
## Troubleshooting
|
||||
|
||||
### Emacs
|
||||
|
||||
#### Parse errors, file state going out of sync
|
||||
With the `lsp-mode` client for Emacs, it seems that the document can very easily get out of sync between, which leads to parse errors being displayed. To fix this, enable full document synchronization with
|
||||
|
||||
```elisp
|
||||
(setq lsp-document-sync-method 'full)
|
||||
```
|
||||
|
||||
#### [`emacs-direnv`](https://github.com/wbolster/emacs-direnv) loads environment too late
|
||||
`emacs-direnv` sometimes loads the environment too late, meaning `lsp-mode` won't be able to find correct GHC/cabal versions. To fix this, add a direnv update hook *after* adding the lsp hook for `haskell-mode` (meaning the direnv hook is executed first, because hooks are LIFO):
|
||||
```elisp
|
||||
(add-hook 'haskell-mode-hook 'lsp)
|
||||
(add-hook 'haskell-mode-hook 'direnv-update-environment)
|
||||
```
|
||||
|
||||
### DYLD on macOS
|
||||
|
||||
If you hit a problem that looks like ```can't load .so/.DLL for: libiconv.dylib (dlopen(libiconv.dylib, 5): image not found)```, it means that libraries cannot be found in the library path. We can hint where to look for them and append more paths to `DYLD_LIBRARY_PATH`.
|
||||
@ -597,3 +617,16 @@ Delete any `.ghc.environment*` files in your project root and try again. (At the
|
||||
|
||||
#### Otherwise
|
||||
Try running `cabal update`.
|
||||
|
||||
### Nix: cabal-helper, No such file or directory
|
||||
|
||||
An error on stderr like
|
||||
|
||||
```
|
||||
cabal-helper-wrapper: /home/<...>/.cache/cabal-helper/cabal-helper<...>: createProcess: runInteractiveProcess:
|
||||
exec: does not exist (No such file or directory)
|
||||
```
|
||||
|
||||
can happen because cabal-helper compiles and runs above executable at runtime without using nix-build, which means a Nix garbage collection can delete the paths it depends on. Delete ~/.cache/cabal-helper and restart HIE to fix this.
|
||||
|
||||
|
||||
|
||||
@ -2,16 +2,13 @@ packages:
|
||||
./
|
||||
./hie-plugin-api/
|
||||
./hie-bios/
|
||||
./haskell-lsp/
|
||||
./lsp-test
|
||||
|
||||
./submodules/HaRe
|
||||
./submodules/brittany
|
||||
./submodules/cabal-helper/
|
||||
./submodules/floskell
|
||||
./submodules/ghc-mod/
|
||||
./submodules/ghc-mod/core/
|
||||
./submodules/floskell
|
||||
./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
allow-newer: floskell:all
|
||||
|
||||
@ -19,3 +16,4 @@ executable-dynamic: True
|
||||
|
||||
ghc-options: -Werror
|
||||
|
||||
|
||||
|
||||
109
docs/Build.md
109
docs/Build.md
@ -10,41 +10,100 @@ The design of the build system has the following main goals:
|
||||
|
||||
* works identically on every platform
|
||||
* has minimal run-time dependencies:
|
||||
- a working installation of `stack`
|
||||
- `stack`
|
||||
- `git`
|
||||
* is completely functional right after simple `git clone`
|
||||
* one-stop-shop for building all executables required for using `hie` in IDEs.
|
||||
* is completely functional right after a simple `git clone` and after every `git pull`
|
||||
* one-stop-shop for building and naming all executables required for using `hie` in IDEs.
|
||||
* prevents certain build failures by either identifying a failed precondition (such as wrong `stack` version) or by performing the necessary steps so users can't forget them (such as invoking `git` to update submodules)
|
||||
|
||||
|
||||
* is able to modify the environment such that `hie` can be run
|
||||
- setup `hoogle` database
|
||||
- setup `hlint` data-files
|
||||
|
||||
See the project's `README` for detailed information about installing `hie`.
|
||||
|
||||
### Targets
|
||||
|
||||
The build script `install.hs` defines several targets using the `shake` build system. The targets are roughly:
|
||||
|
||||
* `hie-*`: builds and installs the `hie` binaries. Also renames the binaries to contain the correct version-number.
|
||||
* `build`: builds and installs `hie` binaries for all supported `ghc` versions.
|
||||
* `build-doc`: builds the hoogle-db required by `hie`
|
||||
* `cabal-*`: execute the same task as the original target, but with `cabal` instead of `stack`
|
||||
|
||||
Each `stack-*.yaml` contains references to packages in the submodules. Calling `stack` with one of those causes the build to fail if the submodules have not been initialized already. The file `shake.yaml` solves this issue invoking the `git` binary itself to update the submodules. Moreover, it specifies the correct version of `shake` and is used for installing all run-time dependencies such as `cabal` and `hoogle` if necessary.
|
||||
|
||||
### Run-time dependencies
|
||||
|
||||
`hie` depends on a correct environment in order to function properly:
|
||||
|
||||
* `cabal-install`: If no `cabal` executable can be found or has an outdated version, `cabal-install` is installed via `stack`.
|
||||
* The `hoogle` database: `hoogle generate` needs to be called with the most-recent `hoogle` version.
|
||||
|
||||
### Steps to build `hie`
|
||||
|
||||
Installing `hie` is a multi-step process:
|
||||
|
||||
1. `git submodule sync && git submodule update --init`
|
||||
2. `hoogle generate` (`hoogle>=5.0.17` to be safe)
|
||||
3. ensure that `cabal-install` is installed in the correct version
|
||||
4. `stack --stack-yaml=stack-<X>.yaml install` or `cabal new-install -w ghc-<X>`
|
||||
5. rename `hie` binary to `hie-<X>` in `$HOME/.local/bin`, where `<X>` is the GHC version used
|
||||
6. repeat step 4 and 5 for all desired GHC versions
|
||||
|
||||
This ensures that a complete install is always possible after each `git pull` or a `git clone`.
|
||||
|
||||
#### Building `hie` with profiling support
|
||||
|
||||
To build `hie` with profiling enabled `cabal new-install` needs to be used instead of `stack`.
|
||||
|
||||
Configure `cabal` to enable profiling by setting `profiling: True` in `cabal.project.local` for all packages. If that file does not already exist, create it as follows:
|
||||
|
||||
```bash
|
||||
cat << EOF > cabal.project.local
|
||||
package *
|
||||
profiling: True
|
||||
EOF
|
||||
```
|
||||
|
||||
Then `hie` can be compiled for a specific GHC version:
|
||||
|
||||
```bash
|
||||
export GHCP=<path-to-ghc-binary>
|
||||
cabal new-install exe:hie -w $GHCP \
|
||||
--write-ghc-environment-files=never --symlink-bindir=$HOME/.local/bin \
|
||||
--overwrite-policy=always --reinstall
|
||||
```
|
||||
|
||||
The final step is to configure the `hie` client to use a custom `hie-wrapper` script that enables the runtime options for profiling. Such a script could look like this:
|
||||
|
||||
```bash
|
||||
#!/bin/sh
|
||||
~/.local/bin/hie-wrapper "$@" +RTS -xc
|
||||
```
|
||||
|
||||
(Note: If no profiling information is shown when using `hie` with a certain project, it may help to build that project itself with profiling support, e.g. `stack build --profile`.)
|
||||
|
||||
### Safety checks
|
||||
|
||||
The `install.hs` script performs some checks to ensure that a correct installation is possible and provide meaningful error messages for known issues.
|
||||
|
||||
* `stack` needs to be up-to-date. Version `1.9.3` is required
|
||||
* `ghc-8.6.3` is broken on windows. Trying to install `hie-8.6.3` on windows is not possible.
|
||||
* `cabal new-build` does not work on windows at the moment. All `cabal-*` targets exit with an error message about that.
|
||||
* When the build fails, an error message, that suggests to remove `.stack-work` directory, is displayed.
|
||||
|
||||
### Tradeoffs
|
||||
|
||||
#### `shake.yaml`
|
||||
|
||||
A `shake.yaml` is required for executing the `install.hs` file.
|
||||
|
||||
* It contains the required version of `shake`.
|
||||
* In contrast to the other `*.yaml` it does not contain the submodules, which is necessary for `stack` to work even before the submodules have been initialized.
|
||||
|
||||
It is necessary to update the `resolver` field of the `shake.yaml` if the script should run with a different `GHC`.
|
||||
|
||||
#### `install.hs` installs a GHC
|
||||
|
||||
Before the code in `install.hs` can be executed, `stack` installs a `GHC`, depending on the `resolver` field in `shake.yaml`. This is necessary if `install.hs` should be completely functional right after a fresh `git clone` without further configuration.
|
||||
|
||||
This may lead to an extra `GHC` to be installed by `stack` if not all versions of `haskell-ide-engine` are installed.
|
||||
|
||||
#### `stack` is a build dependency
|
||||
|
||||
Currently, it is not possible to build all `hie-*` executables automatically without `stack`, since the `install.hs` script is executed by `stack`.
|
||||
|
||||
Other parts of the script also depend on `stack`:
|
||||
We are open to suggestions of other build systems that honor the requirements above, but are executable without `stack`.
|
||||
|
||||
* finding the local install-dir `stack path --local-bin`
|
||||
* finding and installing different `ghc` versions
|
||||
#### `install.hs` installs a GHC before running
|
||||
|
||||
#### `install.hs` executes `cabal install Cabal`
|
||||
Before the code in `install.hs` can be executed, `stack` installs a `GHC`, depending on the `resolver` field in `shake.yaml`. This is necessary if `install.hs` should be completely functional right after a fresh `git clone` without further configuration.
|
||||
|
||||
`ghc-mod` installs `cabal-helper` at runtime depending on the `ghc` used by the project, which can take a long time upon startup of `hie`. The `install.hs` script speeds up this process by calling `cabal install Cabal` upon build.
|
||||
|
||||
Hopefully, this behaviour can be removed in the future.
|
||||
This may lead to an extra `GHC` to be installed by `stack` if not all versions of `haskell-ide-engine` are installed.
|
||||
|
||||
@ -62,27 +62,29 @@ library
|
||||
, data-default
|
||||
, directory
|
||||
, filepath
|
||||
, floskell
|
||||
, floskell == 0.10.*
|
||||
, fold-debounce
|
||||
, ghc >= 8.0.1
|
||||
, ghc-exactprint
|
||||
, gitrev >= 1.1
|
||||
, haddock-api
|
||||
, haddock-library
|
||||
, haskell-lsp == 0.10.*
|
||||
, haskell-lsp-types == 0.10.*
|
||||
, haskell-lsp == 0.13.*
|
||||
, haskell-lsp-types == 0.13.*
|
||||
, haskell-src-exts
|
||||
, hie-plugin-api
|
||||
, hlint >= 2.0.11
|
||||
, hlint (>= 2.0.11 && < 2.1.18) || >= 2.1.22
|
||||
, hoogle >= 5.0.13
|
||||
, hsimport
|
||||
, hslogger
|
||||
, lifted-async
|
||||
, lens >= 4.15.2
|
||||
, monoid-subclasses > 0.4
|
||||
, mtl
|
||||
, optparse-simple >= 0.0.3
|
||||
, parsec
|
||||
, process
|
||||
, rope-utf16-splay >= 0.3.1.0
|
||||
, safe
|
||||
, sorted-list >= 0.2.1.0
|
||||
, stm
|
||||
@ -92,7 +94,6 @@ library
|
||||
, unordered-containers
|
||||
, vector
|
||||
, yaml >= 0.8.31
|
||||
, yi-rope
|
||||
, hie-bios
|
||||
, bytestring-trie
|
||||
, unliftio
|
||||
@ -174,11 +175,14 @@ test-suite unit-test
|
||||
DiffSpec
|
||||
ExtensibleStateSpec
|
||||
GhcModPluginSpec
|
||||
LiquidSpec
|
||||
HaRePluginSpec
|
||||
HooglePluginSpec
|
||||
JsonSpec
|
||||
LiquidSpec
|
||||
PackagePluginSpec
|
||||
Spec
|
||||
-- Technically cabal-helper should be a 'run-tool-depends', but that doesn't exist yet
|
||||
build-tool-depends: cabal-helper:cabal-helper-main, hspec-discover:hspec-discover
|
||||
build-depends: QuickCheck
|
||||
, aeson
|
||||
, base
|
||||
@ -201,7 +205,6 @@ test-suite unit-test
|
||||
if flag(pedantic)
|
||||
ghc-options: -Werror
|
||||
default-language: Haskell2010
|
||||
build-tool-depends: hspec-discover:hspec-discover
|
||||
|
||||
test-suite dispatcher-test
|
||||
type: exitcode-stdio-1.0
|
||||
@ -270,27 +273,29 @@ test-suite func-test
|
||||
, SymbolsSpec
|
||||
, TypeDefinitionSpec
|
||||
, Utils
|
||||
-- This cannot currently be handled by hie (cabal-helper)
|
||||
-- build-tool-depends: haskell-ide-engine:hie
|
||||
build-depends: aeson
|
||||
, base
|
||||
, data-default
|
||||
, directory
|
||||
, filepath
|
||||
, lsp-test >= 0.5.1.3
|
||||
, lsp-test >= 0.5.2
|
||||
, haskell-ide-engine
|
||||
, haskell-lsp-types == 0.10.*
|
||||
, haskell-lsp-types == 0.13.*
|
||||
, haskell-lsp == 0.13.*
|
||||
, hie-test-utils
|
||||
, hie-plugin-api
|
||||
, hspec
|
||||
, lens
|
||||
, text
|
||||
, unordered-containers
|
||||
, containers
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wredundant-constraints
|
||||
if flag(pedantic)
|
||||
ghc-options: -Werror
|
||||
default-language: Haskell2010
|
||||
build-tool-depends: hspec-discover:hspec-discover
|
||||
, haskell-ide-engine:hie
|
||||
, cabal-helper:cabal-helper-main
|
||||
|
||||
test-suite wrapper-test
|
||||
type: exitcode-stdio-1.0
|
||||
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit 807482a037bcf936c4df249403fdd3a8f44712d9
|
||||
@ -1,4 +1,4 @@
|
||||
module Haskell.Ide.Engine.ArtifactMap where
|
||||
module Haskell.Ide.Engine.ArtifactMap where
|
||||
|
||||
import Data.Maybe
|
||||
import qualified Data.IntervalMap.FingerTree as IM
|
||||
|
||||
@ -1,6 +1,14 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
module Haskell.Ide.Engine.Compat where
|
||||
|
||||
import qualified GHC
|
||||
import qualified Type
|
||||
import qualified TcHsSyn
|
||||
import qualified TysWiredIn
|
||||
import qualified Var
|
||||
|
||||
#if MIN_VERSION_filepath(1,4,2)
|
||||
#else
|
||||
import Data.List
|
||||
@ -27,3 +35,108 @@ isExtensionOf :: String -> FilePath -> Bool
|
||||
isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions
|
||||
isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions
|
||||
#endif
|
||||
|
||||
|
||||
#if MIN_VERSION_ghc(8, 4, 0)
|
||||
type GhcTc = GHC.GhcTc
|
||||
#else
|
||||
type GhcTc = GHC.Id
|
||||
#endif
|
||||
|
||||
pattern HsOverLitType :: Type.Type -> GHC.HsExpr GhcTc
|
||||
pattern HsOverLitType t <-
|
||||
#if MIN_VERSION_ghc(8, 6, 0)
|
||||
GHC.HsOverLit _ (GHC.overLitType -> t)
|
||||
#elif MIN_VERSION_ghc(8, 4, 0)
|
||||
GHC.HsOverLit (GHC.overLitType -> t)
|
||||
#else
|
||||
GHC.HsOverLit (GHC.overLitType -> t)
|
||||
#endif
|
||||
|
||||
pattern HsLitType :: Type.Type -> GHC.HsExpr GhcTc
|
||||
pattern HsLitType t <-
|
||||
#if MIN_VERSION_ghc(8, 6, 0)
|
||||
GHC.HsLit _ (TcHsSyn.hsLitType -> t)
|
||||
#elif MIN_VERSION_ghc(8, 4, 0)
|
||||
GHC.HsLit (TcHsSyn.hsLitType -> t)
|
||||
#else
|
||||
GHC.HsLit (TcHsSyn.hsLitType -> t)
|
||||
#endif
|
||||
|
||||
pattern HsLamType :: Type.Type -> GHC.HsExpr GhcTc
|
||||
pattern HsLamType t <-
|
||||
#if MIN_VERSION_ghc(8, 6, 0)
|
||||
GHC.HsLam _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t)
|
||||
#elif MIN_VERSION_ghc(8, 4, 0)
|
||||
GHC.HsLam (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t)
|
||||
#else
|
||||
GHC.HsLam (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t)
|
||||
#endif
|
||||
|
||||
pattern HsLamCaseType :: Type.Type -> GHC.HsExpr GhcTc
|
||||
pattern HsLamCaseType t <-
|
||||
#if MIN_VERSION_ghc(8, 6, 0)
|
||||
GHC.HsLamCase _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t)
|
||||
#elif MIN_VERSION_ghc(8, 4, 0)
|
||||
GHC.HsLamCase (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t)
|
||||
#else
|
||||
GHC.HsLamCase (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t)
|
||||
#endif
|
||||
|
||||
pattern HsCaseType :: Type.Type -> GHC.HsExpr GhcTc
|
||||
pattern HsCaseType t <-
|
||||
#if MIN_VERSION_ghc(8, 6, 0)
|
||||
GHC.HsCase _ _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t)
|
||||
#elif MIN_VERSION_ghc(8, 4, 0)
|
||||
GHC.HsCase _ (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t)
|
||||
#else
|
||||
GHC.HsCase _ (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t)
|
||||
#endif
|
||||
|
||||
pattern ExplicitListType :: Type.Type -> GHC.HsExpr GhcTc
|
||||
pattern ExplicitListType t <-
|
||||
#if MIN_VERSION_ghc(8, 6, 0)
|
||||
GHC.ExplicitList (TysWiredIn.mkListTy -> t) _ _
|
||||
#elif MIN_VERSION_ghc(8, 4, 0)
|
||||
GHC.ExplicitList (TysWiredIn.mkListTy -> t) _ _
|
||||
#else
|
||||
GHC.ExplicitList (TysWiredIn.mkListTy -> t) _ _
|
||||
#endif
|
||||
|
||||
pattern ExplicitSumType :: Type.Type -> GHC.HsExpr GhcTc
|
||||
pattern ExplicitSumType t <-
|
||||
#if MIN_VERSION_ghc(8, 6, 0)
|
||||
GHC.ExplicitSum (TysWiredIn.mkSumTy -> t) _ _ _
|
||||
#elif MIN_VERSION_ghc(8, 4, 0)
|
||||
GHC.ExplicitSum _ _ _ (TysWiredIn.mkSumTy -> t)
|
||||
#else
|
||||
GHC.ExplicitSum _ _ _ (TysWiredIn.mkSumTy -> t)
|
||||
#endif
|
||||
|
||||
|
||||
pattern HsMultiIfType :: Type.Type -> GHC.HsExpr GhcTc
|
||||
pattern HsMultiIfType t <-
|
||||
#if MIN_VERSION_ghc(8, 6, 0)
|
||||
GHC.HsMultiIf t _
|
||||
#elif MIN_VERSION_ghc(8, 4, 0)
|
||||
GHC.HsMultiIf t _
|
||||
#else
|
||||
GHC.HsMultiIf t _
|
||||
#endif
|
||||
|
||||
pattern FunBindType :: Type.Type -> GHC.HsBindLR GhcTc GhcTc
|
||||
pattern FunBindType t <-
|
||||
#if MIN_VERSION_ghc(8, 6, 0)
|
||||
GHC.FunBind _ (GHC.L _ (Var.varType -> t)) _ _ _
|
||||
#elif MIN_VERSION_ghc(8, 4, 0)
|
||||
GHC.FunBind (GHC.L _ (Var.varType -> t)) _ _ _ _
|
||||
#else
|
||||
GHC.FunBind (GHC.L _ (Var.varType -> t)) _ _ _ _
|
||||
#endif
|
||||
|
||||
|
||||
#if MIN_VERSION_ghc(8, 6, 0)
|
||||
matchGroupType :: GHC.MatchGroupTc -> GHC.Type
|
||||
matchGroupType (GHC.MatchGroupTc args res) = Type.mkFunTys args res
|
||||
#endif
|
||||
|
||||
|
||||
288
hie-plugin-api/Haskell/Ide/Engine/Ghc.hs
Normal file
288
hie-plugin-api/Haskell/Ide/Engine/Ghc.hs
Normal file
@ -0,0 +1,288 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
-- | This module provides the interface to GHC, mainly for loading
|
||||
-- modules while updating the module cache.
|
||||
|
||||
module Haskell.Ide.Engine.Ghc
|
||||
(
|
||||
setTypecheckedModule
|
||||
, Diagnostics
|
||||
, AdditionalErrs
|
||||
, cabalModuleGraphs
|
||||
, makeRevRedirMapFunc
|
||||
) where
|
||||
|
||||
import Bag
|
||||
import Control.Monad.IO.Class
|
||||
import Data.IORef
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Monoid ((<>))
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as T
|
||||
import ErrUtils
|
||||
|
||||
import Haskell.Ide.Engine.MonadFunctions
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.PluginUtils
|
||||
import System.FilePath
|
||||
|
||||
import DynFlags
|
||||
import GHC
|
||||
import IOEnv as G
|
||||
import HscTypes
|
||||
import Outputable (renderWithStyle)
|
||||
|
||||
import Bag
|
||||
import Control.Monad.IO.Class
|
||||
import Data.IORef
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Monoid ((<>))
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as T
|
||||
import ErrUtils
|
||||
import System.FilePath
|
||||
|
||||
import Haskell.Ide.Engine.MonadFunctions
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.PluginUtils
|
||||
import Haskell.Ide.Engine.GhcUtils
|
||||
--import qualified Haskell.Ide.Engine.Plugin.HieExtras as Hie
|
||||
|
||||
import DynFlags
|
||||
import GHC
|
||||
import IOEnv as G
|
||||
import HscTypes
|
||||
import Outputable hiding ((<>))
|
||||
-- This function should be defined in HIE probably, nothing in particular
|
||||
-- to do with BIOS
|
||||
import qualified HIE.Bios.GHCApi as BIOS (withDynFlags, CradleError)
|
||||
import qualified HIE.Bios as BIOS
|
||||
import Debug.Trace
|
||||
import qualified HscMain as G
|
||||
|
||||
import System.Directory
|
||||
|
||||
|
||||
type Diagnostics = Map.Map Uri (Set.Set Diagnostic)
|
||||
type AdditionalErrs = [T.Text]
|
||||
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
lspSev :: Severity -> DiagnosticSeverity
|
||||
lspSev SevWarning = DsWarning
|
||||
lspSev SevError = DsError
|
||||
lspSev SevFatal = DsError
|
||||
lspSev SevInfo = DsInfo
|
||||
lspSev _ = DsInfo
|
||||
|
||||
-- | Turn a 'SourceError' into the HIE 'Diagnostics' format.
|
||||
srcErrToDiag :: MonadIO m
|
||||
=> DynFlags
|
||||
-> (FilePath -> FilePath)
|
||||
-> SourceError -> m (Diagnostics, AdditionalErrs)
|
||||
srcErrToDiag df rfm se = do
|
||||
debugm "in srcErrToDiag"
|
||||
let errMsgs = bagToList $ srcErrorMessages se
|
||||
processMsg err = do
|
||||
let sev = Just DsError
|
||||
unqual = errMsgContext err
|
||||
st = mkErrStyle df unqual
|
||||
msgTxt = T.pack $ renderWithStyle df (pprLocErrMsg err) st
|
||||
eloc <- srcSpan2Loc rfm $ errMsgSpan err
|
||||
case eloc of
|
||||
Right (Location uri range) ->
|
||||
return $ Right (uri, Diagnostic range sev Nothing (Just "bios") msgTxt Nothing)
|
||||
Left _ -> return $ Left msgTxt
|
||||
processMsgs [] = return (Map.empty,[])
|
||||
processMsgs (x:xs) = do
|
||||
res <- processMsg x
|
||||
(m,es) <- processMsgs xs
|
||||
case res of
|
||||
Right (uri, diag) ->
|
||||
return (Map.insertWith Set.union uri (Set.singleton diag) m, es)
|
||||
Left e -> return (m, e:es)
|
||||
processMsgs errMsgs
|
||||
|
||||
|
||||
-- | Run a Ghc action and capture any diagnostics and errors produced.
|
||||
captureDiagnostics :: (MonadIO m, GhcMonad m)
|
||||
=> (FilePath -> FilePath)
|
||||
-> m r
|
||||
-> m (Diagnostics, AdditionalErrs, Maybe r)
|
||||
captureDiagnostics rfm action = do
|
||||
env <- getSession
|
||||
diagRef <- liftIO $ newIORef Map.empty
|
||||
errRef <- liftIO $ newIORef []
|
||||
let setLogger df = df { log_action = logDiag rfm errRef diagRef }
|
||||
setDeferTypedHoles = setGeneralFlag' Opt_DeferTypedHoles
|
||||
ghcErrRes msg = do
|
||||
diags <- liftIO $ readIORef diagRef
|
||||
errs <- liftIO $ readIORef errRef
|
||||
return (diags, (T.pack msg) : errs, Nothing)
|
||||
to_diag x = do
|
||||
(d1, e1) <- srcErrToDiag (hsc_dflags env) rfm x
|
||||
diags <- liftIO $ readIORef diagRef
|
||||
errs <- liftIO $ readIORef errRef
|
||||
return (Map.unionWith Set.union d1 diags, e1 ++ errs, Nothing)
|
||||
|
||||
|
||||
handlers = errorHandlers ghcErrRes to_diag
|
||||
action' = do
|
||||
r <- BIOS.withDynFlags (setLogger . setDeferTypedHoles) action
|
||||
diags <- liftIO $ readIORef diagRef
|
||||
errs <- liftIO $ readIORef errRef
|
||||
return (diags,errs, Just r)
|
||||
gcatches action' handlers
|
||||
|
||||
-- | Create a 'LogAction' which will be invoked by GHC when it tries to
|
||||
-- write anything to `stdout`.
|
||||
logDiag :: (FilePath -> FilePath) -> IORef AdditionalErrs -> IORef Diagnostics -> LogAction
|
||||
-- type LogAction = DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
|
||||
logDiag rfm eref dref df _reason sev spn style msg = do
|
||||
eloc <- srcSpan2Loc rfm spn
|
||||
traceShowM (spn, eloc)
|
||||
let msgTxt = T.pack $ renderWithStyle df msg style
|
||||
case eloc of
|
||||
Right (Location uri range) -> do
|
||||
let update = Map.insertWith Set.union uri l
|
||||
where l = Set.singleton diag
|
||||
diag = Diagnostic range (Just $ lspSev sev) Nothing (Just "bios") msgTxt Nothing
|
||||
debugm $ "Writing diag" <> (show diag)
|
||||
modifyIORef' dref update
|
||||
Left _ -> do
|
||||
debugm $ "Writing err" <> (show msgTxt)
|
||||
modifyIORef' eref (msgTxt:)
|
||||
return ()
|
||||
|
||||
|
||||
errorHandlers :: (String -> m a) -> (SourceError -> m a) -> [ErrorHandler m a]
|
||||
errorHandlers ghcErrRes renderSourceError = handlers
|
||||
where
|
||||
-- ghc throws GhcException, SourceError, GhcApiError and
|
||||
-- IOEnvFailure. ghc-mod-core throws GhcModError.
|
||||
handlers =
|
||||
[ ErrorHandler $ \(ex :: IOEnvFailure) ->
|
||||
ghcErrRes (show ex)
|
||||
, ErrorHandler $ \(ex :: GhcApiError) ->
|
||||
ghcErrRes (show ex)
|
||||
, ErrorHandler $ \(ex :: SourceError) ->
|
||||
renderSourceError ex
|
||||
, ErrorHandler $ \(ex :: IOError) ->
|
||||
ghcErrRes (show ex)
|
||||
, ErrorHandler $ \(ex :: BIOS.CradleError) ->
|
||||
ghcErrRes (show ex)
|
||||
]
|
||||
|
||||
|
||||
-- | Load a module from a filepath into the cache, first check the cache
|
||||
-- to see if it's already there.
|
||||
setTypecheckedModule :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs))
|
||||
setTypecheckedModule uri =
|
||||
pluginGetFile "setTypecheckedModule: " uri $ \_fp -> do
|
||||
debugm "setTypecheckedModule: before ghc-mod"
|
||||
debugm "Loading file"
|
||||
-- mapped_fp <- persistVirtualFile uri
|
||||
-- ifCachedModuleM mapped_fp (setTypecheckedModule_load uri) cont
|
||||
setTypecheckedModule_load uri
|
||||
|
||||
-- Hacky, need to copy hs-boot file if one exists for a module
|
||||
-- This is because the virtual file gets created at VFS-1234.hs and
|
||||
-- then GHC looks for the boot file at VFS-1234.hs-boot
|
||||
--
|
||||
-- This strategy doesn't work if the user wants to edit the boot file but
|
||||
-- not save it and expect the VFS to save them. However, I expect that HIE
|
||||
-- already didn't deal with boot files correctly.
|
||||
copyHsBoot :: FilePath -> FilePath -> IO ()
|
||||
copyHsBoot fp mapped_fp = do
|
||||
ex <- doesFileExist (fp <> "-boot")
|
||||
if ex
|
||||
then copyFile (fp <> "-boot") (mapped_fp <> "-boot")
|
||||
else return ()
|
||||
|
||||
loadFile :: (FilePath -> FilePath) -> (FilePath, FilePath)
|
||||
-> IdeGhcM (Diagnostics, AdditionalErrs,
|
||||
Maybe (Maybe TypecheckedModule, [TypecheckedModule]))
|
||||
loadFile rfm t = do
|
||||
withProgress "loading" NotCancellable $ \f -> (captureDiagnostics rfm $ BIOS.loadFileWithMessage (Just $ toMessager f) t)
|
||||
|
||||
-- | Actually load the module if it's not in the cache
|
||||
setTypecheckedModule_load :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs))
|
||||
setTypecheckedModule_load uri =
|
||||
pluginGetFile "setTypecheckedModule: " uri $ \fp -> do
|
||||
debugm "setTypecheckedModule: before ghc-mod"
|
||||
debugm "Loading file"
|
||||
mapped_fp <- persistVirtualFile uri
|
||||
liftIO $ copyHsBoot fp mapped_fp
|
||||
rfm <- reverseFileMap
|
||||
let progTitle = "Typechecking " <> T.pack (takeFileName fp)
|
||||
(diags', errs, mmods) <- loadFile rfm (fp, mapped_fp)
|
||||
debugm "File, loaded"
|
||||
canonUri <- canonicalizeUri uri
|
||||
let diags = Map.insertWith Set.union canonUri Set.empty diags'
|
||||
debugm "setTypecheckedModule: after ghc-mod"
|
||||
debugm ("Diags: " <> show diags')
|
||||
let collapse Nothing = (Nothing, [])
|
||||
collapse (Just (n, xs)) = (n, xs)
|
||||
|
||||
diags2 <- case collapse mmods of
|
||||
--Just (Just pm, Nothing) -> do
|
||||
-- debugm $ "setTypecheckedModule: Did get parsed module for: " ++ show fp
|
||||
-- cacheModule fp (Left pm)
|
||||
-- debugm "setTypecheckedModule: done"
|
||||
-- return diags
|
||||
|
||||
(Just _tm, ts) -> do
|
||||
debugm $ "setTypecheckedModule: Did get typechecked module for: " ++ show fp
|
||||
--sess <- fmap GM.gmgsSession . GM.gmGhcSession <$> GM.gmsGet
|
||||
|
||||
-- set the session before we cache the module, so that deferred
|
||||
-- responses triggered by cacheModule can access it
|
||||
--modifyMTS (\s -> s {ghcSession = sess})
|
||||
cacheModules rfm ts
|
||||
--cacheModules rfm [tm]
|
||||
debugm "setTypecheckedModule: done"
|
||||
return diags
|
||||
|
||||
(Nothing, ts) -> do
|
||||
debugm $ "setTypecheckedModule: Didn't get typechecked or parsed module for: " ++ show fp
|
||||
--debugm $ "setTypecheckedModule: errs: " ++ show errs
|
||||
cacheModules rfm ts
|
||||
failModule fp
|
||||
|
||||
let sev = Just DsError
|
||||
range = Range (Position 0 0) (Position 1 0)
|
||||
msgTxt = T.unlines errs
|
||||
let d = Diagnostic range sev Nothing (Just "bios") msgTxt Nothing
|
||||
return $ Map.insertWith Set.union canonUri (Set.singleton d) diags
|
||||
|
||||
return $ IdeResultOk (diags2,errs)
|
||||
|
||||
--
|
||||
cabalModuleGraphs = undefined
|
||||
{-
|
||||
cabalModuleGraphs :: IdeGhcM [GM.GmModuleGraph]
|
||||
cabalModuleGraphs = doCabalModuleGraphs
|
||||
where
|
||||
doCabalModuleGraphs :: (GM.IOish m) => GM.GhcModT m [GM.GmModuleGraph]
|
||||
doCabalModuleGraphs = do
|
||||
crdl <- GM.cradle
|
||||
case GM.cradleCabalFile crdl of
|
||||
Just _ -> do
|
||||
mcs <- GM.cabalResolvedComponents
|
||||
let graph = map GM.gmcHomeModuleGraph $ Map.elems mcs
|
||||
return graph
|
||||
Nothing -> return []
|
||||
-}
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
makeRevRedirMapFunc :: IdeGhcM (FilePath -> FilePath)
|
||||
makeRevRedirMapFunc = reverseFileMap
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
@ -27,6 +27,7 @@ module Haskell.Ide.Engine.ModuleCache
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Trans.Control
|
||||
import Control.Monad.Trans.Free
|
||||
import Data.Dynamic (toDyn, fromDynamic, Dynamic)
|
||||
import Data.Generics (Proxy(..), TypeRep, typeRep, typeOf)
|
||||
@ -64,7 +65,7 @@ modifyCache f = do
|
||||
-- then runs the action in the default cradle.
|
||||
-- Sets the current directory to the cradle root dir
|
||||
-- in either case
|
||||
runActionWithContext :: (MonadIde m, GHC.GhcMonad m, HasGhcModuleCache m, MonadUnliftIO m)
|
||||
runActionWithContext :: (MonadIde m, GHC.GhcMonad m, HasGhcModuleCache m, MonadBaseControl IO m)
|
||||
=> GHC.DynFlags -> Maybe FilePath -> m a -> m a
|
||||
runActionWithContext _df Nothing action = do
|
||||
-- Cradle with no additional flags
|
||||
@ -77,7 +78,7 @@ runActionWithContext df (Just uri) action = do
|
||||
getCradle uri (\lc -> loadCradle df lc >> action)
|
||||
|
||||
loadCradle :: (MonadIde m, HasGhcModuleCache m, GHC.GhcMonad m
|
||||
, MonadUnliftIO m) => GHC.DynFlags -> LookupCradleResult -> m ()
|
||||
, MonadBaseControl IO m) => GHC.DynFlags -> LookupCradleResult -> m ()
|
||||
loadCradle _ ReuseCradle = do
|
||||
traceM ("Reusing cradle")
|
||||
loadCradle iniDynFlags (NewCradle fp) = do
|
||||
@ -90,7 +91,7 @@ loadCradle iniDynFlags (NewCradle fp) = do
|
||||
traceShowM crdl
|
||||
liftIO (GHC.newHscEnv iniDynFlags) >>= GHC.setSession
|
||||
liftIO $ setCurrentDirectory (BIOS.cradleRootDir crdl)
|
||||
withProgress "Initialising Cradle" $ \f ->
|
||||
withProgress "Initialising Cradle" NotCancellable $ \f ->
|
||||
BIOS.initializeFlagsWithCradleWithMessage (Just $ toMessager f) fp crdl
|
||||
setCurrentCradle crdl
|
||||
loadCradle _iniDynFlags (LoadCradle (CachedCradle crd env)) = do
|
||||
|
||||
80
hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs
Normal file
80
hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs
Normal file
@ -0,0 +1,80 @@
|
||||
-- | This module provides an API that software intented to be
|
||||
-- integrated into HIE can use, so that they can make use of the
|
||||
-- shared BIOS features.
|
||||
|
||||
{-
|
||||
-- Stuff used in HaRe currently
|
||||
Options(..)
|
||||
defaultOptions
|
||||
GmModuleGraph(..)
|
||||
ModulePath(..)
|
||||
GmComponent(..)
|
||||
GmComponentType(..)
|
||||
|
||||
CachedInfo(..)
|
||||
HasGhcModuleCache(..)
|
||||
IdeGhcM
|
||||
|
||||
cabalModuleGraphs
|
||||
filePathToUri
|
||||
makeRevRedirMapFunc
|
||||
|
||||
MonadIO(..)
|
||||
ifCachedModule
|
||||
runIdeGhcMBare
|
||||
setTypecheckedModule
|
||||
-}
|
||||
|
||||
|
||||
module Haskell.Ide.Engine.PluginApi
|
||||
(
|
||||
-- ** Re-exported from ghc-mod via ghc-project-types
|
||||
GP.GmModuleGraph(..)
|
||||
, GP.ModulePath(..)
|
||||
, GP.GmComponent(..)
|
||||
, GP.GmComponentType(..)
|
||||
|
||||
-- * IDE monads
|
||||
, HIE.IdeState(..)
|
||||
, HIE.IdeGhcM
|
||||
, HIE.runIdeGhcM
|
||||
, runIdeGhcMBare
|
||||
, HIE.IdeM
|
||||
, HIE.runIdeM
|
||||
, HIE.IdeDeferM
|
||||
, HIE.MonadIde
|
||||
, HIE.iterT
|
||||
, HIE.LiftsToGhc(..)
|
||||
, HIE.HasGhcModuleCache(..)
|
||||
, HIE.cabalModuleGraphs
|
||||
, HIE.makeRevRedirMapFunc
|
||||
|
||||
-- * Using the HIE module cache etc
|
||||
, HIE.setTypecheckedModule
|
||||
, HIE.Diagnostics
|
||||
, HIE.AdditionalErrs
|
||||
, LSP.filePathToUri
|
||||
, HIE.ifCachedModule
|
||||
, HIE.CachedInfo(..)
|
||||
|
||||
-- * used for tests in HaRe
|
||||
-- , HIE.BiosLogLevel(..)
|
||||
, BiosOptions(..)
|
||||
, defaultOptions
|
||||
) where
|
||||
|
||||
|
||||
|
||||
import qualified GhcProject.Types as GP
|
||||
import qualified Haskell.Ide.Engine.Ghc as HIE
|
||||
import qualified Haskell.Ide.Engine.GhcModuleCache as HIE (CachedInfo(..),HasGhcModuleCache(..))
|
||||
import qualified Haskell.Ide.Engine.ModuleCache as HIE (ifCachedModule)
|
||||
import qualified Haskell.Ide.Engine.PluginsIdeMonads as HIE
|
||||
import qualified Language.Haskell.LSP.Types as LSP ( filePathToUri )
|
||||
import qualified HIE.Bios.Types as HIE
|
||||
|
||||
defaultOptions = HIE.defaultCradleOpts
|
||||
type BiosLogLevel = HIE.BIOSVerbosity
|
||||
|
||||
type BiosOptions = HIE.CradleOpts
|
||||
runIdeGhcMBare = error "Not implemented"
|
||||
@ -60,7 +60,7 @@ import SrcLoc
|
||||
import Exception
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import qualified Yi.Rope as Yi
|
||||
import qualified Data.Rope.UTF16 as Rope
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
@ -95,6 +95,8 @@ srcSpan2Range :: SrcSpan -> Either T.Text Range
|
||||
srcSpan2Range spn =
|
||||
realSrcSpan2Range <$> getRealSrcSpan spn
|
||||
|
||||
|
||||
|
||||
reverseMapFile :: MonadIO m => (FilePath -> FilePath) -> FilePath -> m FilePath
|
||||
reverseMapFile rfm fp = do
|
||||
fp' <- liftIO $ canonicalizePath fp
|
||||
@ -276,7 +278,7 @@ readVFS :: (MonadIde m, MonadIO m) => Uri -> m (Maybe T.Text)
|
||||
readVFS uri = do
|
||||
mvf <- getVirtualFile uri
|
||||
case mvf of
|
||||
Just (VirtualFile _ txt _) -> return $ Just (Yi.toText txt)
|
||||
Just (VirtualFile _ txt _) -> return $ Just (Rope.toText txt)
|
||||
Nothing -> return Nothing
|
||||
|
||||
getRangeFromVFS :: (MonadIde m, MonadIO m) => Uri -> Range -> m (Maybe T.Text)
|
||||
@ -286,13 +288,6 @@ getRangeFromVFS uri rg = do
|
||||
Just vfs -> return $ Just $ rangeLinesFromVfs vfs rg
|
||||
Nothing -> return Nothing
|
||||
|
||||
rangeLinesFromVfs :: VirtualFile -> Range -> T.Text
|
||||
rangeLinesFromVfs (VirtualFile _ yitext _) (Range (Position lf _cf) (Position lt _ct)) = r
|
||||
where
|
||||
(_ ,s1) = Yi.splitAtLine lf yitext
|
||||
(s2, _) = Yi.splitAtLine (lt - lf) s1
|
||||
r = Yi.toText s2
|
||||
|
||||
|
||||
-- Error catching utilities
|
||||
|
||||
|
||||
@ -12,6 +12,9 @@
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
|
||||
-- | IdeGhcM and associated types
|
||||
module Haskell.Ide.Engine.PluginsIdeMonads
|
||||
@ -49,6 +52,7 @@ module Haskell.Ide.Engine.PluginsIdeMonads
|
||||
, IdeState(..)
|
||||
, IdeGhcM
|
||||
, runIdeGhcM
|
||||
-- , runIdeGhcMBare
|
||||
, IdeM
|
||||
, runIdeM
|
||||
, IdeDeferM
|
||||
@ -61,10 +65,10 @@ module Haskell.Ide.Engine.PluginsIdeMonads
|
||||
, getPlugins
|
||||
, withProgress
|
||||
, withIndefiniteProgress
|
||||
, withIndefiniteProgressIO
|
||||
, persistVirtualFile
|
||||
, reverseFileMap
|
||||
, Core.Progress(..)
|
||||
, Core.ProgressCancellable(..)
|
||||
-- ** Lifting
|
||||
, iterT
|
||||
, LiftsToGhc(..)
|
||||
@ -96,9 +100,12 @@ where
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Free
|
||||
import Control.Monad.Trans.Control
|
||||
import Control.Monad.Base
|
||||
import UnliftIO
|
||||
import Control.Applicative
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson hiding (defaultOptions)
|
||||
import qualified Data.ConstrainedDynamic as CD
|
||||
import Data.Default
|
||||
import qualified Data.List as List
|
||||
@ -119,8 +126,8 @@ import Exception
|
||||
|
||||
import Haskell.Ide.Engine.Compat
|
||||
import Haskell.Ide.Engine.Config
|
||||
import Haskell.Ide.Engine.MultiThreadState
|
||||
import Haskell.Ide.Engine.GhcModuleCache
|
||||
import Haskell.Ide.Engine.MultiThreadState
|
||||
|
||||
import qualified Language.Haskell.LSP.Core as Core
|
||||
import Language.Haskell.LSP.Types.Capabilities
|
||||
@ -221,13 +228,16 @@ type HoverProvider = Uri -> Position -> IdeM (IdeResult [Hover])
|
||||
|
||||
type SymbolProvider = Uri -> IdeDeferM (IdeResult [DocumentSymbol])
|
||||
|
||||
-- | Format the document either as a whole or only a given Range of it.
|
||||
data FormattingType = FormatDocument
|
||||
-- | Format the given Text as a whole or only a @Range@ of it.
|
||||
-- Range must be relative to the text to format.
|
||||
-- To format the whole document, read the Text from the file and use 'FormatText'
|
||||
-- as the FormattingType.
|
||||
data FormattingType = FormatText
|
||||
| FormatRange Range
|
||||
|
||||
-- | Formats the given Text associated with the given Uri.
|
||||
-- Should, but might not, honor the provided formatting options (e.g. Floskell does not).
|
||||
-- A formatting type can be given to either format the whole document or only a Range.
|
||||
-- Should, but might not, honour the provided formatting options (e.g. Floskell does not).
|
||||
-- A formatting type can be given to either format the whole text or only a Range.
|
||||
--
|
||||
-- Text to format, may or may not, originate from the associated Uri.
|
||||
-- E.g. it is ok, to modify the text and then reformat it through this API.
|
||||
@ -238,6 +248,11 @@ data FormattingType = FormatDocument
|
||||
-- Failing means here that a IdeResultFail is returned.
|
||||
-- This can be used to display errors to the user, unless the error is an Internal one.
|
||||
-- The record 'IdeError' and 'IdeErrorCode' can be used to determine the type of error.
|
||||
--
|
||||
--
|
||||
-- To format a whole document, the 'FormatText' @FormattingType@ can be used.
|
||||
-- It is required to pass in the whole Document Text for that to happen, an empty text
|
||||
-- and file uri, does not suffice.
|
||||
type FormattingProvider = T.Text -- ^ Text to format
|
||||
-> Uri -- ^ Uri of the file being formatted
|
||||
-> FormattingType -- ^ How much to format
|
||||
@ -339,11 +354,18 @@ runIdeGhcM plugins mlf stateVar f = do
|
||||
env <- IdeEnv <$> pure mlf <*> getProcessID <*> pure plugins
|
||||
eres <- flip runReaderT stateVar $ flip runReaderT env $ BIOS.withGhcT f
|
||||
return eres
|
||||
{-
|
||||
case eres of
|
||||
Left err -> liftIO $ throwIO err
|
||||
Right res -> return res
|
||||
-}
|
||||
|
||||
{-
|
||||
-- | Run an IdeGhcM in an external context (e.g. HaRe), with no plugins or LSP functions
|
||||
runIdeGhcMBare :: BiosOptions -> IdeGhcM a -> IO a
|
||||
runIdeGhcMBare biosOptions f = do
|
||||
let
|
||||
plugins = IdePlugins Map.empty
|
||||
mlf = Nothing
|
||||
initialState = IdeState emptyModuleCache Map.empty Map.empty Nothing
|
||||
stateVar <- newTVarIO initialState
|
||||
runIdeGhcM biosOptions plugins mlf stateVar f
|
||||
-}
|
||||
|
||||
-- | A computation that is deferred until the module is cached.
|
||||
-- Note that the module may not typecheck, in which case 'UriCacheFailed' is passed
|
||||
@ -424,36 +446,30 @@ getClientCapabilities = do
|
||||
getPlugins :: MonadIde m => m IdePlugins
|
||||
getPlugins = idePlugins <$> getIdeEnv
|
||||
|
||||
-- | 'withProgress' @title f@ wraps a progress reporting session for long running tasks.
|
||||
-- | 'withProgress' @title cancellable f@ wraps a progress reporting session for long running tasks.
|
||||
-- f is passed a reporting function that can be used to give updates on the progress
|
||||
-- of the task.
|
||||
withProgress :: forall m a . (MonadIde m, MonadUnliftIO m) => T.Text -> ((Core.Progress -> IO ()) -> m a) -> m a
|
||||
withProgress t f = do
|
||||
withProgress :: (MonadIde m , MonadIO m, MonadBaseControl IO m)
|
||||
=> T.Text -> Core.ProgressCancellable
|
||||
-> ((Core.Progress -> IO ()) -> m a) -> m a
|
||||
withProgress t c f = do
|
||||
lf <- ideEnvLspFuncs <$> getIdeEnv
|
||||
let mWp = Core.withProgress <$> lf
|
||||
case mWp of
|
||||
Nothing -> f (const $ return ())
|
||||
Just wp -> withRunInIO $ \u -> wp t (u . f)
|
||||
Just wp -> control $ \run -> wp t c $ \update -> run (f update)
|
||||
|
||||
-- | 'withIndefiniteProgress' @title f@ is the same as the 'withProgress' but for tasks
|
||||
|
||||
-- | 'withIndefiniteProgress' @title cancellable f@ is the same as the 'withProgress' but for tasks
|
||||
-- which do not continuously report their progress.
|
||||
withIndefiniteProgress :: (MonadIde m, MonadUnliftIO m) => T.Text -> m a -> m a
|
||||
withIndefiniteProgress t f = do
|
||||
withIndefiniteProgress :: (MonadIde m, MonadBaseControl IO m)
|
||||
=> T.Text -> Core.ProgressCancellable -> m a -> m a
|
||||
withIndefiniteProgress t c f = do
|
||||
lf <- ideEnvLspFuncs <$> getIdeEnv
|
||||
let mWp = Core.withIndefiniteProgress <$> lf
|
||||
case mWp of
|
||||
Nothing -> f
|
||||
Just wp -> withRunInIO $ \u -> wp t (u f)
|
||||
|
||||
-- | 'withIndefiniteProgress' @title f@ is the same as the 'withProgress' but for tasks
|
||||
-- which do not continuously report their progress.
|
||||
withIndefiniteProgressIO :: (MonadIO m, MonadIde m) => T.Text -> IO a -> m a
|
||||
withIndefiniteProgressIO t f = do
|
||||
lf <- ideEnvLspFuncs <$> getIdeEnv
|
||||
let mWp = Core.withIndefiniteProgress <$> lf
|
||||
liftIO $ case mWp of
|
||||
Nothing -> f
|
||||
Just wp -> wp t f
|
||||
Just wp -> control $ \run -> wp t c (run f)
|
||||
|
||||
data IdeState = IdeState
|
||||
{ moduleCache :: GhcModuleCache
|
||||
@ -504,6 +520,17 @@ instance HasGhcModuleCache IdeM where
|
||||
tvar <- lift ask
|
||||
atomically $ modifyTVar' tvar (\st -> st { moduleCache = mc })
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
{-
|
||||
instance GHC.HasDynFlags IdeGhcM where
|
||||
getDynFlags = GHC.hsc_dflags <$> GHC.getSession
|
||||
|
||||
instance GHC.GhcMonad IdeGhcM where
|
||||
getSession = GM.unGmlT GM.gmlGetSession
|
||||
setSession env = GM.unGmlT (GM.gmlSetSession env)
|
||||
-}
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Results
|
||||
-- ---------------------------------------------------------------------
|
||||
@ -587,3 +614,7 @@ instance MonadTrans GhcT where
|
||||
|
||||
deriving via (ReaderT Session IO) instance MonadUnliftIO Ghc
|
||||
deriving via (ReaderT Session IdeM) instance MonadUnliftIO (GhcT IdeM)
|
||||
deriving via (ReaderT Session IdeM) instance MonadBaseControl IO (GhcT IdeM)
|
||||
deriving via (ReaderT Session IdeM) instance MonadBase IO (GhcT IdeM)
|
||||
deriving via (ReaderT Session IdeM) instance MonadPlus (GhcT IdeM)
|
||||
deriving via (ReaderT Session IdeM) instance Alternative (GhcT IdeM)
|
||||
|
||||
@ -15,28 +15,36 @@ import Data.Data as Data
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Maybe
|
||||
import qualified TcHsSyn
|
||||
import qualified TysWiredIn
|
||||
import qualified CoreUtils
|
||||
import qualified Type
|
||||
import qualified Desugar
|
||||
import Haskell.Ide.Engine.Compat
|
||||
|
||||
import Haskell.Ide.Engine.ArtifactMap
|
||||
|
||||
-- | Generate a mapping from an Interval to types.
|
||||
-- Intervals may overlap and return more specific results.
|
||||
genTypeMap :: GHC.GhcMonad m => TypecheckedModule -> m TypeMap
|
||||
genTypeMap tm = do
|
||||
let typecheckedSource = GHC.tm_typechecked_source tm
|
||||
hs_env <- GHC.getSession
|
||||
hs_env <- GHC.getSession
|
||||
liftIO $ types hs_env typecheckedSource
|
||||
|
||||
|
||||
everythingInTypecheckedSourceM
|
||||
:: Data x => (forall a . Data a => a -> IO TypeMap) -> x -> IO TypeMap
|
||||
everythingInTypecheckedSourceM = everythingButTypeM @GHC.Id
|
||||
|
||||
|
||||
-- | Obtain details map for types.
|
||||
types :: GHC.HscEnv -> GHC.TypecheckedSource -> IO TypeMap
|
||||
types hs_env = everythingInTypecheckedSourceM (ty `combineM` fun)
|
||||
types hs_env = everythingInTypecheckedSourceM (ty `combineM` fun `combineM` funBind)
|
||||
where
|
||||
ty :: forall a . Data a => a -> IO TypeMap
|
||||
ty term = case cast term of
|
||||
(Just lhsExprGhc@(GHC.L (GHC.RealSrcSpan spn) _)) ->
|
||||
getType hs_env lhsExprGhc >>= \case
|
||||
Nothing -> return IM.empty
|
||||
Nothing -> return IM.empty
|
||||
Just (_, typ) -> return (IM.singleton (rspToInt spn) typ)
|
||||
_ -> return IM.empty
|
||||
|
||||
@ -46,19 +54,17 @@ types hs_env = everythingInTypecheckedSourceM (ty `combineM` fun)
|
||||
return (IM.singleton (rspToInt spn) (TcHsSyn.hsPatType hsPatType))
|
||||
_ -> return IM.empty
|
||||
|
||||
|
||||
everythingInTypecheckedSourceM
|
||||
:: Data x
|
||||
=> (forall a . Data a => a -> IO TypeMap)
|
||||
-> x
|
||||
-> IO TypeMap
|
||||
everythingInTypecheckedSourceM f = everythingButTypeM @GHC.Id f
|
||||
funBind :: forall a . Data a => a -> IO TypeMap
|
||||
funBind term = case cast term of
|
||||
(Just (GHC.L (GHC.RealSrcSpan spn) (FunBindType t))) ->
|
||||
return (IM.singleton (rspToInt spn) t)
|
||||
_ -> return IM.empty
|
||||
|
||||
-- | Combine two queries into one using alternative combinator.
|
||||
combineM
|
||||
:: (forall a. Data a => a -> IO TypeMap)
|
||||
-> (forall a. Data a => a -> IO TypeMap)
|
||||
-> (forall a. Data a => a -> IO TypeMap)
|
||||
:: (forall a . Data a => a -> IO TypeMap)
|
||||
-> (forall a . Data a => a -> IO TypeMap)
|
||||
-> (forall a . Data a => a -> IO TypeMap)
|
||||
combineM f g x = do
|
||||
a <- f x
|
||||
b <- g x
|
||||
@ -97,53 +103,38 @@ everythingButM f x = do
|
||||
(everythingButM f)
|
||||
x
|
||||
|
||||
-- | This instance tries to construct 'HieAST' nodes which include the type of
|
||||
-- the expression. It is not yet possible to do this efficiently for all
|
||||
-- expression forms, so we skip filling in the type for those inputs.
|
||||
-- | Attempts to get the type for expressions in a lazy and cost saving way.
|
||||
-- Avoids costly desugaring of Expressions and only obtains the type at the leaf of an expression.
|
||||
--
|
||||
-- 'HsApp', for example, doesn't have any type information available directly on
|
||||
-- the node. Our next recourse would be to desugar it into a 'CoreExpr' then
|
||||
-- query the type of that. Yet both the desugaring call and the type query both
|
||||
-- involve recursive calls to the function and argument! This is particularly
|
||||
-- problematic when you realize that the HIE traversal will eventually visit
|
||||
-- those nodes too and ask for their types again.
|
||||
-- Implementation is taken from: HieAst.hs<https://gitlab.haskell.org/ghc/ghc/blob/1f5cc9dc8aeeafa439d6d12c3c4565ada524b926/compiler/hieFile/HieAst.hs>
|
||||
-- Slightly adapted to work for the supported GHC versions 8.2.1 - 8.6.4
|
||||
--
|
||||
-- Since the above is quite costly, we just skip cases where computing the
|
||||
-- expression's type is going to be expensive.
|
||||
--
|
||||
-- See #16233
|
||||
-- See #16233<https://gitlab.haskell.org/ghc/ghc/issues/16233>
|
||||
getType
|
||||
:: GHC.HscEnv -> GHC.LHsExpr GHC.GhcTc -> IO (Maybe (GHC.SrcSpan, Type.Type))
|
||||
:: GHC.HscEnv -> GHC.LHsExpr GhcTc -> IO (Maybe (GHC.SrcSpan, Type.Type))
|
||||
getType hs_env e@(GHC.L spn e') =
|
||||
-- Some expression forms have their type immediately available
|
||||
let
|
||||
tyOpt = case e' of
|
||||
GHC.HsLit _ l -> Just (TcHsSyn.hsLitType l)
|
||||
GHC.HsOverLit _ o -> Just (GHC.overLitType o)
|
||||
|
||||
GHC.HsLam _ GHC.MG { GHC.mg_ext = groupTy } ->
|
||||
Just (matchGroupType groupTy)
|
||||
GHC.HsLamCase _ GHC.MG { GHC.mg_ext = groupTy } ->
|
||||
Just (matchGroupType groupTy)
|
||||
GHC.HsCase _ _ GHC.MG { GHC.mg_ext = groupTy } ->
|
||||
Just (GHC.mg_res_ty groupTy)
|
||||
|
||||
GHC.ExplicitList ty _ _ -> Just (TysWiredIn.mkListTy ty)
|
||||
GHC.ExplicitSum ty _ _ _ -> Just (TysWiredIn.mkSumTy ty)
|
||||
GHC.HsDo ty _ _ -> Just ty
|
||||
GHC.HsMultiIf ty _ -> Just ty
|
||||
HsOverLitType t -> Just t
|
||||
HsLitType t -> Just t
|
||||
HsLamType t -> Just t
|
||||
HsLamCaseType t -> Just t
|
||||
HsCaseType t -> Just t
|
||||
ExplicitListType t -> Just t
|
||||
ExplicitSumType t -> Just t
|
||||
HsMultiIfType t -> Just t
|
||||
|
||||
_ -> Nothing
|
||||
in case tyOpt of
|
||||
_
|
||||
Just t -> return $ Just (spn ,t)
|
||||
Nothing
|
||||
| skipDesugaring e' -> pure Nothing
|
||||
| otherwise -> do
|
||||
(_, mbe) <- Desugar.deSugarExpr hs_env e
|
||||
let res = (spn, ) . CoreUtils.exprType <$> mbe
|
||||
pure res
|
||||
where
|
||||
matchGroupType :: GHC.MatchGroupTc -> GHC.Type
|
||||
matchGroupType (GHC.MatchGroupTc args res) = Type.mkFunTys args res
|
||||
-- | Skip desugaring of these expressions for performance reasons.
|
||||
--
|
||||
-- See impact on Haddock output (esp. missing type annotations or links)
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: hie-plugin-api
|
||||
version: 0.6.0.0
|
||||
version: 0.9.0.0
|
||||
synopsis: Haskell IDE API for plugin communication
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
@ -24,13 +24,15 @@ library
|
||||
Haskell.Ide.Engine.GhcUtils
|
||||
Haskell.Ide.Engine.Config
|
||||
Haskell.Ide.Engine.Context
|
||||
Haskell.Ide.Engine.Ghc
|
||||
Haskell.Ide.Engine.GhcModuleCache
|
||||
Haskell.Ide.Engine.ModuleCache
|
||||
Haskell.Ide.Engine.MonadFunctions
|
||||
Haskell.Ide.Engine.MonadTypes
|
||||
Haskell.Ide.Engine.MultiThreadState
|
||||
Haskell.Ide.Engine.PluginsIdeMonads
|
||||
Haskell.Ide.Engine.PluginApi
|
||||
Haskell.Ide.Engine.PluginUtils
|
||||
Haskell.Ide.Engine.PluginsIdeMonads
|
||||
Haskell.Ide.Engine.TypeMap
|
||||
build-depends: base >= 4.9 && < 5
|
||||
, Diff
|
||||
@ -48,16 +50,19 @@ library
|
||||
, ghc
|
||||
, ghc-mod-core >= 5.9.0.0
|
||||
, hie-bios
|
||||
, haskell-lsp == 0.10.*
|
||||
, ghc-project-types >= 5.9.0.0
|
||||
, haskell-lsp == 0.13.*
|
||||
, hslogger
|
||||
, unliftio
|
||||
, monad-control
|
||||
, mtl
|
||||
, rope-utf16-splay >= 0.3.1.0
|
||||
, stm
|
||||
, syb
|
||||
, text
|
||||
, transformers
|
||||
, unordered-containers
|
||||
, yi-rope
|
||||
, transformers-base
|
||||
if os(windows)
|
||||
build-depends: Win32
|
||||
else
|
||||
|
||||
@ -222,7 +222,7 @@ cabalInstallHie versionNumber = do
|
||||
|
||||
cabalBuildDoc :: Action ()
|
||||
cabalBuildDoc = do
|
||||
execCabal_ ["new-build", "hoogle", "generate"]
|
||||
execCabal_ ["new-build", "hoogle"]
|
||||
execCabal_ ["new-exec", "hoogle", "generate"]
|
||||
|
||||
cabalTest :: VersionNumber -> Action ()
|
||||
|
||||
1
lsp-test
1
lsp-test
@ -1 +0,0 @@
|
||||
Subproject commit f740ca4229806616fde0c2d6add0c9c1a202b4e9
|
||||
@ -13,7 +13,7 @@ where
|
||||
import qualified Control.Concurrent.STM.TChan as TChan
|
||||
import qualified Control.Concurrent.STM as STM
|
||||
|
||||
-- | The writing end of a STM channel, only values of type 'a' cam be written
|
||||
-- | The writing end of a STM channel, only values of type 'a' can be written
|
||||
-- to the channel
|
||||
newtype InChan a = InChan (TChan.TChan a)
|
||||
|
||||
|
||||
@ -6,6 +6,9 @@ module Haskell.Ide.Engine.Plugin.ApplyRefact where
|
||||
|
||||
import Control.Arrow
|
||||
import Control.Exception ( IOException
|
||||
, ErrorCall
|
||||
, Handler(..)
|
||||
, catches
|
||||
, try
|
||||
)
|
||||
import Control.Lens hiding ( List )
|
||||
@ -252,10 +255,17 @@ applyHint fp mhint fileMap = do
|
||||
-- If we provide "applyRefactorings" with "Just (1,13)" then
|
||||
-- the "Redundant bracket" hint will never be executed
|
||||
-- because SrcSpan (1,20,??,??) doesn't contain position (1,13).
|
||||
appliedFile <- liftIO $ applyRefactorings Nothing commands fp
|
||||
diff <- ExceptT $ Right <$> makeDiffResult fp (T.pack appliedFile) fileMap
|
||||
liftIO $ logm $ "applyHint:diff=" ++ show diff
|
||||
return diff
|
||||
res <- liftIO $ (Right <$> applyRefactorings Nothing commands fp) `catches`
|
||||
[ Handler $ \e -> return (Left (show (e :: IOException)))
|
||||
, Handler $ \e -> return (Left (show (e :: ErrorCall)))
|
||||
]
|
||||
case res of
|
||||
Right appliedFile -> do
|
||||
diff <- ExceptT $ Right <$> makeDiffResult fp (T.pack appliedFile) fileMap
|
||||
liftIO $ logm $ "applyHint:diff=" ++ show diff
|
||||
return diff
|
||||
Left err ->
|
||||
throwE (show err)
|
||||
|
||||
-- | Gets HLint ideas for
|
||||
getIdeas :: MonadIO m => FilePath -> Maybe OneHint -> ExceptT String m [Idea]
|
||||
|
||||
@ -34,6 +34,7 @@ import qualified HIE.Bios.GHCApi as BIOS (withDynFlags, CradleError)
|
||||
import qualified HIE.Bios as BIOS
|
||||
import Debug.Trace
|
||||
import qualified HscMain as G
|
||||
import Haskell.Ide.Engine.Ghc
|
||||
|
||||
import System.Directory
|
||||
|
||||
@ -54,203 +55,10 @@ biosDescriptor plId = PluginDescriptor
|
||||
, pluginFormattingProvider = Nothing
|
||||
}
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
type Diagnostics = Map.Map Uri (Set.Set Diagnostic)
|
||||
type AdditionalErrs = [T.Text]
|
||||
|
||||
checkCmd :: CommandFunc Uri (Diagnostics, AdditionalErrs)
|
||||
checkCmd = CmdSync setTypecheckedModule
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
lspSev :: Severity -> DiagnosticSeverity
|
||||
lspSev SevWarning = DsWarning
|
||||
lspSev SevError = DsError
|
||||
lspSev SevFatal = DsError
|
||||
lspSev SevInfo = DsInfo
|
||||
lspSev _ = DsInfo
|
||||
|
||||
-- | Turn a 'SourceError' into the HIE 'Diagnostics' format.
|
||||
srcErrToDiag :: MonadIO m
|
||||
=> DynFlags
|
||||
-> (FilePath -> FilePath)
|
||||
-> SourceError -> m (Diagnostics, AdditionalErrs)
|
||||
srcErrToDiag df rfm se = do
|
||||
debugm "in srcErrToDiag"
|
||||
let errMsgs = bagToList $ srcErrorMessages se
|
||||
processMsg err = do
|
||||
let sev = Just DsError
|
||||
unqual = errMsgContext err
|
||||
st = mkErrStyle df unqual
|
||||
msgTxt = T.pack $ renderWithStyle df (pprLocErrMsg err) st
|
||||
eloc <- srcSpan2Loc rfm $ errMsgSpan err
|
||||
case eloc of
|
||||
Right (Location uri range) ->
|
||||
return $ Right (uri, Diagnostic range sev Nothing (Just "bios") msgTxt Nothing)
|
||||
Left _ -> return $ Left msgTxt
|
||||
processMsgs [] = return (Map.empty,[])
|
||||
processMsgs (x:xs) = do
|
||||
res <- processMsg x
|
||||
(m,es) <- processMsgs xs
|
||||
case res of
|
||||
Right (uri, diag) ->
|
||||
return (Map.insertWith Set.union uri (Set.singleton diag) m, es)
|
||||
Left e -> return (m, e:es)
|
||||
processMsgs errMsgs
|
||||
|
||||
|
||||
-- | Run a Ghc action and capture any diagnostics and errors produced.
|
||||
captureDiagnostics :: (MonadIO m, GhcMonad m)
|
||||
=> (FilePath -> FilePath)
|
||||
-> m r
|
||||
-> m (Diagnostics, AdditionalErrs, Maybe r)
|
||||
captureDiagnostics rfm action = do
|
||||
env <- getSession
|
||||
diagRef <- liftIO $ newIORef Map.empty
|
||||
errRef <- liftIO $ newIORef []
|
||||
let setLogger df = df { log_action = logDiag rfm errRef diagRef }
|
||||
setDeferTypedHoles = setGeneralFlag' Opt_DeferTypedHoles
|
||||
ghcErrRes msg = do
|
||||
diags <- liftIO $ readIORef diagRef
|
||||
errs <- liftIO $ readIORef errRef
|
||||
return (diags, (T.pack msg) : errs, Nothing)
|
||||
to_diag x = do
|
||||
(d1, e1) <- srcErrToDiag (hsc_dflags env) rfm x
|
||||
diags <- liftIO $ readIORef diagRef
|
||||
errs <- liftIO $ readIORef errRef
|
||||
return (Map.unionWith Set.union d1 diags, e1 ++ errs, Nothing)
|
||||
|
||||
|
||||
handlers = errorHandlers ghcErrRes to_diag
|
||||
action' = do
|
||||
r <- BIOS.withDynFlags (setLogger . setDeferTypedHoles) action
|
||||
diags <- liftIO $ readIORef diagRef
|
||||
errs <- liftIO $ readIORef errRef
|
||||
return (diags,errs, Just r)
|
||||
gcatches action' handlers
|
||||
|
||||
-- | Create a 'LogAction' which will be invoked by GHC when it tries to
|
||||
-- write anything to `stdout`.
|
||||
logDiag :: (FilePath -> FilePath) -> IORef AdditionalErrs -> IORef Diagnostics -> LogAction
|
||||
-- type LogAction = DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
|
||||
logDiag rfm eref dref df _reason sev spn style msg = do
|
||||
eloc <- srcSpan2Loc rfm spn
|
||||
traceShowM (spn, eloc)
|
||||
let msgTxt = T.pack $ renderWithStyle df msg style
|
||||
case eloc of
|
||||
Right (Location uri range) -> do
|
||||
let update = Map.insertWith Set.union uri l
|
||||
where l = Set.singleton diag
|
||||
diag = Diagnostic range (Just $ lspSev sev) Nothing (Just "bios") msgTxt Nothing
|
||||
debugm $ "Writing diag" <> (show diag)
|
||||
modifyIORef' dref update
|
||||
Left _ -> do
|
||||
debugm $ "Writing err" <> (show msgTxt)
|
||||
modifyIORef' eref (msgTxt:)
|
||||
return ()
|
||||
|
||||
|
||||
errorHandlers :: (String -> m a) -> (SourceError -> m a) -> [ErrorHandler m a]
|
||||
errorHandlers ghcErrRes renderSourceError = handlers
|
||||
where
|
||||
-- ghc throws GhcException, SourceError, GhcApiError and
|
||||
-- IOEnvFailure. ghc-mod-core throws GhcModError.
|
||||
handlers =
|
||||
[ ErrorHandler $ \(ex :: IOEnvFailure) ->
|
||||
ghcErrRes (show ex)
|
||||
, ErrorHandler $ \(ex :: GhcApiError) ->
|
||||
ghcErrRes (show ex)
|
||||
, ErrorHandler $ \(ex :: SourceError) ->
|
||||
renderSourceError ex
|
||||
, ErrorHandler $ \(ex :: IOError) ->
|
||||
ghcErrRes (show ex)
|
||||
, ErrorHandler $ \(ex :: BIOS.CradleError) ->
|
||||
ghcErrRes (show ex)
|
||||
]
|
||||
|
||||
|
||||
-- | Load a module from a filepath into the cache, first check the cache
|
||||
-- to see if it's already there.
|
||||
setTypecheckedModule :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs))
|
||||
setTypecheckedModule uri =
|
||||
pluginGetFile "setTypecheckedModule: " uri $ \_fp -> do
|
||||
debugm "setTypecheckedModule: before ghc-mod"
|
||||
debugm "Loading file"
|
||||
-- mapped_fp <- persistVirtualFile uri
|
||||
-- ifCachedModuleM mapped_fp (setTypecheckedModule_load uri) cont
|
||||
setTypecheckedModule_load uri
|
||||
|
||||
-- Hacky, need to copy hs-boot file if one exists for a module
|
||||
-- This is because the virtual file gets created at VFS-1234.hs and
|
||||
-- then GHC looks for the boot file at VFS-1234.hs-boot
|
||||
--
|
||||
-- This strategy doesn't work if the user wants to edit the boot file but
|
||||
-- not save it and expect the VFS to save them. However, I expect that HIE
|
||||
-- already didn't deal with boot files correctly.
|
||||
copyHsBoot :: FilePath -> FilePath -> IO ()
|
||||
copyHsBoot fp mapped_fp = do
|
||||
ex <- doesFileExist (fp <> "-boot")
|
||||
if ex
|
||||
then copyFile (fp <> "-boot") (mapped_fp <> "-boot")
|
||||
else return ()
|
||||
|
||||
loadFile :: (FilePath -> FilePath) -> (FilePath, FilePath)
|
||||
-> IdeGhcM (Diagnostics, AdditionalErrs,
|
||||
Maybe (Maybe TypecheckedModule, [TypecheckedModule]))
|
||||
loadFile rfm t = do
|
||||
withProgress "loading" $ \f -> (captureDiagnostics rfm $ BIOS.loadFileWithMessage (Just $ toMessager f) t)
|
||||
|
||||
-- | Actually load the module if it's not in the cache
|
||||
setTypecheckedModule_load :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs))
|
||||
setTypecheckedModule_load uri =
|
||||
pluginGetFile "setTypecheckedModule: " uri $ \fp -> do
|
||||
debugm "setTypecheckedModule: before ghc-mod"
|
||||
debugm "Loading file"
|
||||
mapped_fp <- persistVirtualFile uri
|
||||
liftIO $ copyHsBoot fp mapped_fp
|
||||
rfm <- reverseFileMap
|
||||
let progTitle = "Typechecking " <> T.pack (takeFileName fp)
|
||||
(diags', errs, mmods) <- loadFile rfm (fp, mapped_fp)
|
||||
debugm "File, loaded"
|
||||
canonUri <- canonicalizeUri uri
|
||||
let diags = Map.insertWith Set.union canonUri Set.empty diags'
|
||||
debugm "setTypecheckedModule: after ghc-mod"
|
||||
debugm ("Diags: " <> show diags')
|
||||
let collapse Nothing = (Nothing, [])
|
||||
collapse (Just (n, xs)) = (n, xs)
|
||||
|
||||
diags2 <- case collapse mmods of
|
||||
--Just (Just pm, Nothing) -> do
|
||||
-- debugm $ "setTypecheckedModule: Did get parsed module for: " ++ show fp
|
||||
-- cacheModule fp (Left pm)
|
||||
-- debugm "setTypecheckedModule: done"
|
||||
-- return diags
|
||||
|
||||
(Just _tm, ts) -> do
|
||||
debugm $ "setTypecheckedModule: Did get typechecked module for: " ++ show fp
|
||||
--sess <- fmap GM.gmgsSession . GM.gmGhcSession <$> GM.gmsGet
|
||||
|
||||
-- set the session before we cache the module, so that deferred
|
||||
-- responses triggered by cacheModule can access it
|
||||
--modifyMTS (\s -> s {ghcSession = sess})
|
||||
cacheModules rfm ts
|
||||
--cacheModules rfm [tm]
|
||||
debugm "setTypecheckedModule: done"
|
||||
return diags
|
||||
|
||||
(Nothing, ts) -> do
|
||||
debugm $ "setTypecheckedModule: Didn't get typechecked or parsed module for: " ++ show fp
|
||||
--debugm $ "setTypecheckedModule: errs: " ++ show errs
|
||||
cacheModules rfm ts
|
||||
failModule fp
|
||||
|
||||
let sev = Just DsError
|
||||
range = Range (Position 0 0) (Position 1 0)
|
||||
msgTxt = T.unlines errs
|
||||
let d = Diagnostic range sev Nothing (Just "bios") msgTxt Nothing
|
||||
return $ Map.insertWith Set.union canonUri (Set.singleton d) diags
|
||||
|
||||
return $ IdeResultOk (diags2,errs)
|
||||
|
||||
|
||||
|
||||
@ -43,8 +43,8 @@ provider
|
||||
provider text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do
|
||||
confFile <- liftIO $ getConfFile fp
|
||||
let (range, selectedContents) = case formatType of
|
||||
FormatDocument -> (fullRange text, text)
|
||||
FormatRange r -> (normalize r, extractRange r text)
|
||||
FormatText -> (fullRange text, text)
|
||||
FormatRange r -> (normalize r, extractRange r text)
|
||||
|
||||
res <- formatText confFile opts selectedContents
|
||||
case res of
|
||||
@ -65,21 +65,28 @@ formatText
|
||||
=> Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.
|
||||
-> FormattingOptions -- ^ Options for the formatter such as indentation.
|
||||
-> Text -- ^ Text to format
|
||||
-> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany.
|
||||
formatText confFile opts text =
|
||||
-> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany.
|
||||
formatText confFile opts text =
|
||||
liftIO $ runBrittany tabSize confFile text
|
||||
where tabSize = opts ^. J.tabSize
|
||||
|
||||
-- | Extend to the line below to replace newline character, as above.
|
||||
-- | Extend to the line below and above to replace newline character.
|
||||
normalize :: Range -> Range
|
||||
normalize (Range (Position sl _) (Position el _)) =
|
||||
Range (Position sl 0) (Position (el + 1) 0)
|
||||
|
||||
-- | Recursively search in every directory of the given filepath for brittany.yaml
|
||||
-- | Recursively search in every directory of the given filepath for brittany.yaml.
|
||||
-- If no such file has been found, return Nothing.
|
||||
getConfFile :: FilePath -> IO (Maybe FilePath)
|
||||
getConfFile = findLocalConfigPath . takeDirectory
|
||||
|
||||
-- | Run Brittany on the given text with the given tab size and
|
||||
-- a configuration path. If no configuration path is given, a
|
||||
-- default configuration is chosen. The configuration may overwrite
|
||||
-- tab size parameter.
|
||||
--
|
||||
-- Returns either a list of Brittany Errors or the reformatted text.
|
||||
-- May not throw an exception.
|
||||
runBrittany :: Int -- ^ tab size
|
||||
-> Maybe FilePath -- ^ local config file
|
||||
-> Text -- ^ text to format
|
||||
|
||||
@ -35,9 +35,9 @@ provider contents uri typ _opts =
|
||||
pluginGetFile "Floskell: " uri $ \file -> do
|
||||
config <- liftIO $ findConfigOrDefault file
|
||||
let (range, selectedContents) = case typ of
|
||||
FormatDocument -> (fullRange contents, contents)
|
||||
FormatRange r -> (r, extractRange r contents)
|
||||
result = reformat config (uriToFilePath uri) (BS.fromStrict (T.encodeUtf8 selectedContents))
|
||||
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 $ IdeResultFail (IdeError PluginError (T.pack $ "floskellCmd: " ++ err) Null)
|
||||
Right new -> return $ IdeResultOk [TextEdit range (T.decodeUtf8 (BS.toStrict new))]
|
||||
|
||||
@ -16,8 +16,6 @@ import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Monoid ((<>))
|
||||
import qualified Data.Text as T
|
||||
import System.FilePath
|
||||
import ErrUtils
|
||||
import Name
|
||||
import GHC.Generics
|
||||
import Haskell.Ide.Engine.MonadFunctions
|
||||
|
||||
@ -242,7 +242,11 @@ runHareCommand name cmd = do
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
runHareCommand' :: RefactGhc a
|
||||
-- newtype RefactGhc a = RefactGhc
|
||||
-- { unRefactGhc :: StateT RefactState HIE.IdeGhcM a
|
||||
-- }
|
||||
|
||||
runHareCommand' :: forall a. RefactGhc a
|
||||
-> IdeGhcM (Either String a)
|
||||
runHareCommand' cmd =
|
||||
do let initialState =
|
||||
@ -255,11 +259,11 @@ runHareCommand' cmd =
|
||||
,rsStorage = StorageNone
|
||||
,rsCurrentTarget = Nothing
|
||||
,rsModule = Nothing}
|
||||
let cmd' = unRefactGhc cmd
|
||||
let
|
||||
cmd' :: StateT RefactState IdeGhcM a
|
||||
cmd' = unRefactGhc cmd
|
||||
embeddedCmd =
|
||||
GM.unGmlT $
|
||||
hoist (liftIO . flip evalStateT initialState)
|
||||
(GM.GmlT cmd')
|
||||
evalStateT cmd' initialState
|
||||
handlers
|
||||
:: Applicative m
|
||||
=> [GM.GHandler m (Either String a)]
|
||||
@ -273,6 +277,7 @@ runHareCommand' cmd =
|
||||
(Left err, _) -> error (show err)
|
||||
|
||||
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- | This is like hoist from the mmorph package, but build on
|
||||
-- `MonadTransControl` since we don’t have an `MFunctor` instance.
|
||||
|
||||
@ -188,12 +188,12 @@ renderMarkDown =
|
||||
, markupProperty = \s -> T.unlines
|
||||
["\n```haskell"
|
||||
,"prop> " <> removeInner (T.pack s)
|
||||
,"\n```\n"]
|
||||
,"```\n"]
|
||||
, markupExample = T.unlines . map (\e -> T.pack $ unlines $
|
||||
["\n```haskell"
|
||||
,"> " <> exampleExpression e
|
||||
] ++ exampleResult e ++
|
||||
["\n```\n"])
|
||||
["```\n"])
|
||||
, markupHeader = \h ->
|
||||
T.replicate (headerLevel h) "#" <> " " <> headerTitle h <> "\n"
|
||||
#if __GLASGOW_HASKELL__ >= 804
|
||||
|
||||
@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
module Haskell.Ide.Engine.Plugin.HsImport where
|
||||
|
||||
import Control.Lens.Operators
|
||||
@ -41,32 +42,44 @@ hsimportDescriptor plId = PluginDescriptor
|
||||
, pluginFormattingProvider = Nothing
|
||||
}
|
||||
|
||||
-- | Import Parameters for Modules.
|
||||
-- Can be used to import every symbol from a module,
|
||||
-- or to import only a specific function from a module.
|
||||
data ImportParams = ImportParams
|
||||
{ file :: Uri
|
||||
, moduleToImport :: T.Text
|
||||
{ file :: Uri -- ^ Uri to the file to import the module to.
|
||||
, addToImportList :: Maybe T.Text -- ^ If set, an import-list will be created.
|
||||
, moduleToImport :: T.Text -- ^ Name of the module to import.
|
||||
}
|
||||
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
|
||||
|
||||
importCmd :: CommandFunc ImportParams J.WorkspaceEdit
|
||||
importCmd = CmdSync $ \(ImportParams uri modName) -> importModule uri modName
|
||||
importCmd = CmdSync $ \(ImportParams uri importList modName) ->
|
||||
importModule uri importList modName
|
||||
|
||||
importModule :: Uri -> T.Text -> IdeGhcM (IdeResult J.WorkspaceEdit)
|
||||
importModule uri modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do
|
||||
-- | Import the given module for the given file.
|
||||
-- May take an explicit function name to perform an import-list import.
|
||||
-- Multiple import-list imports will result in merged imports,
|
||||
-- e.g. two consecutive imports for the same module will result in a single
|
||||
-- import line.
|
||||
importModule
|
||||
:: Uri -> Maybe T.Text -> T.Text -> IdeGhcM (IdeResult J.WorkspaceEdit)
|
||||
importModule uri importList modName =
|
||||
pluginGetFile "hsimport cmd: " uri $ \origInput -> do
|
||||
shouldFormat <- formatOnImportOn <$> getConfig
|
||||
|
||||
fileMap <- return id -- TODO: GM.mkRevRedirMapFunc
|
||||
-- GM.withMappedFile origInput $ \input -> do
|
||||
let input = origInput
|
||||
do
|
||||
|
||||
tmpDir <- liftIO getTemporaryDirectory
|
||||
(output, outputH) <- liftIO $ openTempFile tmpDir "hsimportOutput"
|
||||
liftIO $ hClose outputH
|
||||
|
||||
let args = defaultArgs { moduleName = T.unpack modName
|
||||
, inputSrcFile = input
|
||||
, symbolName = T.unpack $ fromMaybe "" importList
|
||||
, outputSrcFile = output
|
||||
}
|
||||
-- execute hsimport on the given file and write into a temporary file.
|
||||
maybeErr <- liftIO $ hsimportWithArgs defaultConfig args
|
||||
case maybeErr of
|
||||
Just err -> do
|
||||
@ -74,29 +87,59 @@ importModule uri modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do
|
||||
let msg = T.pack $ show err
|
||||
return $ IdeResultFail (IdeError PluginError msg Null)
|
||||
Nothing -> do
|
||||
-- Since no error happened, calculate the differences of
|
||||
-- the original file and after the import has been done.
|
||||
newText <- liftIO $ T.readFile output
|
||||
liftIO $ removeFile output
|
||||
J.WorkspaceEdit mChanges mDocChanges <- liftToGhc
|
||||
$ makeDiffResult input newText fileMap
|
||||
|
||||
-- If the client wants its import formatted,
|
||||
-- it can be configured in the config.
|
||||
if shouldFormat
|
||||
then do
|
||||
config <- getConfig
|
||||
plugins <- getPlugins
|
||||
let mprovider = Hie.getFormattingPlugin config plugins
|
||||
case mprovider of
|
||||
-- Client may have no formatter selected
|
||||
-- but still the option to format on import.
|
||||
Nothing ->
|
||||
return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
|
||||
|
||||
Just (_, provider) -> do
|
||||
let formatEdit :: J.TextEdit -> IdeGhcM J.TextEdit
|
||||
formatEdit origEdit@(J.TextEdit _ t) = do
|
||||
let
|
||||
-- | Dirty little hack.
|
||||
-- Necessary in the following case:
|
||||
-- We want to add an item to an existing import-list.
|
||||
-- The diff algorithm does not count the newline character
|
||||
-- as part of the diff between new and old text.
|
||||
-- However, some formatters (Brittany), add a trailing
|
||||
-- newline nevertheless.
|
||||
-- This leads to the problem that an additional
|
||||
-- newline is inserted into the source.
|
||||
-- This function makes sure, that if the original text
|
||||
-- did not have a newline, none will be added, assuming
|
||||
-- that the diff algorithm continues to not count newlines
|
||||
-- as part of the diff.
|
||||
-- This is only save to do in this very specific environment.
|
||||
-- In any other case, this function may not be copy-pasted
|
||||
-- to solve a similar problem.
|
||||
renormalise :: T.Text -> T.Text -> T.Text
|
||||
renormalise orig formatted
|
||||
| T.null orig || T.null formatted = orig <> formatted
|
||||
| T.last orig /= '\n' && T.last formatted == '\n' = T.init formatted
|
||||
| otherwise = formatted
|
||||
|
||||
formatEdit :: J.TextEdit -> IdeGhcM J.TextEdit
|
||||
formatEdit origEdit@(J.TextEdit r t) = do
|
||||
-- TODO: are these default FormattingOptions ok?
|
||||
res <- liftToGhc $ provider t uri FormatDocument (FormattingOptions 2 True)
|
||||
let formatEdits = case res of
|
||||
IdeResultOk xs -> xs
|
||||
_ -> []
|
||||
return $ foldl' J.editTextEdit origEdit formatEdits
|
||||
formatEdits <-
|
||||
liftToGhc $ provider t uri FormatText (FormattingOptions 2 True) >>= \case
|
||||
IdeResultOk xs -> return xs
|
||||
_ -> return [origEdit]
|
||||
-- let edits = foldl' J.editTextEdit origEdit formatEdits -- TODO: this seems broken.
|
||||
return (J.TextEdit r (renormalise t . J._newText $ head formatEdits))
|
||||
|
||||
-- behold: the legendary triple mapM
|
||||
newChanges <- (mapM . mapM . mapM) formatEdit mChanges
|
||||
@ -111,48 +154,132 @@ importModule uri modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do
|
||||
$ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges)
|
||||
else return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
|
||||
|
||||
-- | Search style for Hoogle.
|
||||
-- Can be used to look either for the exact term,
|
||||
-- only the exact name or a relaxed form of the term.
|
||||
data SearchStyle
|
||||
= Exact -- ^ If you want to match exactly the search string.
|
||||
| ExactName -- ^ If you want to match exactly a function name.
|
||||
-- Same as @Exact@ if the term is just a function name.
|
||||
| Relax (T.Text -> T.Text) -- ^ Relax the search term to match even more.
|
||||
|
||||
-- | Produces code actions.
|
||||
codeActionProvider :: CodeActionProvider
|
||||
codeActionProvider plId docId _ context = do
|
||||
let J.List diags = context ^. J.diagnostics
|
||||
terms = mapMaybe getImportables diags
|
||||
|
||||
res <- mapM (bimapM return Hoogle.searchModules) terms
|
||||
actions <- catMaybes <$> mapM (uncurry mkImportAction) (concatTerms res)
|
||||
terms = mapMaybe getImportables diags
|
||||
-- Search for the given diagnostics and produce appropiate import actions.
|
||||
actions <- importActionsForTerms Exact terms
|
||||
|
||||
if null actions
|
||||
then do
|
||||
let relaxedTerms = map (bimap id (head . T.words)) terms
|
||||
relaxedRes <- mapM (bimapM return Hoogle.searchModules) relaxedTerms
|
||||
relaxedActions <- catMaybes <$> mapM (uncurry mkImportAction) (concatTerms relaxedRes)
|
||||
return $ IdeResultOk relaxedActions
|
||||
else return $ IdeResultOk actions
|
||||
then do
|
||||
-- If we didn't find any exact matches, relax the search terms.
|
||||
-- Only looks for the function names, not the exact siganture.
|
||||
relaxedActions <- importActionsForTerms ExactName terms
|
||||
return $ IdeResultOk relaxedActions
|
||||
else return $ IdeResultOk actions
|
||||
|
||||
where
|
||||
concatTerms = concatMap (\(d, ts) -> map (d,) ts)
|
||||
where
|
||||
-- | Creates CodeActions from the diagnostics to add imports.
|
||||
-- Takes a relaxation Function. Used to relax the search term,
|
||||
-- e.g. instead of `take :: Int -> [a] -> [a]` use `take` as the search term.
|
||||
--
|
||||
-- List of Diagnostics with the associated term to look for.
|
||||
-- Diagnostic that is supposed to import the appropiate term.
|
||||
--
|
||||
-- Result may produce several import actions, or none.
|
||||
importActionsForTerms
|
||||
:: SearchStyle -> [(J.Diagnostic, T.Text)] -> IdeM [J.CodeAction]
|
||||
importActionsForTerms style terms = do
|
||||
let searchTerms = map (bimap id (applySearchStyle style)) terms
|
||||
-- Get the function names for a nice import-list title.
|
||||
let functionNames = map (head . T.words . snd) terms
|
||||
searchResults' <- mapM (bimapM return Hoogle.searchModules) searchTerms
|
||||
let searchResults = zip functionNames searchResults'
|
||||
let normalise =
|
||||
concatMap (\(a, b) -> zip (repeat a) (concatTerms b)) searchResults
|
||||
|
||||
--TODO: Check if package is already installed
|
||||
mkImportAction :: J.Diagnostic -> T.Text -> IdeM (Maybe J.CodeAction)
|
||||
mkImportAction diag modName = do
|
||||
cmd <- mkLspCommand plId "import" title (Just cmdParams)
|
||||
return (Just (codeAction cmd))
|
||||
where
|
||||
codeAction cmd = J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [diag])) Nothing (Just cmd)
|
||||
title = "Import module " <> modName
|
||||
cmdParams = [toJSON (ImportParams (docId ^. J.uri) modName)]
|
||||
concat <$> mapM (uncurry (termToActions style)) normalise
|
||||
|
||||
getImportables :: J.Diagnostic -> Maybe (J.Diagnostic, T.Text)
|
||||
getImportables diag@(J.Diagnostic _ _ _ (Just "ghcmod") msg _) = (diag,) <$> extractImportableTerm msg
|
||||
getImportables _ = Nothing
|
||||
-- | Apply the search style to given term.
|
||||
-- Can be used to look for a term that matches exactly the search term,
|
||||
-- or one that matches only the exact name.
|
||||
-- At last, a custom relaxation function can be passed for more control.
|
||||
applySearchStyle :: SearchStyle -> T.Text -> T.Text
|
||||
applySearchStyle Exact term = "is:exact " <> term
|
||||
applySearchStyle ExactName term = case T.words term of
|
||||
[] -> term
|
||||
(x : _) -> "is:exact " <> x
|
||||
applySearchStyle (Relax relax) term = relax term
|
||||
|
||||
-- | Turn a search term with function name into Import Actions.
|
||||
-- Function name may be of only the exact phrase to import.
|
||||
-- The resulting CodeAction's contain a general import of a module or
|
||||
-- uses an Import-List.
|
||||
--
|
||||
-- Note, that repeated use of the Import-List will add imports to
|
||||
-- the appropriate import line, e.g. no module import is duplicated, except
|
||||
-- for qualified imports.
|
||||
--
|
||||
-- If the search term is relaxed in a custom way,
|
||||
-- no import list can be offered, since the function name
|
||||
-- may be not the one we expect.
|
||||
termToActions
|
||||
:: SearchStyle -> T.Text -> (J.Diagnostic, T.Text) -> IdeM [J.CodeAction]
|
||||
termToActions style functionName (diagnostic, termName) = do
|
||||
let useImportList = case style of
|
||||
Relax _ -> Nothing
|
||||
_ -> Just (mkImportAction (Just functionName) diagnostic termName)
|
||||
catMaybes <$> sequenceA
|
||||
(mkImportAction Nothing diagnostic termName : maybeToList useImportList)
|
||||
|
||||
concatTerms :: (a, [b]) -> [(a, b)]
|
||||
concatTerms (a, b) = zip (repeat a) b
|
||||
|
||||
--TODO: Check if package is already installed
|
||||
mkImportAction
|
||||
:: Maybe T.Text -> J.Diagnostic -> T.Text -> IdeM (Maybe J.CodeAction)
|
||||
mkImportAction importList diag modName = do
|
||||
cmd <- mkLspCommand plId "import" title (Just cmdParams)
|
||||
return (Just (codeAction cmd))
|
||||
where
|
||||
codeAction cmd = J.CodeAction title
|
||||
(Just J.CodeActionQuickFix)
|
||||
(Just (J.List [diag]))
|
||||
Nothing
|
||||
(Just cmd)
|
||||
title =
|
||||
"Import module "
|
||||
<> modName
|
||||
<> maybe "" (\name -> " (" <> name <> ")") importList
|
||||
cmdParams = [toJSON (ImportParams (docId ^. J.uri) importList modName)]
|
||||
|
||||
|
||||
-- | For a Diagnostic, get an associated function name.
|
||||
-- If Ghc-Mod can not find any candidates, Nothing is returned.
|
||||
getImportables :: J.Diagnostic -> Maybe (J.Diagnostic, T.Text)
|
||||
getImportables diag@(J.Diagnostic _ _ _ (Just "ghcmod") msg _) =
|
||||
(diag, ) <$> extractImportableTerm msg
|
||||
getImportables _ = Nothing
|
||||
|
||||
-- | Extract from an error message an appropriate term to search for.
|
||||
-- This looks at the error message and tries to extract the expected
|
||||
-- signature of an unknown function.
|
||||
-- If this is not possible, Nothing is returned.
|
||||
extractImportableTerm :: T.Text -> Maybe T.Text
|
||||
extractImportableTerm dirtyMsg = T.strip <$> asum
|
||||
[ T.stripPrefix "Variable not in scope: " msg
|
||||
, T.init <$> T.stripPrefix "Not in scope: type constructor or class ‘" msg
|
||||
, T.stripPrefix "Data constructor not in scope: " msg]
|
||||
where msg = head
|
||||
-- Get rid of the rename suggestion parts
|
||||
$ T.splitOn "Perhaps you meant "
|
||||
$ T.replace "\n" " "
|
||||
-- Get rid of trailing/leading whitespace on each individual line
|
||||
$ T.unlines $ map T.strip $ T.lines
|
||||
$ T.replace "• " "" dirtyMsg
|
||||
, T.stripPrefix "Data constructor not in scope: " msg
|
||||
]
|
||||
where
|
||||
msg =
|
||||
head
|
||||
-- Get rid of the rename suggestion parts
|
||||
$ T.splitOn "Perhaps you meant "
|
||||
$ T.replace "\n" " "
|
||||
-- Get rid of trailing/leading whitespace on each individual line
|
||||
$ T.unlines
|
||||
$ map T.strip
|
||||
$ T.lines
|
||||
$ T.replace "• " "" dirtyMsg
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
module Haskell.Ide.Engine.Plugin.Liquid where
|
||||
|
||||
--import Control.Concurrent.Async
|
||||
import Control.Concurrent.Async.Lifted
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Trans.Class
|
||||
@ -31,7 +31,6 @@ import System.FilePath
|
||||
import System.Process
|
||||
import Text.Parsec
|
||||
import Text.Parsec.Text
|
||||
import UnliftIO.Async
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
@ -123,7 +122,9 @@ diagnosticProvider DiagnosticOnSave uri cb = pluginGetFile "Liquid.diagnosticPro
|
||||
mapM_ (liftIO . cancel) mtid
|
||||
|
||||
let progTitle = "Running Liquid Haskell on " <> T.pack (takeFileName file)
|
||||
tid <- lift $ async $ withIndefiniteProgress progTitle $ (liftIO $ generateDiagnosics cb uri file)
|
||||
tid <- lift $ async $
|
||||
withIndefiniteProgress progTitle NotCancellable $
|
||||
liftIO $ generateDiagnosics cb uri file
|
||||
|
||||
put (LiquidData (Just tid))
|
||||
|
||||
|
||||
@ -63,17 +63,38 @@ packageDescriptor plId = PluginDescriptor
|
||||
}
|
||||
|
||||
data AddParams = AddParams
|
||||
{ rootDirParam :: FilePath -- ^ The root directory.
|
||||
, fileParam :: FilePath -- ^ A path to a module inside the
|
||||
-- library/executable/test-suite you want to
|
||||
-- add the package to.
|
||||
, packageParam :: T.Text -- ^ The name of the package to add.
|
||||
{ rootDirParam :: FilePath -- ^ The root directory.
|
||||
, fileParam :: ModulePath -- ^ A path to a module inside the
|
||||
-- library/executable/test-suite you want to
|
||||
-- add the package to. May be a relative or
|
||||
-- absolute path, thus, must be normalised.
|
||||
, packageParam :: Package -- ^ The name of the package to add.
|
||||
}
|
||||
deriving (Eq, Show, Read, Generic, ToJSON, FromJSON)
|
||||
|
||||
addCmd :: CommandFunc AddParams J.WorkspaceEdit
|
||||
addCmd = CmdSync $ \(AddParams rootDir modulePath pkg) -> do
|
||||
-- | FilePath to a cabal package description file.
|
||||
type CabalFilePath = FilePath
|
||||
-- | FilePath to a package.yaml package description file.
|
||||
type HpackFilePath = FilePath
|
||||
-- | FilePath to a module within the project.
|
||||
-- May be used to establish what component the dependency shall be added to.
|
||||
type ModulePath = FilePath
|
||||
-- | Name of the Package to add.
|
||||
type Package = T.Text
|
||||
|
||||
-- | Add a package to the project's dependencies.
|
||||
-- May fail if no project dependency specification can be found.
|
||||
-- Supported are `*.cabal` and `package.yaml` specifications.
|
||||
-- Moreover, may fail with an IOException in case of a filesystem problem.
|
||||
addCmd :: CommandFunc AddParams J.WorkspaceEdit
|
||||
addCmd = CmdSync addCmd'
|
||||
|
||||
-- | Add a package to the project's dependencies.
|
||||
-- May fail if no project dependency specification can be found.
|
||||
-- Supported are `*.cabal` and `package.yaml` specifications.
|
||||
-- Moreover, may fail with an IOException in case of a filesystem problem.
|
||||
addCmd' :: AddParams -> IdeGhcM (IdeResult J.WorkspaceEdit)
|
||||
addCmd' (AddParams rootDir modulePath pkg) = do
|
||||
packageType <- liftIO $ findPackageType rootDir
|
||||
fileMap <- reverseFileMap
|
||||
|
||||
@ -82,30 +103,51 @@ addCmd = CmdSync $ \(AddParams rootDir modulePath pkg) -> do
|
||||
absFp <- liftIO $ canonicalizePath relFp
|
||||
let relModulePath = makeRelative (takeDirectory absFp) modulePath
|
||||
|
||||
liftToGhc $ editCabalPackage absFp relModulePath (T.unpack pkg) fileMap
|
||||
liftToGhc $ editCabalPackage absFp relModulePath pkg fileMap
|
||||
HpackPackage relFp -> do
|
||||
absFp <- liftIO $ canonicalizePath relFp
|
||||
let relModulePath = makeRelative (takeDirectory absFp) modulePath
|
||||
liftToGhc $ editHpackPackage absFp relModulePath pkg
|
||||
NoPackage -> return $ IdeResultFail (IdeError PluginError "No package.yaml or .cabal found" Null)
|
||||
|
||||
data PackageType = CabalPackage FilePath
|
||||
| HpackPackage FilePath
|
||||
| NoPackage
|
||||
data PackageType = CabalPackage FilePath -- ^ Location of Cabal File. May be relative.
|
||||
| HpackPackage FilePath -- ^ Location of `package.yaml`. May be relative.
|
||||
| NoPackage -- ^ No package format has been found.
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Find the package type the project with the given root uses.
|
||||
-- Might have weird results if there is more than one cabal package specification
|
||||
-- in the root directory.
|
||||
-- The `package.yaml` is preferred in case both files are present.
|
||||
-- May fail with various IOException's, for example if the given
|
||||
-- directory does not exist, a Hardware Failure happens or
|
||||
-- the permissions deny it.
|
||||
-- However, normally this command should succeeed without any exceptions.
|
||||
findPackageType :: FilePath -> IO PackageType
|
||||
findPackageType rootDir = do
|
||||
files <- getDirectoryContents rootDir
|
||||
-- Search for all files that have '.cabal' as a file ending,
|
||||
-- since that is the format of the cabal file. May be more to one or zero.
|
||||
let mCabal = listToMaybe $ filter (isExtensionOf "cabal") files
|
||||
|
||||
mHpack <- findFile [rootDir] "package.yaml"
|
||||
|
||||
return $ fromMaybe NoPackage $ asum [HpackPackage <$> mHpack, CabalPackage <$> mCabal]
|
||||
|
||||
-- | Edit a hpack package to add the given package to the package.yaml.
|
||||
-- If package.yaml is not in an expected format, will fail fatally.
|
||||
--
|
||||
-- Currently does not preserve format.
|
||||
-- Keep an eye out on this other GSOC project!
|
||||
-- https://github.com/wisn/format-preserving-yaml
|
||||
editHpackPackage :: FilePath -> FilePath -> T.Text -> IdeM (IdeResult WorkspaceEdit)
|
||||
editHpackPackage :: HpackFilePath -- ^ Path to the package.yaml file
|
||||
-- containing the package description.
|
||||
-> ModulePath -- ^ Path to the module where the command has
|
||||
-- been issued in.
|
||||
-- Used to find out what component the
|
||||
-- dependency shall be added to.
|
||||
-> Package -- ^ Name of the package to add as a dependency.
|
||||
-> IdeM (IdeResult WorkspaceEdit)
|
||||
editHpackPackage fp modulePath pkgName = do
|
||||
contents <- liftIO $ B.readFile fp
|
||||
|
||||
@ -113,19 +155,29 @@ editHpackPackage fp modulePath pkgName = do
|
||||
|
||||
case Y.decodeThrow contents :: Maybe Object of
|
||||
Just obj -> do
|
||||
-- Map over all major components, such as "executable", "executables",
|
||||
-- "tests" and "benchmarks". Note, that "library" is a major component,
|
||||
-- but its structure is different and can not be mapped over in the same way.
|
||||
--
|
||||
-- Only adds the package if the declared "source-dirs" field is part of the
|
||||
-- module path, or if no "source-dirs" is declared.
|
||||
let compsMapped = mapComponentTypes (ensureObject $ mapComponents (ensureObject $ mapCompDependencies addDep)) obj
|
||||
|
||||
let addDepToMainLib = fromMaybe True $ do
|
||||
Object lib <- HM.lookup "library" compsMapped
|
||||
sourceDirs <- HM.lookup "source-dirs" lib
|
||||
return $ isInSourceDir sourceDirs
|
||||
-- Is there a global "dependencies" yaml object?
|
||||
let addDepToMainDep = fromMaybe False $ do
|
||||
Array _ <- HM.lookup "dependencies" compsMapped
|
||||
return True
|
||||
|
||||
let newPkg = if addDepToMainLib
|
||||
then mapMainDependencies addDep compsMapped
|
||||
else compsMapped
|
||||
-- Either add the package to only the top-level "dependencies",
|
||||
-- or to all main components of which the given module is part of.
|
||||
let newPkg
|
||||
| addDepToMainDep = mapMainDependencies addDep obj
|
||||
-- Map over the library component at last, since it has different structure.
|
||||
| otherwise = mapLibraryDependency addDep compsMapped
|
||||
|
||||
newPkgText = T.decodeUtf8 $ Y.encode newPkg
|
||||
let newPkgText = T.decodeUtf8 $ Y.encode newPkg
|
||||
|
||||
-- Construct the WorkSpaceEdit
|
||||
let numOldLines = length $ T.lines $ T.decodeUtf8 contents
|
||||
range = J.Range (J.Position 0 0) (J.Position numOldLines 0)
|
||||
textEdit = J.TextEdit range newPkgText
|
||||
@ -144,10 +196,18 @@ editHpackPackage fp modulePath pkgName = do
|
||||
|
||||
mapMainDependencies :: (Value -> Value) -> Object -> Object
|
||||
mapMainDependencies f o =
|
||||
let g "dependencies" = f
|
||||
let g :: T.Text -> Value -> Value
|
||||
g "dependencies" = f
|
||||
g _ = id
|
||||
in HM.mapWithKey g o
|
||||
|
||||
mapLibraryDependency :: (Value -> Value) -> Object -> Object
|
||||
mapLibraryDependency f o =
|
||||
let g :: T.Text -> Value -> Value
|
||||
g "library" (Y.Object o') = Y.Object (mapCompDependencies f o')
|
||||
g _ x = x
|
||||
in HM.mapWithKey g o
|
||||
|
||||
mapComponentTypes :: (Value -> Value) -> Object -> Object
|
||||
mapComponentTypes f o =
|
||||
let g "executables" = f
|
||||
@ -185,9 +245,16 @@ editHpackPackage fp modulePath pkgName = do
|
||||
addDep (Array deps) = Array $ fromList (String pkgName:GHC.Exts.toList deps)
|
||||
addDep _ = error "Not an array in addDep"
|
||||
|
||||
|
||||
-- | Takes a cabal file and a path to a module in the dependency you want to edit.
|
||||
editCabalPackage :: FilePath -> FilePath -> String -> (FilePath -> FilePath) -> IdeM (IdeResult J.WorkspaceEdit)
|
||||
-- | Takes a cabal file and a path to a module in the project and a package name to add
|
||||
-- to the cabal file. Reverse file map is needed to find the correct file in the project.
|
||||
-- May fail with an IOException if the Cabal file is invalid.
|
||||
editCabalPackage :: CabalFilePath -- ^ Path to the cabal file to add the dependency to.
|
||||
-> ModulePath -- ^ Path to the module that wants to add the package.
|
||||
-- Used to find out what component the
|
||||
-- dependency shall be added to.
|
||||
-> Package -- ^ Name of the package added as a dependency.
|
||||
-> (FilePath -> FilePath) -- ^ Reverse File for computing file diffs.
|
||||
-> IdeM (IdeResult J.WorkspaceEdit)
|
||||
editCabalPackage file modulePath pkgName fileMap = do
|
||||
|
||||
package <- liftIO $ readGenericPackageDescription normal file
|
||||
@ -203,7 +270,6 @@ editCabalPackage file modulePath pkgName fileMap = do
|
||||
|
||||
IdeResultOk <$> makeAdditiveDiffResult file newContents fileMap
|
||||
|
||||
|
||||
where
|
||||
|
||||
applyLens :: L.HasBuildInfo a => Lens' GenericPackageDescription [(b, CondTree v c a)]
|
||||
@ -217,7 +283,7 @@ editCabalPackage file modulePath pkgName fileMap = do
|
||||
updateTree = mapIfHasModule modulePath (addDep pkgName)
|
||||
|
||||
|
||||
mapIfHasModule :: L.HasBuildInfo a => FilePath -> (a -> a) -> CondTree v c a -> CondTree v c a
|
||||
mapIfHasModule :: L.HasBuildInfo a => ModulePath -> (a -> a) -> CondTree v c a -> CondTree v c a
|
||||
mapIfHasModule modFp f = mapTreeData g
|
||||
where g x
|
||||
| null (sourceDirs x) = f x
|
||||
@ -226,18 +292,26 @@ editCabalPackage file modulePath pkgName fileMap = do
|
||||
hasThisModule = any (`isPrefixOf` modFp) . sourceDirs
|
||||
sourceDirs x = x ^. L.buildInfo . L.hsSourceDirs
|
||||
|
||||
addDep :: L.HasBuildInfo a => String -> a -> a
|
||||
-- | Add the given package name to the cabal file.
|
||||
-- Package is appended to the dependency list.
|
||||
addDep :: L.HasBuildInfo a => Package -> a -> a
|
||||
addDep dep x = L.buildInfo . L.targetBuildDepends .~ newDeps $ x
|
||||
where oldDeps = x ^. L.buildInfo . L.targetBuildDepends
|
||||
-- Add it to the bottom of the dependencies list
|
||||
newDeps = oldDeps ++ [Dependency (mkPackageName dep) anyVersion]
|
||||
-- TODO: we could sort the depencies and then insert it,
|
||||
-- or insert it in order iff the list is already sorted.
|
||||
newDeps = oldDeps ++ [Dependency (mkPackageName (T.unpack dep)) anyVersion]
|
||||
|
||||
-- | Provide a code action to add a package to the local package.yaml or cabal file.
|
||||
-- Reads from diagnostics the unknown import module path and searches for it on Hoogle.
|
||||
-- If found, offer a code action to add the package to the local package description.
|
||||
codeActionProvider :: CodeActionProvider
|
||||
codeActionProvider plId docId _ context = do
|
||||
mRootDir <- getRootPath
|
||||
let J.List diags = context ^. J.diagnostics
|
||||
pkgs = mapMaybe getAddablePackages diags
|
||||
|
||||
-- Search for packages that define the given module.
|
||||
res <- mapM (bimapM return Hoogle.searchPackages) pkgs
|
||||
actions <- catMaybes <$> mapM (uncurry (mkAddPackageAction mRootDir)) (concatPkgs res)
|
||||
|
||||
@ -246,7 +320,8 @@ codeActionProvider plId docId _ context = do
|
||||
where
|
||||
concatPkgs = concatMap (\(d, ts) -> map (d,) ts)
|
||||
|
||||
mkAddPackageAction :: Maybe FilePath -> J.Diagnostic -> T.Text -> IdeM (Maybe J.CodeAction)
|
||||
-- | Create the Add Package Action with the given diagnostics and the found package name.
|
||||
mkAddPackageAction :: Maybe FilePath -> J.Diagnostic -> Package -> IdeM (Maybe J.CodeAction)
|
||||
mkAddPackageAction mRootDir diag pkgName = case (mRootDir, J.uriToFilePath (docId ^. J.uri)) of
|
||||
(Just rootDir, Just docFp) -> do
|
||||
let title = "Add " <> pkgName <> " as a dependency"
|
||||
@ -255,11 +330,12 @@ codeActionProvider plId docId _ context = do
|
||||
return $ Just (J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [diag])) Nothing (Just cmd))
|
||||
_ -> return Nothing
|
||||
|
||||
getAddablePackages :: J.Diagnostic -> Maybe (J.Diagnostic, T.Text)
|
||||
getAddablePackages :: J.Diagnostic -> Maybe (J.Diagnostic, Package)
|
||||
getAddablePackages diag@(J.Diagnostic _ _ _ (Just "ghcmod") msg _) = (diag,) <$> extractModuleName msg
|
||||
getAddablePackages _ = Nothing
|
||||
|
||||
extractModuleName :: T.Text -> Maybe T.Text
|
||||
-- | Extract a module name from an error message.
|
||||
extractModuleName :: T.Text -> Maybe Package
|
||||
extractModuleName msg
|
||||
| T.isPrefixOf "Could not find module " msg = Just $ T.tail $ T.init nameAndQuotes
|
||||
| T.isPrefixOf "Could not load module " msg = Just $ T.tail $ T.init nameAndQuotes
|
||||
@ -267,6 +343,7 @@ extractModuleName msg
|
||||
where line = head $ T.lines msg
|
||||
nameAndQuotes = T.dropWhileEnd (/= '’') $ T.dropWhile (/= '‘') line
|
||||
|
||||
-- Example error messages
|
||||
{- GHC 8.6.2 error message is
|
||||
|
||||
"Could not load module \8216Data.Text\8217\n" ++
|
||||
|
||||
@ -32,12 +32,17 @@ pragmasDescriptor plId = PluginDescriptor
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- | Parameters for the addPragma PluginCommand.
|
||||
data AddPragmaParams = AddPragmaParams
|
||||
{ file :: Uri
|
||||
, pragma :: T.Text
|
||||
{ file :: Uri -- ^ Uri of the file to add the pragma to
|
||||
, pragma :: T.Text -- ^ Name of the Pragma to add
|
||||
}
|
||||
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
|
||||
|
||||
-- | Add a Pragma to the given URI at the top of the file.
|
||||
-- Pragma is added to the first line of the Uri.
|
||||
-- It is assumed that the pragma name is a valid pragma,
|
||||
-- thus, not validated.
|
||||
addPragmaCmd :: CommandFunc AddPragmaParams J.WorkspaceEdit
|
||||
addPragmaCmd = CmdSync $ \(AddPragmaParams uri pragmaName) -> do
|
||||
let
|
||||
@ -53,15 +58,20 @@ addPragmaCmd = CmdSync $ \(AddPragmaParams uri pragmaName) -> do
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- | Offer to add a missing Language Pragma to the top of a file.
|
||||
-- Pragmas are defined by a curated list of known pragmas, see 'possiblePragmas'.
|
||||
codeActionProvider :: CodeActionProvider
|
||||
codeActionProvider plId docId _ (J.CodeActionContext (J.List diags) _monly) = do
|
||||
cmds <- mapM mkCommand pragmas
|
||||
return $ IdeResultOk cmds
|
||||
where
|
||||
-- Filter diagnostics that are from ghcmod
|
||||
ghcDiags = filter (\d -> d ^. J.source == Just "ghcmod") diags
|
||||
-- Get all potential Pragmas for all diagnostics.
|
||||
pragmas = concatMap (\d -> findPragma (d ^. J.message)) ghcDiags
|
||||
mkCommand pragmaName = do
|
||||
let
|
||||
-- | Code Action for the given command.
|
||||
codeAction :: J.Command -> J.CodeAction
|
||||
codeAction cmd = J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing (Just cmd)
|
||||
title = "Add \"" <> pragmaName <> "\""
|
||||
@ -71,6 +81,7 @@ codeActionProvider plId docId _ (J.CodeActionContext (J.List diags) _monly) = do
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- | Find all Pragmas are an infix of the search term.
|
||||
findPragma :: T.Text -> [T.Text]
|
||||
findPragma str = concatMap check possiblePragmas
|
||||
where
|
||||
@ -78,6 +89,8 @@ findPragma str = concatMap check possiblePragmas
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- | Possible Pragma names.
|
||||
-- Is non-exhaustive, and may be extended.
|
||||
possiblePragmas :: [T.Text]
|
||||
possiblePragmas =
|
||||
[
|
||||
|
||||
@ -16,7 +16,7 @@ module Haskell.Ide.Engine.Support.HieExtras
|
||||
, findTypeDef
|
||||
, showName
|
||||
, safeTyThingId
|
||||
, PosPrefixInfo(..)
|
||||
, VFS.PosPrefixInfo(..)
|
||||
, HarePoint(..)
|
||||
, customOptions
|
||||
-- , splitCaseCmd'
|
||||
@ -57,6 +57,7 @@ import qualified Haskell.Ide.Engine.Support.Fuzzy as Fuzzy
|
||||
import HscTypes
|
||||
import qualified Language.Haskell.LSP.Types as J
|
||||
import qualified Language.Haskell.LSP.Types.Lens as J
|
||||
import qualified Language.Haskell.LSP.VFS as VFS
|
||||
import Language.Haskell.Refact.API (showGhc)
|
||||
import Language.Haskell.Refact.Utils.MonadFunctions
|
||||
import Name
|
||||
@ -180,24 +181,6 @@ safeTyThingId _ = Nothing
|
||||
-- Associates a module's qualifier with its members
|
||||
type QualCompls = Map.Map T.Text [CompItem]
|
||||
|
||||
-- | Describes the line at the current cursor position
|
||||
data PosPrefixInfo = PosPrefixInfo
|
||||
{ fullLine :: T.Text
|
||||
-- ^ The full contents of the line the cursor is at
|
||||
|
||||
, prefixModule :: T.Text
|
||||
-- ^ If any, the module name that was typed right before the cursor position.
|
||||
-- For example, if the user has typed "Data.Maybe.from", then this property
|
||||
-- will be "Data.Maybe"
|
||||
|
||||
, prefixText :: T.Text
|
||||
-- ^ The word right before the cursor position, after removing the module part.
|
||||
-- For example if the user has typed "Data.Maybe.from",
|
||||
-- then this property will be "from"
|
||||
, cursorPos :: J.Position
|
||||
-- ^ The cursor position
|
||||
}
|
||||
|
||||
data CachedCompletions = CC
|
||||
{ allModNamesAsNS :: [T.Text]
|
||||
, unqualCompls :: [CompItem]
|
||||
@ -331,7 +314,7 @@ instance ModuleCache CachedCompletions where
|
||||
newtype WithSnippets = WithSnippets Bool
|
||||
|
||||
-- | Returns the cached completions for the given module and position.
|
||||
getCompletions :: Uri -> PosPrefixInfo -> WithSnippets -> IdeM (IdeResult [J.CompletionItem])
|
||||
getCompletions :: Uri -> VFS.PosPrefixInfo -> WithSnippets -> IdeM (IdeResult [J.CompletionItem])
|
||||
getCompletions uri prefixInfo (WithSnippets withSnippets) =
|
||||
pluginGetFile "getCompletions: " uri $ \file -> do
|
||||
let snippetLens = (^? J.textDocument
|
||||
@ -349,7 +332,7 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) =
|
||||
, J._insertText = Nothing
|
||||
}
|
||||
|
||||
PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
|
||||
VFS.PosPrefixInfo { VFS.fullLine, VFS.prefixModule, VFS.prefixText } = prefixInfo
|
||||
debugm $ "got prefix" ++ show (prefixModule, prefixText)
|
||||
let enteredQual = if T.null prefixModule then "" else prefixModule <> "."
|
||||
fullPrefix = enteredQual <> prefixText
|
||||
@ -366,7 +349,7 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) =
|
||||
^
|
||||
-}
|
||||
pos =
|
||||
let newPos = cursorPos prefixInfo
|
||||
let newPos = VFS.cursorPos prefixInfo
|
||||
Position l c = fromMaybe newPos (newPosToOld newPos)
|
||||
typeStuff = [isSpace, (`elem` (">-." :: String))]
|
||||
stripTypeStuff = T.dropWhileEnd (\x -> any (\f -> f x) typeStuff)
|
||||
|
||||
@ -27,7 +27,6 @@ import qualified Data.Aeson as A
|
||||
import Control.Monad.STM
|
||||
import Data.Aeson ( (.=) )
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Char (isUpper, isAlphaNum)
|
||||
import Data.Coerce (coerce)
|
||||
import Data.Default
|
||||
import Data.Foldable
|
||||
@ -40,6 +39,7 @@ import qualified Data.SortedList as SL
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding
|
||||
import Haskell.Ide.Engine.Config
|
||||
import qualified Haskell.Ide.Engine.Ghc as HIE
|
||||
import Haskell.Ide.Engine.LSP.CodeActions
|
||||
import Haskell.Ide.Engine.LSP.Reactor
|
||||
import Haskell.Ide.Engine.MonadFunctions
|
||||
@ -70,8 +70,8 @@ import qualified Language.Haskell.LSP.Types.Lens as J
|
||||
import qualified Language.Haskell.LSP.Utility as U
|
||||
import qualified Language.Haskell.LSP.VFS as VFS
|
||||
import System.Exit
|
||||
import qualified System.Log.Logger as L
|
||||
import qualified Yi.Rope as Yi
|
||||
import qualified System.Log.Logger as L
|
||||
import qualified Data.Rope.UTF16 as Rope
|
||||
|
||||
import Outputable hiding ((<>))
|
||||
|
||||
@ -207,29 +207,10 @@ configVal field = field <$> getClientConfig
|
||||
|
||||
getPrefixAtPos :: (MonadIO m, MonadReader REnv m)
|
||||
=> Uri -> Position -> m (Maybe Hie.PosPrefixInfo)
|
||||
getPrefixAtPos uri pos@(Position l c) = do
|
||||
getPrefixAtPos uri pos = do
|
||||
mvf <- liftIO =<< asksLspFuncs Core.getVirtualFileFunc <*> pure uri
|
||||
case mvf of
|
||||
Just (VFS.VirtualFile _ yitext _) ->
|
||||
return $ Just $ fromMaybe (Hie.PosPrefixInfo "" "" "" pos) $ do
|
||||
let headMaybe [] = Nothing
|
||||
headMaybe (x:_) = Just x
|
||||
lastMaybe [] = Nothing
|
||||
lastMaybe xs = Just $ last xs
|
||||
curLine <- headMaybe $ Yi.lines $ snd $ Yi.splitAtLine l yitext
|
||||
let beforePos = Yi.take c curLine
|
||||
curWord <- case Yi.last beforePos of
|
||||
Just ' ' -> Just "" -- don't count abc as the curword in 'abc '
|
||||
_ -> Yi.toText <$> lastMaybe (Yi.words beforePos)
|
||||
let parts = T.split (=='.')
|
||||
$ T.takeWhileEnd (\x -> isAlphaNum x || x `elem` ("._'"::String)) curWord
|
||||
case reverse parts of
|
||||
[] -> Nothing
|
||||
(x:xs) -> do
|
||||
let modParts = dropWhile (not . isUpper . T.head)
|
||||
$ reverse $ filter (not .T.null) xs
|
||||
modName = T.intercalate "." modParts
|
||||
return $ Hie.PosPrefixInfo (Yi.toText curLine) modName x pos
|
||||
Just vf -> VFS.getCompletionPrefix pos vf
|
||||
Nothing -> return Nothing
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
@ -735,7 +716,7 @@ reactor inp diagIn = do
|
||||
doc = params ^. J.textDocument . J.uri
|
||||
withDocumentContents (req ^. J.id) doc $ \text ->
|
||||
let callback = reactorSend . RspDocumentFormatting . Core.makeResponseMessage req . J.List
|
||||
hreq = IReq tn (req ^. J.id) callback $ lift $ provider text doc FormatDocument (params ^. J.options)
|
||||
hreq = IReq tn (req ^. J.id) callback $ lift $ provider text doc FormatText (params ^. J.options)
|
||||
in makeRequest hreq
|
||||
|
||||
-- -------------------------------
|
||||
@ -825,7 +806,7 @@ withDocumentContents reqId uri f = do
|
||||
(J.responseId reqId)
|
||||
J.InvalidRequest
|
||||
"Document was not open"
|
||||
Just (VFS.VirtualFile _ txt _) -> f (Yi.toText txt)
|
||||
Just (VFS.VirtualFile _ txt _) -> f (Rope.toText txt)
|
||||
|
||||
-- | Get the currently configured formatter provider.
|
||||
-- The currently configured formatter provider is defined in @Config@ by PluginId.
|
||||
|
||||
@ -7,26 +7,28 @@ extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
# - brittany-0.11.0.0
|
||||
- butcher-1.3.1.1
|
||||
- cabal-plan-0.3.0.0
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- czipwith-1.0.1.0
|
||||
- floskell-0.10.0
|
||||
- ghc-exactprint-0.5.8.2
|
||||
- haddock-api-2.18.1
|
||||
- haddock-library-1.4.4
|
||||
- haskell-lsp-0.10.0.0
|
||||
- haskell-lsp-types-0.10.0.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0@rev:2
|
||||
- hlint-2.0.11
|
||||
- hsimport-0.8.6
|
||||
- lsp-test-0.5.1.3
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- mtl-2.2.2
|
||||
- pretty-show-1.8.2
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- sorted-list-0.2.1.0
|
||||
- syz-0.2.0.0
|
||||
- yaml-0.8.32
|
||||
|
||||
@ -7,9 +7,9 @@ extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
# - brittany-0.11.0.0
|
||||
- butcher-1.3.1.1
|
||||
@ -17,19 +17,21 @@ extra-deps:
|
||||
- conduit-parse-0.2.1.0
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- czipwith-1.0.1.0
|
||||
- floskell-0.10.0
|
||||
- ghc-exactprint-0.5.8.2
|
||||
- haddock-api-2.18.1
|
||||
- haddock-library-1.4.4
|
||||
- haskell-lsp-0.10.0.0
|
||||
- haskell-lsp-types-0.10.0.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0@rev:2
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.16
|
||||
- hlint-2.1.17 # last hlint supporting GHC 8.2
|
||||
- hoogle-5.0.17.6
|
||||
- hsimport-0.8.8
|
||||
- lsp-test-0.5.1.3
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- pretty-show-1.8.2
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- sorted-list-0.2.1.0
|
||||
- syz-0.2.0.0
|
||||
|
||||
|
||||
@ -7,27 +7,30 @@ extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
# - brittany-0.11.0.0
|
||||
- base-compat-0.9.3
|
||||
- cabal-plan-0.3.0.0
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- floskell-0.10.0
|
||||
- ghc-exactprint-0.5.8.2
|
||||
- ghc-lib-parser-0.20190523
|
||||
- haddock-api-2.20.0
|
||||
- haddock-library-1.6.0
|
||||
- haskell-lsp-0.10.0.0
|
||||
- haskell-lsp-types-0.10.0.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0@rev:2
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.16
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hsimport-0.8.8
|
||||
- lsp-test-0.5.1.3
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- pretty-show-1.8.2
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
- windns-0.1.0.0
|
||||
|
||||
@ -7,26 +7,29 @@ extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- base-compat-0.9.3
|
||||
- cabal-plan-0.3.0.0
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- floskell-0.10.0
|
||||
- ghc-exactprint-0.5.8.2
|
||||
- ghc-lib-parser-0.20190523
|
||||
- haddock-api-2.20.0
|
||||
- haddock-library-1.6.0
|
||||
- haskell-lsp-0.10.0.0
|
||||
- haskell-lsp-types-0.10.0.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0@rev:2
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.16
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hsimport-0.8.8
|
||||
- lsp-test-0.5.1.3
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- pretty-show-1.8.2
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
|
||||
|
||||
@ -7,27 +7,30 @@ extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
# - brittany-0.11.0.0
|
||||
- cabal-plan-0.4.0.0
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- floskell-0.10.0
|
||||
- ghc-exactprint-0.5.8.2
|
||||
- ghc-lib-parser-0.20190523
|
||||
- haddock-api-2.20.0
|
||||
- haddock-library-1.6.0
|
||||
- haskell-lsp-0.10.0.0
|
||||
- haskell-lsp-types-0.10.0.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.16
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hsimport-0.8.8
|
||||
- lsp-test-0.5.1.3
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- optparse-simple-0.1.0
|
||||
- pretty-show-1.9.5
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
|
||||
|
||||
@ -7,9 +7,9 @@ extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- apply-refact-0.6.0.0
|
||||
- butcher-1.3.2.1
|
||||
@ -18,21 +18,24 @@ extra-deps:
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- czipwith-1.0.1.1
|
||||
- data-tree-print-0.1.0.2
|
||||
- floskell-0.10.0
|
||||
- ghc-lib-parser-0.20190523
|
||||
- haddock-api-2.21.0
|
||||
- haskell-lsp-0.10.0.0
|
||||
- haskell-lsp-types-0.10.0.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.16
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hsimport-0.8.8
|
||||
- lsp-test-0.5.1.3
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- monad-memo-0.4.1
|
||||
- monoid-subclasses-0.4.6.1
|
||||
- multistate-0.8.0.1
|
||||
- primes-0.2.1.0
|
||||
- resolv-0.1.1.2
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
- yaml-0.8.32
|
||||
|
||||
@ -7,25 +7,28 @@ extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- butcher-1.3.2.1
|
||||
- cabal-plan-0.4.0.0
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- floskell-0.10.0
|
||||
- ghc-lib-parser-0.20190523
|
||||
- haddock-api-2.21.0
|
||||
- haskell-lsp-0.10.0.0
|
||||
- haskell-lsp-types-0.10.0.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.16
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hsimport-0.8.8
|
||||
- lsp-test-0.5.1.3
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- monad-memo-0.4.1
|
||||
- multistate-0.8.0.1
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
- yaml-0.8.32
|
||||
|
||||
@ -8,29 +8,30 @@ extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/floskell
|
||||
- ./haskell-lsp
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- bytestring-trie-0.2.5.0
|
||||
- butcher-1.3.2.1
|
||||
- cabal-plan-0.4.0.0
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- floskell-0.10.0
|
||||
- ghc-lib-parser-0.20190523
|
||||
- haddock-api-2.21.0
|
||||
- haskell-lsp-0.10.0.0
|
||||
- haskell-lsp-types-0.10.0.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.16
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hsimport-0.8.8
|
||||
- lsp-test-0.5.1.3
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- monad-memo-0.4.1
|
||||
- multistate-0.8.0.1
|
||||
- optparse-simple-0.1.0
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
- yaml-0.8.32
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
resolver: lts-13.15 # GHC 8.6.4
|
||||
resolver: lts-13.19 # GHC 8.6.4
|
||||
packages:
|
||||
- .
|
||||
- hie-plugin-api
|
||||
@ -8,28 +8,27 @@ extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./haskell-lsp
|
||||
- ./lsp-test
|
||||
|
||||
- butcher-1.3.2.1
|
||||
- bytestring-trie-0.2.5.0
|
||||
- cabal-plan-0.4.0.0
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- floskell-0.10.0
|
||||
- ghc-lib-parser-0.20190523
|
||||
- haddock-api-2.22.0
|
||||
- haskell-lsp-0.10.0.0
|
||||
- haskell-lsp-types-0.10.0.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.16
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hsimport-0.8.8
|
||||
- lsp-test-0.5.1.3
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2@rev:1
|
||||
- monad-memo-0.4.1
|
||||
- multistate-0.8.0.1
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
- yaml-0.8.32
|
||||
|
||||
47
stack-8.6.5.yaml
Normal file
47
stack-8.6.5.yaml
Normal file
@ -0,0 +1,47 @@
|
||||
resolver: nightly-2019-04-30 # First GHC 8.6.5
|
||||
packages:
|
||||
- .
|
||||
- hie-plugin-api
|
||||
|
||||
extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- ansi-terminal-0.8.2
|
||||
- butcher-1.3.2.1
|
||||
- cabal-plan-0.4.0.0
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- deque-0.2.7
|
||||
- floskell-0.10.0
|
||||
- ghc-exactprint-0.5.8.2
|
||||
- ghc-lib-parser-0.20190523
|
||||
- haddock-api-2.22.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- hlint-2.1.22
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2@rev:1
|
||||
- monad-memo-0.4.1
|
||||
- multistate-0.8.0.1
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
- yaml-0.8.32
|
||||
|
||||
flags:
|
||||
haskell-ide-engine:
|
||||
pedantic: true
|
||||
hie-plugin-api:
|
||||
pedantic: true
|
||||
|
||||
# allow-newer: true
|
||||
|
||||
nix:
|
||||
packages: [ icu libcxx zlib ]
|
||||
|
||||
concurrent-tests: false
|
||||
19
stack.yaml
19
stack.yaml
@ -1,4 +1,4 @@
|
||||
resolver: nightly-2019-04-05 # GHC 8.6.4
|
||||
resolver: nightly-2019-04-30 # First GHC 8.6.5
|
||||
packages:
|
||||
- .
|
||||
- hie-plugin-api
|
||||
@ -8,10 +8,9 @@ extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/floskell
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./haskell-lsp
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- ansi-terminal-0.8.2
|
||||
- butcher-1.3.2.1
|
||||
@ -19,17 +18,19 @@ extra-deps:
|
||||
- cabal-plan-0.4.0.0
|
||||
- constrained-dynamic-0.1.0.0
|
||||
- deque-0.2.7
|
||||
- floskell-0.10.0
|
||||
- ghc-exactprint-0.5.8.2
|
||||
- ghc-lib-parser-0.20190523
|
||||
- haddock-api-2.22.0
|
||||
- haskell-lsp-0.10.0.0
|
||||
- haskell-lsp-types-0.10.0.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.16
|
||||
- hsimport-0.8.8
|
||||
- lsp-test-0.5.1.3
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- hlint-2.1.22
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- monad-dijkstra-0.1.1.2@rev:1
|
||||
- monad-memo-0.4.1
|
||||
- multistate-0.8.0.1
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
- yaml-0.8.32
|
||||
|
||||
@ -1 +1 @@
|
||||
Subproject commit 53979f062bebcaa132390d1fd0cec74a51662952
|
||||
Subproject commit dfab0004320c28e1aa0331a507a9428952f2c938
|
||||
@ -1 +1 @@
|
||||
Subproject commit 8fecf6a7754424ed1653dce632382707e8f03499
|
||||
Subproject commit eafed5e8c1d82b8daa35775b52361132f2e70261
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit 9b9fe8b651b432209b7d7c170697cb6400a41185
|
||||
@ -1 +1 @@
|
||||
Subproject commit 1544779ac040ca30d5b3e0c5b9156e2007a51c4d
|
||||
Subproject commit 43476965b5d715f7fcdadd9e14d5e0c53cdb9385
|
||||
@ -29,7 +29,7 @@ spec = do
|
||||
|
||||
skipMany anyNotification
|
||||
hoverRsp <- message :: Session HoverResponse
|
||||
liftIO $ hoverRsp ^? result . _Just . _Just . contents `shouldBe` (Just HoverContentsEmpty)
|
||||
liftIO $ hoverRsp ^? result . _Just . _Just . contents `shouldBe` Nothing
|
||||
liftIO $ hoverRsp ^. LSP.id `shouldBe` responseId id1
|
||||
|
||||
id2 <- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module FunctionalCodeActionsSpec where
|
||||
|
||||
@ -9,6 +10,7 @@ import Control.Monad.IO.Class
|
||||
import Data.Aeson
|
||||
import Data.Default
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Set as Set
|
||||
import Data.Maybe
|
||||
import Data.Monoid ((<>))
|
||||
import qualified Data.Text as T
|
||||
@ -125,63 +127,62 @@ spec = describe "code actions" $ do
|
||||
liftIO $ x `shouldBe` "foo = putStrLn \"world\""
|
||||
|
||||
describe "import suggestions" $ do
|
||||
it "works with 3.8 code action kinds" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImport.hs" "haskell"
|
||||
|
||||
-- ignore the first empty hlint diagnostic publish
|
||||
[_,diag:_] <- count 2 waitForDiagnostics
|
||||
liftIO $ diag ^. L.message `shouldBe` "Variable not in scope: when :: Bool -> IO () -> IO ()"
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let actns = map fromAction actionsOrCommands
|
||||
|
||||
liftIO $ do
|
||||
head actns ^. L.title `shouldBe` "Import module Control.Monad"
|
||||
forM_ actns $ \a -> do
|
||||
a ^. L.kind `shouldBe` Just CodeActionQuickFix
|
||||
a ^. L.command `shouldSatisfy` isJust
|
||||
a ^. L.edit `shouldBe` Nothing
|
||||
let hasOneDiag (Just (List [_])) = True
|
||||
hasOneDiag _ = False
|
||||
a ^. L.diagnostics `shouldSatisfy` hasOneDiag
|
||||
length actns `shouldBe` 5
|
||||
|
||||
executeCodeAction (head actns)
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ contents `shouldBe` "import Control.Monad\nmain :: IO ()\nmain = when True $ putStrLn \"hello\""
|
||||
it "formats with brittany" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let action:_ = map fromAction actionsOrCommands
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ do
|
||||
let l1:l2:_ = T.lines contents
|
||||
l1 `shouldBe` "import qualified Data.Maybe"
|
||||
l2 `shouldBe` "import Control.Monad"
|
||||
it "respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
|
||||
let config = def { formatOnImportOn = False }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let action:_ = map fromAction actionsOrCommands
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ do
|
||||
let l1:l2:_ = T.lines contents
|
||||
l1 `shouldBe` "import qualified Data.Maybe"
|
||||
l2 `shouldBe` "import Control.Monad"
|
||||
|
||||
hsImportSpec "brittany"
|
||||
[ -- Expected output for simple format.
|
||||
[ "import qualified Data.Maybe"
|
||||
, "import Control.Monad"
|
||||
, "main :: IO ()"
|
||||
, "main = when True $ putStrLn \"hello\""
|
||||
]
|
||||
, -- Use an import list and format the output.
|
||||
[ "import qualified Data.Maybe"
|
||||
, "import Control.Monad ( when )"
|
||||
, "main :: IO ()"
|
||||
, "main = when True $ putStrLn \"hello\""
|
||||
]
|
||||
, -- Multiple import lists, should not introduce multiple newlines.
|
||||
[ "import System.IO ( stdout"
|
||||
, " , hPutStrLn"
|
||||
, " )"
|
||||
, "import Control.Monad ( when )"
|
||||
, "import Data.Maybe ( fromMaybe )"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stdout"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
]
|
||||
hsImportSpec "floskell"
|
||||
[ -- Expected output for simple format.
|
||||
[ "import qualified Data.Maybe"
|
||||
, "import Control.Monad"
|
||||
, "main :: IO ()"
|
||||
, "main = when True $ putStrLn \"hello\""
|
||||
]
|
||||
, -- Use an import list and format the output.
|
||||
[ "import qualified Data.Maybe"
|
||||
, "import Control.Monad (when)"
|
||||
, "main :: IO ()"
|
||||
, "main = when True $ putStrLn \"hello\""
|
||||
]
|
||||
, -- Multiple import lists, should not introduce multiple newlines.
|
||||
[ "import System.IO (stdout, hPutStrLn)"
|
||||
, "import Control.Monad (when)"
|
||||
, "import Data.Maybe (fromMaybe)"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stdout"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
]
|
||||
describe "add package suggestions" $ do
|
||||
it "adds to .cabal files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal" $ do
|
||||
-- Only execute this test with ghc 8.4.4, below seems to be broken in the package.
|
||||
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0)))
|
||||
it "adds to .cabal files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do
|
||||
doc <- openDoc "AddPackage.hs" "haskell"
|
||||
|
||||
-- ignore the first empty hlint diagnostic publish
|
||||
@ -205,9 +206,9 @@ spec = describe "code actions" $ do
|
||||
|
||||
contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal"
|
||||
liftIO $ T.lines contents `shouldSatisfy` \x -> any (\l -> "text -any" `T.isSuffixOf` (x !! l)) [15, 16]
|
||||
|
||||
#endif
|
||||
it "adds to hpack package.yaml files" $
|
||||
runSession hieCommand fullCaps "test/testdata/addPackageTest/hpack" $ do
|
||||
runSession hieCommand fullCaps "test/testdata/addPackageTest/hpack-exe" $ do
|
||||
doc <- openDoc "app/Asdf.hs" "haskell"
|
||||
|
||||
-- ignore the first empty hlint diagnostic publish
|
||||
@ -231,9 +232,35 @@ spec = describe "code actions" $ do
|
||||
|
||||
contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "package.yaml"
|
||||
liftIO $ do
|
||||
T.lines contents !! 33 `shouldSatisfy` T.isSuffixOf "zlib"
|
||||
T.lines contents !! 12 `shouldNotSatisfy` T.isSuffixOf "zlib"
|
||||
T.lines contents !! 13 `shouldNotSatisfy` T.isSuffixOf "zlib"
|
||||
T.lines contents !! 3 `shouldSatisfy` T.isSuffixOf "zlib"
|
||||
T.lines contents !! 21 `shouldNotSatisfy` T.isSuffixOf "zlib"
|
||||
|
||||
it "adds to hpack package.yaml files if both are present" $
|
||||
runSession hieCommand fullCaps "test/testdata/addPackageTest/hybrid-exe" $ do
|
||||
doc <- openDoc "app/Asdf.hs" "haskell"
|
||||
|
||||
-- ignore the first empty hlint diagnostic publish
|
||||
[_,diag:_] <- count 2 waitForDiagnostics
|
||||
|
||||
let preds = [ T.isPrefixOf "Could not load module ‘Codec.Compression.GZip’"
|
||||
, T.isPrefixOf "Could not find module ‘Codec.Compression.GZip’"
|
||||
]
|
||||
in liftIO $ diag ^. L.message `shouldSatisfy` \x -> any (\f -> f x) preds
|
||||
|
||||
mActions <- getAllCodeActions doc
|
||||
let allActions = map fromAction mActions
|
||||
action = head allActions
|
||||
|
||||
liftIO $ do
|
||||
action ^. L.title `shouldBe` "Add zlib as a dependency"
|
||||
forM_ allActions $ \a -> a ^. L.kind `shouldBe` Just CodeActionQuickFix
|
||||
forM_ allActions $ \a -> a ^. L.command . _Just . L.command `shouldSatisfy` T.isSuffixOf "package:add"
|
||||
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "package.yaml"
|
||||
liftIO $
|
||||
T.lines contents !! 21 `shouldSatisfy` T.isSuffixOf "zlib"
|
||||
|
||||
-- -----------------------------------
|
||||
|
||||
@ -320,10 +347,11 @@ spec = describe "code actions" $ do
|
||||
|
||||
contents <- documentContents doc
|
||||
|
||||
liftIO $ contents `shouldBe`
|
||||
"module TypedHoles where\n\
|
||||
\foo :: [Int] -> Int\n\
|
||||
\foo x = " <> suggestion
|
||||
liftIO $ contents `shouldBe` T.concat
|
||||
[ "module TypedHoles where\n"
|
||||
, "foo :: [Int] -> Int\n"
|
||||
, "foo x = " <> suggestion
|
||||
]
|
||||
|
||||
it "shows more suggestions" $
|
||||
runSession hieCommand fullCaps "test/testdata" $ do
|
||||
@ -473,6 +501,178 @@ spec = describe "code actions" $ do
|
||||
kinds `shouldSatisfy` all (Just CodeActionRefactorInline ==)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Parameterized HsImport Spec.
|
||||
-- ---------------------------------------------------------------------
|
||||
hsImportSpec :: T.Text -> [[T.Text]]-> Spec
|
||||
hsImportSpec formatterName [e1, e2, e3] =
|
||||
describe ("Execute HsImport with formatter " <> T.unpack formatterName) $ do
|
||||
it "works with 3.8 code action kinds" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImport.hs" "haskell"
|
||||
-- No Formatting:
|
||||
let config = def { formattingProvider = "none" }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
-- ignore the first empty hlint diagnostic publish
|
||||
[_,diag:_] <- count 2 waitForDiagnostics
|
||||
liftIO $ diag ^. L.message `shouldBe` "Variable not in scope: when :: Bool -> IO () -> IO ()"
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let actns = map fromAction actionsOrCommands
|
||||
|
||||
liftIO $ do
|
||||
head actns ^. L.title `shouldBe` "Import module Control.Monad"
|
||||
head (tail actns) ^. L.title `shouldBe` "Import module Control.Monad (when)"
|
||||
forM_ actns $ \a -> do
|
||||
a ^. L.kind `shouldBe` Just CodeActionQuickFix
|
||||
a ^. L.command `shouldSatisfy` isJust
|
||||
a ^. L.edit `shouldBe` Nothing
|
||||
let hasOneDiag (Just (List [_])) = True
|
||||
hasOneDiag _ = False
|
||||
a ^. L.diagnostics `shouldSatisfy` hasOneDiag
|
||||
length actns `shouldBe` 10
|
||||
|
||||
executeCodeAction (head actns)
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ contents `shouldBe` "import Control.Monad\nmain :: IO ()\nmain = when True $ putStrLn \"hello\""
|
||||
|
||||
it "formats" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
|
||||
let config = def { formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let action:_ = map fromAction actionsOrCommands
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ T.lines contents `shouldMatchList` e1
|
||||
|
||||
it "import-list formats" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
|
||||
let config = def { formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let _:action:_ = map fromAction actionsOrCommands
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ T.lines contents `shouldMatchList` e2
|
||||
|
||||
it "multiple import-list formats" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportList.hs" "haskell"
|
||||
|
||||
let config = def { formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)"
|
||||
, "Import module System.IO (stdout)"
|
||||
, "Import module Control.Monad (when)"
|
||||
, "Import module Data.Maybe (fromMaybe)"
|
||||
]
|
||||
|
||||
executeAllCodeActions doc wantedCodeActionTitles
|
||||
|
||||
contents <- documentContents doc
|
||||
liftIO $ Set.fromList (T.lines contents) `shouldBe` Set.fromList e3
|
||||
|
||||
it "respects format config, multiple import-list" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportList.hs" "haskell"
|
||||
|
||||
let config = def { formatOnImportOn = False, formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)"
|
||||
, "Import module System.IO (stdout)"
|
||||
, "Import module Control.Monad (when)"
|
||||
, "Import module Data.Maybe (fromMaybe)"
|
||||
]
|
||||
|
||||
executeAllCodeActions doc wantedCodeActionTitles
|
||||
contents <- documentContents doc
|
||||
liftIO $ Set.fromList (T.lines contents) `shouldBe`
|
||||
Set.fromList
|
||||
[ "import System.IO (stdout, hPutStrLn)"
|
||||
, "import Control.Monad (when)"
|
||||
, "import Data.Maybe (fromMaybe)"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stdout"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
it "respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
|
||||
let config = def { formatOnImportOn = False, formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let action:_ = map fromAction actionsOrCommands
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ do
|
||||
let [l1, l2, l3, l4] = T.lines contents
|
||||
l1 `shouldBe` "import qualified Data.Maybe"
|
||||
l2 `shouldBe` "import Control.Monad"
|
||||
l3 `shouldBe` "main :: IO ()"
|
||||
l4 `shouldBe` "main = when True $ putStrLn \"hello\""
|
||||
|
||||
it ("import-list respects format config with " <> T.unpack formatterName) $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
|
||||
let config = def { formatOnImportOn = False, formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let _:action:_ = map fromAction actionsOrCommands
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ do
|
||||
let [l1, l2, l3, l4] = T.lines contents
|
||||
l1 `shouldBe` "import qualified Data.Maybe"
|
||||
l2 `shouldBe` "import Control.Monad (when)"
|
||||
l3 `shouldBe` "main :: IO ()"
|
||||
l4 `shouldBe` "main = when True $ putStrLn \"hello\""
|
||||
where
|
||||
executeAllCodeActions :: TextDocumentIdentifier -> [T.Text] -> Session ()
|
||||
executeAllCodeActions doc names =
|
||||
replicateM_ (length names) $ do
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
executeCodeActionByName doc names
|
||||
_ <- skipManyTill publishDiagnosticsNotification $ getDocumentEdit doc
|
||||
waitForDiagnosticsSource "ghcmod"
|
||||
|
||||
executeCodeActionByName :: TextDocumentIdentifier -> [T.Text] -> Session ()
|
||||
executeCodeActionByName doc names = do
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let allActions = map fromAction actionsOrCommands
|
||||
let actions = filter (\actn -> actn ^. L.title `elem` names) allActions
|
||||
case actions of
|
||||
(action:_) -> executeCodeAction action
|
||||
xs ->
|
||||
error
|
||||
$ "Found an unexpected amount of action. Expected 1, but got: "
|
||||
++ show (length xs)
|
||||
++ "\n. Titles: " ++ show (map (^. L.title) allActions)
|
||||
|
||||
-- Silence warnings
|
||||
hsImportSpec formatter args =
|
||||
error $ "Not the right amount of arguments for \"hsImportSpec ("
|
||||
++ T.unpack formatter
|
||||
++ ")\", expected 3, got "
|
||||
++ show (length args)
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
fromAction :: CAResult -> CodeAction
|
||||
fromAction (CACodeAction action) = action
|
||||
|
||||
@ -21,7 +21,7 @@ spec = describe "hover" $
|
||||
h ^. range `shouldBe` Just (Range (Position 1 16) (Position 1 19))
|
||||
let
|
||||
hasType (HoverContents (MarkupContent MkMarkdown s))
|
||||
= "```haskell\nsum :: [Int] -> Int\n```" `T.isPrefixOf`s
|
||||
= "\n```haskell\nsum :: [Int] -> Int\n```" `T.isPrefixOf`s
|
||||
hasType _ = False
|
||||
|
||||
sumDoc = "The `sum` function computes the sum of the numbers of a structure."
|
||||
|
||||
@ -4,7 +4,11 @@ module ProgressSpec where
|
||||
import Control.Applicative.Combinators
|
||||
import Control.Lens
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Aeson
|
||||
import Data.Default
|
||||
import Haskell.Ide.Engine.Config
|
||||
import Language.Haskell.LSP.Test
|
||||
import Language.Haskell.LSP.Messages -- TODO: Move this into haskell-lsp-types
|
||||
import Language.Haskell.LSP.Types
|
||||
import qualified Language.Haskell.LSP.Types.Lens as L
|
||||
import Language.Haskell.LSP.Types.Capabilities
|
||||
@ -12,7 +16,7 @@ import Test.Hspec
|
||||
import TestUtils
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "window/progress" $
|
||||
spec = describe "window/progress" $ do
|
||||
it "sends indefinite progress notifications" $
|
||||
-- Testing that ghc-mod sends progress notifications
|
||||
runSession hieCommand progressCaps "test/testdata" $ do
|
||||
@ -23,7 +27,7 @@ spec = describe "window/progress" $
|
||||
-- Initial hlint notifications
|
||||
_ <- publishDiagnosticsNotification
|
||||
|
||||
startNotification <- message :: Session ProgressStartNotification
|
||||
startNotification <- message :: Session ProgressStartNotification
|
||||
liftIO $ do
|
||||
startNotification ^. L.params . L.title `shouldBe` "Typechecking ApplyRefact2.hs"
|
||||
startNotification ^. L.params . L.id `shouldBe` "0"
|
||||
@ -40,17 +44,52 @@ spec = describe "window/progress" $
|
||||
-- hlint notifications
|
||||
_ <- publishDiagnosticsNotification
|
||||
|
||||
startNotification' <- message :: Session ProgressStartNotification
|
||||
startNotification' <- message :: Session ProgressStartNotification
|
||||
liftIO $ do
|
||||
startNotification' ^. L.params . L.title `shouldBe` "Typechecking ApplyRefact2.hs"
|
||||
startNotification' ^. L.params . L.id `shouldBe` "1"
|
||||
|
||||
doneNotification' <- message :: Session ProgressDoneNotification
|
||||
liftIO $ doneNotification' ^. L.params . L.id `shouldBe` "1"
|
||||
|
||||
|
||||
-- the ghc-mod diagnostics
|
||||
const () <$> publishDiagnosticsNotification
|
||||
|
||||
it "sends indefinite progress notifications with liquid" $
|
||||
-- Testing that Liquid Haskell sends progress notifications
|
||||
runSession hieCommand progressCaps "test/testdata" $ do
|
||||
doc <- openDoc "liquid/Evens.hs" "haskell"
|
||||
|
||||
skipMany loggingNotification
|
||||
|
||||
-- Initial hlint notifications
|
||||
_ <- publishDiagnosticsNotification
|
||||
|
||||
_ <- message :: Session ProgressStartNotification
|
||||
_ <- message :: Session ProgressDoneNotification
|
||||
|
||||
-- the ghc-mod diagnostics
|
||||
_ <- publishDiagnosticsNotification
|
||||
|
||||
-- Enable liquid haskell plugin
|
||||
let config = def { liquidOn = True, hlintOn = False }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
-- Test liquid
|
||||
sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
|
||||
|
||||
-- hlint notifications
|
||||
_ <- publishDiagnosticsNotification
|
||||
|
||||
let startPred (NotProgressStart m) =
|
||||
m ^. L.params . L.title == "Running Liquid Haskell on Evens.hs"
|
||||
startPred _ = False
|
||||
|
||||
let donePred (NotProgressDone _) = True
|
||||
donePred _ = False
|
||||
|
||||
_ <- skipManyTill anyMessage $ between (satisfy startPred) (satisfy donePred) $
|
||||
many (satisfy (\x -> not (startPred x || donePred x)))
|
||||
return ()
|
||||
|
||||
progressCaps :: ClientCapabilities
|
||||
progressCaps = fullCaps { _window = Just (WindowClientCapabilities (Just True)) }
|
||||
2
test/testdata/ApplyRefactError.hs
vendored
Normal file
2
test/testdata/ApplyRefactError.hs
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
foo :: forall a. (a -> a) -> a -> a
|
||||
foo f x = f $ x
|
||||
6
test/testdata/CodeActionImportList.hs
vendored
Normal file
6
test/testdata/CodeActionImportList.hs
vendored
Normal file
@ -0,0 +1,6 @@
|
||||
-- | Main entry point to the program
|
||||
main :: IO ()
|
||||
main =
|
||||
when True
|
||||
$ hPutStrLn stdout
|
||||
$ fromMaybe "Good night, World!" (Just "Hello, World!")
|
||||
33
test/testdata/Types.hs
vendored
Normal file
33
test/testdata/Types.hs
vendored
Normal file
@ -0,0 +1,33 @@
|
||||
module Types where
|
||||
|
||||
import Control.Applicative
|
||||
|
||||
foo :: Maybe Int -> Int
|
||||
foo (Just x) = x
|
||||
foo Nothing = 0
|
||||
|
||||
bar :: Maybe Int -> Int
|
||||
bar x = case x of
|
||||
Just y -> y + 1
|
||||
Nothing -> 0
|
||||
|
||||
maybeMonad :: Maybe Int -> Maybe Int
|
||||
maybeMonad x = do
|
||||
y <- x
|
||||
let z = return (y + 10)
|
||||
b <- z
|
||||
return (b + y)
|
||||
|
||||
funcTest :: (a -> a) -> a -> a
|
||||
funcTest f a = f a
|
||||
|
||||
compTest :: (b -> c) -> (a -> b) -> a -> c
|
||||
compTest f g = let h = f . g in h
|
||||
|
||||
monadStuff :: (a -> b) -> IO a -> IO b
|
||||
monadStuff f action = f <$> action
|
||||
|
||||
data Test
|
||||
= TestC Int
|
||||
| TestM String
|
||||
deriving (Show, Eq, Ord)
|
||||
14
test/testdata/addPackageTest/cabal-exe/add-package-test.cabal
vendored
Normal file
14
test/testdata/addPackageTest/cabal-exe/add-package-test.cabal
vendored
Normal file
@ -0,0 +1,14 @@
|
||||
name: add-package-test
|
||||
version: 0.1.0.0
|
||||
license: BSD3
|
||||
author: Luke Lau
|
||||
maintainer: luke_lau@icloud.com
|
||||
build-type: Simple
|
||||
extra-source-files: ChangeLog.md
|
||||
cabal-version: >=1.10
|
||||
|
||||
executable AddPackage
|
||||
exposed-modules: ./.
|
||||
main-is: AddPackage.hs
|
||||
build-depends: base >=4.7 && <5
|
||||
default-language: Haskell2010
|
||||
4
test/testdata/addPackageTest/cabal-lib/AddPackage.hs
vendored
Normal file
4
test/testdata/addPackageTest/cabal-lib/AddPackage.hs
vendored
Normal file
@ -0,0 +1,4 @@
|
||||
module AddPackage where
|
||||
|
||||
import Data.Text
|
||||
foo = pack "I'm a Text"
|
||||
@ -22,9 +22,6 @@ description: Please see the README on GitHub at <https://github.com/gith
|
||||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
||||
executables:
|
||||
asdf-exe:
|
||||
main: Main.hs
|
||||
@ -34,15 +31,4 @@ executables:
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
dependencies:
|
||||
- asdf
|
||||
|
||||
tests:
|
||||
asdf-test:
|
||||
main: Spec.hs
|
||||
source-dirs: test
|
||||
ghc-options:
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
dependencies:
|
||||
- asdf
|
||||
- asdf
|
||||
7
test/testdata/addPackageTest/hpack-lib/app/Asdf.hs
vendored
Normal file
7
test/testdata/addPackageTest/hpack-lib/app/Asdf.hs
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Asdf where
|
||||
|
||||
import Codec.Compression.GZip
|
||||
|
||||
main = return $ compress "hello"
|
||||
25
test/testdata/addPackageTest/hpack-lib/package.yaml
vendored
Normal file
25
test/testdata/addPackageTest/hpack-lib/package.yaml
vendored
Normal file
@ -0,0 +1,25 @@
|
||||
name: asdf
|
||||
version: 0.1.0.0
|
||||
github: "githubuser/asdf"
|
||||
license: BSD3
|
||||
author: "Author name here"
|
||||
maintainer: "example@example.com"
|
||||
copyright: "2018 Author name here"
|
||||
|
||||
extra-source-files:
|
||||
- README.md
|
||||
- ChangeLog.md
|
||||
|
||||
# Metadata used when publishing your package
|
||||
# synopsis: Short description of your package
|
||||
# category: Web
|
||||
|
||||
# To avoid duplicated efforts in documentation and dealing with the
|
||||
# complications of embedding Haddock markup inside cabal files, it is
|
||||
# common to point users to the README.md file.
|
||||
description: Please see the README on GitHub at <https://github.com/githubuser/asdf#readme>
|
||||
|
||||
library:
|
||||
source-dirs: app
|
||||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
2
test/testdata/addPackageTest/hybrid-exe/AddPackage.hs
vendored
Normal file
2
test/testdata/addPackageTest/hybrid-exe/AddPackage.hs
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
import Data.Text
|
||||
foo = pack "I'm a Text"
|
||||
5
test/testdata/addPackageTest/hybrid-exe/app/Asdf.hs
vendored
Normal file
5
test/testdata/addPackageTest/hybrid-exe/app/Asdf.hs
vendored
Normal file
@ -0,0 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import Codec.Compression.GZip
|
||||
|
||||
main = return $ compress "hello"
|
||||
60
test/testdata/addPackageTest/hybrid-exe/asdf.cabal
vendored
Normal file
60
test/testdata/addPackageTest/hybrid-exe/asdf.cabal
vendored
Normal file
@ -0,0 +1,60 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.31.2.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: a63a1c272a979a805027c5855cbe062ec4698b6ea6dbe59dd5f7aa34b15656a6
|
||||
|
||||
name: asdf
|
||||
version: 0.1.0.0
|
||||
description: Please see the README on GitHub at <https://github.com/githubuser/asdf#readme>
|
||||
homepage: https://github.com/githubuser/asdf#readme
|
||||
bug-reports: https://github.com/githubuser/asdf/issues
|
||||
author: Author name here
|
||||
maintainer: example@example.com
|
||||
copyright: 2018 Author name here
|
||||
license: BSD3
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
README.md
|
||||
ChangeLog.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/githubuser/asdf
|
||||
|
||||
library
|
||||
other-modules:
|
||||
Paths_asdf
|
||||
hs-source-dirs:
|
||||
src
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
default-language: Haskell2010
|
||||
|
||||
executable asdf-exe
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Asdf
|
||||
Paths_asdf
|
||||
hs-source-dirs:
|
||||
app
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
asdf
|
||||
, base >=4.7 && <5
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite asdf-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Paths_asdf
|
||||
hs-source-dirs:
|
||||
test
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
asdf
|
||||
, base >=4.7 && <5
|
||||
default-language: Haskell2010
|
||||
34
test/testdata/addPackageTest/hybrid-exe/package.yaml
vendored
Normal file
34
test/testdata/addPackageTest/hybrid-exe/package.yaml
vendored
Normal file
@ -0,0 +1,34 @@
|
||||
name: asdf
|
||||
version: 0.1.0.0
|
||||
github: "githubuser/asdf"
|
||||
license: BSD3
|
||||
author: "Author name here"
|
||||
maintainer: "example@example.com"
|
||||
copyright: "2018 Author name here"
|
||||
|
||||
extra-source-files:
|
||||
- README.md
|
||||
- ChangeLog.md
|
||||
|
||||
# Metadata used when publishing your package
|
||||
# synopsis: Short description of your package
|
||||
# category: Web
|
||||
|
||||
# To avoid duplicated efforts in documentation and dealing with the
|
||||
# complications of embedding Haddock markup inside cabal files, it is
|
||||
# common to point users to the README.md file.
|
||||
description: Please see the README on GitHub at <https://github.com/githubuser/asdf#readme>
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
||||
executables:
|
||||
asdf-exe:
|
||||
main: Main.hs
|
||||
source-dirs: app
|
||||
ghc-options:
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
dependencies:
|
||||
- asdf
|
||||
5
test/testdata/addPackageTest/hybrid-lib/app/Asdf.hs
vendored
Normal file
5
test/testdata/addPackageTest/hybrid-lib/app/Asdf.hs
vendored
Normal file
@ -0,0 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Asdf where
|
||||
import Codec.Compression.GZip
|
||||
|
||||
main = return $ compress "hello"
|
||||
36
test/testdata/addPackageTest/hybrid-lib/asdf.cabal
vendored
Normal file
36
test/testdata/addPackageTest/hybrid-lib/asdf.cabal
vendored
Normal file
@ -0,0 +1,36 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.31.2.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 0a09a2280cfeb48f88861d105a48255e71ec34cc865390f1d038119511564661
|
||||
|
||||
name: asdf
|
||||
version: 0.1.0.0
|
||||
description: Please see the README on GitHub at <https://github.com/githubuser/asdf#readme>
|
||||
homepage: https://github.com/githubuser/asdf#readme
|
||||
bug-reports: https://github.com/githubuser/asdf/issues
|
||||
author: Author name here
|
||||
maintainer: example@example.com
|
||||
copyright: 2018 Author name here
|
||||
license: BSD3
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
README.md
|
||||
ChangeLog.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/githubuser/asdf
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
Asdf
|
||||
other-modules:
|
||||
Paths_asdf
|
||||
hs-source-dirs:
|
||||
app
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
default-language: Haskell2010
|
||||
25
test/testdata/addPackageTest/hybrid-lib/package.yaml
vendored
Normal file
25
test/testdata/addPackageTest/hybrid-lib/package.yaml
vendored
Normal file
@ -0,0 +1,25 @@
|
||||
name: asdf
|
||||
version: 0.1.0.0
|
||||
github: "githubuser/asdf"
|
||||
license: BSD3
|
||||
author: "Author name here"
|
||||
maintainer: "example@example.com"
|
||||
copyright: "2018 Author name here"
|
||||
|
||||
extra-source-files:
|
||||
- README.md
|
||||
- ChangeLog.md
|
||||
|
||||
# Metadata used when publishing your package
|
||||
# synopsis: Short description of your package
|
||||
# category: Web
|
||||
|
||||
# To avoid duplicated efforts in documentation and dealing with the
|
||||
# complications of embedding Haddock markup inside cabal files, it is
|
||||
# common to point users to the README.md file.
|
||||
description: Please see the README on GitHub at <https://github.com/githubuser/asdf#readme>
|
||||
|
||||
library:
|
||||
source-dirs: app
|
||||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
2
test/testdata/addPackageTest/invalid/AddPackage.hs
vendored
Normal file
2
test/testdata/addPackageTest/invalid/AddPackage.hs
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
import Data.Text
|
||||
foo = pack "I'm a Text"
|
||||
@ -4,6 +4,7 @@
|
||||
module ApplyRefactPluginSpec where
|
||||
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import qualified Data.Text as T
|
||||
import Haskell.Ide.Engine.Plugin.ApplyRefact
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.PluginUtils
|
||||
@ -89,7 +90,8 @@ applyRefactSpec = do
|
||||
-- ---------------------------------
|
||||
|
||||
it "returns hlint parse error as DsInfo ignored diagnostic" $ do
|
||||
filePath <- filePathToUri <$> makeAbsolute "./test/testdata/HlintParseFail.hs"
|
||||
filePathNoUri <- makeAbsolute "./test/testdata/HlintParseFail.hs"
|
||||
let filePath = filePathToUri filePathNoUri
|
||||
|
||||
let act = lintCmd' arg
|
||||
arg = filePath
|
||||
@ -97,7 +99,15 @@ applyRefactSpec = do
|
||||
PublishDiagnosticsParams
|
||||
{ _uri = filePath
|
||||
, _diagnostics = List
|
||||
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)))
|
||||
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0)))
|
||||
[Diagnostic {_range = Range { _start = Position {_line = 13, _character = 0}
|
||||
, _end = Position {_line = 13, _character = 100000}}
|
||||
, _severity = Just DsInfo
|
||||
, _code = Just "parser"
|
||||
, _source = Just "hlint"
|
||||
, _message = T.pack filePathNoUri <> ":13:24: error:\n Operator applied to too few arguments: +\n data instance Sing (z :: (a :~: b)) where\n SRefl :: Sing Refl +\n> \n\n"
|
||||
, _relatedInformation = Nothing }]}
|
||||
#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)))
|
||||
[Diagnostic {_range = Range { _start = Position {_line = 13, _character = 0}
|
||||
, _end = Position {_line = 13, _character = 100000}}
|
||||
, _severity = Just DsInfo
|
||||
@ -153,3 +163,15 @@ applyRefactSpec = do
|
||||
, _diagnostics = List []
|
||||
}
|
||||
))
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
it "reports error without crash" $ do
|
||||
filePath <- filePathToUri <$> makeAbsolute "./test/testdata/ApplyRefactError.hs"
|
||||
|
||||
let req = applyAllCmd' filePath
|
||||
isExpectedError (IdeResultFail (IdeError PluginError err _)) =
|
||||
"Illegal symbol '.' in type" `T.isInfixOf` err
|
||||
isExpectedError _ = False
|
||||
r <- withCurrentDirectory "./test/testdata" $ runIGM testPlugins req
|
||||
r `shouldSatisfy` isExpectedError
|
||||
|
||||
23
test/unit/GhcModPluginSpec.hs
Normal file
23
test/unit/GhcModPluginSpec.hs
Normal file
@ -0,0 +1,23 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module GhcModPluginSpec where
|
||||
|
||||
import Control.Exception
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import qualified Data.Map as Map
|
||||
#if __GLASGOW_HASKELL__ < 804
|
||||
import Data.Monoid
|
||||
#endif
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.Plugin.GhcMod
|
||||
import Haskell.Ide.Engine.PluginUtils
|
||||
import Haskell.Ide.Engine.Support.HieExtras
|
||||
import Language.Haskell.LSP.Types (TextEdit (..))
|
||||
import System.Directory
|
||||
import TestUtils
|
||||
|
||||
import Test.Hspec
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
31
test/unit/HaRePluginSpec.hs
Normal file
31
test/unit/HaRePluginSpec.hs
Normal file
@ -0,0 +1,31 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
module HaRePluginSpec where
|
||||
|
||||
import Control.Monad.Trans.Free
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Aeson
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.PluginUtils
|
||||
import Haskell.Ide.Engine.Plugin.GhcMod
|
||||
import Haskell.Ide.Engine.Plugin.HaRe
|
||||
import Haskell.Ide.Engine.Support.HieExtras
|
||||
import Language.Haskell.LSP.Types ( Location(..)
|
||||
, TextEdit(..)
|
||||
)
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import TestUtils
|
||||
|
||||
import Test.Hspec
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
{-# ANN module ("hlint: ignore Eta reduce" :: String) #-}
|
||||
{-# ANN module ("hlint: ignore Redundant do" :: String) #-}
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
@ -37,7 +37,7 @@ jsonSpec = do
|
||||
describe "General JSON instances round trip" $ do
|
||||
-- Plugin params
|
||||
prop "ApplyOneParams" (propertyJsonRoundtrip :: ApplyOneParams -> Bool)
|
||||
prop "InfoParams" (propertyJsonRoundtrip :: InfoParams -> Bool)
|
||||
prop "TypeParams" (propertyJsonRoundtrip :: TypeParams -> Bool)
|
||||
prop "HarePoint" (propertyJsonRoundtrip :: HarePoint -> Bool)
|
||||
prop "HarePointWithText" (propertyJsonRoundtrip :: HarePointWithText -> Bool)
|
||||
prop "HareRange" (propertyJsonRoundtrip :: HareRange -> Bool)
|
||||
@ -62,8 +62,8 @@ smallList = resize 3 . listOf
|
||||
instance Arbitrary ApplyOneParams where
|
||||
arbitrary = AOP <$> arbitrary <*> arbitrary <*> arbitrary
|
||||
|
||||
instance Arbitrary InfoParams where
|
||||
arbitrary = IP <$> arbitrary <*> arbitrary
|
||||
instance Arbitrary TypeParams where
|
||||
arbitrary = TP <$> arbitrary <*> arbitrary <*> arbitrary
|
||||
|
||||
instance Arbitrary HarePoint where
|
||||
arbitrary = HP <$> arbitrary <*> arbitrary
|
||||
|
||||
326
test/unit/PackagePluginSpec.hs
Normal file
326
test/unit/PackagePluginSpec.hs
Normal file
@ -0,0 +1,326 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module PackagePluginSpec where
|
||||
|
||||
import Control.Monad ( forM_ )
|
||||
import qualified Data.Aeson as Json
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.Plugin.Package
|
||||
import System.FilePath
|
||||
import System.Directory
|
||||
import Test.Hspec
|
||||
import TestUtils
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Package plugin" packageSpec
|
||||
|
||||
testdata :: FilePath
|
||||
testdata = "test/testdata/addPackageTest"
|
||||
|
||||
testPlugins :: IdePlugins
|
||||
testPlugins = pluginDescToIdePlugins [packageDescriptor "package"]
|
||||
|
||||
cabalProject :: [FilePath]
|
||||
cabalProject = ["cabal-lib", "cabal-exe"]
|
||||
|
||||
hpackProject :: [FilePath]
|
||||
hpackProject = ["hpack-lib", "hpack-exe", "hybrid-lib", "hybrid-exe"]
|
||||
|
||||
packageSpec :: Spec
|
||||
packageSpec = do
|
||||
cwd <- runIO getCurrentDirectory
|
||||
describe "Find correct package type" $ do
|
||||
forM_ hpackProject $ \hpack ->
|
||||
it ("hpack project find package.yaml (\"" ++ hpack ++ "\")") $ do
|
||||
let fp = testdata </> hpack
|
||||
packageType <- findPackageType fp
|
||||
packageType `shouldBe` HpackPackage (fp </> "package.yaml")
|
||||
forM_ cabalProject $ \cabal ->
|
||||
it ("hpack project find cabal file (\"" ++ cabal ++ "\")") $ do
|
||||
let fp = testdata </> cabal
|
||||
packageType <- findPackageType fp
|
||||
packageType `shouldBe` CabalPackage "add-package-test.cabal"
|
||||
it "Find no project description if none is present " $ do
|
||||
let fp = cwd </> testdata </> "invalid"
|
||||
packageType <- findPackageType fp
|
||||
packageType `shouldBe` NoPackage
|
||||
it "Throws exception if path is invalid" $ do
|
||||
let fp = testdata </> "unknownPath"
|
||||
findPackageType fp `shouldThrow` anyIOException
|
||||
describe "Add the package to the correct file" $ do
|
||||
it "Add package to .cabal to executable component"
|
||||
$ withCurrentDirectory (testdata </> "cabal-exe")
|
||||
$ do
|
||||
let
|
||||
fp = cwd </> testdata </> "cabal-exe"
|
||||
uri = filePathToUri $ fp </> "add-package-test.cabal"
|
||||
args = AddParams fp (fp </> "AddPackage.hs") "text"
|
||||
act = addCmd' args
|
||||
textEdits =
|
||||
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0)))
|
||||
List
|
||||
[ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat
|
||||
[ "cabal-version: >=1.10\n"
|
||||
, "name: add-package-test\n"
|
||||
, "version: 0.1.0.0\n"
|
||||
, "license: BSD3\n"
|
||||
, "maintainer: luke_lau@icloud.com\n"
|
||||
, "author: Luke Lau\n"
|
||||
, "build-type: Simple\n"
|
||||
, "extra-source-files:\n"
|
||||
, " ChangeLog.md"
|
||||
]
|
||||
, TextEdit (Range (Position 10 0) (Position 13 34)) $ T.concat
|
||||
[ " main-is: AddPackage.hs\n"
|
||||
, " default-language: Haskell2010\n"
|
||||
, " build-depends:\n"
|
||||
, " base >=4.7 && <5,\n"
|
||||
, " text -any"
|
||||
]
|
||||
]
|
||||
#else
|
||||
List -- TODO: this seems to indicate that the command does nothing
|
||||
[ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat
|
||||
[ "name: add-package-test\n"
|
||||
, "version: 0.1.0.0\n"
|
||||
, "cabal-version: >=1.10\n"
|
||||
, "build-type: Simple\n"
|
||||
, "license: BSD3\n"
|
||||
, "maintainer: luke_lau@icloud.com\n"
|
||||
, "author: Luke Lau\n"
|
||||
, "extra-source-files:\n"
|
||||
, " ChangeLog.md"
|
||||
]
|
||||
, TextEdit (Range (Position 9 0) (Position 13 34)) $ T.concat
|
||||
[ "executable AddPackage\n"
|
||||
, " main-is: AddPackage.hs\n"
|
||||
]
|
||||
]
|
||||
#endif
|
||||
res = IdeResultOk
|
||||
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
|
||||
testCommand testPlugins act "package" "add" args res
|
||||
|
||||
it "Add package to .cabal to library component"
|
||||
$ withCurrentDirectory (testdata </> "cabal-lib")
|
||||
$ do
|
||||
let
|
||||
fp = cwd </> testdata </> "cabal-lib"
|
||||
uri = filePathToUri $ fp </> "add-package-test.cabal"
|
||||
args = AddParams fp (fp </> "AddPackage.hs") "text"
|
||||
act = addCmd' args
|
||||
textEdits =
|
||||
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0)))
|
||||
List
|
||||
[ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat
|
||||
[ "cabal-version: >=1.10\n"
|
||||
, "name: add-package-test\n"
|
||||
, "version: 0.1.0.0\n"
|
||||
, "license: BSD3\n"
|
||||
, "maintainer: luke_lau@icloud.com\n"
|
||||
, "author: Luke Lau\n"
|
||||
, "build-type: Simple\n"
|
||||
, "extra-source-files:\n"
|
||||
, " ChangeLog.md"
|
||||
]
|
||||
, TextEdit (Range (Position 10 0) (Position 13 34)) $ T.concat
|
||||
[ " exposed-modules:\n"
|
||||
, " AddPackage\n"
|
||||
, " default-language: Haskell2010\n"
|
||||
, " build-depends:\n"
|
||||
, " base >=4.7 && <5,\n"
|
||||
, " text -any"
|
||||
]
|
||||
]
|
||||
#else
|
||||
List
|
||||
[ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat
|
||||
[ "name: add-package-test\n"
|
||||
, "version: 0.1.0.0\n"
|
||||
, "cabal-version: >=1.10\n"
|
||||
, "build-type: Simple\n"
|
||||
, "license: BSD3\n"
|
||||
, "maintainer: luke_lau@icloud.com\n"
|
||||
, "author: Luke Lau\n"
|
||||
, "extra-source-files:\n"
|
||||
, " ChangeLog.md"
|
||||
]
|
||||
, TextEdit (Range (Position 10 0) (Position 13 34)) $ T.concat
|
||||
[ " exposed-modules:\n"
|
||||
, " AddPackage\n"
|
||||
, " build-depends:\n"
|
||||
, " base >=4.7 && <5,\n"
|
||||
, " text -any\n"
|
||||
, " default-language: Haskell2010\n"
|
||||
]
|
||||
]
|
||||
#endif
|
||||
res = IdeResultOk
|
||||
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
|
||||
testCommand testPlugins act "package" "add" args res
|
||||
|
||||
|
||||
it "Add package to package.yaml to executable component"
|
||||
$ withCurrentDirectory (testdata </> "hpack-exe")
|
||||
$ do
|
||||
let
|
||||
fp = cwd </> testdata </> "hpack-exe"
|
||||
uri = filePathToUri $ fp </> "package.yaml"
|
||||
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
|
||||
act = addCmd' args
|
||||
res = IdeResultOk
|
||||
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
|
||||
textEdits = List
|
||||
[ TextEdit (Range (Position 0 0) (Position 34 0)) $ T.concat
|
||||
[ "copyright: 2018 Author name here\n"
|
||||
, "maintainer: example@example.com\n"
|
||||
, "dependencies:\n"
|
||||
, "- zlib\n"
|
||||
, "- base >= 4.7 && < 5\n"
|
||||
, "name: asdf\n"
|
||||
, "version: 0.1.0.0\n"
|
||||
, "extra-source-files:\n"
|
||||
, "- README.md\n"
|
||||
, "- ChangeLog.md\n"
|
||||
, "author: Author name here\n"
|
||||
, "github: githubuser/asdf\n"
|
||||
, "license: BSD3\n"
|
||||
, "executables:\n"
|
||||
, " asdf-exe:\n"
|
||||
, " source-dirs: app\n"
|
||||
, " main: Main.hs\n"
|
||||
, " ghc-options:\n"
|
||||
, " - -threaded\n"
|
||||
, " - -rtsopts\n"
|
||||
, " - -with-rtsopts=-N\n"
|
||||
, " dependencies:\n"
|
||||
, " - asdf\n"
|
||||
, "description: Please see the README on GitHub at <https://github.com/githubuser/asdf#readme>\n"
|
||||
]
|
||||
]
|
||||
testCommand testPlugins act "package" "add" args res
|
||||
|
||||
it "Add package to package.yaml to library component"
|
||||
$ withCurrentDirectory (testdata </> "hpack-lib")
|
||||
$ do
|
||||
let
|
||||
fp = cwd </> testdata </> "hpack-lib"
|
||||
uri = filePathToUri $ fp </> "package.yaml"
|
||||
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
|
||||
act = addCmd' args
|
||||
res = IdeResultOk
|
||||
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
|
||||
textEdits =
|
||||
List
|
||||
[ TextEdit (Range (Position 0 0) (Position 25 0)) $ T.concat
|
||||
[ "library:\n"
|
||||
, " source-dirs: app\n"
|
||||
, " dependencies:\n"
|
||||
, " - zlib\n"
|
||||
, " - base >= 4.7 && < 5\n"
|
||||
, "copyright: 2018 Author name here\n"
|
||||
, "maintainer: example@example.com\n"
|
||||
, "name: asdf\n"
|
||||
, "version: 0.1.0.0\n"
|
||||
, "extra-source-files:\n"
|
||||
, "- README.md\n"
|
||||
, "- ChangeLog.md\n"
|
||||
, "author: Author name here\n"
|
||||
, "github: githubuser/asdf\n"
|
||||
, "license: BSD3\n"
|
||||
, "description: Please see the README on GitHub at <https://github.com/githubuser/asdf#readme>\n"
|
||||
]
|
||||
]
|
||||
testCommand testPlugins act "package" "add" args res
|
||||
it
|
||||
"Add package to package.yaml in hpack project with generated cabal to executable component"
|
||||
$ withCurrentDirectory (testdata </> "hybrid-exe")
|
||||
$ do
|
||||
let
|
||||
fp = cwd </> testdata </> "hybrid-exe"
|
||||
uri = filePathToUri $ fp </> "package.yaml"
|
||||
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
|
||||
act = addCmd' args
|
||||
res = IdeResultOk
|
||||
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
|
||||
textEdits = List
|
||||
[ TextEdit (Range (Position 0 0) (Position 34 0)) $ T.concat
|
||||
[ "library:\n"
|
||||
, " source-dirs: src\n"
|
||||
, "copyright: 2018 Author name here\n"
|
||||
, "maintainer: example@example.com\n"
|
||||
, "name: asdf\n"
|
||||
, "version: 0.1.0.0\n"
|
||||
, "extra-source-files:\n"
|
||||
, "- README.md\n"
|
||||
, "- ChangeLog.md\n"
|
||||
, "author: Author name here\n"
|
||||
, "github: githubuser/asdf\n"
|
||||
, "license: BSD3\n"
|
||||
, "executables:\n"
|
||||
, " asdf-exe:\n"
|
||||
, " source-dirs: app\n"
|
||||
, " main: Main.hs\n"
|
||||
, " ghc-options:\n"
|
||||
, " - -threaded\n"
|
||||
, " - -rtsopts\n"
|
||||
, " - -with-rtsopts=-N\n"
|
||||
, " dependencies:\n"
|
||||
, " - zlib\n"
|
||||
, " - asdf\n"
|
||||
, "description: Please see the README on GitHub at <https://github.com/githubuser/asdf#readme>\n"
|
||||
]
|
||||
]
|
||||
testCommand testPlugins act "package" "add" args res
|
||||
it "Add package to package.yaml in hpack project with generated cabal to library component"
|
||||
$ withCurrentDirectory (testdata </> "hybrid-lib")
|
||||
$ do
|
||||
let
|
||||
fp = cwd </> testdata </> "hybrid-lib"
|
||||
uri = filePathToUri $ fp </> "package.yaml"
|
||||
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
|
||||
act = addCmd' args
|
||||
res = IdeResultOk
|
||||
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
|
||||
textEdits = List
|
||||
[ TextEdit (Range (Position 0 0) (Position 25 0)) $ T.concat
|
||||
[ "library:\n"
|
||||
, " source-dirs: app\n"
|
||||
, " dependencies:\n"
|
||||
, " - zlib\n"
|
||||
, " - base >= 4.7 && < 5\n"
|
||||
, "copyright: 2018 Author name here\n"
|
||||
, "maintainer: example@example.com\n"
|
||||
, "name: asdf\n"
|
||||
, "version: 0.1.0.0\n"
|
||||
, "extra-source-files:\n"
|
||||
, "- README.md\n"
|
||||
, "- ChangeLog.md\n"
|
||||
, "author: Author name here\n"
|
||||
, "github: githubuser/asdf\n"
|
||||
, "license: BSD3\n"
|
||||
, "description: Please see the README on GitHub at <https://github.com/githubuser/asdf#readme>\n"
|
||||
]
|
||||
]
|
||||
testCommand testPlugins act "package" "add" args res
|
||||
it "Do nothing on NoPackage"
|
||||
$ withCurrentDirectory (testdata </> "invalid")
|
||||
$ do
|
||||
let
|
||||
fp = cwd </> testdata </> "invalid"
|
||||
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
|
||||
act = addCmd' args
|
||||
res =
|
||||
IdeResultFail
|
||||
(IdeError PluginError
|
||||
"No package.yaml or .cabal found"
|
||||
Json.Null
|
||||
)
|
||||
testCommand testPlugins act "package" "add" args res
|
||||
@ -24,6 +24,8 @@ import Data.Typeable
|
||||
import Data.Yaml
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe
|
||||
-- import qualified GhcMod.Monad as GM
|
||||
-- import qualified GhcMod.Types as GM
|
||||
import qualified Language.Haskell.LSP.Core as Core
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import System.Directory
|
||||
@ -90,8 +92,12 @@ setupStackFiles =
|
||||
files :: [FilePath]
|
||||
files =
|
||||
[ "./test/testdata/"
|
||||
, "./test/testdata/addPackageTest/cabal/"
|
||||
, "./test/testdata/addPackageTest/hpack/"
|
||||
, "./test/testdata/addPackageTest/cabal-exe/"
|
||||
, "./test/testdata/addPackageTest/hpack-exe/"
|
||||
, "./test/testdata/addPackageTest/hybrid-exe/"
|
||||
, "./test/testdata/addPackageTest/cabal-lib/"
|
||||
, "./test/testdata/addPackageTest/hpack-lib/"
|
||||
, "./test/testdata/addPackageTest/hybrid-lib/"
|
||||
, "./test/testdata/addPragmas/"
|
||||
, "./test/testdata/badProjects/cabal/"
|
||||
, "./test/testdata/completion/"
|
||||
@ -118,7 +124,9 @@ ghcVersion = GHCPre84
|
||||
|
||||
stackYaml :: FilePath
|
||||
stackYaml =
|
||||
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,4,0)))
|
||||
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,5,0)))
|
||||
"stack.yaml"
|
||||
#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,4,0)))
|
||||
"stack-8.6.4.yaml"
|
||||
#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,3,0)))
|
||||
"stack-8.6.3.yaml"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user