mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-09-11 11:05:30 +03:00
Merge branch 'master' of https://github.com/haskell/haskell-ide-engine into hie-bios-wz1000
This commit is contained in:
commit
5ab587cfa2
32
.azure/linux-installhs-stack.yml
Normal file
32
.azure/linux-installhs-stack.yml
Normal file
@ -0,0 +1,32 @@
|
||||
jobs:
|
||||
- job: Linux_installhs_Stack
|
||||
timeoutInMinutes: 0
|
||||
pool:
|
||||
vmImage: ubuntu-16.04
|
||||
strategy:
|
||||
matrix:
|
||||
shake:
|
||||
YAML_FILE: install/shake.yaml
|
||||
steps:
|
||||
- bash: |
|
||||
export STACK_ROOT="$(Build.SourcesDirectory)"/.stack-root
|
||||
mkdir -p ~/.local/bin
|
||||
curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | \
|
||||
tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
|
||||
displayName: Install stack
|
||||
- bash: |
|
||||
source .azure/linux.bashrc
|
||||
stack setup --stack-yaml $(YAML_FILE)
|
||||
displayName: Install GHC
|
||||
- bash: |
|
||||
source .azure/linux.bashrc
|
||||
stack --stack-yaml $(YAML_FILE) --install-ghc build --only-dependencies
|
||||
displayName: Build dependencies
|
||||
- bash: |
|
||||
source .azure/linux.bashrc
|
||||
stack build --stack-yaml $(YAML_FILE)
|
||||
displayName: Build `hie-install`
|
||||
- bash: |
|
||||
source .azure/linux.bashrc
|
||||
stack install.hs help
|
||||
displayName: Run help of `instal.hs`
|
68
.azure/linux-stack.yml
Normal file
68
.azure/linux-stack.yml
Normal file
@ -0,0 +1,68 @@
|
||||
jobs:
|
||||
- job: Linux_Stack
|
||||
timeoutInMinutes: 0
|
||||
pool:
|
||||
vmImage: ubuntu-16.04
|
||||
strategy:
|
||||
matrix:
|
||||
stack-def:
|
||||
YAML_FILE: stack.yaml
|
||||
stack-8.6.5:
|
||||
YAML_FILE: stack-8.6.5.yaml
|
||||
stack-8.6.4:
|
||||
YAML_FILE: stack-8.6.4.yaml
|
||||
stack-8.6.3:
|
||||
YAML_FILE: stack-8.6.3.yaml
|
||||
stack-8.6.2:
|
||||
YAML_FILE: stack-8.6.2.yaml
|
||||
stack-8.6.1:
|
||||
YAML_FILE: stack-8.6.1.yaml
|
||||
stack-8.4.4:
|
||||
YAML_FILE: stack-8.4.4.yaml
|
||||
stack-8.4.3:
|
||||
YAML_FILE: stack-8.4.3.yaml
|
||||
stack-8.4.2:
|
||||
YAML_FILE: stack-8.4.2.yaml
|
||||
stack-8.2.2:
|
||||
YAML_FILE: stack-8.2.2.yaml
|
||||
steps:
|
||||
- bash: |
|
||||
git submodule sync
|
||||
git submodule update --init
|
||||
displayName: Sync submodules
|
||||
- bash: |
|
||||
export STACK_ROOT="$(Build.SourcesDirectory)"/.stack-root
|
||||
mkdir -p ~/.local/bin
|
||||
curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | \
|
||||
tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
|
||||
displayName: Install stack
|
||||
- bash: |
|
||||
source .azure/linux.bashrc
|
||||
stack setup --stack-yaml $(YAML_FILE)
|
||||
displayName: Install GHC
|
||||
- bash: |
|
||||
source .azure/linux.bashrc
|
||||
stack --stack-yaml $(YAML_FILE) --install-ghc build --only-dependencies
|
||||
displayName: Build dependencies
|
||||
- bash: |
|
||||
source .azure/linux.bashrc
|
||||
stack build --stack-yaml $(YAML_FILE)
|
||||
displayName: Build `hie`
|
||||
- bash: |
|
||||
source .azure/linux.bashrc
|
||||
stack build --stack-yaml $(YAML_FILE) --test --bench --only-dependencies
|
||||
stack install --stack-yaml $(YAML_FILE) # `hie` binary required for tests
|
||||
stack --stack-yaml $(YAML_FILE) exec hoogle generate
|
||||
displayName: Build Test-dependencies
|
||||
- bash: |
|
||||
sudo apt update
|
||||
sudo apt install z3
|
||||
displayName: "Install Runtime Test-Dependencies: z3"
|
||||
- bash: |
|
||||
source .azure/linux.bashrc
|
||||
stack install --resolver=lts-11.18 liquid-fixpoint-0.7.0.7 dotgen-0.4.2 fgl-visualize-0.1.0.1 located-base-0.1.1.1 liquidhaskell-0.8.2.4
|
||||
displayName: "Install Runtime Test-Dependencies: liquidhaskell"
|
||||
# - bash: |
|
||||
# source .azure/linux.bashrc
|
||||
# stack test --stack-yaml $(YAML_FILE)
|
||||
# displayName: Run Test
|
1
.azure/linux.bashrc
Normal file
1
.azure/linux.bashrc
Normal file
@ -0,0 +1 @@
|
||||
export PATH=$HOME/.local/bin:$PATH
|
32
.azure/macos-installhs-stack.yml
Normal file
32
.azure/macos-installhs-stack.yml
Normal file
@ -0,0 +1,32 @@
|
||||
jobs:
|
||||
- job: MacOs_installhs_Stack
|
||||
timeoutInMinutes: 0
|
||||
pool:
|
||||
vmImage: macOS-10.13
|
||||
strategy:
|
||||
matrix:
|
||||
shake:
|
||||
YAML_FILE: install/shake.yaml
|
||||
steps:
|
||||
- bash: |
|
||||
export STACK_ROOT="$(Build.SourcesDirectory)"/.stack-root
|
||||
mkdir -p ~/.local/bin
|
||||
curl -skL https://get.haskellstack.org/stable/osx-x86_64.tar.gz | \
|
||||
tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin;
|
||||
displayName: Install stack
|
||||
- bash: |
|
||||
source .azure/macos.bashrc
|
||||
stack setup --stack-yaml $(YAML_FILE)
|
||||
displayName: Install GHC
|
||||
- bash: |
|
||||
source .azure/macos.bashrc
|
||||
stack --stack-yaml $(YAML_FILE) --install-ghc build --only-dependencies
|
||||
displayName: Build dependencies
|
||||
- bash: |
|
||||
source .azure/macos.bashrc
|
||||
stack build --stack-yaml $(YAML_FILE)
|
||||
displayName: Build `hie-install`
|
||||
- bash: |
|
||||
source .azure/macos.bashrc
|
||||
stack install.hs help
|
||||
displayName: Run help of `instal.hs`
|
65
.azure/macos-stack.yml
Normal file
65
.azure/macos-stack.yml
Normal file
@ -0,0 +1,65 @@
|
||||
jobs:
|
||||
- job: MacOs_Stack
|
||||
timeoutInMinutes: 0
|
||||
pool:
|
||||
vmImage: macOS-10.13
|
||||
strategy:
|
||||
matrix:
|
||||
stack-def:
|
||||
YAML_FILE: stack.yaml
|
||||
stack-8.6.5:
|
||||
YAML_FILE: stack-8.6.5.yaml
|
||||
stack-8.6.4:
|
||||
YAML_FILE: stack-8.6.4.yaml
|
||||
stack-8.6.3:
|
||||
YAML_FILE: stack-8.6.3.yaml
|
||||
stack-8.4.4:
|
||||
YAML_FILE: stack-8.4.4.yaml
|
||||
stack-8.4.3:
|
||||
YAML_FILE: stack-8.4.3.yaml
|
||||
stack-8.4.2:
|
||||
YAML_FILE: stack-8.4.2.yaml
|
||||
stack-8.2.2:
|
||||
YAML_FILE: stack-8.2.2.yaml
|
||||
steps:
|
||||
- bash: |
|
||||
git submodule sync
|
||||
git submodule update --init
|
||||
displayName: Sync submodules
|
||||
- bash: |
|
||||
export STACK_ROOT="$(Build.SourcesDirectory)"/.stack-root
|
||||
mkdir -p ~/.local/bin
|
||||
curl -skL https://get.haskellstack.org/stable/osx-x86_64.tar.gz | \
|
||||
tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin;
|
||||
displayName: Install stack
|
||||
- bash: |
|
||||
source .azure/macos.bashrc
|
||||
stack setup --stack-yaml $(YAML_FILE)
|
||||
displayName: Install GHC
|
||||
- bash: |
|
||||
source .azure/macos.bashrc
|
||||
stack --stack-yaml $(YAML_FILE) --install-ghc build --only-dependencies
|
||||
displayName: Build dependencies
|
||||
- bash: |
|
||||
source .azure/macos.bashrc
|
||||
stack build --stack-yaml $(YAML_FILE)
|
||||
displayName: Build `hie`
|
||||
- bash: |
|
||||
source .azure/macos.bashrc
|
||||
stack build --stack-yaml $(YAML_FILE) --test --bench --only-dependencies
|
||||
stack install --stack-yaml $(YAML_FILE) # `hie` binary required for tests
|
||||
stack --stack-yaml $(YAML_FILE) exec hoogle generate
|
||||
displayName: Build Test-dependencies
|
||||
- bash: |
|
||||
ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)"
|
||||
brew update
|
||||
brew install z3
|
||||
displayName: "Install Runtime Test-Dependencies: z3"
|
||||
- bash: |
|
||||
source .azure/macos.bashrc
|
||||
stack install --resolver=lts-11.18 liquid-fixpoint-0.7.0.7 dotgen-0.4.2 fgl-visualize-0.1.0.1 located-base-0.1.1.1 liquidhaskell-0.8.2.4
|
||||
displayName: "Install Runtime Test-Dependencies: liquidhaskell"
|
||||
# - bash: |
|
||||
# source .azure/macos.bashrc
|
||||
# stack test --stack-yaml $(YAML_FILE)
|
||||
# displayName: Run Test
|
1
.azure/macos.bashrc
Normal file
1
.azure/macos.bashrc
Normal file
@ -0,0 +1 @@
|
||||
export PATH=$HOME/.local/bin:$PATH
|
37
.azure/windows-installhs-cabal.yml
Normal file
37
.azure/windows-installhs-cabal.yml
Normal file
@ -0,0 +1,37 @@
|
||||
jobs:
|
||||
- job: Windows_installhs_Cabal
|
||||
timeoutInMinutes: 0
|
||||
pool:
|
||||
vmImage: windows-2019
|
||||
variables:
|
||||
YAML_FILE: install/shake.yaml
|
||||
PROJECT_FILE: install/shake.project
|
||||
steps:
|
||||
- bash: |
|
||||
curl -sSkL http://www.stackage.org/stack/windows-x86_64 -o /usr/bin/stack.zip
|
||||
unzip -o /usr/bin/stack.zip -d /usr/bin/
|
||||
displayName: Install stack
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack setup --stack-yaml $(YAML_FILE)
|
||||
displayName: Install GHC
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack install cabal-install --stack-yaml $(YAML_FILE)
|
||||
displayName: Install `cabal-install`
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
cabal update
|
||||
displayName: update cabal
|
||||
# - bash: |
|
||||
# source .azure/windows.bashrc
|
||||
# stack --stack-yaml $(YAML_FILE) build --only-dependencies
|
||||
# displayName: Build dependencies
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
cabal v2-build hie-install -w $(stack path --stack-yaml $(YAML_FILE) --compiler-exe) --project-file $(PROJECT_FILE)
|
||||
displayName: Build `hie-install`
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
cabal v2-run install.hs -w $(stack path --stack-yaml $(YAML_FILE) --compiler-exe) --project-file $(PROJECT_FILE) help
|
||||
displayName: Run help of `install.hs`
|
30
.azure/windows-installhs-stack.yml
Normal file
30
.azure/windows-installhs-stack.yml
Normal file
@ -0,0 +1,30 @@
|
||||
jobs:
|
||||
- job: Windows_installhs_Stack
|
||||
timeoutInMinutes: 0
|
||||
pool:
|
||||
vmImage: windows-2019
|
||||
strategy:
|
||||
matrix:
|
||||
shake:
|
||||
YAML_FILE: install/shake.yaml
|
||||
steps:
|
||||
- bash: |
|
||||
curl -sSkL http://www.stackage.org/stack/windows-x86_64 -o /usr/bin/stack.zip
|
||||
unzip -o /usr/bin/stack.zip -d /usr/bin/
|
||||
displayName: Install stack
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack setup --stack-yaml $(YAML_FILE)
|
||||
displayName: Install GHC
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack --stack-yaml $(YAML_FILE) --install-ghc build --only-dependencies
|
||||
displayName: Build dependencies
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack build --stack-yaml $(YAML_FILE)
|
||||
displayName: Build `hie-install`
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack install.hs help
|
||||
displayName: Run help of `instal.hs`
|
67
.azure/windows-stack.yml
Normal file
67
.azure/windows-stack.yml
Normal file
@ -0,0 +1,67 @@
|
||||
jobs:
|
||||
- job: Windows_Stack
|
||||
timeoutInMinutes: 0
|
||||
pool:
|
||||
vmImage: windows-2019
|
||||
strategy:
|
||||
matrix:
|
||||
stack-def:
|
||||
YAML_FILE: stack.yaml
|
||||
stack-8.6.5:
|
||||
YAML_FILE: stack-8.6.5.yaml
|
||||
stack-8.6.4:
|
||||
YAML_FILE: stack-8.6.4.yaml
|
||||
stack-8.6.2:
|
||||
YAML_FILE: stack-8.6.2.yaml
|
||||
stack-8.6.1:
|
||||
YAML_FILE: stack-8.6.1.yaml
|
||||
stack-8.4.4:
|
||||
YAML_FILE: stack-8.4.4.yaml
|
||||
stack-8.4.3:
|
||||
YAML_FILE: stack-8.4.3.yaml
|
||||
stack-8.4.2:
|
||||
YAML_FILE: stack-8.4.2.yaml
|
||||
stack-8.2.2:
|
||||
YAML_FILE: stack-8.2.2.yaml
|
||||
steps:
|
||||
- bash: |
|
||||
git submodule sync
|
||||
git submodule update --init
|
||||
displayName: Sync submodules
|
||||
- bash: |
|
||||
curl -sSkL http://www.stackage.org/stack/windows-x86_64 -o /usr/bin/stack.zip
|
||||
unzip -o /usr/bin/stack.zip -d /usr/bin/
|
||||
displayName: Install stack
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack setup --stack-yaml $(YAML_FILE)
|
||||
displayName: Install GHC
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack --stack-yaml $(YAML_FILE) --install-ghc build --only-dependencies
|
||||
displayName: Build dependencies
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack build --stack-yaml $(YAML_FILE)
|
||||
displayName: Build `hie`
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack build --stack-yaml $(YAML_FILE) --test --bench --only-dependencies
|
||||
stack install --stack-yaml $(YAML_FILE) # `hie` binary required for tests
|
||||
stack exec --stack-yaml $(YAML_FILE) hoogle generate
|
||||
displayName: Build Test-dependencies
|
||||
- bash: |
|
||||
# TODO: try to install automatically (`choco install z3` fails and pacman is not installed)
|
||||
mkdir -p /usr/local
|
||||
curl -L https://github.com/Z3Prover/z3/releases/download/Z3-4.8.5/z3-4.8.5-x64-win.zip -o /usr/local/z3.zip
|
||||
unzip -o /usr/local/z3.zip -d /usr/local/
|
||||
displayName: "Install Runtime Test-Dependencies: z3"
|
||||
- bash: |
|
||||
source .azure/windows.bashrc
|
||||
stack install --resolver=lts-11.18 liquid-fixpoint-0.7.0.7 dotgen-0.4.2 fgl-visualize-0.1.0.1 located-base-0.1.1.1 liquidhaskell-0.8.2.4
|
||||
liquid -v
|
||||
displayName: "Install Runtime Test-Dependencies: liquidhaskell"
|
||||
# - bash: |
|
||||
# source .azure/windows.bashrc
|
||||
# stack test --stack-yaml $(YAML_FILE) :unit-test
|
||||
# displayName: Run Test
|
4
.azure/windows.bashrc
Normal file
4
.azure/windows.bashrc
Normal file
@ -0,0 +1,4 @@
|
||||
export STACK_ROOT="C:\\sr"
|
||||
export LOCAL_BIN_PATH=$(cygpath $APPDATA\\local\\bin)
|
||||
export Z3_BIN_PATH=/usr/local/z3-4.8.5-x64-win/bin
|
||||
export PATH=$Z3_BIN_PATH:$LOCAL_BIN_PATH:$PATH
|
@ -195,7 +195,6 @@ workflows:
|
||||
version: 2
|
||||
multiple-ghcs:
|
||||
jobs:
|
||||
- ghc-8.2.1
|
||||
- ghc-8.2.2
|
||||
- ghc-8.4.2
|
||||
- ghc-8.4.3
|
||||
|
6
.gitignore
vendored
6
.gitignore
vendored
@ -69,4 +69,8 @@ test-results/
|
||||
.vscode
|
||||
|
||||
# shake build information
|
||||
_build/
|
||||
_build/
|
||||
|
||||
# stack 2.1 stack.yaml lock files
|
||||
stack*.yaml.lock
|
||||
shake.yaml.lock
|
||||
|
4
.gitmodules
vendored
4
.gitmodules
vendored
@ -15,10 +15,6 @@
|
||||
# url = https://github.com/bubba/HaRe.git
|
||||
url = https://github.com/alanz/HaRe.git
|
||||
|
||||
[submodule "submodules/brittany"]
|
||||
path = submodules/brittany
|
||||
url = https://github.com/lspitzner/brittany.git
|
||||
|
||||
[submodule "submodules/cabal-helper"]
|
||||
path = submodules/cabal-helper
|
||||
# url = https://github.com/arbor/cabal-helper.git
|
||||
|
17
.travis.yml
17
.travis.yml
@ -54,10 +54,6 @@ jobs:
|
||||
env: GHC_VER="8.2.2"
|
||||
script: *setup
|
||||
|
||||
- stage: setup
|
||||
env: GHC_VER="8.2.1"
|
||||
script: *setup
|
||||
|
||||
- stage: dependencies
|
||||
env: GHC_VER="8.4.4"
|
||||
script: &dependencies
|
||||
@ -75,10 +71,6 @@ jobs:
|
||||
env: GHC_VER="8.2.2"
|
||||
script: *dependencies
|
||||
|
||||
- stage: dependencies
|
||||
env: GHC_VER="8.2.1"
|
||||
script: *dependencies
|
||||
|
||||
- stage: test
|
||||
env: GHC_VER="8.4.4"
|
||||
script: &test
|
||||
@ -96,10 +88,6 @@ jobs:
|
||||
env: GHC_VER="8.2.2"
|
||||
script: *test
|
||||
|
||||
- stage: test
|
||||
env: GHC_VER="8.2.1"
|
||||
script: *test
|
||||
|
||||
- stage: deploy
|
||||
env: GHC_VER="8.4.4"
|
||||
script: &deploy
|
||||
@ -135,8 +123,3 @@ jobs:
|
||||
env: GHC_VER="8.2.2"
|
||||
script: *deploy
|
||||
deploy: *upload
|
||||
|
||||
- stage: deploy
|
||||
env: GHC_VER="8.2.1"
|
||||
script: *deploy
|
||||
deploy: *upload
|
||||
|
162
Changelog.md
162
Changelog.md
@ -1,3 +1,165 @@
|
||||
# 0.11.0.0
|
||||
|
||||
- Bump resolvers. `lts-13.27` for GHC 8.6.5, `nightly-2019-07-07` for
|
||||
nightly build, rest are unchanged.
|
||||
([#1319 ](https://github.com/haskell/haskell-ide-engine/pull/1319),by @alanz)
|
||||
([#1316 ](https://github.com/haskell/haskell-ide-engine/pull/1316), by @lorenzo)
|
||||
|
||||
- Clear out pattern matching and error message of executeCodeActionByName
|
||||
([#1317 ](https://github.com/haskell/haskell-ide-engine/pull/1317), by @jneira)
|
||||
|
||||
- Upgrade to haskell-lsp 0.15
|
||||
([#1316 ](https://github.com/haskell/haskell-ide-engine/pull/1316), by @lorenzo)
|
||||
|
||||
- Update Arch Linux install instructions
|
||||
([#1315 ](https://github.com/haskell/haskell-ide-engine/pull/1315), by @friedbrice)
|
||||
|
||||
- Fix liquid unit test normalizing paths
|
||||
([#1310 ](https://github.com/haskell/haskell-ide-engine/pull/1310), by @jneira)
|
||||
|
||||
- Add unix-time constraint to cabal file
|
||||
([#1306 ](https://github.com/haskell/haskell-ide-engine/pull/1306), by @alanz)
|
||||
|
||||
- Fix a memory leak found by @mpickering
|
||||
([#1305 ](https://github.com/haskell/haskell-ide-engine/pull/1305), by @lorenzo)
|
||||
|
||||
- Fix build for Windows 7
|
||||
([#1304 ](https://github.com/haskell/haskell-ide-engine/pull/1304), by @jneira)
|
||||
|
||||
- Brittany 0.12
|
||||
([#1301 ](https://github.com/haskell/haskell-ide-engine/pull/1301), by @alanz)
|
||||
|
||||
- Use ghc-mod without memory leak
|
||||
([#1299 ](https://github.com/haskell/haskell-ide-engine/pull/1299), by @alanz)
|
||||
|
||||
- install.hs: Make all available GHCs in PATH buildable
|
||||
([#1297 ](https://github.com/haskell/haskell-ide-engine/pull/1297), by @maoe)
|
||||
|
||||
- Fix file mapping state when we have a parsed module but not a typechecked module
|
||||
([#1295 ](https://github.com/haskell/haskell-ide-engine/pull/1295), by @wz1000)
|
||||
|
||||
- Use ghc-mod which loads ghc plugins
|
||||
([#1293 ](https://github.com/haskell/haskell-ide-engine/pull/1293), by @alanz)
|
||||
|
||||
- Fix UriCaches being leaked (bug fix)
|
||||
([#1292 ](https://github.com/haskell/haskell-ide-engine/pull/1292), by @bubba)
|
||||
|
||||
- Stack 2.1.1
|
||||
([#1291 ](https://github.com/haskell/haskell-ide-engine/pull/1291), by @alanz)
|
||||
|
||||
- Render completion documentation to markdown
|
||||
([#1290 ](https://github.com/haskell/haskell-ide-engine/pull/1290), by @Avi-D-coder)
|
||||
|
||||
- Trying out haskell-lsp 0.14
|
||||
([#1288 ](https://github.com/haskell/haskell-ide-engine/pull/1288), by @alanz)
|
||||
|
||||
- Hlint 2.1.24
|
||||
([#1287 ](https://github.com/haskell/haskell-ide-engine/pull/1287), by @alanz)
|
||||
|
||||
- Improve import action of hsimport
|
||||
([#1284 ](https://github.com/haskell/haskell-ide-engine/pull/1284), by @fendor)
|
||||
|
||||
- Add liquid haskell smt solver to README
|
||||
([#1283 ](https://github.com/haskell/haskell-ide-engine/pull/1283), by @fendor)
|
||||
|
||||
|
||||
# 0.10.0.0
|
||||
|
||||
- Drop GHC 8.2.1 support.
|
||||
([#1279](https://github.com/haskell/haskell-ide-engine/pull/1279),
|
||||
@alanz)
|
||||
|
||||
- Bump resolvers and hoogle, LTS 13.23 for GHC 8.6.5,
|
||||
nightly-2019-05-31 for stack.yaml and hoogle version 5.0.17.9
|
||||
([#1277](https://github.com/haskell/haskell-ide-engine/pull/1277),
|
||||
@alanz)
|
||||
|
||||
- HsImport importlist, Offers code action to add a function to import list.
|
||||
([#1170](https://github.com/haskell/haskell-ide-engine/pull/1170), @fendor)
|
||||
|
||||
- Typemap reimplementation
|
||||
([#1186](https://github.com/haskell/haskell-ide-engine/pull/1186), @fendor)
|
||||
|
||||
- Add window/progress reporting for typechecking. Note: needs LSP
|
||||
client to support a recent spec change.
|
||||
([#1190](https://github.com/haskell/haskell-ide-engine/pull/1190),
|
||||
@bubba)
|
||||
|
||||
- Add package to library component in package.yaml
|
||||
([#1237](https://github.com/haskell/haskell-ide-engine/pull/1237), @fendor)
|
||||
|
||||
- hie sends invalid message on hover
|
||||
([#1246](https://github.com/haskell/haskell-ide-engine/pull/1246), @Hogeyama)
|
||||
|
||||
- Use floskell from hackage
|
||||
([#1242](https://github.com/haskell/haskell-ide-engine/pull/1242), @bubba)
|
||||
|
||||
- Adapting to new haskell-lsp
|
||||
([#1247](https://github.com/haskell/haskell-ide-engine/pull/1247), @alanz)
|
||||
|
||||
- Remove HoverContentsEmpty
|
||||
([#1251](https://github.com/haskell/haskell-ide-engine/pull/1251), @alanz)
|
||||
|
||||
- Use lsp-test-0.5.2.2 from hackage
|
||||
([#1252](https://github.com/haskell/haskell-ide-engine/pull/1252), @bubba)
|
||||
|
||||
- Use haskell-lsp-12.1.0 from hackage
|
||||
([#1253](https://github.com/haskell/haskell-ide-engine/pull/1253), @alanz)
|
||||
|
||||
- Bump haskell-lsp to 0.13.0.0
|
||||
([#1260](https://github.com/haskell/haskell-ide-engine/pull/1260), @alanz)
|
||||
|
||||
- Bump version for hsimport to 0.10.0
|
||||
([#1265](https://github.com/haskell/haskell-ide-engine/pull/1265), @fendor)
|
||||
|
||||
- Revert "Revert "Merge pull request #1237 from fendor/add-package-tests""
|
||||
([#1268](https://github.com/haskell/haskell-ide-engine/pull/1268), @alanz)
|
||||
|
||||
- Hlint 2.1.22
|
||||
([#1270](https://github.com/haskell/haskell-ide-engine/pull/1270), @alanz)
|
||||
|
||||
- Documentation
|
||||
|
||||
- Add Nix cabal-helper fix to troubleshooting section
|
||||
([#1231](https://github.com/haskell/haskell-ide-engine/pull/1231),
|
||||
@Infinisil)
|
||||
|
||||
- Troubleshooting for emacs
|
||||
([#1240](https://github.com/haskell/haskell-ide-engine/pull/1240),
|
||||
@Infinisil)
|
||||
|
||||
- Change url for nix installation instructions
|
||||
([#1258](https://github.com/haskell/haskell-ide-engine/pull/1258),
|
||||
@malob)
|
||||
|
||||
- Preparations for hie-bios
|
||||
|
||||
- HaRe hie plugin api
|
||||
([#1215](https://github.com/haskell/haskell-ide-engine/pull/1215),
|
||||
@alanz)
|
||||
|
||||
- Narrow ghc mod core
|
||||
([#1255](https://github.com/haskell/haskell-ide-engine/pull/1255),
|
||||
@alanz)
|
||||
|
||||
- Build system (install.hs)
|
||||
|
||||
- Extra argument causes cabal-build-doc to fail
|
||||
([#1239](https://github.com/haskell/haskell-ide-engine/pull/1239),
|
||||
@bflyblue)
|
||||
|
||||
- Add an explicit stack file for GHC 8.6.5
|
||||
([#1241](https://github.com/haskell/haskell-ide-engine/pull/1241),
|
||||
@alanz)
|
||||
|
||||
- Bump shake resolver
|
||||
([#1272](https://github.com/haskell/haskell-ide-engine/pull/1272),
|
||||
@fendor)
|
||||
|
||||
- Avoid legacy warning
|
||||
([#1273](https://github.com/haskell/haskell-ide-engine/pull/1273),
|
||||
@fendor)
|
||||
|
||||
# 0.9.0.0
|
||||
|
||||
- GHC 8.6.5 preliminary support added via the nightly build (@alanz)
|
||||
|
34
README.md
34
README.md
@ -63,6 +63,7 @@ we talk to clients.__
|
||||
- [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)
|
||||
- [Liquid Haskell](#liquid-haskell)
|
||||
|
||||
## Features
|
||||
|
||||
@ -128,12 +129,12 @@ Follow the instructions at https://github.com/Infinisil/all-hies
|
||||
|
||||
### Installation on ArchLinux
|
||||
|
||||
An [haskell-ide-engine-git](https://aur.archlinux.org/packages/haskell-ide-engine-git/) package is available on the AUR.
|
||||
An [haskell-ide-engine](https://aur.archlinux.org/packages/haskell-ide-engine/) package is available on the AUR.
|
||||
|
||||
Using [Aura](https://github.com/aurapm/aura):
|
||||
|
||||
```
|
||||
# aura -A haskell-ide-engine-git
|
||||
# aura -A haskell-ide-engine
|
||||
```
|
||||
|
||||
|
||||
@ -200,6 +201,20 @@ stack ./install.hs help
|
||||
|
||||
Remember, this will take time to download a Stackage-LTS and an appropriate GHC. However, afterwards all commands should work as expected.
|
||||
|
||||
##### Install via cabal
|
||||
|
||||
The install-script can be invoked via `cabal` instead of `stack` with the command
|
||||
|
||||
```bash
|
||||
cabal v2-run ./install.hs --project-file install/shake.project <target>
|
||||
```
|
||||
|
||||
Running the script with cabal on windows seems to have some issues and is currently not fully supported.
|
||||
|
||||
Unfortunately, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected.
|
||||
|
||||
For brevity, only the `stack`-based commands are presented in the following sections.
|
||||
|
||||
##### Install specific GHC Version
|
||||
|
||||
Install **Nightly** (and hoogle docs):
|
||||
@ -345,7 +360,7 @@ in
|
||||
}
|
||||
```
|
||||
|
||||
Now open a haskell project with Sublime Text. You should have these features available to you:
|
||||
Now open a Haskell project with Sublime Text. You should have these features available to you:
|
||||
|
||||
1. Errors are underlined in red
|
||||
2. LSP: Show Diagnostics will show a list of hints and errors
|
||||
@ -356,8 +371,8 @@ Now open a haskell project with Sublime Text. You should have these features ava
|
||||
As above, make sure HIE is installed. These instructions are for using the [LanguageClient-neovim](https://github.com/autozimu/LanguageClient-neovim) client.
|
||||
|
||||
#### vim-plug
|
||||
If you use [vim-plug](https://github.com/junegunn/vim-plug), then you can do this by e.g.
|
||||
including the following line in the Plug section of your `init.vim`:
|
||||
If you use [vim-plug](https://github.com/junegunn/vim-plug), then you can do this by e.g.,
|
||||
including the following line in the Plug section of your `init.vim` or `~/.vimrc`:
|
||||
|
||||
```
|
||||
Plug 'autozimu/LanguageClient-neovim', {
|
||||
@ -366,10 +381,10 @@ Plug 'autozimu/LanguageClient-neovim', {
|
||||
\ }
|
||||
```
|
||||
|
||||
and issuing a `:PlugInstall` command within neovim.
|
||||
and issuing a `:PlugInstall` command within Neovim or Vim.
|
||||
|
||||
#### Vim 8.0
|
||||
Clone [LanguageClient-neovim](https://github.com/autozimu/LanguageClient-neovim)
|
||||
#### Clone the LanguageClient-neovim repo
|
||||
As an alternative to using [vim-plug](https://github.com/junegunn/vim-plug) shown above, clone [LanguageClient-neovim](https://github.com/autozimu/LanguageClient-neovim)
|
||||
into `~/.vim/pack/XXX/start/`, where `XXX` is just a name for your "plugin suite".
|
||||
|
||||
#### Sample `~/.vimrc`
|
||||
@ -629,4 +644,7 @@ cabal-helper-wrapper: /home/<...>/.cache/cabal-helper/cabal-helper<...>: createP
|
||||
|
||||
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.
|
||||
|
||||
### Liquid Haskell
|
||||
|
||||
Liquid Haskell requires an SMT solver on the path. We do not take care of installing one, thus, Liquid Haskell will not run until one is installed.
|
||||
The recommended SMT solver is [z3](https://github.com/Z3Prover/z3). To run the tests, it is also required to have an SMT solver on the path, otherwise the tests will fail for Liquid Haskell.
|
||||
|
@ -8,7 +8,6 @@ environment:
|
||||
- GHCVER: 8.4.3
|
||||
- GHCVER: 8.4.2
|
||||
- GHCVER: 8.2.2
|
||||
- GHCVER: 8.2.1
|
||||
install:
|
||||
- cmd: >-
|
||||
git submodule update --init --recursive
|
||||
|
7
azure-pipelines.yml
Normal file
7
azure-pipelines.yml
Normal file
@ -0,0 +1,7 @@
|
||||
jobs:
|
||||
- template: ./.azure/linux-stack.yml
|
||||
- template: ./.azure/windows-stack.yml
|
||||
- template: ./.azure/macos-stack.yml
|
||||
- template: ./.azure/linux-installhs-stack.yml
|
||||
- template: ./.azure/windows-installhs-stack.yml
|
||||
- template: ./.azure/macos-installhs-stack.yml
|
@ -4,7 +4,6 @@ packages:
|
||||
./hie-bios/
|
||||
|
||||
./submodules/HaRe
|
||||
./submodules/brittany
|
||||
./submodules/cabal-helper/
|
||||
./submodules/ghc-mod/
|
||||
./submodules/ghc-mod/core/
|
||||
|
@ -2,15 +2,15 @@
|
||||
|
||||
### ghc-mod
|
||||
|
||||
1. Linking aginst Cabal directly meant lots of breakage when interacting with the on disk configuration state. (Since solved by using wrapper)
|
||||
2. Supporting ill defined interfaces and protocols is hard to impossible. Over the course of it's almost 100 releases (!!!) compatibility was broken way too often.
|
||||
3. Supporting many GHC versions simultaniously is very hard since they keep breaking the API.
|
||||
4. Linking against GHC means simmilar problems as with linking against Cabal, i.e. when the user upgrades their GHC binary stuff will break.
|
||||
1. Linking against Cabal directly meant lots of breakage when interacting with the on-disk configuration state. (Since solved by using wrapper)
|
||||
2. Supporting ill-defined interfaces and protocols is hard to impossible. Over the course of its almost 100 releases (!!!) compatibility was broken way too often.
|
||||
3. Supporting many GHC versions simultaneously is very hard since they keep breaking the API.
|
||||
4. Linking against GHC means similar problems as with linking against Cabal, i.e., when the user upgrades their GHC binary stuff will break.
|
||||
|
||||
:memo: Don't link against Cabal directly ever
|
||||
:memo: (maybe) Target only one GHC version at a time or provide some compatibility layer
|
||||
:memo: Let's get the interfaces mostly right on the first go
|
||||
:memo: Handle changing compiler versions transparently
|
||||
* :memo: Don't link against Cabal directly ever
|
||||
* :memo: (maybe) Target only one GHC version at a time or provide some compatibility layer
|
||||
* :memo: Let's get the interfaces mostly right on the first go
|
||||
* :memo: Handle changing compiler versions transparently
|
||||
|
||||
### ide-backend / stack-ide
|
||||
|
||||
|
@ -69,8 +69,8 @@ library
|
||||
, gitrev >= 1.1
|
||||
, haddock-api
|
||||
, haddock-library
|
||||
, haskell-lsp == 0.13.*
|
||||
, haskell-lsp-types == 0.13.*
|
||||
, haskell-lsp == 0.15.*
|
||||
, haskell-lsp-types == 0.15.*
|
||||
, haskell-src-exts
|
||||
, hie-plugin-api
|
||||
, hlint (>= 2.0.11 && < 2.1.18) || >= 2.1.22
|
||||
@ -91,8 +91,10 @@ library
|
||||
, tagsoup
|
||||
, text
|
||||
, transformers
|
||||
, unix-time >= 0.4.7
|
||||
, unordered-containers
|
||||
, vector
|
||||
, versions
|
||||
, yaml >= 0.8.31
|
||||
, hie-bios
|
||||
, bytestring-trie
|
||||
@ -192,7 +194,7 @@ test-suite unit-test
|
||||
, filepath
|
||||
, free
|
||||
, haskell-ide-engine
|
||||
, haskell-lsp-types
|
||||
, haskell-lsp-types >= 0.15.0.0
|
||||
, hie-test-utils
|
||||
, hie-plugin-api
|
||||
, hoogle > 5.0.11
|
||||
@ -278,10 +280,10 @@ test-suite func-test
|
||||
, data-default
|
||||
, directory
|
||||
, filepath
|
||||
, lsp-test >= 0.5.2
|
||||
, lsp-test >= 0.6.0.0
|
||||
, haskell-ide-engine
|
||||
, haskell-lsp-types == 0.13.*
|
||||
, haskell-lsp == 0.13.*
|
||||
, haskell-lsp-types == 0.15.*
|
||||
, haskell-lsp == 0.15.*
|
||||
, hie-test-utils
|
||||
, hie-plugin-api
|
||||
, hspec
|
||||
|
@ -8,14 +8,23 @@ import Language.Haskell.LSP.Types
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- | Callback from haskell-lsp core to convert the generic message to the
|
||||
-- specific one for hie
|
||||
-- | Given a DidChangeConfigurationNotification message, this function returns the parsed
|
||||
-- Config object if possible.
|
||||
getConfigFromNotification :: DidChangeConfigurationNotification -> Either T.Text Config
|
||||
getConfigFromNotification (NotificationMessage _ _ (DidChangeConfigurationParams p)) =
|
||||
case fromJSON p of
|
||||
Success c -> Right c
|
||||
Error err -> Left $ T.pack err
|
||||
|
||||
-- | Given an InitializeRequest message, this function returns the parsed
|
||||
-- Config object if possible. Otherwise, it returns the default configuration
|
||||
getInitialConfig :: InitializeRequest -> Either T.Text Config
|
||||
getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Nothing }) = Right def
|
||||
getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Just opts}) =
|
||||
case fromJSON opts of
|
||||
Success c -> Right c
|
||||
Error err -> Left $ T.pack err
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
data Config =
|
||||
|
@ -11,7 +11,7 @@
|
||||
module Haskell.Ide.Engine.Ghc
|
||||
(
|
||||
setTypecheckedModule
|
||||
, Diagnostics
|
||||
, Diagnostics(..)
|
||||
, AdditionalErrs
|
||||
, cabalModuleGraphs
|
||||
, makeRevRedirMapFunc
|
||||
@ -21,9 +21,11 @@ import Bag
|
||||
import Control.Monad.IO.Class
|
||||
import Data.IORef
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Semigroup ((<>), Semigroup)
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Aeson
|
||||
import Data.Coerce
|
||||
import ErrUtils
|
||||
|
||||
import Haskell.Ide.Engine.MonadFunctions
|
||||
@ -36,6 +38,7 @@ import GHC
|
||||
import IOEnv as G
|
||||
import HscTypes
|
||||
import Outputable (renderWithStyle)
|
||||
import Language.Haskell.LSP.Types ( NormalizedUri(..), toNormalizedUri )
|
||||
|
||||
import Bag
|
||||
import Control.Monad.IO.Class
|
||||
@ -68,7 +71,20 @@ import qualified HscMain as G
|
||||
import System.Directory
|
||||
|
||||
|
||||
type Diagnostics = Map.Map Uri (Set.Set Diagnostic)
|
||||
newtype Diagnostics = Diagnostics (Map.Map NormalizedUri (Set.Set Diagnostic))
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Semigroup Diagnostics where
|
||||
Diagnostics d1 <> Diagnostics d2 = Diagnostics (d1 <> d2)
|
||||
|
||||
instance Monoid Diagnostics where
|
||||
mappend = (<>)
|
||||
mempty = Diagnostics mempty
|
||||
|
||||
instance Data.Aeson.ToJSON Diagnostics where
|
||||
toJSON (Diagnostics d) = Data.Aeson.toJSON
|
||||
(Map.mapKeys coerce d :: Map.Map T.Text (Set.Set Diagnostic))
|
||||
|
||||
type AdditionalErrs = [T.Text]
|
||||
|
||||
|
||||
@ -81,7 +97,30 @@ lspSev SevFatal = DsError
|
||||
lspSev SevInfo = DsInfo
|
||||
lspSev _ = DsInfo
|
||||
|
||||
-- | Turn a 'SourceError' into the HIE 'Diagnostics' format.
|
||||
-- type LogAction = DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
|
||||
logDiag :: (FilePath -> FilePath) -> IORef AdditionalErrs -> IORef Diagnostics -> LogAction
|
||||
logDiag rfm eref dref df _reason sev spn style msg = do
|
||||
eloc <- srcSpan2Loc rfm spn
|
||||
let msgTxt = T.pack $ renderWithStyle df msg style
|
||||
case eloc of
|
||||
Right (Location uri range) -> do
|
||||
let update = Map.insertWith Set.union (toNormalizedUri uri) (Set.singleton diag)
|
||||
diag = Diagnostic range (Just $ lspSev sev) Nothing (Just "ghcmod") msgTxt Nothing
|
||||
modifyIORef' dref (\(Diagnostics d) -> Diagnostics $ update d)
|
||||
Left _ -> do
|
||||
modifyIORef' eref (msgTxt:)
|
||||
return ()
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- unhelpfulSrcSpanErr :: T.Text -> IdeError
|
||||
-- unhelpfulSrcSpanErr err =
|
||||
-- IdeError PluginError
|
||||
-- ("Unhelpful SrcSpan" <> ": \"" <> err <> "\"")
|
||||
-- Null
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
srcErrToDiag :: MonadIO m
|
||||
=> DynFlags
|
||||
-> (FilePath -> FilePath)
|
||||
@ -105,9 +144,11 @@ srcErrToDiag df rfm se = do
|
||||
(m,es) <- processMsgs xs
|
||||
case res of
|
||||
Right (uri, diag) ->
|
||||
return (Map.insertWith Set.union uri (Set.singleton diag) m, es)
|
||||
return (Map.insertWith Set.union (toNormalizedUri uri) (Set.singleton diag) m, es)
|
||||
Left e -> return (m, e:es)
|
||||
processMsgs errMsgs
|
||||
|
||||
(diags, errs) <- processMsgs errMsgs
|
||||
return (Diagnostics diags, errs)
|
||||
|
||||
|
||||
-- | Run a Ghc action and capture any diagnostics and errors produced.
|
||||
@ -117,10 +158,12 @@ captureDiagnostics :: (MonadIO m, GhcMonad m)
|
||||
-> m (Diagnostics, AdditionalErrs, Maybe r)
|
||||
captureDiagnostics rfm action = do
|
||||
env <- getSession
|
||||
diagRef <- liftIO $ newIORef Map.empty
|
||||
diagRef <- liftIO $ newIORef mempty
|
||||
errRef <- liftIO $ newIORef []
|
||||
let setLogger df = df { log_action = logDiag rfm errRef diagRef }
|
||||
setDeferTypedHoles = setGeneralFlag' Opt_DeferTypedHoles
|
||||
|
||||
ghcErrRes :: String -> (Diagnostics, AdditionalErrs)
|
||||
ghcErrRes msg = do
|
||||
diags <- liftIO $ readIORef diagRef
|
||||
errs <- liftIO $ readIORef errRef
|
||||
@ -132,7 +175,7 @@ captureDiagnostics rfm action = do
|
||||
return (Map.unionWith Set.union d1 diags, e1 ++ errs, Nothing)
|
||||
|
||||
|
||||
handlers = errorHandlers ghcErrRes to_diag
|
||||
handlers = errorHandlers ghcErrRes (srcErrToDiag (hsc_dflags env) rfm )
|
||||
action' = do
|
||||
r <- BIOS.withDynFlags (setLogger . setDeferTypedHoles) action
|
||||
diags <- liftIO $ readIORef diagRef
|
||||
@ -223,7 +266,23 @@ setTypecheckedModule_load uri =
|
||||
let progTitle = "Typechecking " <> T.pack (takeFileName fp)
|
||||
(diags', errs, mmods) <- loadFile rfm (fp, mapped_fp)
|
||||
debugm "File, loaded"
|
||||
canonUri <- canonicalizeUri uri
|
||||
fileMap <- GM.getMMappedFiles
|
||||
debugm $ "setTypecheckedModule: file mapping state is: " ++ show fileMap
|
||||
rfm <- GM.mkRevRedirMapFunc
|
||||
let
|
||||
ghcErrRes msg = ((Diagnostics Map.empty, [T.pack msg]),Nothing,Nothing)
|
||||
progTitle = "Typechecking " <> T.pack (takeFileName fp)
|
||||
debugm "setTypecheckedModule: before ghc-mod"
|
||||
-- TODO:AZ: loading this one module may/should trigger loads of any
|
||||
-- other modules which currently have a VFS entry. Need to make
|
||||
-- sure that their diagnostics are reported, and their module
|
||||
-- cache entries are updated.
|
||||
-- TODO: Are there any hooks we can use to report back on the progress?
|
||||
((Diagnostics diags', errs), mtm, mpm) <- withIndefiniteProgress progTitle NotCancellable $ GM.gcatches
|
||||
(GM.getModulesGhc' (myWrapper rfm) fp)
|
||||
(errorHandlers ghcErrRes (return . ghcErrRes . show))
|
||||
|
||||
canonUri <- toNormalizedUri <$> canonicalizeUri uri
|
||||
let diags = Map.insertWith Set.union canonUri Set.empty diags'
|
||||
debugm "setTypecheckedModule: after ghc-mod"
|
||||
debugm ("Diags: " <> show diags')
|
||||
@ -261,7 +320,7 @@ setTypecheckedModule_load uri =
|
||||
let d = Diagnostic range sev Nothing (Just "bios") msgTxt Nothing
|
||||
return $ Map.insertWith Set.union canonUri (Set.singleton d) diags
|
||||
|
||||
return $ IdeResultOk (diags2,errs)
|
||||
return $ IdeResultOk (Diagnostics diags2,errs)
|
||||
|
||||
--
|
||||
cabalModuleGraphs = undefined
|
||||
|
@ -280,9 +280,13 @@ cacheModule fp modul = do
|
||||
let defInfo = CachedInfo mempty mempty mempty mempty rfm return return
|
||||
return $ case muc of
|
||||
Just (UriCacheSuccess uc) ->
|
||||
let newCI = (cachedInfo uc) { revMap = rfm }
|
||||
in uc { cachedPsMod = pm, cachedInfo = newCI, cachedHash = fp_hash }
|
||||
_ -> UriCache defInfo pm Nothing mempty fp_hash
|
||||
let newCI = oldCI { revMap = rfm . revMap oldCI }
|
||||
-- ^^^^^^^^^^^^
|
||||
-- We have to retain the old mapping state, since the
|
||||
-- old TypecheckedModule still contains spans relative to that
|
||||
oldCI = cachedInfo uc
|
||||
in uc { cachedPsMod = pm, cachedInfo = newCI }
|
||||
_ -> UriCache defInfo pm Nothing mempty
|
||||
|
||||
Right tm -> do
|
||||
typm <- genTypeMap tm
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
@ -152,6 +153,7 @@ import Language.Haskell.LSP.Types ( Command(..)
|
||||
, WorkspaceEdit(..)
|
||||
, filePathToUri
|
||||
, uriToFilePath
|
||||
, toNormalizedUri
|
||||
)
|
||||
|
||||
import Language.Haskell.LSP.VFS ( VirtualFile(..) )
|
||||
@ -412,7 +414,7 @@ getVirtualFile :: (MonadIde m, MonadIO m) => Uri -> m (Maybe VirtualFile)
|
||||
getVirtualFile uri = do
|
||||
mlf <- ideEnvLspFuncs <$> getIdeEnv
|
||||
case mlf of
|
||||
Just lf -> liftIO $ Core.getVirtualFileFunc lf uri
|
||||
Just lf -> liftIO $ Core.getVirtualFileFunc lf (toNormalizedUri uri)
|
||||
Nothing -> return Nothing
|
||||
|
||||
persistVirtualFile :: (MonadIde m, MonadIO m) => Uri -> m FilePath
|
||||
@ -472,7 +474,7 @@ withIndefiniteProgress t c f = do
|
||||
Just wp -> control $ \run -> wp t c (run f)
|
||||
|
||||
data IdeState = IdeState
|
||||
{ moduleCache :: GhcModuleCache
|
||||
{ moduleCache :: !GhcModuleCache
|
||||
-- | A queue of requests to be performed once a module is loaded
|
||||
, requestQueue :: Map.Map FilePath [UriCacheResult -> IdeM ()]
|
||||
, extensibleState :: !(Map.Map TypeRep Dynamic)
|
||||
@ -516,7 +518,7 @@ instance HasGhcModuleCache IdeM where
|
||||
tvar <- lift ask
|
||||
state <- readTVarIO tvar
|
||||
return (moduleCache state)
|
||||
setModuleCache mc = do
|
||||
setModuleCache !mc = do
|
||||
tvar <- lift ask
|
||||
atomically $ modifyTVar' tvar (\st -> st { moduleCache = mc })
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: hie-plugin-api
|
||||
version: 0.9.0.0
|
||||
version: 0.11.0.0
|
||||
synopsis: Haskell IDE API for plugin communication
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
@ -50,7 +50,7 @@ library
|
||||
, ghc
|
||||
, hie-bios
|
||||
, ghc-project-types >= 5.9.0.0
|
||||
, haskell-lsp == 0.13.*
|
||||
, haskell-lsp == 0.15.*
|
||||
, hslogger
|
||||
, unliftio
|
||||
, monad-control
|
||||
|
598
install.hs
598
install.hs
@ -1,592 +1,20 @@
|
||||
#!/usr/bin/env stack
|
||||
{- stack
|
||||
runghc
|
||||
--stack-yaml=shake.yaml
|
||||
--package shake
|
||||
--package directory
|
||||
--package extra
|
||||
--stack-yaml=install/shake.yaml
|
||||
--package hie-install
|
||||
-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
import Development.Shake
|
||||
import Development.Shake.Command
|
||||
import Development.Shake.FilePath
|
||||
import Control.Monad
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Extra ( unlessM
|
||||
, mapMaybeM
|
||||
)
|
||||
import Data.Maybe ( isJust )
|
||||
import System.Directory ( findExecutable
|
||||
, listDirectory
|
||||
)
|
||||
import System.Environment ( getProgName
|
||||
, unsetEnv
|
||||
)
|
||||
import System.Info ( os
|
||||
, arch
|
||||
)
|
||||
{- cabal:
|
||||
build-depends:
|
||||
base
|
||||
, hie-install
|
||||
-}
|
||||
-- call as:
|
||||
-- * `cabal v2-run install.hs --project-file install/shake.project <target>`
|
||||
-- * `stack install.hs <target>`
|
||||
|
||||
import Data.Maybe ( isNothing
|
||||
, mapMaybe
|
||||
)
|
||||
import Data.List ( dropWhileEnd
|
||||
, intersperse
|
||||
, intercalate
|
||||
, sort
|
||||
)
|
||||
import qualified Data.Text as T
|
||||
import Data.Char ( isSpace )
|
||||
import Data.Version ( parseVersion
|
||||
, makeVersion
|
||||
, showVersion
|
||||
)
|
||||
import Data.Function ( (&) )
|
||||
import Text.ParserCombinators.ReadP ( readP_to_S )
|
||||
-- TODO: set `shake.project` in cabal-config above, when supported
|
||||
|
||||
type VersionNumber = String
|
||||
type GhcPath = String
|
||||
import HieInstall (defaultMain)
|
||||
|
||||
-- | Defines all different hie versions that are buildable.
|
||||
--
|
||||
-- The current directory is scanned for `stack-*.yaml` files.
|
||||
-- On windows, `8.6.3` is excluded as this version of ghc does not work there
|
||||
getHieVersions :: MonadIO m => m [VersionNumber]
|
||||
getHieVersions = do
|
||||
let stackYamlPrefix = T.pack "stack-"
|
||||
let stackYamlSuffix = T.pack ".yaml"
|
||||
files <- liftIO $ listDirectory "."
|
||||
let hieVersions = files
|
||||
& map T.pack
|
||||
& mapMaybe
|
||||
(T.stripPrefix stackYamlPrefix >=> T.stripSuffix stackYamlSuffix)
|
||||
& map T.unpack
|
||||
-- the following line excludes `8.6.3` on windows systems
|
||||
& filter (\p -> not isWindowsSystem || p /= "8.6.3")
|
||||
& sort
|
||||
return hieVersions
|
||||
|
||||
-- | Most recent version of hie.
|
||||
-- Shown in the more concise help message.
|
||||
mostRecentHieVersion :: MonadIO m => m VersionNumber
|
||||
mostRecentHieVersion = last <$> getHieVersions
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
-- unset GHC_PACKAGE_PATH for cabal
|
||||
unsetEnv "GHC_PACKAGE_PATH"
|
||||
|
||||
ghcPaths <- findInstalledGhcs
|
||||
let ghcVersions = map fst ghcPaths
|
||||
|
||||
hieVersions <- getHieVersions
|
||||
|
||||
shakeArgs shakeOptions { shakeFiles = "_build" } $ do
|
||||
want ["short-help"]
|
||||
-- general purpose targets
|
||||
phony "submodules" updateSubmodules
|
||||
phony "cabal" installCabal
|
||||
phony "short-help" shortHelpMessage
|
||||
phony "all" shortHelpMessage
|
||||
phony "help" helpMessage
|
||||
phony "check-stack" checkStack
|
||||
|
||||
phony "cabal-ghcs" $ do
|
||||
let
|
||||
msg =
|
||||
"Found the following GHC paths: \n"
|
||||
++ unlines
|
||||
(map (\(version, path) -> "ghc-" ++ version ++ ": " ++ path)
|
||||
ghcPaths
|
||||
)
|
||||
liftIO $ putStrLn $ embedInStars msg
|
||||
|
||||
-- stack specific targets
|
||||
phony "build" (need (reverse $ map ("hie-" ++) hieVersions))
|
||||
phony "build-all" (need ["build-doc", "build"])
|
||||
phony "test" $ do
|
||||
need ["submodules"]
|
||||
need ["check-stack"]
|
||||
need ["cabal"]
|
||||
forM_ hieVersions stackTest
|
||||
|
||||
phony "build-copy-compiler-tool" $ forM_ hieVersions buildCopyCompilerTool
|
||||
|
||||
phony "build-doc" $ do
|
||||
need ["submodules"]
|
||||
need ["check-stack"]
|
||||
stackBuildDoc
|
||||
|
||||
-- main targets for building hie with `stack`
|
||||
forM_
|
||||
hieVersions
|
||||
(\version -> phony ("hie-" ++ version) $ do
|
||||
need ["submodules"]
|
||||
need ["check-stack"]
|
||||
need ["cabal"]
|
||||
stackBuildHie version
|
||||
stackInstallHie version
|
||||
)
|
||||
|
||||
-- cabal specific targets
|
||||
phony "cabal-build" (need (map ("cabal-hie-" ++) ghcVersions))
|
||||
phony "cabal-build-all" (need ["cabal-build-doc", "cabal-build"])
|
||||
phony "cabal-build-doc" $ do
|
||||
need ["submodules"]
|
||||
need ["cabal"]
|
||||
cabalBuildDoc
|
||||
|
||||
phony "cabal-test" $ do
|
||||
need ["submodules"]
|
||||
need ["cabal"]
|
||||
forM_ ghcVersions cabalTest
|
||||
|
||||
forM_
|
||||
hieVersions
|
||||
(\version -> phony ("cabal-hie-" ++ version) $ do
|
||||
validateCabalNewInstallIsSupported
|
||||
need ["submodules"]
|
||||
need ["cabal"]
|
||||
cabalBuildHie version
|
||||
cabalInstallHie version
|
||||
)
|
||||
|
||||
-- macos specific targets
|
||||
phony "icu-macos-fix"
|
||||
(need ["icu-macos-fix-install"] >> need ["icu-macos-fix-build"])
|
||||
phony "icu-macos-fix-install" (command_ [] "brew" ["install", "icu4c"])
|
||||
phony "icu-macos-fix-build" $ mapM_ buildIcuMacosFix hieVersions
|
||||
|
||||
|
||||
buildIcuMacosFix :: VersionNumber -> Action ()
|
||||
buildIcuMacosFix version = execStackWithGhc_
|
||||
version
|
||||
[ "build"
|
||||
, "text-icu"
|
||||
, "--extra-lib-dirs=/usr/local/opt/icu4c/lib"
|
||||
, "--extra-include-dirs=/usr/local/opt/icu4c/include"
|
||||
]
|
||||
|
||||
-- | update the submodules that the project is in the state as required by the `stack.yaml` files
|
||||
updateSubmodules :: Action ()
|
||||
updateSubmodules = do
|
||||
command_ [] "git" ["submodule", "sync", "--recursive"]
|
||||
command_ [] "git" ["submodule", "update", "--init", "--recursive"]
|
||||
|
||||
-- TODO: this restriction will be gone in the next release of cabal
|
||||
validateCabalNewInstallIsSupported :: Action ()
|
||||
validateCabalNewInstallIsSupported = when isWindowsSystem $ do
|
||||
liftIO $ putStrLn $ embedInStars cabalInstallNotSuportedFailMsg
|
||||
error cabalInstallNotSuportedFailMsg
|
||||
|
||||
configureCabal :: VersionNumber -> Action ()
|
||||
configureCabal versionNumber = do
|
||||
ghcPath <- getGhcPath versionNumber >>= \case
|
||||
Nothing -> do
|
||||
liftIO $ putStrLn $ embedInStars (ghcVersionNotFoundFailMsg versionNumber)
|
||||
error (ghcVersionNotFoundFailMsg versionNumber)
|
||||
Just p -> return p
|
||||
execCabal_
|
||||
["new-configure", "-w", ghcPath, "--write-ghc-environment-files=never"]
|
||||
|
||||
findInstalledGhcs :: IO [(VersionNumber, GhcPath)]
|
||||
findInstalledGhcs = do
|
||||
hieVersions <- getHieVersions :: IO [VersionNumber]
|
||||
mapMaybeM
|
||||
(\version -> getGhcPath version >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just p -> return $ Just (version, p)
|
||||
)
|
||||
(reverse hieVersions)
|
||||
|
||||
cabalBuildHie :: VersionNumber -> Action ()
|
||||
cabalBuildHie versionNumber = do
|
||||
configureCabal versionNumber
|
||||
execCabal_ ["new-build", "--write-ghc-environment-files=never"]
|
||||
|
||||
cabalInstallHie :: VersionNumber -> Action ()
|
||||
cabalInstallHie versionNumber = do
|
||||
localBin <- getLocalBin
|
||||
execCabal_
|
||||
[ "new-install"
|
||||
, "--write-ghc-environment-files=never"
|
||||
, "--symlink-bindir=" ++ localBin
|
||||
, "exe:hie"
|
||||
, "--overwrite-policy=always"
|
||||
]
|
||||
copyFile' (localBin </> "hie" <.> exe)
|
||||
(localBin </> "hie-" ++ versionNumber <.> exe)
|
||||
copyFile' (localBin </> "hie" <.> exe)
|
||||
(localBin </> "hie-" ++ dropExtension versionNumber <.> exe)
|
||||
|
||||
cabalBuildDoc :: Action ()
|
||||
cabalBuildDoc = do
|
||||
execCabal_ ["new-build", "hoogle"]
|
||||
execCabal_ ["new-exec", "hoogle", "generate"]
|
||||
|
||||
cabalTest :: VersionNumber -> Action ()
|
||||
cabalTest versionNumber = do
|
||||
configureCabal versionNumber
|
||||
execCabal_ ["new-test"]
|
||||
|
||||
installCabal :: Action ()
|
||||
installCabal = do
|
||||
-- try to find existing `cabal` executable with appropriate version
|
||||
cabalExe <- liftIO (findExecutable "cabal") >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just cabalExe -> do
|
||||
Stdout cabalVersion <- execCabal ["--numeric-version"]
|
||||
let (parsedVersion, "") : _ =
|
||||
cabalVersion & trim & readP_to_S parseVersion & filter
|
||||
(("" ==) . snd)
|
||||
|
||||
return $ if parsedVersion >= makeVersion [2, 4, 1, 0]
|
||||
then Just cabalExe
|
||||
else Nothing
|
||||
-- install `cabal-install` if not already installed
|
||||
when (isNothing cabalExe) $
|
||||
execStackShake_ ["install", "cabal-install"]
|
||||
execCabal_ ["update"]
|
||||
|
||||
|
||||
checkStack :: Action ()
|
||||
checkStack = do
|
||||
Stdout stackVersion <- execStackShake ["--numeric-version"]
|
||||
let (parsedVersion, "") : _ =
|
||||
stackVersion & trim & readP_to_S parseVersion & filter
|
||||
(("" ==) . snd)
|
||||
unless (parsedVersion >= makeVersion requiredStackVersion) $ do
|
||||
liftIO $ putStrLn $ embedInStars $ stackExeIsOldFailMsg $ trim stackVersion
|
||||
error $ stackExeIsOldFailMsg $ trim stackVersion
|
||||
|
||||
|
||||
stackBuildHie :: VersionNumber -> Action ()
|
||||
stackBuildHie versionNumber =
|
||||
execStackWithGhc_ versionNumber ["build"]
|
||||
`actionOnException` liftIO (putStrLn stackBuildFailMsg)
|
||||
|
||||
-- | copy the built binaries into the localBinDir
|
||||
stackInstallHie :: VersionNumber -> Action ()
|
||||
stackInstallHie versionNumber = do
|
||||
execStackWithGhc_ versionNumber ["install"]
|
||||
localBinDir <- getLocalBin
|
||||
localInstallRoot <- getLocalInstallRoot versionNumber
|
||||
let hie = "hie" <.> exe
|
||||
copyFile' (localInstallRoot </> "bin" </> hie)
|
||||
(localBinDir </> "hie-" ++ versionNumber <.> exe)
|
||||
copyFile' (localInstallRoot </> "bin" </> hie)
|
||||
(localBinDir </> "hie-" ++ dropExtension versionNumber <.> exe)
|
||||
|
||||
buildCopyCompilerTool :: VersionNumber -> Action ()
|
||||
buildCopyCompilerTool versionNumber =
|
||||
execStackWithGhc_ versionNumber ["build", "--copy-compiler-tool"]
|
||||
|
||||
stackTest :: VersionNumber -> Action ()
|
||||
stackTest versionNumber = execStackWithGhc_ versionNumber ["test"]
|
||||
|
||||
stackBuildDoc :: Action ()
|
||||
stackBuildDoc = do
|
||||
execStackShake_ ["build", "hoogle"]
|
||||
execStackShake_ ["exec", "hoogle", "generate"]
|
||||
|
||||
-- | short help message is printed by default
|
||||
shortHelpMessage :: Action ()
|
||||
shortHelpMessage = do
|
||||
hieVersions <- getHieVersions
|
||||
let out = liftIO . putStrLn
|
||||
scriptName <- liftIO getProgName
|
||||
out ""
|
||||
out "Usage:"
|
||||
out' ("stack " <> scriptName <> " <target>")
|
||||
out ""
|
||||
out "Targets:"
|
||||
mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions)
|
||||
out ""
|
||||
where
|
||||
out = liftIO . putStrLn
|
||||
out' = out . (" " ++)
|
||||
|
||||
spaces hieVersions = space (targets hieVersions)
|
||||
targets hieVersions =
|
||||
[ ("help", "Show help message including all targets")
|
||||
, emptyTarget
|
||||
, ( "build"
|
||||
, "Builds hie for all supported GHC versions ("
|
||||
++ allVersionMessage hieVersions
|
||||
++ ")"
|
||||
)
|
||||
, stackBuildAllTarget
|
||||
-- , stackHieTarget mostRecentHieVersion
|
||||
, stackBuildDocTarget
|
||||
, stackHieTarget (last hieVersions)
|
||||
, emptyTarget
|
||||
, ( "cabal-ghcs"
|
||||
, "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`."
|
||||
)
|
||||
, cabalBuildTarget
|
||||
, cabalBuildAllTarget
|
||||
-- , cabalHieTarget mostRecentHieVersion
|
||||
, cabalBuildDocTarget
|
||||
, cabalHieTarget (last hieVersions)
|
||||
]
|
||||
|
||||
|
||||
helpMessage :: Action ()
|
||||
helpMessage = do
|
||||
|
||||
hieVersions <- getHieVersions
|
||||
scriptName <- liftIO getProgName
|
||||
out ""
|
||||
out "Usage:"
|
||||
out' ("stack " <> scriptName <> " <target>")
|
||||
out ""
|
||||
out "Targets:"
|
||||
mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions)
|
||||
out ""
|
||||
where
|
||||
out = liftIO . putStrLn
|
||||
out' = out . (" " ++)
|
||||
|
||||
spaces hieVersions = space (targets hieVersions)
|
||||
-- All targets the shake file supports
|
||||
targets :: [VersionNumber] -> [(String, String)]
|
||||
targets hieVersions = intercalate
|
||||
[emptyTarget]
|
||||
[ generalTargets
|
||||
, stackTargets hieVersions
|
||||
, cabalTargets hieVersions
|
||||
, macosTargets
|
||||
]
|
||||
|
||||
-- All targets with their respective help message.
|
||||
generalTargets =
|
||||
[ ("help", "Show help message including all targets")
|
||||
, ( "cabal"
|
||||
, "Makes sure that Cabal the lib is available for cabal-helper-wapper, to speed up project start"
|
||||
)
|
||||
]
|
||||
|
||||
macosTargets = [("icu-macos-fix", "Fixes icu related problems in MacOS")]
|
||||
|
||||
stackTargets hieVersions =
|
||||
[ ( "build"
|
||||
, "Builds hie for all supported GHC versions ("
|
||||
++ allVersionMessage hieVersions
|
||||
++ ")"
|
||||
)
|
||||
, stackBuildAllTarget
|
||||
, stackBuildDocTarget
|
||||
, ("test", "Runs hie tests with stack")
|
||||
]
|
||||
++ map stackHieTarget hieVersions
|
||||
|
||||
cabalTargets hieVersions =
|
||||
[ ( "cabal-ghcs"
|
||||
, "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`."
|
||||
)
|
||||
, cabalBuildTarget
|
||||
, cabalBuildAllTarget
|
||||
, cabalBuildDocTarget
|
||||
, ("cabal-test", "Runs hie tests with cabal")
|
||||
]
|
||||
++ map cabalHieTarget hieVersions
|
||||
|
||||
-- | Empty target. Purpose is to introduce a newline between the targets
|
||||
emptyTarget :: (String, String)
|
||||
emptyTarget = ("", "")
|
||||
|
||||
-- | Number of spaces the target name including whitespace should have.
|
||||
-- At least twenty, maybe more if target names are long. At most the length of the longest target plus five.
|
||||
space :: [(String, String)] -> Int
|
||||
space phonyTargets = maximum (20 : map ((+ 5) . length . fst) phonyTargets)
|
||||
|
||||
-- | Show a target.
|
||||
-- Concatenates the target with its help message and inserts whitespace between them.
|
||||
showTarget :: Int -> (String, String) -> String
|
||||
showTarget spaces (target, msg) =
|
||||
target ++ replicate (spaces - length target) ' ' ++ msg
|
||||
|
||||
-- | Target for a specific ghc version
|
||||
stackHieTarget :: String -> (String, String)
|
||||
stackHieTarget version =
|
||||
( "hie-" ++ version
|
||||
, "Builds hie for GHC version " ++ version ++ " only with stack"
|
||||
)
|
||||
|
||||
-- | Target for a specific ghc version
|
||||
cabalHieTarget :: String -> (String, String)
|
||||
cabalHieTarget version =
|
||||
( "cabal-hie-" ++ version
|
||||
, "Builds hie for GHC version " ++ version ++ " only with cabal new-build"
|
||||
)
|
||||
|
||||
stackBuildDocTarget :: (String, String)
|
||||
stackBuildDocTarget = ("build-doc", "Builds the Hoogle database")
|
||||
|
||||
stackBuildAllTarget :: (String, String)
|
||||
stackBuildAllTarget =
|
||||
( "build-all"
|
||||
, "Builds hie for all supported GHC versions and the hoogle database"
|
||||
)
|
||||
|
||||
cabalBuildTarget :: (String, String)
|
||||
cabalBuildTarget =
|
||||
("cabal-build", "Builds hie with cabal with all installed GHCs.")
|
||||
|
||||
cabalBuildDocTarget :: (String, String)
|
||||
cabalBuildDocTarget =
|
||||
("cabal-build-doc", "Builds the Hoogle database with cabal")
|
||||
|
||||
cabalBuildAllTarget :: (String, String)
|
||||
cabalBuildAllTarget =
|
||||
( "cabal-build-all"
|
||||
, "Builds hie for all installed GHC versions and the hoogle database with cabal"
|
||||
)
|
||||
|
||||
-- | Creates a message of the form "a, b, c and d", where a,b,c,d are GHC versions.
|
||||
-- If there is no GHC in the list of `hieVersions`
|
||||
allVersionMessage :: [String] -> String
|
||||
allVersionMessage wordList = case wordList of
|
||||
[] -> ""
|
||||
[a] -> show a
|
||||
(a : as) ->
|
||||
let msg = intersperse ", " wordList
|
||||
lastVersion = last msg
|
||||
in concat $ (init $ init msg) ++ [" and ", lastVersion]
|
||||
|
||||
|
||||
-- RUN EXECUTABLES
|
||||
|
||||
-- | Execute a stack command for a specified ghc, discarding the output
|
||||
execStackWithGhc_ :: VersionNumber -> [String] -> Action ()
|
||||
execStackWithGhc_ versionNumber args = do
|
||||
let stackFile = "stack-" ++ versionNumber ++ ".yaml"
|
||||
command_ [] "stack" (("--stack-yaml=" ++ stackFile) : args)
|
||||
|
||||
-- | Execute a stack command for a specified ghc
|
||||
execStackWithGhc :: CmdResult r => VersionNumber -> [String] -> Action r
|
||||
execStackWithGhc versionNumber args = do
|
||||
let stackFile = "stack-" ++ versionNumber ++ ".yaml"
|
||||
command [] "stack" (("--stack-yaml=" ++ stackFile) : args)
|
||||
|
||||
-- | Execute a stack command with the same resolver as the build script
|
||||
execStackShake :: CmdResult r => [String] -> Action r
|
||||
execStackShake args =
|
||||
command [] "stack" ("--stack-yaml=shake.yaml" : args)
|
||||
|
||||
-- | Execute a stack command with the same resolver as the build script, discarding the output
|
||||
execStackShake_ :: [String] -> Action ()
|
||||
execStackShake_ args =
|
||||
command_ [] "stack" ("--stack-yaml=shake.yaml" : args)
|
||||
|
||||
execCabal :: CmdResult r => [String] -> Action r
|
||||
execCabal =
|
||||
command [] "cabal"
|
||||
|
||||
execCabal_ :: [String] -> Action ()
|
||||
execCabal_ = command_ [] "cabal"
|
||||
|
||||
existsExecutable :: MonadIO m => String -> m Bool
|
||||
existsExecutable executable = liftIO $ isJust <$> findExecutable executable
|
||||
|
||||
|
||||
-- QUERY ENVIRONMENT
|
||||
|
||||
-- |Check if the current system is windows
|
||||
isWindowsSystem :: Bool
|
||||
isWindowsSystem = os `elem` ["mingw32", "win32"]
|
||||
|
||||
-- | Get the path to the GHC compiler executable linked to the local `stack-$GHCVER.yaml`.
|
||||
-- Equal to the command `stack path --stack-yaml $stack-yaml --compiler-exe`.
|
||||
-- This might install a GHC if it is not already installed, thus, might fail if stack fails to install the GHC.
|
||||
getStackGhcPath :: VersionNumber -> Action GhcPath
|
||||
getStackGhcPath ghcVersion = do
|
||||
Stdout ghc <- execStackWithGhc ghcVersion ["path", "--compiler-exe"]
|
||||
return $ trim ghc
|
||||
|
||||
getStackGhcPathShake :: Action GhcPath
|
||||
getStackGhcPathShake = do
|
||||
Stdout ghc <- execStackShake ["path", "--compiler-exe"]
|
||||
return $ trim ghc
|
||||
|
||||
-- | Get the path to a GHC that has the version specified by `VersionNumber`
|
||||
-- If no such GHC can be found, Nothing is returned.
|
||||
-- First, it is checked whether there is a GHC with the name `ghc-$VersionNumber`.
|
||||
-- If this yields no result, it is checked, whether the numeric-version of the `ghc`
|
||||
-- command fits to the desired version.
|
||||
getGhcPath :: MonadIO m => VersionNumber -> m (Maybe GhcPath)
|
||||
getGhcPath ghcVersion = liftIO $
|
||||
findExecutable ("ghc-" ++ ghcVersion) >>= \case
|
||||
Nothing -> do
|
||||
findExecutable "ghc" >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just p -> do
|
||||
Stdout version <- cmd p ["--numeric-version"] :: IO (Stdout String)
|
||||
if ghcVersion == trim version then return $ Just p else return Nothing
|
||||
p -> return p
|
||||
|
||||
-- | Read the local install root of the stack project specified by the VersionNumber
|
||||
-- Returns the filepath of the local install root.
|
||||
-- Equal to the command `stack path --local-install-root`
|
||||
getLocalInstallRoot :: VersionNumber -> Action FilePath
|
||||
getLocalInstallRoot hieVersion = do
|
||||
Stdout localInstallRoot' <- execStackWithGhc
|
||||
hieVersion
|
||||
["path", "--local-install-root"]
|
||||
return $ trim localInstallRoot'
|
||||
|
||||
-- | Get the local binary path of stack.
|
||||
-- Equal to the command `stack path --local-bin`
|
||||
getLocalBin :: Action FilePath
|
||||
getLocalBin = do
|
||||
Stdout stackLocalDir' <- execStackShake
|
||||
["path", "--local-bin"]
|
||||
return $ trim stackLocalDir'
|
||||
|
||||
-- | Trim the end of a string
|
||||
trim :: String -> String
|
||||
trim = dropWhileEnd isSpace
|
||||
|
||||
-- | Embed a string within two lines of stars to improve perceivability and, thus, readability.
|
||||
embedInStars :: String -> String
|
||||
embedInStars str =
|
||||
let starsLine
|
||||
= "\n******************************************************************\n"
|
||||
in starsLine <> str <> starsLine
|
||||
|
||||
-- |Stack build fails message
|
||||
stackBuildFailMsg :: String
|
||||
stackBuildFailMsg =
|
||||
embedInStars
|
||||
$ "Building failed, "
|
||||
++ "Try running `stack clean` and restart the build\n"
|
||||
++ "If this does not work, open an issue at \n"
|
||||
++ "\thttps://github.com/haskell/haskell-ide-engine"
|
||||
|
||||
-- | No suitable ghc version has been found. Show a message.
|
||||
ghcVersionNotFoundFailMsg :: VersionNumber -> String
|
||||
ghcVersionNotFoundFailMsg versionNumber =
|
||||
"No GHC with version "
|
||||
<> versionNumber
|
||||
<> " has been found.\n"
|
||||
<> "Either install a fitting GHC, use the stack targets or modify the PATH variable accordingly."
|
||||
|
||||
-- | Error message when a windows system tries to install HIE via `cabal new-install`
|
||||
cabalInstallNotSuportedFailMsg :: String
|
||||
cabalInstallNotSuportedFailMsg =
|
||||
"This system has been identified as a windows system.\n"
|
||||
++ "Unfortunately, `cabal new-install` is currently not supported on windows.\n"
|
||||
++ "Please use one of the stack-based targets.\n\n"
|
||||
++ "If this system has been falsely identified, please open an issue at:\n\thttps://github.com/haskell/haskell-ide-engine\n"
|
||||
|
||||
-- | Error message when the `stack` binary is an older version
|
||||
stackExeIsOldFailMsg :: String -> String
|
||||
stackExeIsOldFailMsg stackVersion =
|
||||
"The `stack` executable is outdated.\n"
|
||||
++ "found version is `" ++ stackVersion ++ "`.\n"
|
||||
++ "required version is `" ++ showVersion (makeVersion requiredStackVersion) ++ "`.\n"
|
||||
++ "Please run `stack upgrade` to upgrade your stack installation"
|
||||
|
||||
requiredStackVersion :: [Int]
|
||||
requiredStackVersion = [1, 9, 3]
|
||||
main = defaultMain
|
||||
|
2
install/Setup.hs
Normal file
2
install/Setup.hs
Normal file
@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
2
install/cabal.project
Normal file
2
install/cabal.project
Normal file
@ -0,0 +1,2 @@
|
||||
packages:
|
||||
./
|
37
install/hie-install.cabal
Normal file
37
install/hie-install.cabal
Normal file
@ -0,0 +1,37 @@
|
||||
name: hie-install
|
||||
version: 0.8.0.0
|
||||
synopsis: Install the haskell-ide-engine
|
||||
license: BSD3
|
||||
author: Many, TBD when we release
|
||||
maintainer: samuel.pilz@posteo.net
|
||||
copyright: 2019
|
||||
build-type: Simple
|
||||
cabal-version: >=2.0
|
||||
|
||||
library
|
||||
hs-source-dirs: src
|
||||
exposed-modules: HieInstall
|
||||
other-modules: BuildSystem
|
||||
, Stack
|
||||
, Version
|
||||
, Cabal
|
||||
, Print
|
||||
, Env
|
||||
, Help
|
||||
build-depends: base >= 4.9 && < 5
|
||||
, shake == 0.17.8
|
||||
, directory
|
||||
, extra
|
||||
, text
|
||||
default-extensions: LambdaCase
|
||||
, TupleSections
|
||||
, RecordWildCards
|
||||
default-language: Haskell2010
|
||||
|
||||
if flag(run-from-stack)
|
||||
cpp-options: -DRUN_FROM_STACK
|
||||
|
||||
flag run-from-stack
|
||||
description: Inform the application that it is run from stack
|
||||
default: False
|
||||
manual: True
|
2
install/shake.project
Normal file
2
install/shake.project
Normal file
@ -0,0 +1,2 @@
|
||||
packages:
|
||||
install/
|
@ -1,7 +1,11 @@
|
||||
# Used to provide a different environment for the shake build script
|
||||
resolver: nightly-2018-12-15 # GHC 8.6.2
|
||||
resolver: lts-13.18 # GHC 8.6.4
|
||||
packages:
|
||||
- .
|
||||
|
||||
nix:
|
||||
packages: [ zlib ]
|
||||
|
||||
flags:
|
||||
hie-install:
|
||||
run-from-stack: true
|
17
install/src/BuildSystem.hs
Normal file
17
install/src/BuildSystem.hs
Normal file
@ -0,0 +1,17 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module BuildSystem where
|
||||
|
||||
buildSystem :: String
|
||||
buildSystem =
|
||||
#if RUN_FROM_STACK
|
||||
"stack"
|
||||
#else
|
||||
"cabal"
|
||||
#endif
|
||||
|
||||
isRunFromStack :: Bool
|
||||
isRunFromStack = buildSystem == "stack"
|
||||
|
||||
isRunFromCabal :: Bool
|
||||
isRunFromCabal = buildSystem == "cabal"
|
108
install/src/Cabal.hs
Normal file
108
install/src/Cabal.hs
Normal file
@ -0,0 +1,108 @@
|
||||
module Cabal where
|
||||
|
||||
import Development.Shake
|
||||
import Development.Shake.Command
|
||||
import Development.Shake.FilePath
|
||||
import Control.Monad
|
||||
import Data.Maybe ( isNothing )
|
||||
import Control.Monad.Extra ( whenMaybe )
|
||||
import System.Directory ( findExecutable
|
||||
, copyFile
|
||||
)
|
||||
|
||||
import Version
|
||||
import Print
|
||||
import Env
|
||||
import Stack
|
||||
|
||||
|
||||
execCabal :: CmdResult r => [String] -> Action r
|
||||
execCabal = command [] "cabal"
|
||||
|
||||
execCabal_ :: [String] -> Action ()
|
||||
execCabal_ = command_ [] "cabal"
|
||||
|
||||
cabalBuildData :: Action ()
|
||||
cabalBuildData = do
|
||||
execCabal_ ["new-build", "hoogle"]
|
||||
execCabal_ ["new-exec", "hoogle", "generate"]
|
||||
|
||||
cabalBuildHie :: VersionNumber -> Action ()
|
||||
cabalBuildHie versionNumber = do
|
||||
ghcPath <- getGhcPathOf versionNumber >>= \case
|
||||
Nothing -> do
|
||||
printInStars $ ghcVersionNotFoundFailMsg versionNumber
|
||||
error (ghcVersionNotFoundFailMsg versionNumber)
|
||||
Just p -> return p
|
||||
execCabal_
|
||||
["new-build", "-w", ghcPath, "--write-ghc-environment-files=never", "--max-backjumps=5000"]
|
||||
|
||||
cabalInstallHie :: VersionNumber -> Action ()
|
||||
cabalInstallHie versionNumber = do
|
||||
localBin <- getLocalBin
|
||||
execCabal_
|
||||
[ "new-install"
|
||||
, "--write-ghc-environment-files=never"
|
||||
, "--symlink-bindir=" ++ localBin
|
||||
, "exe:hie"
|
||||
, "--overwrite-policy=always"
|
||||
]
|
||||
liftIO $ do
|
||||
copyFile (localBin </> "hie" <.> exe)
|
||||
(localBin </> "hie-" ++ versionNumber <.> exe)
|
||||
copyFile (localBin </> "hie" <.> exe)
|
||||
(localBin </> "hie-" ++ dropExtension versionNumber <.> exe)
|
||||
|
||||
installCabal :: Action ()
|
||||
installCabal = do
|
||||
-- try to find existing `cabal` executable with appropriate version
|
||||
cabalExe <- liftIO (findExecutable "cabal") >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just cabalExe -> do
|
||||
cabalVersion <- trimmedStdout <$> execCabal ["--numeric-version"]
|
||||
whenMaybe (checkVersion requiredCabalVersion cabalVersion)
|
||||
$ return cabalExe
|
||||
|
||||
-- install `cabal-install` if not already installed
|
||||
when (isNothing cabalExe) $ execStackShake_ ["install", "cabal-install"]
|
||||
|
||||
-- | check `stack` has the required version
|
||||
checkCabal :: Action ()
|
||||
checkCabal = do
|
||||
cabalVersion <- trimmedStdout <$> execCabal ["--numeric-version"]
|
||||
unless (checkVersion requiredCabalVersion cabalVersion) $ do
|
||||
printInStars $ cabalInstallIsOldFailMsg cabalVersion
|
||||
error $ stackExeIsOldFailMsg cabalVersion
|
||||
|
||||
getCabalVersion :: Action String
|
||||
getCabalVersion = trimmedStdout <$> execCabal ["--numeric-version"]
|
||||
|
||||
-- TODO: this restriction will be gone in the next release of cabal
|
||||
validateCabalNewInstallIsSupported :: Action ()
|
||||
validateCabalNewInstallIsSupported = when isWindowsSystem $ do
|
||||
printInStars cabalInstallNotSuportedFailMsg
|
||||
error cabalInstallNotSuportedFailMsg
|
||||
|
||||
-- | Error message when a windows system tries to install HIE via `cabal new-install`
|
||||
cabalInstallNotSuportedFailMsg :: String
|
||||
cabalInstallNotSuportedFailMsg =
|
||||
"This system has been identified as a windows system.\n"
|
||||
++ "Unfortunately, `cabal new-install` is currently not supported on windows.\n"
|
||||
++ "Please use one of the stack-based targets.\n\n"
|
||||
++ "If this system has been falsely identified, please open an issue at:\n\thttps://github.com/haskell/haskell-ide-engine\n"
|
||||
|
||||
|
||||
-- | Error message when the `stack` binary is an older version
|
||||
cabalInstallIsOldFailMsg :: String -> String
|
||||
cabalInstallIsOldFailMsg cabalVersion =
|
||||
"The `cabal` executable is outdated.\n"
|
||||
++ "found version is `"
|
||||
++ cabalVersion
|
||||
++ "`.\n"
|
||||
++ "required version is `"
|
||||
++ versionToString requiredCabalVersion
|
||||
++ "`."
|
||||
|
||||
|
||||
requiredCabalVersion :: RequiredVersion
|
||||
requiredCabalVersion = [2, 4, 1, 0]
|
111
install/src/Env.hs
Normal file
111
install/src/Env.hs
Normal file
@ -0,0 +1,111 @@
|
||||
module Env where
|
||||
|
||||
import Development.Shake
|
||||
import Development.Shake.Command
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad
|
||||
import Development.Shake.FilePath
|
||||
import System.Info ( os
|
||||
, arch
|
||||
)
|
||||
import Data.Maybe ( isJust )
|
||||
import System.Directory ( findExecutable
|
||||
, findExecutables
|
||||
, listDirectory
|
||||
)
|
||||
import Data.Function ( (&)
|
||||
, on
|
||||
)
|
||||
import Data.List ( sort
|
||||
, isInfixOf
|
||||
, nubBy
|
||||
)
|
||||
import Control.Monad.Extra ( mapMaybeM )
|
||||
import Data.Maybe ( isNothing
|
||||
, mapMaybe
|
||||
)
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Version
|
||||
import Print
|
||||
|
||||
|
||||
type GhcPath = String
|
||||
|
||||
existsExecutable :: MonadIO m => String -> m Bool
|
||||
existsExecutable executable = liftIO $ isJust <$> findExecutable executable
|
||||
|
||||
|
||||
-- | Check if the current system is windows
|
||||
isWindowsSystem :: Bool
|
||||
isWindowsSystem = os `elem` ["mingw32", "win32"]
|
||||
|
||||
findInstalledGhcs :: IO [(VersionNumber, GhcPath)]
|
||||
findInstalledGhcs = do
|
||||
hieVersions <- getHieVersions :: IO [VersionNumber]
|
||||
knownGhcs <- mapMaybeM
|
||||
(\version -> getGhcPathOf version >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just p -> return $ Just (version, p)
|
||||
)
|
||||
(reverse hieVersions)
|
||||
availableGhcs <- getGhcPaths
|
||||
return
|
||||
-- nub by version. knownGhcs takes precedence.
|
||||
$ nubBy ((==) `on` fst)
|
||||
-- filter out stack provided GHCs
|
||||
$ filter (not . isInfixOf ".stack" . snd) (knownGhcs ++ availableGhcs)
|
||||
|
||||
-- | Get the path to a GHC that has the version specified by `VersionNumber`
|
||||
-- If no such GHC can be found, Nothing is returned.
|
||||
-- First, it is checked whether there is a GHC with the name `ghc-$VersionNumber`.
|
||||
-- If this yields no result, it is checked, whether the numeric-version of the `ghc`
|
||||
-- command fits to the desired version.
|
||||
getGhcPathOf :: MonadIO m => VersionNumber -> m (Maybe GhcPath)
|
||||
getGhcPathOf ghcVersion =
|
||||
liftIO $ findExecutable ("ghc-" ++ ghcVersion) >>= \case
|
||||
Nothing -> lookup ghcVersion <$> getGhcPaths
|
||||
path -> return path
|
||||
|
||||
-- | Get a list of GHCs that are available in $PATH
|
||||
getGhcPaths :: MonadIO m => m [(VersionNumber, GhcPath)]
|
||||
getGhcPaths = liftIO $ do
|
||||
paths <- findExecutables "ghc"
|
||||
forM paths $ \path -> do
|
||||
Stdout version <- cmd path ["--numeric-version"]
|
||||
return (trim version, path)
|
||||
|
||||
-- | No suitable ghc version has been found. Show a message.
|
||||
ghcVersionNotFoundFailMsg :: VersionNumber -> String
|
||||
ghcVersionNotFoundFailMsg versionNumber =
|
||||
"No GHC with version "
|
||||
<> versionNumber
|
||||
<> " has been found.\n"
|
||||
<> "Either install a fitting GHC, use the stack targets or modify the PATH variable accordingly."
|
||||
|
||||
|
||||
-- | Defines all different hie versions that are buildable.
|
||||
--
|
||||
-- The current directory is scanned for `stack-*.yaml` files.
|
||||
-- On windows, `8.6.3` is excluded as this version of ghc does not work there
|
||||
getHieVersions :: MonadIO m => m [VersionNumber]
|
||||
getHieVersions = do
|
||||
let stackYamlPrefix = T.pack "stack-"
|
||||
let stackYamlSuffix = T.pack ".yaml"
|
||||
files <- liftIO $ listDirectory "."
|
||||
let hieVersions =
|
||||
files
|
||||
& map T.pack
|
||||
& mapMaybe
|
||||
(T.stripPrefix stackYamlPrefix >=> T.stripSuffix stackYamlSuffix)
|
||||
& map T.unpack
|
||||
-- the following line excludes `8.6.3` on windows systems
|
||||
& filter (\p -> not isWindowsSystem || p /= "8.6.3")
|
||||
& sort
|
||||
return hieVersions
|
||||
|
||||
|
||||
-- | Most recent version of hie.
|
||||
-- Shown in the more concise help message.
|
||||
mostRecentHieVersion :: MonadIO m => m VersionNumber
|
||||
mostRecentHieVersion = last <$> getHieVersions
|
148
install/src/Help.hs
Normal file
148
install/src/Help.hs
Normal file
@ -0,0 +1,148 @@
|
||||
-- |Module for Help messages and traget descriptions
|
||||
module Help where
|
||||
|
||||
import Development.Shake
|
||||
import Data.List ( intersperse
|
||||
, intercalate
|
||||
)
|
||||
|
||||
import Env
|
||||
import Print
|
||||
import Version
|
||||
import BuildSystem
|
||||
|
||||
printUsage :: Action ()
|
||||
printUsage = do
|
||||
printLine ""
|
||||
printLine "Usage:"
|
||||
printLineIndented ("stack install.hs <target>")
|
||||
printLineIndented "or"
|
||||
printLineIndented ("cabal new-run install.hs --project-file shake.project <target>")
|
||||
|
||||
-- | short help message is printed by default
|
||||
shortHelpMessage :: Action ()
|
||||
shortHelpMessage = do
|
||||
hieVersions <- getHieVersions
|
||||
printUsage
|
||||
printLine ""
|
||||
printLine "Targets:"
|
||||
mapM_ (printLineIndented . showTarget (spaces hieVersions)) (targets hieVersions)
|
||||
printLine ""
|
||||
where
|
||||
spaces hieVersions = space (targets hieVersions)
|
||||
targets hieVersions =
|
||||
[ ("help", "Show help message including all targets")
|
||||
, emptyTarget
|
||||
, buildTarget
|
||||
, buildAllTarget
|
||||
, hieTarget $ last hieVersions
|
||||
, buildDataTarget
|
||||
, cabalGhcsTarget
|
||||
]
|
||||
|
||||
-- | A record that specifies for each build system which versions of @hie@ can be built.
|
||||
data BuildableVersions = BuildableVersions
|
||||
{ stackVersions :: [VersionNumber]
|
||||
, cabalVersions :: [VersionNumber]
|
||||
}
|
||||
|
||||
getDefaultBuildSystemVersions :: BuildableVersions -> [VersionNumber]
|
||||
getDefaultBuildSystemVersions BuildableVersions {..}
|
||||
| isRunFromStack = stackVersions
|
||||
| isRunFromCabal = cabalVersions
|
||||
| otherwise = error $ "unknown build system: " ++ buildSystem
|
||||
|
||||
helpMessage :: BuildableVersions -> Action ()
|
||||
helpMessage versions@BuildableVersions {..} = do
|
||||
printUsage
|
||||
printLine ""
|
||||
printLine "Targets:"
|
||||
mapM_ (printLineIndented . showTarget spaces) targets
|
||||
printLine ""
|
||||
where
|
||||
spaces = space targets
|
||||
-- All targets the shake file supports
|
||||
targets :: [(String, String)]
|
||||
targets = intercalate
|
||||
[emptyTarget]
|
||||
[ generalTargets
|
||||
, defaultTargets
|
||||
, stackTargets
|
||||
, cabalTargets
|
||||
, [macosIcuTarget]
|
||||
]
|
||||
|
||||
-- All targets with their respective help message.
|
||||
generalTargets = [helpTarget]
|
||||
|
||||
defaultTargets = [buildTarget, buildAllTarget, buildDataTarget]
|
||||
++ map hieTarget (getDefaultBuildSystemVersions versions)
|
||||
|
||||
stackTargets =
|
||||
[ stackTarget buildTarget
|
||||
, stackTarget buildAllTarget
|
||||
, stackTarget buildDataTarget
|
||||
]
|
||||
++ map (stackTarget . hieTarget) stackVersions
|
||||
|
||||
cabalTargets =
|
||||
[ cabalGhcsTarget
|
||||
, cabalTarget buildTarget
|
||||
, cabalTarget buildAllTarget
|
||||
, cabalTarget buildDataTarget
|
||||
]
|
||||
++ map (cabalTarget . hieTarget) cabalVersions
|
||||
|
||||
-- | Empty target. Purpose is to introduce a newline between the targets
|
||||
emptyTarget :: (String, String)
|
||||
emptyTarget = ("", "")
|
||||
|
||||
targetWithBuildSystem :: String -> TargetDescription -> TargetDescription
|
||||
targetWithBuildSystem system (target, description) =
|
||||
(system ++ "-" ++ target, description ++ "; with " ++ system)
|
||||
|
||||
stackTarget :: TargetDescription -> TargetDescription
|
||||
stackTarget = targetWithBuildSystem "stack"
|
||||
|
||||
cabalTarget :: TargetDescription -> TargetDescription
|
||||
cabalTarget = targetWithBuildSystem "cabal"
|
||||
|
||||
hieTarget :: String -> TargetDescription
|
||||
hieTarget version =
|
||||
("hie-" ++ version, "Builds hie for GHC version " ++ version)
|
||||
|
||||
buildTarget :: TargetDescription
|
||||
buildTarget = ("build", "Builds hie with all installed GHCs")
|
||||
|
||||
buildDataTarget :: TargetDescription
|
||||
buildDataTarget =
|
||||
("build-data", "Get the required data-files for `hie` (Hoogle DB)")
|
||||
|
||||
buildAllTarget :: TargetDescription
|
||||
buildAllTarget =
|
||||
("build-all", "Builds hie for all installed GHC versions and the data files")
|
||||
|
||||
-- speical targets
|
||||
|
||||
macosIcuTarget :: TargetDescription
|
||||
macosIcuTarget = ("icu-macos-fix", "Fixes icu related problems in MacOS")
|
||||
|
||||
helpTarget :: TargetDescription
|
||||
helpTarget = ("help", "Show help message including all targets")
|
||||
|
||||
cabalGhcsTarget :: TargetDescription
|
||||
cabalGhcsTarget =
|
||||
( "cabal-ghcs"
|
||||
, "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`."
|
||||
)
|
||||
|
||||
-- | Creates a message of the form "a, b, c and d", where a,b,c,d are GHC versions.
|
||||
-- If there is no GHC in the list of `hieVersions`
|
||||
allVersionMessage :: [String] -> String
|
||||
allVersionMessage wordList = case wordList of
|
||||
[] -> ""
|
||||
[a] -> show a
|
||||
(a : as) ->
|
||||
let msg = intersperse ", " wordList
|
||||
lastVersion = last msg
|
||||
in concat $ init (init msg) ++ [" and ", lastVersion]
|
147
install/src/HieInstall.hs
Normal file
147
install/src/HieInstall.hs
Normal file
@ -0,0 +1,147 @@
|
||||
module HieInstall where
|
||||
|
||||
import Development.Shake
|
||||
import Development.Shake.Command
|
||||
import Development.Shake.FilePath
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Extra ( unlessM
|
||||
, mapMaybeM
|
||||
)
|
||||
import Data.Maybe ( isJust )
|
||||
import System.Directory ( listDirectory )
|
||||
import System.Environment ( unsetEnv )
|
||||
import System.Info ( os
|
||||
, arch
|
||||
)
|
||||
|
||||
import Data.Maybe ( isNothing
|
||||
, mapMaybe
|
||||
)
|
||||
import Data.List ( dropWhileEnd
|
||||
, intersperse
|
||||
, intercalate
|
||||
, sort
|
||||
, sortOn
|
||||
)
|
||||
import qualified Data.Text as T
|
||||
import Data.Char ( isSpace )
|
||||
import Data.Version ( parseVersion
|
||||
, makeVersion
|
||||
, showVersion
|
||||
)
|
||||
import Data.Function ( (&) )
|
||||
import Text.ParserCombinators.ReadP ( readP_to_S )
|
||||
|
||||
import BuildSystem
|
||||
import Stack
|
||||
import Cabal
|
||||
import Version
|
||||
import Print
|
||||
import Env
|
||||
import Help
|
||||
|
||||
defaultMain :: IO ()
|
||||
defaultMain = do
|
||||
-- unset GHC_PACKAGE_PATH for cabal
|
||||
unsetEnv "GHC_PACKAGE_PATH"
|
||||
|
||||
-- used for cabal-based targets
|
||||
ghcPaths <- findInstalledGhcs
|
||||
let ghcVersions = map fst ghcPaths
|
||||
|
||||
-- used for stack-based targets
|
||||
hieVersions <- getHieVersions
|
||||
|
||||
let versions = BuildableVersions { stackVersions = hieVersions
|
||||
, cabalVersions = ghcVersions
|
||||
}
|
||||
|
||||
putStrLn $ "run from: " ++ buildSystem
|
||||
|
||||
shakeArgs shakeOptions { shakeFiles = "_build" } $ do
|
||||
want ["short-help"]
|
||||
-- general purpose targets
|
||||
phony "submodules" updateSubmodules
|
||||
phony "cabal" installCabal
|
||||
phony "short-help" shortHelpMessage
|
||||
phony "all" shortHelpMessage
|
||||
phony "help" (helpMessage versions)
|
||||
phony "check-stack" checkStack
|
||||
phony "check-cabal" checkCabal
|
||||
|
||||
phony "cabal-ghcs" $ do
|
||||
let
|
||||
msg =
|
||||
"Found the following GHC paths: \n"
|
||||
++ unlines
|
||||
(map (\(version, path) -> "ghc-" ++ version ++ ": " ++ path)
|
||||
ghcPaths
|
||||
)
|
||||
printInStars msg
|
||||
|
||||
-- default-targets
|
||||
phony "build" $ need [buildSystem ++ "-build"]
|
||||
phony "build-all" $ need [buildSystem ++ "-build-all"]
|
||||
phony "build-data" $ need [buildSystem ++ "-build-data"]
|
||||
forM_
|
||||
(getDefaultBuildSystemVersions versions)
|
||||
(\version ->
|
||||
phony ("hie-" ++ version) $ need [buildSystem ++ "-hie-" ++ version]
|
||||
)
|
||||
|
||||
-- stack specific targets
|
||||
phony "stack-build" (need (reverse $ map ("hie-" ++) hieVersions))
|
||||
phony "stack-build-all" (need ["build-data", "build"])
|
||||
phony "stack-build-data" $ do
|
||||
need ["submodules"]
|
||||
need ["check-stack"]
|
||||
stackBuildData
|
||||
forM_
|
||||
hieVersions
|
||||
(\version -> phony ("stack-hie-" ++ version) $ do
|
||||
need ["submodules"]
|
||||
need ["check-stack"]
|
||||
need ["cabal"]
|
||||
stackBuildHie version
|
||||
stackInstallHie version
|
||||
)
|
||||
|
||||
-- cabal specific targets
|
||||
phony "cabal-build" (need (map ("cabal-hie-" ++) ghcVersions))
|
||||
phony "cabal-build-all" (need ["cabal-build-data", "cabal-build"])
|
||||
phony "cabal-build-data" $ do
|
||||
need ["submodules"]
|
||||
need ["cabal"]
|
||||
cabalBuildData
|
||||
forM_
|
||||
ghcVersions
|
||||
(\version -> phony ("cabal-hie-" ++ version) $ do
|
||||
validateCabalNewInstallIsSupported
|
||||
need ["submodules"]
|
||||
need ["cabal"]
|
||||
cabalBuildHie version
|
||||
cabalInstallHie version
|
||||
)
|
||||
|
||||
-- macos specific targets
|
||||
phony "icu-macos-fix"
|
||||
(need ["icu-macos-fix-install"] >> need ["icu-macos-fix-build"])
|
||||
phony "icu-macos-fix-install" (command_ [] "brew" ["install", "icu4c"])
|
||||
phony "icu-macos-fix-build" $ mapM_ buildIcuMacosFix hieVersions
|
||||
|
||||
|
||||
buildIcuMacosFix :: VersionNumber -> Action ()
|
||||
buildIcuMacosFix version = execStackWithGhc_
|
||||
version
|
||||
[ "build"
|
||||
, "text-icu"
|
||||
, "--extra-lib-dirs=/usr/local/opt/icu4c/lib"
|
||||
, "--extra-include-dirs=/usr/local/opt/icu4c/include"
|
||||
]
|
||||
|
||||
-- | update the submodules that the project is in the state as required by the `stack.yaml` files
|
||||
updateSubmodules :: Action ()
|
||||
updateSubmodules = do
|
||||
command_ [] "git" ["submodule", "sync"]
|
||||
command_ [] "git" ["submodule", "update", "--init"]
|
47
install/src/Print.hs
Normal file
47
install/src/Print.hs
Normal file
@ -0,0 +1,47 @@
|
||||
module Print where
|
||||
|
||||
import Development.Shake
|
||||
import Development.Shake.Command
|
||||
import Control.Monad.IO.Class
|
||||
import Data.List ( dropWhileEnd
|
||||
, dropWhile
|
||||
)
|
||||
import Data.Char ( isSpace )
|
||||
|
||||
-- | lift putStrLn to MonadIO
|
||||
printLine :: MonadIO m => String -> m ()
|
||||
printLine = liftIO . putStrLn
|
||||
|
||||
-- | print a line prepended with 4 spaces
|
||||
printLineIndented :: MonadIO m => String -> m ()
|
||||
printLineIndented = printLine . (" " ++)
|
||||
|
||||
embedInStars :: String -> String
|
||||
embedInStars str =
|
||||
let starsLine = "\n" <> replicate 30 '*' <> "\n"
|
||||
in starsLine <> str <> starsLine
|
||||
|
||||
printInStars :: MonadIO m => String -> m ()
|
||||
printInStars = liftIO . putStrLn . embedInStars
|
||||
|
||||
|
||||
-- | Trim whitespace of both ends of a string
|
||||
trim :: String -> String
|
||||
trim = dropWhileEnd isSpace . dropWhile isSpace
|
||||
|
||||
-- | Trim the whitespace of the stdout of a command
|
||||
trimmedStdout :: Stdout String -> String
|
||||
trimmedStdout (Stdout s) = trim s
|
||||
|
||||
type TargetDescription = (String, String)
|
||||
|
||||
-- | Number of spaces the target name including whitespace should have.
|
||||
-- At least twenty, maybe more if target names are long. At most the length of the longest target plus five.
|
||||
space :: [TargetDescription] -> Int
|
||||
space phonyTargets = maximum (20 : map ((+ 5) . length . fst) phonyTargets)
|
||||
|
||||
-- | Show a target.
|
||||
-- Concatenates the target with its help message and inserts whitespace between them.
|
||||
showTarget :: Int -> TargetDescription -> String
|
||||
showTarget spaces (target, msg) =
|
||||
target ++ replicate (spaces - length target) ' ' ++ msg
|
98
install/src/Stack.hs
Normal file
98
install/src/Stack.hs
Normal file
@ -0,0 +1,98 @@
|
||||
module Stack where
|
||||
|
||||
import Development.Shake
|
||||
import Development.Shake.Command
|
||||
import Development.Shake.FilePath
|
||||
import Control.Monad
|
||||
import System.Directory ( copyFile )
|
||||
|
||||
import Version
|
||||
import Print
|
||||
import Env
|
||||
|
||||
|
||||
stackBuildHie :: VersionNumber -> Action ()
|
||||
stackBuildHie versionNumber = execStackWithGhc_ versionNumber ["build"]
|
||||
`actionOnException` liftIO (putStrLn stackBuildFailMsg)
|
||||
|
||||
-- | copy the built binaries into the localBinDir
|
||||
stackInstallHie :: VersionNumber -> Action ()
|
||||
stackInstallHie versionNumber = do
|
||||
execStackWithGhc_ versionNumber ["install"]
|
||||
localBinDir <- getLocalBin
|
||||
let hie = "hie" <.> exe
|
||||
liftIO $ do
|
||||
copyFile (localBinDir </> hie)
|
||||
(localBinDir </> "hie-" ++ versionNumber <.> exe)
|
||||
copyFile (localBinDir </> hie)
|
||||
(localBinDir </> "hie-" ++ dropExtension versionNumber <.> exe)
|
||||
|
||||
buildCopyCompilerTool :: VersionNumber -> Action ()
|
||||
buildCopyCompilerTool versionNumber =
|
||||
execStackWithGhc_ versionNumber ["build", "--copy-compiler-tool"]
|
||||
|
||||
|
||||
-- | check `stack` has the required version
|
||||
checkStack :: Action ()
|
||||
checkStack = do
|
||||
stackVersion <- trimmedStdout <$> execStackShake ["--numeric-version"]
|
||||
unless (checkVersion requiredStackVersion stackVersion) $ do
|
||||
printInStars $ stackExeIsOldFailMsg stackVersion
|
||||
error $ stackExeIsOldFailMsg stackVersion
|
||||
|
||||
-- | Get the local binary path of stack.
|
||||
-- Equal to the command `stack path --local-bin`
|
||||
getLocalBin :: Action FilePath
|
||||
getLocalBin = do
|
||||
Stdout stackLocalDir' <- execStackShake ["path", "--local-bin"]
|
||||
return $ trim stackLocalDir'
|
||||
|
||||
stackBuildData :: Action ()
|
||||
stackBuildData = do
|
||||
execStackShake_ ["build", "hoogle"]
|
||||
execStackShake_ ["exec", "hoogle", "generate"]
|
||||
|
||||
-- | Execute a stack command for a specified ghc, discarding the output
|
||||
execStackWithGhc_ :: VersionNumber -> [String] -> Action ()
|
||||
execStackWithGhc_ versionNumber args = do
|
||||
let stackFile = "stack-" ++ versionNumber ++ ".yaml"
|
||||
command_ [] "stack" (("--stack-yaml=" ++ stackFile) : args)
|
||||
|
||||
-- | Execute a stack command for a specified ghc
|
||||
execStackWithGhc :: CmdResult r => VersionNumber -> [String] -> Action r
|
||||
execStackWithGhc versionNumber args = do
|
||||
let stackFile = "stack-" ++ versionNumber ++ ".yaml"
|
||||
command [] "stack" (("--stack-yaml=" ++ stackFile) : args)
|
||||
|
||||
-- | Execute a stack command with the same resolver as the build script
|
||||
execStackShake :: CmdResult r => [String] -> Action r
|
||||
execStackShake args = command [] "stack" ("--stack-yaml=install/shake.yaml" : args)
|
||||
|
||||
-- | Execute a stack command with the same resolver as the build script, discarding the output
|
||||
execStackShake_ :: [String] -> Action ()
|
||||
execStackShake_ args = command_ [] "stack" ("--stack-yaml=install/shake.yaml" : args)
|
||||
|
||||
|
||||
-- | Error message when the `stack` binary is an older version
|
||||
stackExeIsOldFailMsg :: String -> String
|
||||
stackExeIsOldFailMsg stackVersion =
|
||||
"The `stack` executable is outdated.\n"
|
||||
++ "found version is `"
|
||||
++ stackVersion
|
||||
++ "`.\n"
|
||||
++ "required version is `"
|
||||
++ versionToString requiredStackVersion
|
||||
++ "`.\n"
|
||||
++ "Please run `stack upgrade` to upgrade your stack installation"
|
||||
|
||||
requiredStackVersion :: RequiredVersion
|
||||
requiredStackVersion = [1, 9, 3]
|
||||
|
||||
-- |Stack build fails message
|
||||
stackBuildFailMsg :: String
|
||||
stackBuildFailMsg =
|
||||
embedInStars
|
||||
$ "Building failed, "
|
||||
++ "Try running `stack clean` and restart the build\n"
|
||||
++ "If this does not work, open an issue at \n"
|
||||
++ "\thttps://github.com/haskell/haskell-ide-engine"
|
24
install/src/Version.hs
Normal file
24
install/src/Version.hs
Normal file
@ -0,0 +1,24 @@
|
||||
module Version where
|
||||
|
||||
import Data.Version ( Version
|
||||
, parseVersion
|
||||
, makeVersion
|
||||
, showVersion
|
||||
)
|
||||
import Text.ParserCombinators.ReadP ( readP_to_S )
|
||||
import Control.Monad.IO.Class
|
||||
|
||||
|
||||
type VersionNumber = String
|
||||
type RequiredVersion = [Int]
|
||||
|
||||
versionToString :: RequiredVersion -> String
|
||||
versionToString = showVersion . makeVersion
|
||||
|
||||
-- | Parse a version-string into a version. Fails if the version-string is not valid
|
||||
parseVersionEx :: String -> Version
|
||||
parseVersionEx = fst . head . filter (("" ==) . snd) . readP_to_S parseVersion
|
||||
|
||||
-- | Check that a given version-string is not smaller than the required version
|
||||
checkVersion :: RequiredVersion -> String -> Bool
|
||||
checkVersion required given = parseVersionEx given >= makeVersion required
|
@ -32,7 +32,7 @@ handleCodeActionReq :: TrackingNumber -> J.CodeActionRequest -> R ()
|
||||
handleCodeActionReq tn req = do
|
||||
|
||||
vfsFunc <- asksLspFuncs Core.getVirtualFileFunc
|
||||
docVersion <- fmap _version <$> liftIO (vfsFunc docUri)
|
||||
docVersion <- fmap _version <$> liftIO (vfsFunc (J.toNormalizedUri docUri))
|
||||
let docId = J.VersionedTextDocumentIdentifier docUri docVersion
|
||||
|
||||
let getProvider p = pluginCodeActionProvider p <*> return (pluginId p)
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
@ -25,7 +26,11 @@ import Haskell.Ide.Engine.PluginUtils
|
||||
import Language.Haskell.Exts.SrcLoc
|
||||
import Language.Haskell.Exts.Parser
|
||||
import Language.Haskell.Exts.Extension
|
||||
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0)))
|
||||
import Language.Haskell.HLint4 as Hlint
|
||||
#else
|
||||
import Language.Haskell.HLint3 as Hlint
|
||||
#endif
|
||||
import qualified Language.Haskell.LSP.Types as LSP
|
||||
import qualified Language.Haskell.LSP.Types.Lens as LSP
|
||||
import Refact.Apply
|
||||
|
@ -15,6 +15,7 @@ import Data.Maybe
|
||||
import Data.Semigroup
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Versions as V
|
||||
import Development.GitRev (gitCommitCount)
|
||||
import Distribution.System (buildArch)
|
||||
import Distribution.Text (display)
|
||||
@ -126,14 +127,34 @@ getProjectGhcVersion = do
|
||||
then tryCommand "ghc --numeric-version"
|
||||
else return "No System GHC found"
|
||||
|
||||
tryCommand cmd =
|
||||
init <$> readCreateProcess (shell cmd) ""
|
||||
|
||||
tryCommand :: String -> IO String
|
||||
tryCommand cmd =
|
||||
init <$> readCreateProcess (shell cmd) ""
|
||||
|
||||
hieGhcVersion :: String
|
||||
hieGhcVersion = VERSION_ghc
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
getStackVersion :: IO (Maybe V.Version)
|
||||
getStackVersion = do
|
||||
isStackInstalled <- isJust <$> findExecutable "stack"
|
||||
if isStackInstalled
|
||||
then do
|
||||
versionStr <- tryCommand "stack --numeric-version"
|
||||
case V.version (T.pack versionStr) of
|
||||
Left _err -> return Nothing
|
||||
Right v -> return (Just v)
|
||||
else return Nothing
|
||||
|
||||
stack193Version :: V.Version
|
||||
stack193Version = case V.version "1.9.3" of
|
||||
Left err -> error $ "stack193Version:err=" ++ show err
|
||||
Right v -> v
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
checkCabalInstall :: IO Bool
|
||||
checkCabalInstall = isJust <$> findExecutable "cabal"
|
||||
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Haskell.Ide.Engine.Plugin.Hoogle where
|
||||
@ -5,6 +7,7 @@ module Haskell.Ide.Engine.Plugin.Hoogle where
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad (join)
|
||||
import Control.Exception
|
||||
import Control.Applicative (liftA2)
|
||||
import Data.Aeson
|
||||
import Data.Bifunctor
|
||||
import Data.Maybe
|
||||
@ -44,10 +47,10 @@ hoogleDescriptor plId = PluginDescriptor
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
data HoogleError
|
||||
data HoogleError
|
||||
= NoDb
|
||||
| DbFail T.Text
|
||||
| NoResults
|
||||
| NoResults
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
newtype HoogleDb = HoogleDb (Maybe FilePath)
|
||||
@ -97,11 +100,16 @@ infoCmd = CmdSync $ \expr -> do
|
||||
infoCmd' :: T.Text -> IdeM (Either HoogleError T.Text)
|
||||
infoCmd' expr = do
|
||||
HoogleDb mdb <- get
|
||||
liftIO $ runHoogleQuery mdb expr $ \res ->
|
||||
if null res then
|
||||
Left NoResults
|
||||
else
|
||||
return $ T.pack $ targetInfo $ head res
|
||||
liftIO $ runHoogleQuery mdb expr $ \case
|
||||
[] -> Left NoResults
|
||||
h:_ -> return $ renderTargetInfo h
|
||||
|
||||
renderTargetInfo :: Target -> T.Text
|
||||
renderTargetInfo t =
|
||||
T.intercalate "\n"
|
||||
$ ["```haskell\n" <> unHTML (T.pack $ targetItem t) <> "\n```"]
|
||||
++ [renderDocs $ targetDocs t]
|
||||
++ [T.pack $ curry annotate "More info" $ targetURL t]
|
||||
|
||||
-- | Command to get the prettified documentation of an hoogle identifier.
|
||||
-- Identifier should be understandable for hoogle.
|
||||
@ -115,11 +123,9 @@ infoCmd' expr = do
|
||||
infoCmdFancyRender :: T.Text -> IdeM (Either HoogleError T.Text)
|
||||
infoCmdFancyRender expr = do
|
||||
HoogleDb mdb <- get
|
||||
liftIO $ runHoogleQuery mdb expr $ \res ->
|
||||
if null res then
|
||||
Left NoResults
|
||||
else
|
||||
return $ renderTarget $ head res
|
||||
liftIO $ runHoogleQuery mdb expr $ \case
|
||||
[] -> Left NoResults
|
||||
h:_ -> return $ renderTarget h
|
||||
|
||||
-- | Render the target in valid markdown.
|
||||
-- Transform haddock documentation into markdown.
|
||||
@ -131,18 +137,29 @@ renderTarget t = T.intercalate "\n" $
|
||||
++ [renderDocs $ targetDocs t]
|
||||
++ [T.pack $ curry annotate "More info" $ targetURL t]
|
||||
where mdl = map annotate $ catMaybes [targetPackage t, targetModule t]
|
||||
annotate (thing,url) = "["<>thing++"]"++"("++url++")"
|
||||
unHTML = T.replace "<0>" "" . innerText . parseTags
|
||||
renderDocs = T.concat . map htmlToMarkDown . parseTree . T.pack
|
||||
htmlToMarkDown :: TagTree T.Text -> T.Text
|
||||
htmlToMarkDown (TagLeaf x) = fromMaybe "" $ maybeTagText x
|
||||
htmlToMarkDown (TagBranch "i" _ tree) = "*" <> T.concat (map htmlToMarkDown tree) <> "*"
|
||||
htmlToMarkDown (TagBranch "b" _ tree) = "**" <> T.concat (map htmlToMarkDown tree) <> "**"
|
||||
htmlToMarkDown (TagBranch "a" _ tree) = "`" <> T.concat (map htmlToMarkDown tree) <> "`"
|
||||
htmlToMarkDown (TagBranch "li" _ tree) = "- " <> T.concat (map htmlToMarkDown tree)
|
||||
htmlToMarkDown (TagBranch "tt" _ tree) = "`" <> innerText (flattenTree tree) <> "`"
|
||||
htmlToMarkDown (TagBranch "pre" _ tree) = "```haskell\n" <> T.concat (map htmlToMarkDown tree) <> "```"
|
||||
htmlToMarkDown (TagBranch _ _ tree) = T.concat $ map htmlToMarkDown tree
|
||||
|
||||
annotate :: (String, String) -> String
|
||||
annotate (thing,url) = "["<>thing<>"]"<>"("<>url<>")"
|
||||
|
||||
-- | Hoogle results contain html like tags.
|
||||
-- We remove them with `tagsoup` here.
|
||||
-- So, if something hoogle related shows html tags,
|
||||
-- then maybe this function is responsible.
|
||||
unHTML :: T.Text -> T.Text
|
||||
unHTML = T.replace "<0>" "" . innerText . parseTags
|
||||
|
||||
renderDocs :: String -> T.Text
|
||||
renderDocs = T.concat . map htmlToMarkDown . parseTree . T.pack
|
||||
|
||||
htmlToMarkDown :: TagTree T.Text -> T.Text
|
||||
htmlToMarkDown (TagLeaf x) = fromMaybe "" $ maybeTagText x
|
||||
htmlToMarkDown (TagBranch "i" _ tree) = "*" <> T.concat (map htmlToMarkDown tree) <> "*"
|
||||
htmlToMarkDown (TagBranch "b" _ tree) = "**" <> T.concat (map htmlToMarkDown tree) <> "**"
|
||||
htmlToMarkDown (TagBranch "a" _ tree) = "`" <> T.concat (map htmlToMarkDown tree) <> "`"
|
||||
htmlToMarkDown (TagBranch "li" _ tree) = "- " <> T.concat (map htmlToMarkDown tree)
|
||||
htmlToMarkDown (TagBranch "tt" _ tree) = "`" <> innerText (flattenTree tree) <> "`"
|
||||
htmlToMarkDown (TagBranch "pre" _ tree) = "```haskell\n" <> T.concat (map htmlToMarkDown tree) <> "```"
|
||||
htmlToMarkDown (TagBranch _ _ tree) = T.concat $ map htmlToMarkDown tree
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
@ -152,7 +169,21 @@ renderTarget t = T.intercalate "\n" $
|
||||
-- If an error occurs, such as no hoogle database has been found,
|
||||
-- or the search term has no match, an empty list will be returned.
|
||||
searchModules :: T.Text -> IdeM [T.Text]
|
||||
searchModules = fmap (nub . take 5) . searchTargets (fmap (T.pack . fst) . targetModule)
|
||||
searchModules = fmap (map fst) . searchModules'
|
||||
|
||||
-- | Just like 'searchModules', but includes the signature of the search term
|
||||
-- that has been found in the module.
|
||||
searchModules' :: T.Text -> IdeM [(T.Text, T.Text)]
|
||||
searchModules' = fmap (take 5 . nub) . searchTargets retrieveModuleAndSignature
|
||||
where
|
||||
retrieveModuleAndSignature :: Target -> Maybe (T.Text, T.Text)
|
||||
retrieveModuleAndSignature target = liftA2 (,) (packModuleName target) (packSymbolSignature target)
|
||||
|
||||
packModuleName :: Target -> Maybe T.Text
|
||||
packModuleName = fmap (T.pack . fst) . targetModule
|
||||
|
||||
packSymbolSignature :: Target -> Maybe T.Text
|
||||
packSymbolSignature = Just . unHTML . T.pack . targetItem
|
||||
|
||||
-- | Search for packages that satisfy the given search text.
|
||||
-- Will return at most five, unique results.
|
||||
@ -160,7 +191,7 @@ searchModules = fmap (nub . take 5) . searchTargets (fmap (T.pack . fst) . targe
|
||||
-- If an error occurs, such as no hoogle database has been found,
|
||||
-- or the search term has no match, an empty list will be returned.
|
||||
searchPackages :: T.Text -> IdeM [T.Text]
|
||||
searchPackages = fmap (nub . take 5) . searchTargets (fmap (T.pack . fst) . targetPackage)
|
||||
searchPackages = fmap (take 5 . nub) . searchTargets (fmap (T.pack . fst) . targetPackage)
|
||||
|
||||
-- | Search for Targets that fit to the given Text and satisfy the given predicate.
|
||||
-- Limits the amount of matches to at most ten.
|
||||
|
@ -1,7 +1,6 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
module Haskell.Ide.Engine.Plugin.HsImport where
|
||||
|
||||
@ -9,8 +8,6 @@ import Control.Lens.Operators
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad
|
||||
import Data.Aeson
|
||||
import Data.Bitraversable
|
||||
import Data.Bifunctor
|
||||
import Data.Foldable
|
||||
import Data.Maybe
|
||||
import Data.Monoid ( (<>) )
|
||||
@ -28,6 +25,7 @@ import qualified Haskell.Ide.Engine.Plugin.Hoogle
|
||||
as Hoogle
|
||||
import System.Directory
|
||||
import System.IO
|
||||
import qualified Safe as S
|
||||
|
||||
hsimportDescriptor :: PluginId -> PluginDescriptor
|
||||
hsimportDescriptor plId = PluginDescriptor
|
||||
@ -42,19 +40,82 @@ hsimportDescriptor plId = PluginDescriptor
|
||||
, pluginFormattingProvider = Nothing
|
||||
}
|
||||
|
||||
-- | Type of the symbol to import.
|
||||
-- Important to offer the correct import list, or hiding code action.
|
||||
data SymbolType
|
||||
= Symbol -- ^ Symbol is a simple function
|
||||
| Constructor -- ^ Symbol is a constructor
|
||||
| Type -- ^ Symbol is a type
|
||||
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
|
||||
|
||||
|
||||
-- | What of the symbol should be taken.
|
||||
-- Import a simple symbol, or a value constructor.
|
||||
data SymbolKind
|
||||
= Only SymbolName -- ^ Only the symbol should be taken
|
||||
| OneOf DatatypeName SymbolName -- ^ Some constructors or methods of the symbol should be taken: Symbol(X)
|
||||
| AllOf DatatypeName -- ^ All constructors or methods of the symbol should be taken: Symbol(..)
|
||||
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
|
||||
|
||||
-- | Disambiguates between an import action and an hiding action.
|
||||
-- Can be used to determine suggestion tpye from ghc-mod,
|
||||
-- e.g. whether ghc-mod suggests to hide an identifier or to import an identifier.
|
||||
-- Also important later, to know how the symbol shall be imported.
|
||||
data SymbolImport a
|
||||
= Import a -- ^ the symbol to import
|
||||
| Hiding a -- ^ the symbol to hide from the import
|
||||
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
|
||||
|
||||
|
||||
-- | Utility to retrieve the contents of the 'SymbolImport'.
|
||||
-- May never fail.
|
||||
extractSymbolImport :: SymbolImport a -> a
|
||||
extractSymbolImport (Hiding s) = s
|
||||
extractSymbolImport (Import s) = s
|
||||
|
||||
type ModuleName = T.Text
|
||||
type SymbolName = T.Text
|
||||
type DatatypeName = T.Text
|
||||
|
||||
-- | Wrapper for a FilePath that is used as an Input file for HsImport
|
||||
newtype InputFilePath = MkInputFilePath { getInput :: FilePath }
|
||||
|
||||
-- | Wrapper for a FilePath that is used as an Output file for HsImport
|
||||
newtype OutputFilePath = MkOutputFilePath { getOutput :: FilePath }
|
||||
|
||||
-- | How to import a module.
|
||||
-- Can be used to express to import a whole module or only specific symbols
|
||||
-- from a module.
|
||||
-- Is used to either hide symbols from an import or use an import-list to
|
||||
-- import only a specific symbol.
|
||||
data ImportStyle
|
||||
= Simple -- ^ Import the whole module
|
||||
| Complex (SymbolImport SymbolKind) -- ^ Complex operation, import module hiding symbols or import only selected symbols.
|
||||
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
|
||||
|
||||
-- | Contains information about the diagnostic, the symbol ghc-mod
|
||||
-- complained about and what the kind of the symbol is and whether
|
||||
-- to import or hide the symbol as suggested by ghc-mod.
|
||||
data ImportDiagnostic = ImportDiagnostic
|
||||
{ diagnostic :: J.Diagnostic
|
||||
, term :: SymbolName
|
||||
, termType :: SymbolImport SymbolType
|
||||
}
|
||||
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
|
||||
|
||||
-- | 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 -- ^ 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.
|
||||
{ file :: Uri -- ^ Uri to the file to import the module to.
|
||||
, importStyle :: ImportStyle -- ^ How to import the module
|
||||
, moduleToImport :: ModuleName -- ^ Name of the module to import.
|
||||
}
|
||||
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
|
||||
|
||||
importCmd :: CommandFunc ImportParams J.WorkspaceEdit
|
||||
importCmd = CmdSync $ \(ImportParams uri importList modName) ->
|
||||
importModule uri importList modName
|
||||
importCmd = CmdSync $ \(ImportParams uri style modName) ->
|
||||
importModule uri style modName
|
||||
|
||||
-- | Import the given module for the given file.
|
||||
-- May take an explicit function name to perform an import-list import.
|
||||
@ -62,8 +123,8 @@ importCmd = CmdSync $ \(ImportParams uri importList modName) ->
|
||||
-- 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 =
|
||||
:: Uri -> ImportStyle -> ModuleName -> IdeGhcM (IdeResult J.WorkspaceEdit)
|
||||
importModule uri impStyle modName =
|
||||
pluginGetFile "hsimport cmd: " uri $ \origInput -> do
|
||||
shouldFormat <- formatOnImportOn <$> getConfig
|
||||
|
||||
@ -74,13 +135,13 @@ importModule uri importList modName =
|
||||
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
|
||||
}
|
||||
let args = importStyleToHsImportArgs
|
||||
(MkInputFilePath input)
|
||||
(MkOutputFilePath output)
|
||||
modName
|
||||
impStyle
|
||||
-- execute hsimport on the given file and write into a temporary file.
|
||||
maybeErr <- liftIO $ hsimportWithArgs defaultConfig args
|
||||
maybeErr <- liftIO $ HsImport.hsimportWithArgs HsImport.defaultConfig args
|
||||
case maybeErr of
|
||||
Just err -> do
|
||||
liftIO $ removeFile output
|
||||
@ -154,6 +215,49 @@ importModule uri importList modName =
|
||||
$ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges)
|
||||
else return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
|
||||
|
||||
-- | Convert the import style arguments into HsImport arguments.
|
||||
-- Takes an input and an output file as well as a module name.
|
||||
importStyleToHsImportArgs
|
||||
:: InputFilePath -> OutputFilePath -> ModuleName -> ImportStyle -> HsImport.HsImportArgs
|
||||
importStyleToHsImportArgs input output modName style =
|
||||
let defaultArgs = -- Default args, must be set every time.
|
||||
HsImport.defaultArgs { HsImport.moduleName = T.unpack modName
|
||||
, HsImport.inputSrcFile = getInput input
|
||||
, HsImport.outputSrcFile = getOutput output
|
||||
}
|
||||
|
||||
-- | Remove parenthesis for operators and infix operator cosntructors.
|
||||
-- HsImport demands it. E.g.
|
||||
-- > hsimport -m Data.Array.Repa -s :. -w :.
|
||||
-- import Data.Array.Repa ((:.)((:.)))
|
||||
--
|
||||
-- > hsimport -m Data.Function -s $
|
||||
-- import Data.Function (($))
|
||||
trimParenthesis :: T.Text -> T.Text
|
||||
trimParenthesis = T.dropAround isParenthesis
|
||||
|
||||
isParenthesis = (`elem` ['(', ')'])
|
||||
|
||||
kindToArgs :: SymbolKind -> HsImport.HsImportArgs
|
||||
kindToArgs kind = case kind of
|
||||
-- Only import a single symbol e.g. Data.Text (isPrefixOf)
|
||||
Only sym -> defaultArgs { HsImport.symbolName = T.unpack $ trimParenthesis sym }
|
||||
-- Import a constructor e.g. Data.Mabye (Maybe(Just))
|
||||
OneOf dt sym -> defaultArgs { HsImport.symbolName = T.unpack $ trimParenthesis dt
|
||||
, HsImport.with = [T.unpack $ trimParenthesis sym]
|
||||
}
|
||||
-- Import all constructors e.g. Data.Maybe (Maybe(..))
|
||||
AllOf dt -> defaultArgs { HsImport.symbolName = T.unpack $ trimParenthesis dt
|
||||
, HsImport.all = True
|
||||
}
|
||||
in case style of
|
||||
-- If the import style is simple, import thw whole module
|
||||
Simple -> defaultArgs
|
||||
Complex s -> case s of
|
||||
Hiding kind -> kindToArgs kind {- TODO: wait for hsimport version bump -}
|
||||
Import kind -> kindToArgs kind
|
||||
|
||||
|
||||
-- | 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.
|
||||
@ -189,31 +293,26 @@ codeActionProvider plId docId _ context = do
|
||||
--
|
||||
-- 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
|
||||
|
||||
concat <$> mapM (uncurry (termToActions style)) normalise
|
||||
:: SearchStyle -> [ImportDiagnostic] -> IdeM [J.CodeAction]
|
||||
importActionsForTerms style importDiagnostics = do
|
||||
let searchTerms = map (applySearchStyle style . term) importDiagnostics
|
||||
searchResults <- mapM Hoogle.searchModules' searchTerms
|
||||
let importTerms = zip searchResults importDiagnostics
|
||||
concat <$> mapM (uncurry (termToActions style)) importTerms
|
||||
|
||||
-- | 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
|
||||
applySearchStyle Exact termName = "is:exact " <> termName
|
||||
applySearchStyle ExactName termName = case T.words termName of
|
||||
[] -> termName
|
||||
(x : _) -> "is:exact " <> x
|
||||
applySearchStyle (Relax relax) term = relax term
|
||||
applySearchStyle (Relax relax) termName = relax termName
|
||||
|
||||
-- | Turn a search term with function name into Import Actions.
|
||||
-- Function name may be of only the exact phrase to import.
|
||||
-- | Turn a search term with function name into an Import Actions.
|
||||
-- The 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.
|
||||
--
|
||||
@ -225,61 +324,177 @@ codeActionProvider plId docId _ context = do
|
||||
-- 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)
|
||||
:: SearchStyle -> [(ModuleName, SymbolName)] -> ImportDiagnostic -> IdeM [J.CodeAction]
|
||||
termToActions style modules impDiagnostic =
|
||||
concat <$> mapM (uncurry (importModuleAction style impDiagnostic)) modules
|
||||
|
||||
-- | Creates various import actions for a module and the diagnostic.
|
||||
-- Possible import actions depend on the type of the symbol to import.
|
||||
-- It may be a 'Constructor', so the import actions need to be different
|
||||
-- to a simple function symbol.
|
||||
-- Thus, it may return zero, one or multiple import actions for a module.
|
||||
-- List of import actions does contain no duplicates.
|
||||
importModuleAction
|
||||
:: SearchStyle -> ImportDiagnostic -> ModuleName -> SymbolName -> IdeM [J.CodeAction]
|
||||
importModuleAction searchStyle impDiagnostic moduleName symbolTerm =
|
||||
catMaybes <$> sequenceA codeActions
|
||||
where
|
||||
importListActions :: [IdeM (Maybe J.CodeAction)]
|
||||
importListActions = case searchStyle of
|
||||
-- If the search has been relaxed by a custom function,
|
||||
-- we cant know how much the search query has been altered
|
||||
-- and how close the result terms are to the initial diagnostic.
|
||||
-- Thus, we cant offer more specific imports.
|
||||
Relax _ -> []
|
||||
_ -> catMaybes
|
||||
$ case extractSymbolImport $ termType impDiagnostic of
|
||||
-- If the term to import is a simple symbol, such as a function,
|
||||
-- import only this function
|
||||
Symbol
|
||||
-> [ mkImportAction moduleName impDiagnostic . Just . Only
|
||||
<$> symName symbolTerm
|
||||
]
|
||||
-- Constructors can be imported in two ways, either all
|
||||
-- constructors of a type or only a subset.
|
||||
-- We can only import a single constructor at a time though.
|
||||
Constructor
|
||||
-> [ mkImportAction moduleName impDiagnostic . Just . AllOf
|
||||
<$> datatypeName symbolTerm
|
||||
, (\dt sym -> mkImportAction moduleName impDiagnostic . Just
|
||||
$ OneOf dt sym)
|
||||
<$> datatypeName symbolTerm
|
||||
<*> symName symbolTerm
|
||||
]
|
||||
-- If we are looking for a type, import it as just a symbol
|
||||
Type
|
||||
-> [ mkImportAction moduleName impDiagnostic . Just . Only
|
||||
<$> symName symbolTerm]
|
||||
|
||||
-- | All code actions that may be available
|
||||
-- Currently, omits all
|
||||
codeActions :: [IdeM (Maybe J.CodeAction)]
|
||||
codeActions = case termType impDiagnostic of
|
||||
Hiding _ -> [] {- If we are hiding an import, we can not import
|
||||
a module hiding everything from it. -}
|
||||
Import _ -> [mkImportAction moduleName impDiagnostic Nothing]
|
||||
-- ^ Simple import, import the whole module
|
||||
++ importListActions
|
||||
|
||||
-- | Retrieve the function signature of a term such as
|
||||
-- >>> signatureOf "take :: Int -> [a] -> [a]"
|
||||
-- Just " Int -> [a] -> [a]"
|
||||
signatureOf :: T.Text -> Maybe T.Text
|
||||
signatureOf sig = do
|
||||
let parts = T.splitOn "::" sig
|
||||
typeSig <- S.tailMay parts
|
||||
S.headMay typeSig
|
||||
|
||||
-- | Retrieve the datatype name of a Constructor.
|
||||
--
|
||||
-- >>> datatypeName "Null :: Data.Aeson.Internal.Types.Value"
|
||||
-- Just "Value"
|
||||
--
|
||||
-- >>> datatypeName "take :: Int -> [a] -> [a]" -- Not a constructor
|
||||
-- Just "[a]"
|
||||
--
|
||||
-- >>> datatypeName "Just :: a -> Maybe a"
|
||||
-- Just "Maybe"
|
||||
--
|
||||
-- Thus, the result of this function only makes sense,
|
||||
-- if the symbol kind of the diagnostic term is of type 'Constructor'
|
||||
datatypeName :: T.Text -> Maybe T.Text
|
||||
datatypeName sig = do
|
||||
sig_ <- signatureOf sig
|
||||
let sigParts = T.splitOn "->" sig_
|
||||
lastPart <- S.lastMay sigParts
|
||||
let dtNameSig = T.words lastPart
|
||||
qualifiedDtName <- S.headMay dtNameSig
|
||||
let qualifiedDtNameParts = T.splitOn "." qualifiedDtName
|
||||
S.lastMay qualifiedDtNameParts
|
||||
|
||||
-- | Name of a symbol. May contain a function signature.
|
||||
--
|
||||
-- >>> symName "take :: Int -> [a] -> [a]"
|
||||
-- Just "take"
|
||||
--
|
||||
-- >>> symName "take"
|
||||
-- Just "take"
|
||||
symName :: T.Text -> Maybe SymbolName
|
||||
symName = S.headMay . T.words
|
||||
|
||||
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
|
||||
:: ModuleName -> ImportDiagnostic -> Maybe SymbolKind -> IdeM (Maybe J.CodeAction)
|
||||
mkImportAction modName importDiagnostic symbolType = do
|
||||
cmd <- mkLspCommand plId "import" title (Just cmdParams)
|
||||
return (Just (codeAction cmd))
|
||||
where
|
||||
where
|
||||
codeAction cmd = J.CodeAction title
|
||||
(Just J.CodeActionQuickFix)
|
||||
(Just (J.List [diag]))
|
||||
(Just (J.List [diagnostic importDiagnostic]))
|
||||
Nothing
|
||||
(Just cmd)
|
||||
title =
|
||||
"Import module "
|
||||
<> modName
|
||||
<> maybe "" (\name -> " (" <> name <> ")") importList
|
||||
cmdParams = [toJSON (ImportParams (docId ^. J.uri) importList modName)]
|
||||
title = "Import module "
|
||||
<> modName
|
||||
<> case termType importDiagnostic of
|
||||
Hiding _ -> "hiding"
|
||||
-- ^ Note, that it must never happen
|
||||
-- in combination with `symbolType == Nothing`
|
||||
Import _ -> ""
|
||||
<> case symbolType of
|
||||
Just s -> case s of
|
||||
Only sym -> " (" <> sym <> ")"
|
||||
AllOf dt -> " (" <> dt <> " (..))"
|
||||
OneOf dt sym -> " (" <> dt <> " (" <> sym <> "))"
|
||||
Nothing -> ""
|
||||
|
||||
importStyleParam :: ImportStyle
|
||||
importStyleParam = case symbolType of
|
||||
Nothing -> Simple
|
||||
Just k -> case termType importDiagnostic of
|
||||
Hiding _ -> Complex (Hiding k)
|
||||
Import _ -> Complex (Import k)
|
||||
|
||||
cmdParams = [toJSON (ImportParams (docId ^. J.uri) importStyleParam 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 :: J.Diagnostic -> Maybe ImportDiagnostic
|
||||
getImportables diag@(J.Diagnostic _ _ _ (Just "ghcmod") msg _) =
|
||||
(diag, ) <$> extractImportableTerm msg
|
||||
uncurry (ImportDiagnostic 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
|
||||
extractImportableTerm :: T.Text -> Maybe (T.Text, SymbolImport SymbolType)
|
||||
extractImportableTerm dirtyMsg = do
|
||||
(n, s) <- extractedTerm
|
||||
let n' = T.strip n
|
||||
return (n', s)
|
||||
where
|
||||
importMsg = S.headMay
|
||||
-- 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
|
||||
-- Get rid of trailing/leading whitespace on each individual line
|
||||
$ T.unlines
|
||||
$ map T.strip
|
||||
$ T.lines
|
||||
$ T.replace "• " "" dirtyMsg
|
||||
|
||||
extractedTerm = asum
|
||||
[ importMsg
|
||||
>>= T.stripPrefix "Variable not in scope: "
|
||||
>>= \name -> Just (name, Import Symbol)
|
||||
, importMsg
|
||||
>>= T.stripPrefix "Not in scope: type constructor or class ‘"
|
||||
>>= \name -> Just (T.init name, Import Type)
|
||||
, importMsg
|
||||
>>= T.stripPrefix "Data constructor not in scope: "
|
||||
>>= \name -> Just (name, Import Constructor)]
|
||||
|
||||
|
||||
|
@ -156,7 +156,7 @@ generateDiagnosics cb uri file = do
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- Find and run the liquid haskell executable
|
||||
-- | Find and run the liquid haskell executable
|
||||
runLiquidHaskell :: FilePath -> IO (Maybe (ExitCode,[String]))
|
||||
runLiquidHaskell fp = do
|
||||
mexe <- findExecutable "liquid"
|
||||
@ -168,13 +168,14 @@ runLiquidHaskell fp = do
|
||||
let cmd = lh ++ " --json \"" ++ fp ++ "\""
|
||||
dir = takeDirectory fp
|
||||
cp = (shell cmd) { cwd = Just dir }
|
||||
logm $ "runLiquidHaskell:cmd=[" ++ cmd ++ "]"
|
||||
-- logm $ "runLiquidHaskell:cmd=[" ++ cmd ++ "]"
|
||||
mpp <- lookupEnv "GHC_PACKAGE_PATH"
|
||||
-- logm $ "runLiquidHaskell:mpp=[" ++ show mpp ++ "]"
|
||||
(ec,o,e) <- bracket
|
||||
(unsetEnv "GHC_PACKAGE_PATH")
|
||||
(\_ -> mapM_ (setEnv "GHC_PACKAGE_PATH") mpp)
|
||||
(\_ -> readCreateProcessWithExitCode cp "")
|
||||
logm $ "runLiquidHaskell:v=" ++ show (ec,o,e)
|
||||
-- logm $ "runLiquidHaskell:v=" ++ show (ec,o,e)
|
||||
return $ Just (ec,[o,e])
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
@ -96,13 +96,16 @@ data CompItem = CI
|
||||
, importedFrom :: T.Text
|
||||
, thingType :: Maybe Type
|
||||
, label :: T.Text
|
||||
, isInfix :: Maybe Backtick
|
||||
}
|
||||
|
||||
data Backtick = Surrounded | LeftSide
|
||||
|
||||
instance Eq CompItem where
|
||||
(CI n1 _ _ _) == (CI n2 _ _ _) = n1 == n2
|
||||
ci1 == ci2 = origName ci1 == origName ci2
|
||||
|
||||
instance Ord CompItem where
|
||||
compare (CI n1 _ _ _) (CI n2 _ _ _) = compare n1 n2
|
||||
compare ci1 ci2 = origName ci1 `compare` origName ci2
|
||||
|
||||
occNameToComKind :: OccName -> J.CompletionItemKind
|
||||
occNameToComKind oc
|
||||
@ -118,16 +121,21 @@ mkQuery name importedFrom = name <> " module:" <> importedFrom
|
||||
<> " is:exact"
|
||||
|
||||
mkCompl :: CompItem -> J.CompletionItem
|
||||
mkCompl CI{origName,importedFrom,thingType,label} =
|
||||
mkCompl CI{origName,importedFrom,thingType,label,isInfix} =
|
||||
J.CompletionItem label kind (Just $ maybe "" (<>"\n") typeText <> importedFrom)
|
||||
Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet)
|
||||
Nothing Nothing Nothing Nothing hoogleQuery
|
||||
where kind = Just $ occNameToComKind $ occName origName
|
||||
hoogleQuery = Just $ toJSON $ mkQuery label importedFrom
|
||||
argTypes = maybe [] getArgs thingType
|
||||
insertText
|
||||
| [] <- argTypes = label
|
||||
| otherwise = label <> " " <> argText
|
||||
insertText = case isInfix of
|
||||
Nothing -> case argTypes of
|
||||
[] -> label
|
||||
_ -> label <> " " <> argText
|
||||
Just LeftSide -> label <> "`"
|
||||
|
||||
Just Surrounded -> label
|
||||
|
||||
argText :: T.Text
|
||||
argText = mconcat $ List.intersperse " " $ zipWith snippet [1..] argTypes
|
||||
stripForall t
|
||||
@ -217,17 +225,20 @@ instance ModuleCache CachedCompletions where
|
||||
|
||||
typeEnv = md_types $ snd $ tm_internals_ tm
|
||||
toplevelVars = mapMaybe safeTyThingId $ typeEnvElts typeEnv
|
||||
varToCompl var = CI name (showModName curMod) typ label
|
||||
|
||||
varToCompl :: Var -> CompItem
|
||||
varToCompl var = CI name (showModName curMod) typ label Nothing
|
||||
where
|
||||
typ = Just $ varType var
|
||||
name = Var.varName var
|
||||
label = T.pack $ showGhc name
|
||||
|
||||
toplevelCompls :: [CompItem]
|
||||
toplevelCompls = map varToCompl toplevelVars
|
||||
|
||||
toCompItem :: ModuleName -> Name -> CompItem
|
||||
toCompItem mn n =
|
||||
CI n (showModName mn) Nothing (T.pack $ showGhc n)
|
||||
CI n (showModName mn) Nothing (T.pack $ showGhc n) Nothing
|
||||
|
||||
allImportsInfo :: [(Bool, T.Text, ModuleName, Maybe (Bool, [Name]))]
|
||||
allImportsInfo = map getImpInfo importDeclerations
|
||||
@ -363,6 +374,26 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) =
|
||||
d = T.length fullLine - T.length (stripTypeStuff partialLine)
|
||||
in Position l (c - d)
|
||||
|
||||
hasTrailingBacktick =
|
||||
if T.length fullLine <= trailingBacktickIndex
|
||||
then False
|
||||
else (fullLine `T.index` trailingBacktickIndex) == '`'
|
||||
|
||||
trailingBacktickIndex = let Position _ cursorColumn = VFS.cursorPos prefixInfo in cursorColumn
|
||||
|
||||
isUsedAsInfix = if backtickIndex < 0
|
||||
then False
|
||||
else (fullLine `T.index` backtickIndex) == '`'
|
||||
|
||||
backtickIndex =
|
||||
let Position _ cursorColumn = VFS.cursorPos prefixInfo
|
||||
prefixLength = T.length prefixText
|
||||
moduleLength = if prefixModule == ""
|
||||
then 0
|
||||
else T.length prefixModule + 1 {- Because of "." -}
|
||||
in
|
||||
cursorColumn - (prefixLength + moduleLength) - 1 {- Points to the first letter of either the module or prefix text -}
|
||||
|
||||
filtModNameCompls =
|
||||
map mkModCompl
|
||||
$ mapMaybe (T.stripPrefix enteredQual)
|
||||
@ -372,13 +403,23 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) =
|
||||
where
|
||||
isTypeCompl = isTcOcc . occName . origName
|
||||
-- completions specific to the current context
|
||||
ctxCompls = case context of
|
||||
ctxCompls' = case context of
|
||||
TypeContext -> filter isTypeCompl compls
|
||||
ValueContext -> filter (not . isTypeCompl) compls
|
||||
-- Add whether the text to insert has backticks
|
||||
ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls'
|
||||
|
||||
infixCompls :: Maybe Backtick
|
||||
infixCompls = case (isUsedAsInfix, hasTrailingBacktick) of
|
||||
(True, False) -> Just LeftSide
|
||||
(True, True) -> Just Surrounded
|
||||
_ -> Nothing
|
||||
|
||||
compls = if T.null prefixModule
|
||||
then unqualCompls
|
||||
else Map.findWithDefault [] prefixModule qualCompls
|
||||
|
||||
|
||||
mkImportCompl label = (J.detail ?~ label) . mkModCompl $ fromMaybe
|
||||
""
|
||||
(T.stripPrefix enteredQual label)
|
||||
|
@ -102,7 +102,7 @@ data DiagnosticsRequest = DiagnosticsRequest
|
||||
, trackingNumber :: TrackingNumber
|
||||
-- ^ The tracking identifier for this request
|
||||
|
||||
, file :: J.Uri
|
||||
, file :: Uri
|
||||
-- ^ The file that was change and needs to be checked
|
||||
|
||||
, documentVersion :: J.TextDocumentVersion
|
||||
@ -127,7 +127,7 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do
|
||||
rin <- atomically newTChan :: IO (TChan ReactorInput)
|
||||
commandIds <- allLspCmdIds plugins
|
||||
|
||||
let dp lf = do
|
||||
let onStartup lf = do
|
||||
diagIn <- atomically newTChan
|
||||
let react = runReactor lf scheduler diagnosticProviders hps sps fps plugins
|
||||
reactorFunc = react $ reactor rin diagIn
|
||||
@ -184,8 +184,11 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do
|
||||
fps :: Map.Map PluginId FormattingProvider
|
||||
fps = Map.mapMaybe pluginFormattingProvider $ ipMap plugins
|
||||
|
||||
initCallbacks :: Core.InitializeCallbacks Config
|
||||
initCallbacks = Core.InitializeCallbacks getInitialConfig getConfigFromNotification onStartup
|
||||
|
||||
flip E.finally finalProc $ do
|
||||
CTRL.run (getConfigFromNotification, dp) (hieHandlers rin) (hieOptions commandIds) captureFp
|
||||
CTRL.run initCallbacks (hieHandlers rin) (hieOptions commandIds) captureFp
|
||||
where
|
||||
handlers = [E.Handler ioExcept, E.Handler someExcept]
|
||||
finalProc = L.removeAllHandlers
|
||||
@ -208,7 +211,7 @@ configVal field = field <$> getClientConfig
|
||||
getPrefixAtPos :: (MonadIO m, MonadReader REnv m)
|
||||
=> Uri -> Position -> m (Maybe Hie.PosPrefixInfo)
|
||||
getPrefixAtPos uri pos = do
|
||||
mvf <- liftIO =<< asksLspFuncs Core.getVirtualFileFunc <*> pure uri
|
||||
mvf <- liftIO =<< asksLspFuncs Core.getVirtualFileFunc <*> pure (J.toNormalizedUri uri)
|
||||
case mvf of
|
||||
Just vf -> VFS.getCompletionPrefix pos vf
|
||||
Nothing -> return Nothing
|
||||
@ -222,7 +225,13 @@ mapFileFromVfs :: (MonadIO m, MonadReader REnv m)
|
||||
mapFileFromVfs tn vtdi = do
|
||||
let uri = vtdi ^. J.uri
|
||||
ver = fromMaybe 0 (vtdi ^. J.version)
|
||||
req = GReq tn (Just uri) Nothing Nothing (const $ return ())
|
||||
vfsFunc <- asksLspFuncs Core.getVirtualFileFunc
|
||||
mvf <- liftIO $ vfsFunc (J.toNormalizedUri uri)
|
||||
case (mvf, uriToFilePath uri) of
|
||||
(Just (VFS.VirtualFile _ yitext _), Just fp) -> do
|
||||
let text' = Rope.toString yitext
|
||||
-- text = "{-# LINE 1 \"" ++ fp ++ "\"#-}\n" <> text'
|
||||
let req = GReq tn (Just uri) Nothing Nothing (const $ return ())
|
||||
$ IdeResultOk <$> do
|
||||
persistVirtualFile uri
|
||||
updateDocumentRequest uri ver req
|
||||
@ -308,7 +317,7 @@ updatePositionMap uri changes = pluginGetFile "updatePositionMap: " uri $ \file
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
publishDiagnostics :: (MonadIO m, MonadReader REnv m)
|
||||
=> Int -> J.Uri -> J.TextDocumentVersion -> DiagnosticsBySource -> m ()
|
||||
=> Int -> J.NormalizedUri -> J.TextDocumentVersion -> DiagnosticsBySource -> m ()
|
||||
publishDiagnostics maxToSend uri' mv diags = do
|
||||
lf <- asks lspFuncs
|
||||
liftIO $ Core.publishDiagnosticsFunc lf maxToSend uri' mv diags
|
||||
@ -798,7 +807,7 @@ reactor inp diagIn = do
|
||||
withDocumentContents :: J.LspId -> J.Uri -> (T.Text -> R ()) -> R ()
|
||||
withDocumentContents reqId uri f = do
|
||||
vfsFunc <- asksLspFuncs Core.getVirtualFileFunc
|
||||
mvf <- liftIO $ vfsFunc uri
|
||||
mvf <- liftIO $ vfsFunc (J.toNormalizedUri uri)
|
||||
lf <- asks lspFuncs
|
||||
case mvf of
|
||||
Nothing -> liftIO $
|
||||
@ -839,7 +848,7 @@ queueDiagnosticsRequest
|
||||
:: TChan DiagnosticsRequest -- ^ The channel to publish the diagnostics requests to
|
||||
-> DiagnosticTrigger
|
||||
-> TrackingNumber
|
||||
-> J.Uri
|
||||
-> Uri
|
||||
-> J.TextDocumentVersion
|
||||
-> R ()
|
||||
queueDiagnosticsRequest diagIn dt tn uri mVer =
|
||||
@ -870,11 +879,11 @@ requestDiagnostics DiagnosticsRequest{trigger, file, trackingNumber, documentVer
|
||||
maxToSend = maxNumberOfProblems clientConfig
|
||||
sendOne (fileUri,ds') = do
|
||||
debugm $ "LspStdio.sendone:(fileUri,ds')=" ++ show(fileUri,ds')
|
||||
publishDiagnosticsIO maxToSend fileUri Nothing (Map.fromList [(Just pid,SL.toSortedList ds')])
|
||||
publishDiagnosticsIO maxToSend (J.toNormalizedUri fileUri) Nothing (Map.fromList [(Just pid,SL.toSortedList ds')])
|
||||
|
||||
sendEmpty = do
|
||||
debugm "LspStdio.sendempty"
|
||||
publishDiagnosticsIO maxToSend file Nothing (Map.fromList [(Just pid,SL.toSortedList [])])
|
||||
publishDiagnosticsIO maxToSend (J.toNormalizedUri file) Nothing (Map.fromList [(Just pid,SL.toSortedList [])])
|
||||
|
||||
-- fv = case documentVersion of
|
||||
-- Nothing -> Nothing
|
||||
@ -902,7 +911,7 @@ requestDiagnostics DiagnosticsRequest{trigger, file, trackingNumber, documentVer
|
||||
when enabled $ makeRequest reql
|
||||
|
||||
-- | get hlint and GHC diagnostics and loads the typechecked module into the cache
|
||||
requestDiagnosticsNormal :: TrackingNumber -> J.Uri -> J.TextDocumentVersion -> R ()
|
||||
requestDiagnosticsNormal :: TrackingNumber -> Uri -> J.TextDocumentVersion -> R ()
|
||||
requestDiagnosticsNormal tn file mVer = do
|
||||
clientConfig <- getClientConfig
|
||||
let
|
||||
@ -910,18 +919,20 @@ requestDiagnosticsNormal tn file mVer = do
|
||||
|
||||
-- | If there is a GHC error, flush the hlint diagnostics
|
||||
-- TODO: Just flush the parse error diagnostics
|
||||
sendOneGhc :: J.DiagnosticSource -> (Uri, [Diagnostic]) -> R ()
|
||||
sendOneGhc :: J.DiagnosticSource -> (J.NormalizedUri, [Diagnostic]) -> R ()
|
||||
sendOneGhc pid (fileUri,ds) = do
|
||||
if any (hasSeverity J.DsError) ds
|
||||
then publishDiagnostics maxToSend fileUri Nothing
|
||||
(Map.fromList [(Just "hlint",SL.toSortedList []),(Just pid,SL.toSortedList ds)])
|
||||
else sendOne pid (fileUri,ds)
|
||||
|
||||
sendOne pid (fileUri,ds) = do
|
||||
publishDiagnostics maxToSend fileUri Nothing (Map.fromList [(Just pid,SL.toSortedList ds)])
|
||||
|
||||
hasSeverity :: J.DiagnosticSeverity -> J.Diagnostic -> Bool
|
||||
hasSeverity sev (J.Diagnostic _ (Just s) _ _ _ _) = s == sev
|
||||
hasSeverity _ _ = False
|
||||
sendEmpty = publishDiagnostics maxToSend file Nothing (Map.fromList [(Just "bios",SL.toSortedList [])])
|
||||
sendEmpty = publishDiagnostics maxToSend (J.toNormalizedUri file) Nothing (Map.fromList [(Just "bios",SL.toSortedList [])])
|
||||
maxToSend = maxNumberOfProblems clientConfig
|
||||
|
||||
let sendHlint = hlintOn clientConfig
|
||||
@ -930,7 +941,7 @@ requestDiagnosticsNormal tn file mVer = do
|
||||
let reql = GReq tn (Just file) (Just (file,ver)) Nothing callbackl
|
||||
$ ApplyRefact.lintCmd' file
|
||||
callbackl (PublishDiagnosticsParams fp (List ds))
|
||||
= sendOne "hlint" (fp, ds)
|
||||
= sendOne "hlint" (J.toNormalizedUri fp, ds)
|
||||
makeRequest reql
|
||||
|
||||
-- get GHC diagnostics and loads the typechecked module into the cache
|
||||
|
@ -1,45 +0,0 @@
|
||||
resolver: nightly-2017-11-24 # Last one for GHC 8.2.1
|
||||
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
|
||||
|
||||
# - 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.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0@rev:2
|
||||
- hlint-2.0.11
|
||||
- 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
|
||||
|
||||
flags:
|
||||
haskell-ide-engine:
|
||||
pedantic: true
|
||||
hie-plugin-api:
|
||||
pedantic: true
|
||||
|
||||
nix:
|
||||
packages: [ icu libcxx zlib ]
|
||||
|
||||
concurrent-tests: false
|
@ -5,13 +5,12 @@ packages:
|
||||
|
||||
extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
# - brittany-0.11.0.0
|
||||
- brittany-0.12.0.0
|
||||
- butcher-1.3.1.1
|
||||
- cabal-plan-0.3.0.0
|
||||
- conduit-parse-0.2.1.0
|
||||
@ -21,19 +20,21 @@ extra-deps:
|
||||
- ghc-exactprint-0.5.8.2
|
||||
- haddock-api-2.18.1
|
||||
- haddock-library-1.4.4
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0@rev:2
|
||||
- haskell-lsp-0.15.0.0
|
||||
- haskell-lsp-types-0.15.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.17 # last hlint supporting GHC 8.2
|
||||
- hoogle-5.0.17.6
|
||||
- hoogle-5.0.17.9
|
||||
- hsimport-0.8.8
|
||||
- lsp-test-0.5.2.3
|
||||
- lsp-test-0.6.0.0
|
||||
- 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
|
||||
# To make build work in windows 7
|
||||
- unix-time-0.4.7
|
||||
|
||||
flags:
|
||||
haskell-ide-engine:
|
||||
|
@ -5,34 +5,35 @@ packages:
|
||||
|
||||
extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
# - brittany-0.11.0.0
|
||||
- brittany-0.12.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
|
||||
- ghc-lib-parser-8.8.0.20190424
|
||||
- haddock-api-2.20.0
|
||||
- haddock-library-1.6.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0@rev:2
|
||||
- haskell-lsp-0.15.0.0
|
||||
- haskell-lsp-types-0.15.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hlint-2.2
|
||||
- hoogle-5.0.17.9
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- lsp-test-0.6.0.0
|
||||
- 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
|
||||
# To make build work in windows 7
|
||||
- unix-time-0.4.7
|
||||
- windns-0.1.0.0
|
||||
- yaml-0.8.32
|
||||
- yi-rope-0.11
|
||||
|
@ -5,32 +5,34 @@ packages:
|
||||
|
||||
extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- base-compat-0.9.3
|
||||
- brittany-0.12.0.0
|
||||
- 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
|
||||
- ghc-lib-parser-8.8.0.20190424
|
||||
- haddock-api-2.20.0
|
||||
- haddock-library-1.6.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0@rev:2
|
||||
- haskell-lsp-0.15.0.0
|
||||
- haskell-lsp-types-0.15.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hlint-2.2
|
||||
- hoogle-5.0.17.9
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- lsp-test-0.6.0.0
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- pretty-show-1.8.2
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
# To make build work in windows 7
|
||||
- unix-time-0.4.7
|
||||
- temporary-1.2.1.1
|
||||
|
||||
flags:
|
||||
|
@ -5,33 +5,34 @@ packages:
|
||||
|
||||
extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
# - brittany-0.11.0.0
|
||||
- brittany-0.12.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
|
||||
- ghc-lib-parser-8.8.0.20190424
|
||||
- haddock-api-2.20.0
|
||||
- haddock-library-1.6.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- haskell-lsp-0.15.0.0
|
||||
- haskell-lsp-types-0.15.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hlint-2.2
|
||||
- hoogle-5.0.17.9
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- lsp-test-0.6.0.0
|
||||
- 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
|
||||
# To make build work in windows 7
|
||||
- unix-time-0.4.7
|
||||
- temporary-1.2.1.1
|
||||
|
||||
flags:
|
||||
|
@ -5,13 +5,13 @@ packages:
|
||||
|
||||
extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- apply-refact-0.6.0.0
|
||||
- brittany-0.12.0.0
|
||||
- butcher-1.3.2.1
|
||||
- cabal-install-2.4.0.0
|
||||
- cabal-plan-0.4.0.0
|
||||
@ -19,16 +19,16 @@ extra-deps:
|
||||
- czipwith-1.0.1.1
|
||||
- data-tree-print-0.1.0.2
|
||||
- floskell-0.10.0
|
||||
- ghc-lib-parser-0.20190523
|
||||
- ghc-lib-parser-8.8.0.20190424
|
||||
- haddock-api-2.21.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- haskell-lsp-0.15.0.0
|
||||
- haskell-lsp-types-0.15.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hlint-2.2
|
||||
- hoogle-5.0.17.9
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- lsp-test-0.6.0.0
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- monad-memo-0.4.1
|
||||
- monoid-subclasses-0.4.6.1
|
||||
@ -38,6 +38,8 @@ extra-deps:
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
# To make build work in windows 7
|
||||
- unix-time-0.4.7
|
||||
- yaml-0.8.32
|
||||
|
||||
flags:
|
||||
|
@ -5,32 +5,34 @@ packages:
|
||||
|
||||
extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- brittany-0.12.0.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
|
||||
- ghc-lib-parser-8.8.0.20190424
|
||||
- haddock-api-2.21.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- haskell-lsp-0.15.0.0
|
||||
- haskell-lsp-types-0.15.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hlint-2.2
|
||||
- hoogle-5.0.17.9
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- lsp-test-0.6.0.0
|
||||
- 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
|
||||
# To make build work in windows 7
|
||||
- unix-time-0.4.7
|
||||
- yaml-0.8.32
|
||||
|
||||
flags:
|
||||
|
@ -6,27 +6,27 @@ packages:
|
||||
|
||||
extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- bytestring-trie-0.2.5.0
|
||||
- brittany-0.12.0.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
|
||||
- ghc-lib-parser-8.8.0.20190424
|
||||
- haddock-api-2.21.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- haskell-lsp-0.15.0.0
|
||||
- haskell-lsp-types-0.15.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- haskell-src-exts-util-0.2.5
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hlint-2.2
|
||||
- hoogle-5.0.17.9
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- lsp-test-0.6.0.0
|
||||
- monad-dijkstra-0.1.1.2
|
||||
- monad-memo-0.4.1
|
||||
- multistate-0.8.0.1
|
||||
@ -34,6 +34,8 @@ extra-deps:
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- syz-0.2.0.0
|
||||
- temporary-1.2.1.1
|
||||
# To make build work in windows 7
|
||||
- unix-time-0.4.7
|
||||
- yaml-0.8.32
|
||||
|
||||
flags:
|
||||
|
@ -6,31 +6,33 @@ packages:
|
||||
|
||||
extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/ghc-mod
|
||||
- ./submodules/ghc-mod/core
|
||||
|
||||
- brittany-0.12.0.0
|
||||
- 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
|
||||
- ghc-lib-parser-8.8.0.20190424
|
||||
- haddock-api-2.22.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- haskell-lsp-0.15.0.0
|
||||
- haskell-lsp-types-0.15.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- hlint-2.1.22
|
||||
- hoogle-5.0.17.6
|
||||
- hlint-2.2
|
||||
- hoogle-5.0.17.9
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- lsp-test-0.6.0.0
|
||||
- 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
|
||||
# To make build work in windows 7
|
||||
- unix-time-0.4.7
|
||||
- yaml-0.8.32
|
||||
|
||||
# allow-newer: true
|
||||
|
@ -1,30 +1,29 @@
|
||||
resolver: nightly-2019-04-30 # First GHC 8.6.5
|
||||
resolver: lts-13.27
|
||||
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
|
||||
- brittany-0.12.0.0
|
||||
- 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
|
||||
- ghc-lib-parser-8.8.0.20190424
|
||||
- haddock-api-2.22.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- hlint-2.1.22
|
||||
- haskell-lsp-0.15.0.0
|
||||
- haskell-lsp-types-0.15.0.0
|
||||
- haskell-src-exts-1.21.0
|
||||
- hlint-2.2
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- hoogle-5.0.17.9
|
||||
- lsp-test-0.6.0.0
|
||||
- monad-dijkstra-0.1.1.2@rev:1
|
||||
- monad-memo-0.4.1
|
||||
- multistate-0.8.0.1
|
||||
|
22
stack.yaml
22
stack.yaml
@ -1,4 +1,4 @@
|
||||
resolver: nightly-2019-04-30 # First GHC 8.6.5
|
||||
resolver: nightly-2019-07-07 # GHC 8.6.5
|
||||
packages:
|
||||
- .
|
||||
- hie-plugin-api
|
||||
@ -6,29 +6,25 @@ packages:
|
||||
|
||||
extra-deps:
|
||||
- ./submodules/HaRe
|
||||
- ./submodules/brittany
|
||||
- ./submodules/cabal-helper
|
||||
- ./submodules/ghc-mod/ghc-project-types
|
||||
|
||||
- ansi-terminal-0.8.2
|
||||
- butcher-1.3.2.1
|
||||
- bytestring-trie-0.2.5.0
|
||||
- ansi-wl-pprint-0.6.8.2
|
||||
- brittany-0.12.0.0
|
||||
- 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
|
||||
- floskell-0.10.1
|
||||
- ghc-lib-parser-8.8.0.20190424
|
||||
- haddock-api-2.22.0
|
||||
- haskell-lsp-0.13.0.0
|
||||
- haskell-lsp-types-0.13.0.0
|
||||
- hlint-2.1.22
|
||||
- haskell-lsp-0.15.0.0
|
||||
- haskell-lsp-types-0.15.0.0
|
||||
- hlint-2.2
|
||||
- hsimport-0.10.0
|
||||
- lsp-test-0.5.2.3
|
||||
- lsp-test-0.6.0.0
|
||||
- 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 +0,0 @@
|
||||
Subproject commit 6c187da8f8166d595f36d6aaf419370283b3d1e9
|
@ -1 +1 @@
|
||||
Subproject commit 43476965b5d715f7fcdadd9e14d5e0c53cdb9385
|
||||
Subproject commit 910887b2c33237b703417ec07f35ca8bbf35d729
|
@ -174,7 +174,7 @@ funcSpec = describe "functional dispatch" $ do
|
||||
|
||||
-- followed by the diagnostics ...
|
||||
("req2",Right res2) <- atomically $ readTChan logChan
|
||||
show res2 `shouldBe` "((Map Uri (Set Diagnostic)),[Text])"
|
||||
show res2 `shouldBe` "(Diagnostics,[Text])"
|
||||
|
||||
-- No more pending results
|
||||
rr3 <- atomically $ tryReadTChan logChan
|
||||
@ -281,7 +281,7 @@ funcSpec = describe "functional dispatch" $ do
|
||||
unpackRes hr7 `shouldBe` ("req7", Just ([] :: [Location]))
|
||||
|
||||
("req8", Right diags) <- atomically $ readTChan logChan
|
||||
show diags `shouldBe` "((Map Uri (Set Diagnostic)),[Text])"
|
||||
show diags `shouldBe` "(Diagnostics,[Text])"
|
||||
|
||||
killThread dispatcher
|
||||
|
||||
|
@ -250,6 +250,67 @@ spec = describe "completions" $ do
|
||||
item ^. insertTextFormat `shouldBe` Just Snippet
|
||||
item ^. insertText `shouldBe` Just "mapM ${1:a -> m b} ${2:t a}"
|
||||
|
||||
it "work for infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
|
||||
doc <- openDoc "Completion.hs" "haskell"
|
||||
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
|
||||
|
||||
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte"
|
||||
_ <- applyEdit doc te
|
||||
|
||||
compls <- getCompletions doc (Position 5 18)
|
||||
let item = head $ filter ((== "filter") . (^. label)) compls
|
||||
liftIO $ do
|
||||
item ^. label `shouldBe` "filter"
|
||||
item ^. kind `shouldBe` Just CiFunction
|
||||
item ^. insertTextFormat `shouldBe` Just Snippet
|
||||
item ^. insertText `shouldBe` Just "filter`"
|
||||
|
||||
it "work for infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
|
||||
doc <- openDoc "Completion.hs" "haskell"
|
||||
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
|
||||
|
||||
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`"
|
||||
_ <- applyEdit doc te
|
||||
|
||||
compls <- getCompletions doc (Position 5 18)
|
||||
let item = head $ filter ((== "filter") . (^. label)) compls
|
||||
liftIO $ do
|
||||
item ^. label `shouldBe` "filter"
|
||||
item ^. kind `shouldBe` Just CiFunction
|
||||
item ^. insertTextFormat `shouldBe` Just Snippet
|
||||
item ^. insertText `shouldBe` Just "filter"
|
||||
|
||||
it "work for qualified infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
|
||||
doc <- openDoc "Completion.hs" "haskell"
|
||||
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
|
||||
|
||||
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe"
|
||||
_ <- applyEdit doc te
|
||||
|
||||
compls <- getCompletions doc (Position 5 29)
|
||||
let item = head $ filter ((== "intersperse") . (^. label)) compls
|
||||
liftIO $ do
|
||||
item ^. label `shouldBe` "intersperse"
|
||||
item ^. kind `shouldBe` Just CiFunction
|
||||
item ^. insertTextFormat `shouldBe` Just Snippet
|
||||
item ^. insertText `shouldBe` Just "intersperse`"
|
||||
|
||||
it "work for qualified infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
|
||||
doc <- openDoc "Completion.hs" "haskell"
|
||||
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
|
||||
|
||||
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`"
|
||||
_ <- applyEdit doc te
|
||||
|
||||
|
||||
compls <- getCompletions doc (Position 5 29)
|
||||
let item = head $ filter ((== "intersperse") . (^. label)) compls
|
||||
liftIO $ do
|
||||
item ^. label `shouldBe` "intersperse"
|
||||
item ^. kind `shouldBe` Just CiFunction
|
||||
item ^. insertTextFormat `shouldBe` Just Snippet
|
||||
item ^. insertText `shouldBe` Just "intersperse"
|
||||
|
||||
it "respects lsp configuration" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
|
||||
doc <- openDoc "Completion.hs" "haskell"
|
||||
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
|
||||
|
@ -127,7 +127,7 @@ spec = describe "code actions" $ do
|
||||
liftIO $ x `shouldBe` "foo = putStrLn \"world\""
|
||||
|
||||
describe "import suggestions" $ do
|
||||
hsImportSpec "brittany"
|
||||
describe "formats with brittany" $ hsImportSpec "brittany"
|
||||
[ -- Expected output for simple format.
|
||||
[ "import qualified Data.Maybe"
|
||||
, "import Control.Monad"
|
||||
@ -153,8 +153,27 @@ spec = describe "code actions" $ do
|
||||
, " $ hPutStrLn stdout"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
, -- Complex imports for Constructos and functions
|
||||
[ "{-# LANGUAGE NoImplicitPrelude #-}"
|
||||
, "import System.IO ( IO"
|
||||
, " , hPutStrLn"
|
||||
, " , stderr"
|
||||
, " )"
|
||||
, "import Prelude ( Bool(..) )"
|
||||
, "import Control.Monad ( when )"
|
||||
, "import Data.Function ( ($) )"
|
||||
, "import Data.Maybe ( fromMaybe"
|
||||
, " , Maybe(Just)"
|
||||
, " )"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stderr"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
]
|
||||
hsImportSpec "floskell"
|
||||
describe "formats with floskell" $ hsImportSpec "floskell"
|
||||
[ -- Expected output for simple format.
|
||||
[ "import qualified Data.Maybe"
|
||||
, "import Control.Monad"
|
||||
@ -178,6 +197,20 @@ spec = describe "code actions" $ do
|
||||
, " $ hPutStrLn stdout"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
, -- Complex imports for Constructos and functions
|
||||
[ "{-# LANGUAGE NoImplicitPrelude #-}"
|
||||
, "import System.IO (IO, hPutStrLn, stderr)"
|
||||
, "import Prelude (Bool(..))"
|
||||
, "import Control.Monad (when)"
|
||||
, "import Data.Function (($))"
|
||||
, "import Data.Maybe (fromMaybe, Maybe(Just))"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stderr"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
]
|
||||
describe "add package suggestions" $ do
|
||||
-- Only execute this test with ghc 8.4.4, below seems to be broken in the package.
|
||||
@ -235,32 +268,6 @@ spec = describe "code actions" $ do
|
||||
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"
|
||||
|
||||
-- -----------------------------------
|
||||
|
||||
@ -504,7 +511,7 @@ spec = describe "code actions" $ do
|
||||
-- Parameterized HsImport Spec.
|
||||
-- ---------------------------------------------------------------------
|
||||
hsImportSpec :: T.Text -> [[T.Text]]-> Spec
|
||||
hsImportSpec formatterName [e1, e2, e3] =
|
||||
hsImportSpec formatterName [e1, e2, e3, e4] =
|
||||
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"
|
||||
@ -576,9 +583,8 @@ hsImportSpec formatterName [e1, e2, e3] =
|
||||
, "Import module Data.Maybe (fromMaybe)"
|
||||
]
|
||||
|
||||
executeAllCodeActions doc wantedCodeActionTitles
|
||||
contents <- 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
|
||||
@ -593,8 +599,7 @@ hsImportSpec formatterName [e1, e2, e3] =
|
||||
, "Import module Data.Maybe (fromMaybe)"
|
||||
]
|
||||
|
||||
executeAllCodeActions doc wantedCodeActionTitles
|
||||
contents <- documentContents doc
|
||||
contents <- executeAllCodeActions doc wantedCodeActionTitles
|
||||
liftIO $ Set.fromList (T.lines contents) `shouldBe`
|
||||
Set.fromList
|
||||
[ "import System.IO (stdout, hPutStrLn)"
|
||||
@ -626,7 +631,7 @@ hsImportSpec formatterName [e1, e2, e3] =
|
||||
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
|
||||
it "import-list respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
|
||||
@ -644,14 +649,74 @@ hsImportSpec formatterName [e1, e2, e3] =
|
||||
l2 `shouldBe` "import Control.Monad (when)"
|
||||
l3 `shouldBe` "main :: IO ()"
|
||||
l4 `shouldBe` "main = when True $ putStrLn \"hello\""
|
||||
|
||||
it "complex import-list" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportListElaborate.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
|
||||
let config = def { formatOnImportOn = True, formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)"
|
||||
, "Import module Control.Monad (when)"
|
||||
, "Import module Data.Maybe (fromMaybe)"
|
||||
, "Import module Data.Function (($))"
|
||||
, "Import module Data.Maybe (Maybe (Just))"
|
||||
, "Import module Prelude (Bool (..))"
|
||||
, "Import module System.IO (stderr)"
|
||||
]
|
||||
|
||||
contents <- executeAllCodeActions doc wantedCodeActionTitles
|
||||
|
||||
liftIO $
|
||||
T.lines contents `shouldBe` e4
|
||||
|
||||
it "complex import-list respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportListElaborate.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
|
||||
let config = def { formatOnImportOn = False, formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)"
|
||||
, "Import module Control.Monad (when)"
|
||||
, "Import module Data.Maybe (fromMaybe)"
|
||||
, "Import module Data.Function (($))"
|
||||
, "Import module Data.Maybe (Maybe (Just))"
|
||||
, "Import module Prelude (Bool (..))"
|
||||
, "Import module System.IO (stderr)"
|
||||
]
|
||||
|
||||
contents <- executeAllCodeActions doc wantedCodeActionTitles
|
||||
|
||||
liftIO $
|
||||
T.lines contents `shouldBe`
|
||||
[ "{-# LANGUAGE NoImplicitPrelude #-}"
|
||||
, "import System.IO (IO, hPutStrLn, stderr)"
|
||||
, "import Prelude (Bool(..))"
|
||||
, "import Control.Monad (when)"
|
||||
, "import Data.Function (($))"
|
||||
, "import Data.Maybe (fromMaybe, Maybe(Just))"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stderr"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
|
||||
where
|
||||
executeAllCodeActions :: TextDocumentIdentifier -> [T.Text] -> Session ()
|
||||
executeAllCodeActions :: TextDocumentIdentifier -> [T.Text] -> Session T.Text
|
||||
executeAllCodeActions doc names =
|
||||
replicateM_ (length names) $ do
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
executeCodeActionByName doc names
|
||||
_ <- skipManyTill publishDiagnosticsNotification $ getDocumentEdit doc
|
||||
waitForDiagnosticsSource "ghcmod"
|
||||
foldM (\_ _ -> do
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
executeCodeActionByName doc names
|
||||
content <- skipManyTill publishDiagnosticsNotification $ getDocumentEdit doc
|
||||
_ <- waitForDiagnosticsSource "ghcmod"
|
||||
return content
|
||||
)
|
||||
(T.pack "")
|
||||
[ 1 .. length names ]
|
||||
|
||||
executeCodeActionByName :: TextDocumentIdentifier -> [T.Text] -> Session ()
|
||||
executeCodeActionByName doc names = do
|
||||
@ -660,17 +725,17 @@ hsImportSpec formatterName [e1, e2, e3] =
|
||||
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)
|
||||
$ "No action found to be executed!"
|
||||
++ "\n Actual actions titles: " ++ show (map (^. L.title) allActions)
|
||||
++ "\n Expected actions titles: " ++ show names
|
||||
|
||||
-- Silence warnings
|
||||
hsImportSpec formatter args =
|
||||
error $ "Not the right amount of arguments for \"hsImportSpec ("
|
||||
++ T.unpack formatter
|
||||
++ ")\", expected 3, got "
|
||||
++ ")\", expected 4, got "
|
||||
++ show (length args)
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
|
8
test/testdata/CodeActionImportListElaborate.hs
vendored
Normal file
8
test/testdata/CodeActionImportListElaborate.hs
vendored
Normal file
@ -0,0 +1,8 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
import System.IO (IO)
|
||||
-- | Main entry point to the program
|
||||
main :: IO ()
|
||||
main =
|
||||
when True
|
||||
$ hPutStrLn stderr
|
||||
$ fromMaybe "Good night, World!" (Just "Hello, World!")
|
@ -1,2 +0,0 @@
|
||||
import Data.Text
|
||||
foo = pack "I'm a Text"
|
@ -1,5 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import Codec.Compression.GZip
|
||||
|
||||
main = return $ compress "hello"
|
@ -1,60 +0,0 @@
|
||||
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
|
@ -1,34 +0,0 @@
|
||||
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
|
@ -1,5 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Asdf where
|
||||
import Codec.Compression.GZip
|
||||
|
||||
main = return $ compress "hello"
|
@ -1,36 +0,0 @@
|
||||
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
|
@ -1,25 +0,0 @@
|
||||
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
|
3
test/testdata/completion/Completion.hs
vendored
3
test/testdata/completion/Completion.hs
vendored
@ -4,3 +4,6 @@ import qualified Data.List
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn "hello"
|
||||
|
||||
foo :: Either a b -> Either a b
|
||||
foo = id
|
2
test/testdata/wrapper/8.2.1/Setup.hs
vendored
Normal file
2
test/testdata/wrapper/8.2.1/Setup.hs
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
1
test/testdata/wrapper/8.2.1/cabal.project
vendored
Normal file
1
test/testdata/wrapper/8.2.1/cabal.project
vendored
Normal file
@ -0,0 +1 @@
|
||||
packages: .
|
25
test/testdata/wrapper/8.2.1/cabal1.cabal
vendored
Normal file
25
test/testdata/wrapper/8.2.1/cabal1.cabal
vendored
Normal file
@ -0,0 +1,25 @@
|
||||
-- Initial cabal1.cabal generated by cabal init. For further
|
||||
-- documentation, see http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: cabal1
|
||||
version: 0.1.0.0
|
||||
-- synopsis:
|
||||
-- description:
|
||||
license: PublicDomain
|
||||
-- license-file: LICENSE
|
||||
author: Alan Zimmerman
|
||||
maintainer: alan.zimm@gmail.com
|
||||
-- copyright:
|
||||
-- category:
|
||||
build-type: Simple
|
||||
-- extra-source-files:
|
||||
-- cabal-helper for cabal 2.2/GHC 8.4 needs a cabal version >= 2
|
||||
cabal-version: >=2.0
|
||||
|
||||
executable cabal1
|
||||
main-is: main.hs
|
||||
-- other-modules:
|
||||
-- other-extensions:
|
||||
build-depends: base >=4.6 && <5
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
3
test/testdata/wrapper/8.2.1/src/Foo/Bar.hs
vendored
Normal file
3
test/testdata/wrapper/8.2.1/src/Foo/Bar.hs
vendored
Normal file
@ -0,0 +1,3 @@
|
||||
module Foo.Bar where
|
||||
|
||||
baz = 6
|
7
test/testdata/wrapper/8.2.1/src/main.hs
vendored
Normal file
7
test/testdata/wrapper/8.2.1/src/main.hs
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
-- | Testing that HaRe can find source files from a cabal file
|
||||
|
||||
import qualified Foo.Bar as B
|
||||
|
||||
main = putStrLn "foo"
|
||||
|
||||
baz = 3 + B.baz
|
2
test/testdata/wrapper/lts-11.14/Setup.hs
vendored
Normal file
2
test/testdata/wrapper/lts-11.14/Setup.hs
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
1
test/testdata/wrapper/lts-11.14/cabal.project
vendored
Normal file
1
test/testdata/wrapper/lts-11.14/cabal.project
vendored
Normal file
@ -0,0 +1 @@
|
||||
packages: .
|
25
test/testdata/wrapper/lts-11.14/cabal1.cabal
vendored
Normal file
25
test/testdata/wrapper/lts-11.14/cabal1.cabal
vendored
Normal file
@ -0,0 +1,25 @@
|
||||
-- Initial cabal1.cabal generated by cabal init. For further
|
||||
-- documentation, see http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: cabal1
|
||||
version: 0.1.0.0
|
||||
-- synopsis:
|
||||
-- description:
|
||||
license: PublicDomain
|
||||
-- license-file: LICENSE
|
||||
author: Alan Zimmerman
|
||||
maintainer: alan.zimm@gmail.com
|
||||
-- copyright:
|
||||
-- category:
|
||||
build-type: Simple
|
||||
-- extra-source-files:
|
||||
-- cabal-helper for cabal 2.2/GHC 8.4 needs a cabal version >= 2
|
||||
cabal-version: >=2.0
|
||||
|
||||
executable cabal1
|
||||
main-is: main.hs
|
||||
-- other-modules:
|
||||
-- other-extensions:
|
||||
build-depends: base >=4.6 && <5
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
3
test/testdata/wrapper/lts-11.14/src/Foo/Bar.hs
vendored
Normal file
3
test/testdata/wrapper/lts-11.14/src/Foo/Bar.hs
vendored
Normal file
@ -0,0 +1,3 @@
|
||||
module Foo.Bar where
|
||||
|
||||
baz = 6
|
7
test/testdata/wrapper/lts-11.14/src/main.hs
vendored
Normal file
7
test/testdata/wrapper/lts-11.14/src/main.hs
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
-- | Testing that HaRe can find source files from a cabal file
|
||||
|
||||
import qualified Foo.Bar as B
|
||||
|
||||
main = putStrLn "foo"
|
||||
|
||||
baz = 3 + B.baz
|
@ -100,12 +100,12 @@ applyRefactSpec = do
|
||||
{ _uri = filePath
|
||||
, _diagnostics = List
|
||||
#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}}
|
||||
[Diagnostic {_range = Range { _start = Position {_line = 12, _character = 23}
|
||||
, _end = Position {_line = 12, _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"
|
||||
, _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"
|
||||
, _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}
|
||||
|
@ -15,19 +15,22 @@ spec = do
|
||||
describe "import code actions" $ do
|
||||
it "pick up variable not in scope" $
|
||||
let msg = "Variable not in scope: fromJust :: Maybe Integer -> t"
|
||||
in extractImportableTerm msg `shouldBe` Just "fromJust :: Maybe Integer -> t"
|
||||
in extractImportableTerm msg `shouldBe` Just ("fromJust :: Maybe Integer -> t", Import Symbol)
|
||||
it "pick up variable not in scope with 'perhaps you meant'" $
|
||||
let msg = "• Variable not in scope: msgs :: T.Text\n• Perhaps you meant ‘msg’ (line 90)"
|
||||
in extractImportableTerm msg `shouldBe` Just "msgs :: T.Text"
|
||||
in extractImportableTerm msg `shouldBe` Just ("msgs :: T.Text", Import Symbol)
|
||||
it "pick up multi-line variable not in scope" $
|
||||
let msg = "Variable not in scope:\nliftIO\n:: IO [FilePath]\n-> GhcMod.Monad.Newtypes.GmT\n (GhcMod.Monad.Newtypes.GmOutT IdeM) [[t0]]"
|
||||
in extractImportableTerm msg `shouldBe` Just "liftIO :: IO [FilePath] -> GhcMod.Monad.Newtypes.GmT (GhcMod.Monad.Newtypes.GmOutT IdeM) [[t0]]"
|
||||
in extractImportableTerm msg `shouldBe` Just ("liftIO :: IO [FilePath] -> GhcMod.Monad.Newtypes.GmT (GhcMod.Monad.Newtypes.GmOutT IdeM) [[t0]]", Import Symbol)
|
||||
it "pick up when" $
|
||||
let msg = "Variable not in scope: when :: Bool -> IO () -> t"
|
||||
in extractImportableTerm msg `shouldBe` Just "when :: Bool -> IO () -> t"
|
||||
in extractImportableTerm msg `shouldBe` Just ("when :: Bool -> IO () -> t", Import Symbol)
|
||||
it "pick up data constructors" $
|
||||
let msg = "Data constructor not in scope: ExitFailure :: Integer -> t"
|
||||
in extractImportableTerm msg `shouldBe` Just "ExitFailure :: Integer -> t"
|
||||
in extractImportableTerm msg `shouldBe` Just ("ExitFailure :: Integer -> t", Import Constructor)
|
||||
it "pick up type" $
|
||||
let msg = "Not in scope: type constructor or class ‘Text"
|
||||
in extractImportableTerm msg `shouldBe` Just ("Text", Import Type)
|
||||
|
||||
describe "rename code actions" $ do
|
||||
it "pick up variable not in scope perhaps you meant" $
|
||||
|
@ -10,14 +10,559 @@ import Data.Monoid
|
||||
#endif
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
import Haskell.Ide.Engine.Ghc
|
||||
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 Language.Haskell.LSP.Types (TextEdit (..), toNormalizedUri)
|
||||
import System.Directory
|
||||
import TestUtils
|
||||
|
||||
import Test.Hspec
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "ghc-mod plugin" ghcmodSpec
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
testPlugins :: IdePlugins
|
||||
testPlugins = pluginDescToIdePlugins [ghcmodDescriptor "ghcmod"]
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
ghcmodSpec :: Spec
|
||||
ghcmodSpec =
|
||||
describe "ghc-mod plugin commands(old plugin api)" $ do
|
||||
it "runs the check command" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "./FileWithWarning.hs"
|
||||
let act = setTypecheckedModule arg
|
||||
arg = filePathToUri fp
|
||||
IdeResultOk (_,env) <- runSingle testPlugins act
|
||||
case env of
|
||||
[] -> return ()
|
||||
[s] -> T.unpack s `shouldStartWith` "Loaded package environment from"
|
||||
ss -> fail $ "got:" ++ show ss
|
||||
let
|
||||
res = IdeResultOk $
|
||||
(Diagnostics (Map.singleton (toNormalizedUri arg) (S.singleton diag)), env)
|
||||
diag = Diagnostic (Range (toPos (4,7))
|
||||
(toPos (4,8)))
|
||||
(Just DsError)
|
||||
Nothing
|
||||
(Just "ghcmod")
|
||||
"Variable not in scope: x"
|
||||
Nothing
|
||||
|
||||
testCommand testPlugins act "ghcmod" "check" arg res
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
it "runs the lint command" $ withCurrentDirectory "./test/testdata" $ do
|
||||
pendingWith "make sure we test this elsewhere"
|
||||
-- fp <- makeAbsolute "FileWithWarning.hs"
|
||||
-- let uri = filePathToUri fp
|
||||
-- act = lintCmd' uri
|
||||
-- arg = uri
|
||||
-- #if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)))
|
||||
-- res = IdeResultOk (T.pack fp <> ":6:9: Warning: Redundant do\NULFound:\NUL do return (3 + x)\NULPerhaps:\NUL return (3 + x)\n")
|
||||
-- #else
|
||||
-- res = IdeResultOk (T.pack fp <> ":6:9: Warning: Redundant do\NULFound:\NUL do return (3 + x)\NULWhy not:\NUL return (3 + x)\n")
|
||||
-- #endif
|
||||
-- testCommand testPlugins act "ghcmod" "lint" arg res
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
-- it "runs the info command" $ withCurrentDirectory "./test/testdata" $ do
|
||||
-- fp <- makeAbsolute "HaReRename.hs"
|
||||
-- let uri = filePathToUri fp
|
||||
-- act = infoCmd' uri "main"
|
||||
-- arg = IP uri "main"
|
||||
-- res = IdeResultOk "main :: IO () \t-- Defined at HaReRename.hs:2:1\n"
|
||||
-- -- ghc-mod tries to load the test file in the context of the hie project if we do not cd first.
|
||||
-- testCommand testPlugins act "ghcmod" "info" arg res
|
||||
|
||||
-- ----------------------------------------------------------------------------
|
||||
|
||||
it "runs the type command, find type" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "HaReRename.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (5,9)) uri
|
||||
arg = TP False uri (toPos (5,9))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (5,9)) (toPos (5,10)), "Int")
|
||||
, (Range (toPos (5,1)) (toPos (5,14)), "Int -> Int")
|
||||
]
|
||||
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, find function type" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "HaReRename.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (2,11)) uri
|
||||
arg = TP False uri (toPos (2,11))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (2, 8)) (toPos (2,16)), "String -> IO ()")
|
||||
, (Range (toPos (2, 1)) (toPos (2,24)), "IO ()")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, no type at location" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "HaReRename.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (1,1)) uri
|
||||
arg = TP False uri (toPos (1,1))
|
||||
res = IdeResultOk []
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, simple" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (6,16)) uri
|
||||
arg = TP False uri (toPos (6,16))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (6, 16)) (toPos (6,17)), "Int")
|
||||
, (Range (toPos (6, 1)) (toPos (7, 16)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, sum type pattern match, just" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (6,6)) uri
|
||||
arg = TP False uri (toPos (6, 6))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (6, 6)) (toPos (6, 12)), "Maybe Int")
|
||||
, (Range (toPos (6, 5)) (toPos (6, 13)), "Maybe Int")
|
||||
, (Range (toPos (6, 1)) (toPos (7, 16)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, sum type pattern match, just value" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (6,11)) uri
|
||||
arg = TP False uri (toPos (6, 11))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (6, 11)) (toPos (6, 12)), "Int")
|
||||
, (Range (toPos (6, 6)) (toPos (6, 12)), "Maybe Int")
|
||||
, (Range (toPos (6, 5)) (toPos (6, 13)), "Maybe Int")
|
||||
, (Range (toPos (6, 1)) (toPos (7, 16)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, sum type pattern match, nothing" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (7,5)) uri
|
||||
arg = TP False uri (toPos (7,5))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (7, 5)) (toPos (7, 12)), "Maybe Int")
|
||||
, (Range (toPos (6, 1)) (toPos (7, 16)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, sum type pattern match, nothing, literal" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (7,15)) uri
|
||||
arg = TP False uri (toPos (7,15))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (7, 15)) (toPos (7, 16)), "Int")
|
||||
, (Range (toPos (6, 1)) (toPos (7, 16)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, variable matching" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (10,5)) uri
|
||||
arg = TP False uri (toPos (10,5))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (10, 5)) (toPos (10, 6)), "Maybe Int")
|
||||
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, case expr" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (10,14)) uri
|
||||
arg = TP False uri (toPos (10,14))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (10, 14)) (toPos (10, 15)), "Maybe Int")
|
||||
, (Range (toPos (10, 9)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, case expr match, just" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (11,5)) uri
|
||||
arg = TP False uri (toPos (11,5))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (11, 5)) (toPos (11, 11)), "Maybe Int")
|
||||
, (Range (toPos (10, 9)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, case expr match, just value" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (11,10)) uri
|
||||
arg = TP False uri (toPos (11,10))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (11, 10)) (toPos (11, 11)), "Int")
|
||||
, (Range (toPos (11, 5)) (toPos (11, 11)), "Maybe Int")
|
||||
, (Range (toPos (10, 9)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, infix operator" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (11,17)) uri
|
||||
arg = TP False uri (toPos (11,17))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (11, 17)) (toPos (11, 18)), "Int -> Int -> Int")
|
||||
, (Range (toPos (10, 9)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, case expr match, nothing" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (12,5)) uri
|
||||
arg = TP False uri (toPos (12,5))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (12, 5)) (toPos (12, 12)), "Maybe Int")
|
||||
, (Range (toPos (10, 9)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, do bind expr result " $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (16,5)) uri
|
||||
arg = TP False uri (toPos (16,5))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (16, 5)) (toPos (16, 6)), "Int")
|
||||
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, do bind expr" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (16,10)) uri
|
||||
arg = TP False uri (toPos (16,10))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (16, 10)) (toPos (16, 11)), "Maybe Int")
|
||||
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, let binding function, return func" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (17,13)) uri
|
||||
arg = TP False uri (toPos (17,13))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (17, 13)) (toPos (17, 19)), "Int -> Maybe Int")
|
||||
, (Range (toPos (17, 9)) (toPos (17, 28)), "Maybe Int")
|
||||
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, let binding function, return param" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (17,21)) uri
|
||||
arg = TP False uri (toPos (17,21))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (17, 21)) (toPos (17, 22)), "Int")
|
||||
, (Range (toPos (17, 9)) (toPos (17, 28)), "Maybe Int")
|
||||
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, let binding function, function type" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (17,9)) uri
|
||||
arg = TP False uri (toPos (17,9))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (17, 9)) (toPos (17, 28)), "Maybe Int")
|
||||
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, do expr, function type" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (18,10)) uri
|
||||
arg = TP False uri (toPos (18,10))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (18, 10)) (toPos (18, 11)), "Maybe Int")
|
||||
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, let binding function, do expr bind for local func" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (18,5)) uri
|
||||
arg = TP False uri (toPos (18,5))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (18, 5)) (toPos (18, 6)), "Int")
|
||||
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, function type" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (15,5)) uri
|
||||
arg = TP False uri (toPos (15,5))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, function parameter" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (22,10)) uri
|
||||
arg = TP False uri (toPos (22,10))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (22, 10)) (toPos (22, 11)), "a -> a")
|
||||
, (Range (toPos (22, 1)) (toPos (22, 19)), "(a -> a) -> a -> a")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, function composition" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (25,26)) uri
|
||||
arg = TP False uri (toPos (25,26))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (25, 26)) (toPos (25, 27)), "(b -> c) -> (a -> b) -> a -> c")
|
||||
, (Range (toPos (25, 20)) (toPos (25, 29)), "a -> c")
|
||||
, (Range (toPos (25, 1)) (toPos (25, 34)), "(b -> c) -> (a -> b) -> a -> c")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, let binding, function composition" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (25,20)) uri
|
||||
arg = TP False uri (toPos (25,20))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (25, 20)) (toPos (25, 29)), "a -> c")
|
||||
, (Range (toPos (25, 1)) (toPos (25, 34)), "(b -> c) -> (a -> b) -> a -> c")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, let binding, type of function" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (25,33)) uri
|
||||
arg = TP False uri (toPos (25,33))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (25, 33)) (toPos (25, 34)), "a -> c")
|
||||
, (Range (toPos (25, 1)) (toPos (25, 34)), "(b -> c) -> (a -> b) -> a -> c")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, function type composition" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (25,5)) uri
|
||||
arg = TP False uri (toPos (25,5))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (25, 1)) (toPos (25, 34)), "(b -> c) -> (a -> b) -> a -> c")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, infix operator" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (28,25)) uri
|
||||
arg = TP False uri (toPos (28,25))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (28, 25)) (toPos (28, 28)), "(a -> b) -> IO a -> IO b")
|
||||
, (Range (toPos (28, 1)) (toPos (28, 35)), "(a -> b) -> IO a -> IO b")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, constructor" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (31,7)) uri
|
||||
arg = TP False uri (toPos (31,7))
|
||||
res = IdeResultOk
|
||||
[ -- (Range (toPos (31, 7)) (toPos (31, 12)), "Int -> Test")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, deriving clause Show type" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (33,15)) uri
|
||||
arg = TP False uri (toPos (33,15))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (33, 15)) (toPos (33, 19)), "(Int -> Test -> ShowS) -> (Test -> String) -> ([Test] -> ShowS) -> Show Test")
|
||||
, (Range (toPos (33, 15)) (toPos (33, 19)), "Int -> Test -> ShowS")
|
||||
, (Range (toPos (33, 15)) (toPos (33, 19)), "Test -> String")
|
||||
, (Range (toPos (33, 15)) (toPos (33, 19)), "[Test] -> ShowS")
|
||||
, (Range (toPos (33, 15)) (toPos (33, 19)), "Int -> Test -> ShowS")
|
||||
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0)))
|
||||
#else
|
||||
, (Range (toPos (33, 15)) (toPos (33, 19)), "[Test] -> ShowS")
|
||||
#endif
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
it "runs the type command, deriving clause Eq type" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "Types.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (33,21)) uri
|
||||
arg = TP False uri (toPos (33,21))
|
||||
res = IdeResultOk
|
||||
[ (Range (toPos (33, 21)) (toPos (33, 23)), "(Test -> Test -> Bool) -> (Test -> Test -> Bool) -> Eq Test")
|
||||
, (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool")
|
||||
, (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool")
|
||||
, (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool")
|
||||
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0)))
|
||||
#else
|
||||
, (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool")
|
||||
#endif
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
-- ----------------------------------------------------------------------------
|
||||
it "runs the type command with an absolute path from another folder, correct params" $ do
|
||||
fp <- makeAbsolute "./test/testdata/HaReRename.hs"
|
||||
cd <- getCurrentDirectory
|
||||
cd2 <- getHomeDirectory
|
||||
bracket (setCurrentDirectory cd2)
|
||||
(\_->setCurrentDirectory cd)
|
||||
$ \_-> do
|
||||
let uri = filePathToUri fp
|
||||
let act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
liftToGhc $ newTypeCmd (toPos (5,9)) uri
|
||||
let arg = TP False uri (toPos (5,9))
|
||||
let res = IdeResultOk
|
||||
[(Range (toPos (5,9)) (toPos (5,10)), "Int")
|
||||
, (Range (toPos (5,1)) (toPos (5,14)), "Int -> Int")
|
||||
]
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
it "runs the casesplit command" $ withCurrentDirectory "./test/testdata" $ do
|
||||
fp <- makeAbsolute "GhcModCaseSplit.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
splitCaseCmd' uri (toPos (5,5))
|
||||
arg = HP uri (toPos (5,5))
|
||||
res = IdeResultOk $ WorkspaceEdit
|
||||
(Just $ H.singleton uri
|
||||
$ List [TextEdit (Range (Position 4 0) (Position 4 10))
|
||||
"foo Nothing = ()\nfoo (Just x) = ()"])
|
||||
Nothing
|
||||
testCommand testPlugins act "ghcmod" "casesplit" arg res
|
||||
|
||||
it "runs the casesplit command with an absolute path from another folder, correct params" $ do
|
||||
fp <- makeAbsolute "./test/testdata/GhcModCaseSplit.hs"
|
||||
cd <- getCurrentDirectory
|
||||
cd2 <- getHomeDirectory
|
||||
bracket (setCurrentDirectory cd2)
|
||||
(\_-> setCurrentDirectory cd)
|
||||
$ \_-> do
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
splitCaseCmd' uri (toPos (5,5))
|
||||
arg = HP uri (toPos (5,5))
|
||||
res = IdeResultOk $ WorkspaceEdit
|
||||
(Just $ H.singleton uri
|
||||
$ List [TextEdit (Range (Position 4 0) (Position 4 10))
|
||||
"foo Nothing = ()\nfoo (Just x) = ()"])
|
||||
Nothing
|
||||
testCommand testPlugins act "ghcmod" "casesplit" arg res
|
||||
|
@ -48,7 +48,7 @@ hoogleSpec = do
|
||||
it "runs the info command" $ do
|
||||
let req = liftToGhc $ infoCmd' "head"
|
||||
r <- dispatchRequestP $ initializeHoogleDb >> req
|
||||
r `shouldBe` Right "head :: [a] -> a\nbase Prelude\nExtract the first element of a list, which must be non-empty.\n\n"
|
||||
r `shouldBe` Right "```haskell\nhead :: [a] -> a\n```\nExtract the first element of a list, which must be non-empty.\n\n[More info](https://hackage.haskell.org/package/base/docs/Prelude.html#v:head)"
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
|
@ -4,7 +4,6 @@ module LiquidSpec where
|
||||
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString.Lazy as BS
|
||||
import Data.List
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Monoid ((<>))
|
||||
@ -12,7 +11,6 @@ import Data.Maybe (isJust)
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.Plugin.Liquid
|
||||
import System.Directory
|
||||
import System.Exit
|
||||
import System.FilePath
|
||||
import Test.Hspec
|
||||
|
||||
@ -25,18 +23,23 @@ spec = do
|
||||
cwd <- runIO getCurrentDirectory
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
it "finds liquid haskell exe in $PATH" $ findExecutable "liquid" >>= (`shouldSatisfy` isJust)
|
||||
|
||||
-- ---------------------------------
|
||||
-- This produces some products in /test/testdata/liquid/.liquid/ that is used in subsequent test
|
||||
it "runs the liquid haskell exe" $ do
|
||||
let
|
||||
fp = cwd </> "test/testdata/liquid/Evens.hs"
|
||||
-- fp = "/home/alanz/tmp/haskell-proc-play/Evens.hs"
|
||||
-- uri = filePathToUri fp
|
||||
Just (ef, (msg:_)) <- runLiquidHaskell fp
|
||||
msg `shouldSatisfy` isPrefixOf "RESULT\n[{\"start\":{\"line\":9,\"column\":1},\"stop\":{\"line\":9,\"column\":8},\"message\":\"Error: Liquid Type Mismatch\\n Inferred type\\n VV : {v : Int | v == (7 : int)}\\n \\n not a subtype of Required type\\n VV : {VV : Int | VV mod 2 == 0}\\n"
|
||||
ef `shouldBe` ExitFailure 1
|
||||
|
||||
-- AZ: this test has been moved to func-tests, stack > 2.1 sets
|
||||
-- its own package environment, we can't run it from here.
|
||||
|
||||
-- -- This produces some products in /test/testdata/liquid/.liquid/ that is used in subsequent test
|
||||
-- it "runs the liquid haskell exe" $ do
|
||||
-- let
|
||||
-- fp = cwd </> "test/testdata/liquid/Evens.hs"
|
||||
-- -- fp = "/home/alanz/tmp/haskell-proc-play/Evens.hs"
|
||||
-- -- uri = filePathToUri fp
|
||||
-- Just (ef, (msg:_)) <- runLiquidHaskell fp
|
||||
-- msg `shouldSatisfy` isPrefixOf "RESULT\n[{\"start\":{\"line\":9,\"column\":1},\"stop\":{\"line\":9,\"column\":8},\"message\":\"Error: Liquid Type Mismatch\\n Inferred type\\n VV : {v : Int | v == (7 : int)}\\n \\n not a subtype of Required type\\n VV : {VV : Int | VV mod 2 == 0}\\n"
|
||||
-- ef `shouldBe` ExitFailure 1
|
||||
|
||||
-- ---------------------------------
|
||||
it "gets annot file paths" $ do
|
||||
@ -44,8 +47,8 @@ spec = do
|
||||
uri = filePathToUri $ cwd </> "test/testdata/liquid/Evens.hs"
|
||||
vimFile = vimAnnotFile uri
|
||||
jsonFile = jsonAnnotFile uri
|
||||
vimFile `shouldBe` (cwd </> "test/testdata/liquid/.liquid/Evens.hs.vim.annot")
|
||||
jsonFile `shouldBe` (cwd </> "test/testdata/liquid/.liquid/Evens.hs.json")
|
||||
vimFile `shouldBe` normalise (cwd </> "test/testdata/liquid/.liquid/Evens.hs.vim.annot")
|
||||
jsonFile `shouldBe` normalise (cwd </> "test/testdata/liquid/.liquid/Evens.hs.json")
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
|
@ -22,7 +22,7 @@ spec :: Spec
|
||||
spec = describe "Package plugin" packageSpec
|
||||
|
||||
testdata :: FilePath
|
||||
testdata = "test/testdata/addPackageTest"
|
||||
testdata = "test" </> "testdata" </> "addPackageTest"
|
||||
|
||||
testPlugins :: IdePlugins
|
||||
testPlugins = pluginDescToIdePlugins [packageDescriptor "package"]
|
||||
@ -31,7 +31,7 @@ cabalProject :: [FilePath]
|
||||
cabalProject = ["cabal-lib", "cabal-exe"]
|
||||
|
||||
hpackProject :: [FilePath]
|
||||
hpackProject = ["hpack-lib", "hpack-exe", "hybrid-lib", "hybrid-exe"]
|
||||
hpackProject = ["hpack-lib", "hpack-exe"]
|
||||
|
||||
packageSpec :: Spec
|
||||
packageSpec = do
|
||||
@ -239,77 +239,7 @@ packageSpec = do
|
||||
]
|
||||
]
|
||||
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
|
||||
|
@ -4,6 +4,7 @@ module TestUtils
|
||||
withFileLogging
|
||||
, setupStackFiles
|
||||
, testCommand
|
||||
, runSingle
|
||||
, runSingleReq
|
||||
, makeRequest
|
||||
, runIGM
|
||||
@ -51,6 +52,9 @@ testCommand testPlugins act plugin cmd arg res = do
|
||||
newApiRes `shouldBe` res
|
||||
fmap fromDynJSON oldApiRes `shouldBe` fmap Just res
|
||||
|
||||
runSingle :: IdePlugins -> IdeGhcM (IdeResult b) -> IO (IdeResult b)
|
||||
runSingle testPlugins act = runIGM testPlugins act
|
||||
|
||||
runSingleReq :: ToJSON a
|
||||
=> IdePlugins -> PluginId -> CommandName -> a -> IO (IdeResult DynamicJSON)
|
||||
runSingleReq testPlugins plugin com arg = runIGM testPlugins (makeRequest plugin com arg)
|
||||
@ -94,10 +98,8 @@ files =
|
||||
[ "./test/testdata/"
|
||||
, "./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/"
|
||||
|
@ -18,4 +18,4 @@ main = hspec $
|
||||
withCurrentDirectory "test/testdata/wrapper/ghc" $ do
|
||||
ghcDisplayVer <- readCreateProcess (shell "ghc --version") ""
|
||||
ghcVer <- getProjectGhcVersion
|
||||
init ghcDisplayVer `shouldEndWith` ghcVer
|
||||
init ghcDisplayVer `shouldEndWith` ghcVer
|
||||
|
Loading…
Reference in New Issue
Block a user