From f0381ee7ae18460f35794a8cbd705ca08be43ae4 Mon Sep 17 00:00:00 2001 From: kokobd Date: Mon, 27 Jun 2022 02:39:43 +0000 Subject: [PATCH 01/20] update Gitpod config --- .gitpod.Dockerfile | 17 +++++++++++ .gitpod.yml | 71 +++++++++++++++++++++++++--------------------- 2 files changed, 55 insertions(+), 33 deletions(-) create mode 100644 .gitpod.Dockerfile diff --git a/.gitpod.Dockerfile b/.gitpod.Dockerfile new file mode 100644 index 0000000000..b7bd1c27a1 --- /dev/null +++ b/.gitpod.Dockerfile @@ -0,0 +1,17 @@ +FROM gitpod/workspace-full + +RUN sudo install-packages build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 \ + libncurses-dev libncurses5 libtinfo5 && \ + BOOTSTRAP_HASKELL_NONINTERACTIVE=1 \ + BOOTSTRAP_HASKELL_MINIMAL=1 \ + curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh && \ + echo 'source $HOME/.ghcup/env' >> $HOME/.bashrc && \ + echo 'export PATH=$HOME/.cabal/bin:$HOME/.local/bin:$PATH' >> $HOME/.bashrc && \ + . /home/gitpod/.ghcup/env && \ + ghcup install ghc --set && \ + ghcup install hls --set && \ + ghcup install cabal --set && \ + ghcup install stack --set && \ + cabal update && \ + cabal install stylish-haskell hoogle && \ + pip install pre-commit diff --git a/.gitpod.yml b/.gitpod.yml index 3adf74afc2..318b9bbb36 100644 --- a/.gitpod.yml +++ b/.gitpod.yml @@ -1,42 +1,47 @@ +image: + file: .gitpod.Dockerfile # List the start up tasks. Learn more https://www.gitpod.io/docs/config-start-tasks/ tasks: - - before: | - # Only the /workspace folder is persistent - export XDG_DATA_HOME=/workspace/.local/share - export XDG_CONFIG_HOME=/workspace/.local/config - export XDG_STATE_HOME=/workspace/.local/state - export XDG_CACHE_HOME=/workspace/.cache - export CABAL_DIR=/workspace/.cabal - export STACK_ROOT=/workspace/.stack + - name: Setup + before: | + # Make sure some folders not in /workspace persist between worksapce restarts. + # You may add additional directories to this list. + declare -a CACHE_DIRS=( + $HOME/.local + $HOME/.cabal + $HOME/.stack + $HOME/.ghcup + /nix + ) + for DIR in "${CACHE_DIRS[@]}"; do + mkdir -p $(dirname /workspace/cache$DIR) + mkdir -p $DIR # in case $DIR doesn't already exist + # On a fresh start with no prebuilds, we move existing directory + # to /workspace. 'sudo mv' fails with 'no permission', I don't know why + if [ ! -d /workspace/cache$DIR ]; then + sudo cp -rp $DIR /workspace/cache$DIR + sudo rm -rf $DIR/* + fi + mkdir -p /workspace/cache$DIR # make sure it exists even if cp fails + # Now /workspace/cache$DIR exists. + # Use bind mount to make $DIR backed by /workspace/cache$DIR + sudo mount --bind /workspace/cache$DIR $DIR + done - # install ghcup, ghc and cabal - export GHCUP_INSTALL_BASE_PREFIX=/workspace - export BOOTSTRAP_HASKELL_NONINTERACTIVE=1 - export BOOTSTRAP_HASKELL_MINIMAL=1 - curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh - /workspace/.ghcup/bin/ghcup install ghc --set - /workspace/.ghcup/bin/ghcup install cabal - - # Add ghcup binaries to the PATH since VSCode does not see 'source .ghcup/env' - pushd /usr/local/bin - sudo ln -s /workspace/.ghcup/bin/* /usr/local/bin - popd - - # Fix the Cabal dir since VSCode does not see CABAL_DIR - cabal update - echo "Symlinking /workspace/.cabal to ~/.cabal" - ln -s /workspace/.cabal ~ + # Install pre-commit hook + pre-commit # Configure VSCode to use the locally built version of HLS mkdir -p .vscode - echo '{ "haskell.serverExecutablePath": "/workspace/.cabal/bin/haskell-language-server" }' > .vscode/settings.json - - init: | + if [ ! -f .vscode/settings.json ]; then + # Only write to .vscode/settings.json if it doesn't exist. + echo '{ "haskell.serverExecutablePath": "/home/gitpod/.cabal/bin/haskell-language-server" }' > .vscode/settings.json + fi + init: | + cabal update cabal configure --enable-executable-dynamic - cabal build --enable-tests - cabal install exe:haskell-language-server - command: | - cabal build --enable-tests + cabal build --enable-tests all + cabal install exe:haskell-language-server # List the ports to expose. Learn more https://www.gitpod.io/docs/config-ports/ ports: [] @@ -62,4 +67,4 @@ vscode: extensions: - "haskell.haskell" - "justusadam.language-haskell" - - "usernamehw.errorlens" \ No newline at end of file + - "EditorConfig.EditorConfig" From 111379866a8a680e74590b10176bd122e3dc2f32 Mon Sep 17 00:00:00 2001 From: kokobd Date: Mon, 27 Jun 2022 03:42:51 +0000 Subject: [PATCH 02/20] update nix shellHook & docs --- docs/contributing/contributing.md | 46 ++++------------------------ flake.lock | 49 ------------------------------ flake.nix | 50 +++++-------------------------- 3 files changed, 13 insertions(+), 132 deletions(-) diff --git a/docs/contributing/contributing.md b/docs/contributing/contributing.md index 1907d40856..17ff0f2f02 100644 --- a/docs/contributing/contributing.md +++ b/docs/contributing/contributing.md @@ -170,50 +170,14 @@ Please, try to follow those basic settings to keep the codebase as uniform as po ### Formatter pre-commit hook -We are using [pre-commit-hook.nix](https://github.com/cachix/pre-commit-hooks.nix) to configure git pre-commit hook for formatting. Although it is possible to run formatting manually, we recommend you to use it to set pre-commit hook as our CI checks pre-commit hook is applied or not. +We are using [pre-commit](https://pre-commit.com/) to configure git pre-commit hook for formatting. Although it is possible to run formatting manually, we recommend you to use it to set pre-commit hook as our CI checks pre-commit hook is applied or not. -You can configure the pre-commit-hook by running - -``` bash -nix-shell +Having installed [pre-commit](https://pre-commit.com/), you can install pre-commit hook by running: +```sh +pre-commit ``` -If you don't want to use [nix](https://nixos.org/guides/install-nix.html), you can instead use [pre-commit](https://pre-commit.com) with the following config. - -```json -{ - "repos": [ - { - "hooks": [ - { - "entry": "stylish-haskell --inplace", - "exclude": "(^Setup.hs$|test/testdata/.*$|test/data/.*$|test/manual/lhs/.*$|^hie-compat/.*$|^plugins/hls-tactics-plugin/.*$|^ghcide/src/Development/IDE/GHC/Compat.hs$|^ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs$|^ghcide/src/Development/IDE/GHC/Compat/Core.hs$|^ghcide/src/Development/IDE/Spans/Pragmas.hs$|^ghcide/src/Development/IDE/LSP/Outline.hs$|^plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs$|^ghcide/test/exe/Main.hs$|ghcide/src/Development/IDE/Core/Rules.hs|^hls-test-utils/src/Test/Hls/Util.hs$)", - "files": "\\.l?hs$", - "id": "stylish-haskell", - "language": "system", - "name": "stylish-haskell", - "pass_filenames": true, - "types": [ - "file" - ] - } - ], - "repo": "local" - }, - { - "repo": "https://github.com/pre-commit/pre-commit-hooks", - "rev": "v4.1.0", - "hooks": [ - { - "id": "mixed-line-ending", - "args": ["--fix", "lf"], - "exclude": "test/testdata/.*CRLF*.hs$" - } - ] - } - ] -} -``` +If you are using Nix or Gitpod, pre-commit hook is automatically installed. #### Why some components are excluded from automatic formatting? diff --git a/flake.lock b/flake.lock index 2e99cc6c13..a78b703cd4 100644 --- a/flake.lock +++ b/flake.lock @@ -82,21 +82,6 @@ "type": "github" } }, - "flake-utils_3": { - "locked": { - "lastModified": 1644229661, - "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, "fourmolu": { "flake": false, "locked": { @@ -293,20 +278,6 @@ "type": "github" } }, - "nixpkgs_3": { - "locked": { - "lastModified": 1645655918, - "narHash": "sha256-ZfbEFRW7o237+A1P7eTKhXje435FCAoe0blj2n20Was=", - "owner": "nixos", - "repo": "nixpkgs", - "rev": "77a7a4197740213879b9a1d2e1788c6c8ade4274", - "type": "github" - }, - "original": { - "id": "nixpkgs", - "type": "indirect" - } - }, "poetry2nix": { "inputs": { "flake-utils": "flake-utils_2", @@ -327,25 +298,6 @@ "type": "github" } }, - "pre-commit-hooks": { - "inputs": { - "flake-utils": "flake-utils_3", - "nixpkgs": "nixpkgs_3" - }, - "locked": { - "lastModified": 1652714503, - "narHash": "sha256-qQKVEfDe5FqvGgkZtg5Pc491foeiDPIOeycHMqnPDps=", - "owner": "cachix", - "repo": "pre-commit-hooks.nix", - "rev": "521a524771a8e93caddaa0ac1d67d03766a8b0b3", - "type": "github" - }, - "original": { - "owner": "cachix", - "repo": "pre-commit-hooks.nix", - "type": "github" - } - }, "ptr-poker": { "flake": false, "locked": { @@ -392,7 +344,6 @@ "myst-parser": "myst-parser", "nixpkgs": "nixpkgs", "poetry2nix": "poetry2nix", - "pre-commit-hooks": "pre-commit-hooks", "ptr-poker": "ptr-poker", "retrie": "retrie", "sphinx_rtd_theme": "sphinx_rtd_theme", diff --git a/flake.nix b/flake.nix index 51d0d5e43a..6fd7b89259 100644 --- a/flake.nix +++ b/flake.nix @@ -14,9 +14,6 @@ flake = false; }; flake-utils.url = "github:numtide/flake-utils"; - pre-commit-hooks = { - url = "github:cachix/pre-commit-hooks.nix"; - }; gitignore = { url = "github:hercules-ci/gitignore.nix"; flake = false; @@ -92,7 +89,7 @@ flake = false; }; myst-parser = { - url = "github:smunix/MyST-Parser?ref=fix.hls-docutils"; + url = "github:smunix/MyST-Parser?ref=fix.hls-docutils"; flake = false; }; # For https://github.com/readthedocs/sphinx_rtd_theme/pull/1185, otherwise lists are broken locally @@ -103,7 +100,7 @@ poetry2nix.url = "github:nix-community/poetry2nix/master"; }; outputs = - inputs@{ self, nixpkgs, flake-compat, flake-utils, pre-commit-hooks, gitignore, ... }: + inputs@{ self, nixpkgs, flake-compat, flake-utils, gitignore, ... }: { overlays.default = final: prev: with prev; @@ -123,7 +120,7 @@ in hsuper.mkDerivation (args // { jailbreak = if broken then true else jailbreak; doCheck = if broken then false else check; - # Library profiling is disabled as it causes long compilation time + # Library profiling is disabled as it causes long compilation time # on our CI jobs. Nix users are free tor revert this anytime. enableLibraryProfiling = false; doHaddock = false; @@ -215,42 +212,11 @@ config = { allowBroken = true; }; }; - # Pre-commit hooks to run stylish-haskell - pre-commit-check = hpkgs: pre-commit-hooks.lib.${system}.run { - src = ./.; - hooks = { - stylish-haskell.enable = true; - # use stylish-haskell with our target ghc - stylish-haskell.entry = pkgs.lib.mkForce "${hpkgs.stylish-haskell}/bin/stylish-haskell --inplace"; - stylish-haskell.excludes = [ - # Ignored files - "^Setup.hs$" - "test/testdata/.*$" - "test/data/.*$" - "test/manual/lhs/.*$" - "^hie-compat/.*$" - "^plugins/hls-tactics-plugin/.*$" - - # Temporarily ignored files - # Stylish-haskell (and other formatters) does not work well with some CPP usages in these files - "^ghcide/src/Development/IDE/GHC/Compat.hs$" - "^ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs$" - "^ghcide/src/Development/IDE/GHC/Compat/Core.hs$" - "^ghcide/src/Development/IDE/Spans/Pragmas.hs$" - "^ghcide/src/Development/IDE/LSP/Outline.hs$" - "^plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs$" - "^ghcide/test/exe/Main.hs$" - "ghcide/src/Development/IDE/Core/Rules.hs" - "^hls-test-utils/src/Test/Hls/Util.hs$" - ]; - }; - }; - ghc902Config = (import ./configuration-ghc-90.nix) { inherit pkgs inputs; }; ghc922Config = (import ./configuration-ghc-92.nix) { inherit pkgs inputs; }; # GHC versions - # While HLS still works fine with 8.10 GHCs, we only support the versions that are cached + # While HLS still works fine with 8.10 GHCs, we only support the versions that are cached # by upstream nixpkgs, which now only includes GHC version 9+ supportedGHCs = let ghcVersion = "ghc" + (pkgs.lib.replaceStrings ["."] [""] pkgs.haskellPackages.ghc.version); @@ -268,14 +234,14 @@ myst-parser = pkgs.poetry2nix.mkPoetryEnv { projectDir = inputs.myst-parser; python = pkgs.python39; - overrides = [ + overrides = [ pkgs.poetry2nix.defaultPoetryOverrides ]; }; sphinx_rtd_theme = pkgs.poetry2nix.mkPoetryEnv { projectDir = inputs.sphinx_rtd_theme; python = pkgs.python39; - overrides = [ + overrides = [ pkgs.poetry2nix.defaultPoetryOverrides (self: super: { # The RTD theme doesn't work with newer docutils @@ -334,8 +300,8 @@ export DYLD_LIBRARY_PATH=${gmp}/lib:${zlib}/lib:${ncurses}/lib:${capstone}/lib export PATH=$PATH:$HOME/.local/bin - # Enable the shell hooks - ${self.checks.${system}.pre-commit-check.shellHook} + # Install pre-commit hook + pre-commit # If the cabal project file is not the default one. # Print a warning and generate an alias. From c641dbfbe6a91ef4241049b509697636689346e3 Mon Sep 17 00:00:00 2001 From: kokobd Date: Mon, 27 Jun 2022 03:56:20 +0000 Subject: [PATCH 03/20] install pre-commit hook --- .gitpod.yml | 4 ++-- docs/contributing/contributing.md | 8 ++++---- flake.nix | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/.gitpod.yml b/.gitpod.yml index 318b9bbb36..426ac350be 100644 --- a/.gitpod.yml +++ b/.gitpod.yml @@ -29,13 +29,13 @@ tasks: done # Install pre-commit hook - pre-commit + pre-commit install # Configure VSCode to use the locally built version of HLS mkdir -p .vscode if [ ! -f .vscode/settings.json ]; then # Only write to .vscode/settings.json if it doesn't exist. - echo '{ "haskell.serverExecutablePath": "/home/gitpod/.cabal/bin/haskell-language-server" }' > .vscode/settings.json + echo '{ "haskell.serverExecutablePath": "/home/gitpod/.cabal/bin/haskell-language-server" }' > .vscode/settings.json fi init: | cabal update diff --git a/docs/contributing/contributing.md b/docs/contributing/contributing.md index 17ff0f2f02..a3fd5660b3 100644 --- a/docs/contributing/contributing.md +++ b/docs/contributing/contributing.md @@ -172,13 +172,13 @@ Please, try to follow those basic settings to keep the codebase as uniform as po We are using [pre-commit](https://pre-commit.com/) to configure git pre-commit hook for formatting. Although it is possible to run formatting manually, we recommend you to use it to set pre-commit hook as our CI checks pre-commit hook is applied or not. -Having installed [pre-commit](https://pre-commit.com/), you can install pre-commit hook by running: +If you are using Nix or Gitpod, pre-commit hook is automatically installed. Otherwise, follow instructions on +[https://pre-commit.com/](https://pre-commit.com/) to install the `pre-commit` tool, then run the following command: + ```sh -pre-commit +pre-commit install ``` -If you are using Nix or Gitpod, pre-commit hook is automatically installed. - #### Why some components are excluded from automatic formatting? - `test/testdata` and `test/data` are there as we want to test formatting plugins. diff --git a/flake.nix b/flake.nix index 6fd7b89259..c7db14aac6 100644 --- a/flake.nix +++ b/flake.nix @@ -301,7 +301,7 @@ export PATH=$PATH:$HOME/.local/bin # Install pre-commit hook - pre-commit + pre-commit install # If the cabal project file is not the default one. # Print a warning and generate an alias. From 6bd395f71b4d43f7893e0413090ce5d5cbe15628 Mon Sep 17 00:00:00 2001 From: kokobd Date: Mon, 27 Jun 2022 04:04:50 +0000 Subject: [PATCH 04/20] add kokobd as code owner to .gitpod.* --- CODEOWNERS | 1 + 1 file changed, 1 insertion(+) diff --git a/CODEOWNERS b/CODEOWNERS index 62cd8878b9..b54ff268c3 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -44,3 +44,4 @@ # Build *.nix @berberman @michaelpj @guibou *.project @jneira +.gitpod.* @kokobd From c75222a630cf10977c9b82ae627f277f176e9506 Mon Sep 17 00:00:00 2001 From: kokobd Date: Mon, 27 Jun 2022 04:36:19 +0000 Subject: [PATCH 05/20] add gen-hie to Gitpod --- .gitpod.Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitpod.Dockerfile b/.gitpod.Dockerfile index b7bd1c27a1..6e3f828daa 100644 --- a/.gitpod.Dockerfile +++ b/.gitpod.Dockerfile @@ -13,5 +13,5 @@ RUN sudo install-packages build-essential curl libffi-dev libffi7 libgmp-dev lib ghcup install cabal --set && \ ghcup install stack --set && \ cabal update && \ - cabal install stylish-haskell hoogle && \ + cabal install stylish-haskell hoogle implicit-hie && \ pip install pre-commit From 643ade4ba3490c5a5cae1b3223cfaae6cb22cfca Mon Sep 17 00:00:00 2001 From: kokobd Date: Mon, 27 Jun 2022 04:43:01 +0000 Subject: [PATCH 06/20] add tools for doc --- .gitpod.Dockerfile | 3 ++- .gitpod.yml | 4 ++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/.gitpod.Dockerfile b/.gitpod.Dockerfile index 6e3f828daa..5a244cf56f 100644 --- a/.gitpod.Dockerfile +++ b/.gitpod.Dockerfile @@ -14,4 +14,5 @@ RUN sudo install-packages build-essential curl libffi-dev libffi7 libgmp-dev lib ghcup install stack --set && \ cabal update && \ cabal install stylish-haskell hoogle implicit-hie && \ - pip install pre-commit + pip install pre-commit && \ + npm install -g http-server diff --git a/.gitpod.yml b/.gitpod.yml index 426ac350be..dbae854b4a 100644 --- a/.gitpod.yml +++ b/.gitpod.yml @@ -37,6 +37,10 @@ tasks: # Only write to .vscode/settings.json if it doesn't exist. echo '{ "haskell.serverExecutablePath": "/home/gitpod/.cabal/bin/haskell-language-server" }' > .vscode/settings.json fi + + pushd docs + pip install -r requirements.txt + popd init: | cabal update cabal configure --enable-executable-dynamic From e8a18ce0b2a8a114ba49494146bf3df882982a96 Mon Sep 17 00:00:00 2001 From: kokobd Date: Mon, 27 Jun 2022 05:26:28 +0000 Subject: [PATCH 07/20] remove .pre-commit-config.yaml from .gitignore --- .gitignore | 3 --- 1 file changed, 3 deletions(-) diff --git a/.gitignore b/.gitignore index 61cfe5877b..ed983e69c8 100644 --- a/.gitignore +++ b/.gitignore @@ -30,9 +30,6 @@ test/testdata/**/hie.yaml # shake build folder (used in benchmark suite) .shake/ -# pre-commit-hook.nix -.pre-commit-config.yaml - # direnv /.direnv/ /.envrc From b2e377d9a97aece85a0c9916b8f71575bafa3e20 Mon Sep 17 00:00:00 2001 From: kokobd Date: Tue, 28 Jun 2022 02:37:31 +0000 Subject: [PATCH 08/20] set vscode formatter to stylish-haskell in Gitpod --- .gitpod.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.gitpod.yml b/.gitpod.yml index dbae854b4a..e492004825 100644 --- a/.gitpod.yml +++ b/.gitpod.yml @@ -35,7 +35,10 @@ tasks: mkdir -p .vscode if [ ! -f .vscode/settings.json ]; then # Only write to .vscode/settings.json if it doesn't exist. - echo '{ "haskell.serverExecutablePath": "/home/gitpod/.cabal/bin/haskell-language-server" }' > .vscode/settings.json + echo '{' > .vscode/settings.json + echo ' "haskell.serverExecutablePath": "/home/gitpod/.cabal/bin/haskell-language-server",' >> .vscode/settings.json + echo ' "haskell.formattingProvider": "stylish-haskell"' >> .vscode/settings.json + echo '}' >> .vscode/settings.json fi pushd docs From 92d6609e34dd78daac6b29c9ddf3142c2ccd6715 Mon Sep 17 00:00:00 2001 From: kokobd Date: Tue, 28 Jun 2022 09:18:00 +0000 Subject: [PATCH 09/20] refactor selection range plugin --- exe/Plugins.hs | 4 +- ghcide/src/Development/IDE/Core/RuleTypes.hs | 14 +- .../hls-selection-range-plugin.cabal | 4 + .../src/Ide/Plugin/SelectionRange.hs | 186 ++++++++---------- .../Plugin/SelectionRange/ASTPreProcess.hs | 2 +- .../Ide/Plugin/SelectionRange/CodeRange.hs | 109 ++++++++++ .../hls-selection-range-plugin/test/Main.hs | 39 ++-- 7 files changed, 228 insertions(+), 130 deletions(-) create mode 100644 plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs diff --git a/exe/Plugins.hs b/exe/Plugins.hs index 07c15eb7f2..88147e1ed8 100644 --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -77,7 +77,7 @@ import qualified Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat #endif #if selectionRange -import Ide.Plugin.SelectionRange as SelectionRange +import qualified Ide.Plugin.SelectionRange as SelectionRange #endif #if changeTypeSignature @@ -191,7 +191,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins AlternateNumberFormat.descriptor pluginRecorder : #endif #if selectionRange - SelectionRange.descriptor "selectionRange" : + SelectionRange.descriptor pluginRecorder "selectionRange" : #endif #if changeTypeSignature ChangeTypeSignature.descriptor : diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 41ccfc4819..a196609e37 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -28,7 +28,7 @@ import Development.IDE.GHC.Compat hiding (HieFileResult) import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.CoreFile -import Development.IDE.GHC.Util +import Development.IDE.GHC.Util (fingerprintToBS) import Development.IDE.Graph import Development.IDE.Import.DependencyInformation import Development.IDE.Types.HscEnvEq (HscEnvEq) @@ -173,17 +173,17 @@ tmrModSummary :: TcModuleResult -> ModSummary tmrModSummary = pm_mod_summary . tmrParsed data HiFileResult = HiFileResult - { hirModSummary :: !ModSummary + { hirModSummary :: !ModSummary -- Bang patterns here are important to stop the result retaining -- a reference to a typechecked module - , hirModIface :: !ModIface - , hirModDetails :: ModDetails + , hirModIface :: !ModIface + , hirModDetails :: ModDetails -- ^ Populated lazily - , hirIfaceFp :: !ByteString + , hirIfaceFp :: !ByteString -- ^ Fingerprint for the ModIface , hirRuntimeModules :: !(ModuleEnv ByteString) -- ^ same as tmrRuntimeModules - , hirCoreFp :: !(Maybe (CoreFile, ByteString)) + , hirCoreFp :: !(Maybe (CoreFile, ByteString)) -- ^ If we wrote a core file for this module, then its contents (lazily deserialised) -- along with its hash } @@ -445,7 +445,7 @@ newtype GhcSessionDeps = GhcSessionDeps_ instance Show GhcSessionDeps where show (GhcSessionDeps_ False) = "GhcSessionDeps" - show (GhcSessionDeps_ True) = "GhcSessionDepsFull" + show (GhcSessionDeps_ True) = "GhcSessionDepsFull" pattern GhcSessionDeps :: GhcSessionDeps pattern GhcSessionDeps = GhcSessionDeps_ False diff --git a/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal b/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal index 1038b6760a..f7ad9713ac 100644 --- a/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal +++ b/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal @@ -23,6 +23,7 @@ extra-source-files: library exposed-modules: Ide.Plugin.SelectionRange + Ide.Plugin.SelectionRange.CodeRange other-modules: Ide.Plugin.SelectionRange.ASTPreProcess ghc-options: -Wall @@ -40,6 +41,8 @@ library , text , extra , semigroupoids + , hashable + , deepseq test-suite tests type: exitcode-stdio-1.0 @@ -53,6 +56,7 @@ test-suite tests , filepath , hls-selection-range-plugin , hls-test-utils ^>=1.2 || ^>=1.3 + , ghcide ^>=1.6 || ^>=1.7 , lsp , lsp-test , text diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs index 35e6009be7..5bab05338a 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs @@ -1,67 +1,66 @@ -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module Ide.Plugin.SelectionRange (descriptor) where +module Ide.Plugin.SelectionRange (descriptor, Log) where -import Control.Monad.Except (ExceptT (ExceptT), - runExceptT) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Reader (runReader) -import Control.Monad.Trans.Maybe (MaybeT (MaybeT), - maybeToExceptT) -import Data.Coerce (coerce) -import Data.Containers.ListUtils (nubOrd) -import Data.Either.Extra (maybeToEither) -import Data.Foldable (find) -import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe, mapMaybe) -import qualified Data.Text as T -import Development.IDE (GetHieAst (GetHieAst), - HieAstResult (HAR, hieAst, refMap), - IdeAction, - IdeState (shakeExtras), - Range (Range), - fromNormalizedFilePath, - ideLogger, logDebug, - realSrcSpanToRange, - runIdeAction, - toNormalizedFilePath', - uriToFilePath') -import Development.IDE.Core.Actions (useE) -import Development.IDE.Core.PositionMapping (PositionMapping, - fromCurrentPosition, - toCurrentRange) -import Development.IDE.GHC.Compat (HieAST (Node), Span, - getAsts) -import Development.IDE.GHC.Compat.Util -import Ide.Plugin.SelectionRange.ASTPreProcess (PreProcessEnv (PreProcessEnv), - preProcessAST) -import Ide.PluginUtils (pluginResponse) -import Ide.Types (PluginDescriptor (pluginHandlers), - PluginId, - defaultPluginDescriptor, - mkPluginHandler) -import Language.LSP.Server (LspM) -import Language.LSP.Types (List (List), - NormalizedFilePath, - Position, - ResponseError, - SMethod (STextDocumentSelectionRange), - SelectionRange (..), - SelectionRangeParams (..), - TextDocumentIdentifier (TextDocumentIdentifier), - Uri) -import Prelude hiding (span) +import Control.Monad.Except (ExceptT (ExceptT), + runExceptT) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Maybe (MaybeT (MaybeT), + maybeToExceptT) +import Data.Either.Extra (maybeToEither) +import Data.Maybe (fromMaybe, mapMaybe) +import Development.IDE (IdeAction, + IdeState (shakeExtras), + Range (Range), Recorder, + WithPriority, + cmapWithPrio, + runIdeAction, + toNormalizedFilePath', + uriToFilePath') +import Development.IDE.Core.Actions (useE) +import Development.IDE.Core.PositionMapping (PositionMapping, + fromCurrentPosition, + toCurrentRange) +import Development.IDE.Types.Logger (Pretty (..)) +import Ide.Plugin.SelectionRange.CodeRange (CodeRange (..), + GetCodeRange (..), + codeRangeRule) +import qualified Ide.Plugin.SelectionRange.CodeRange as CodeRange +import Ide.PluginUtils (pluginResponse, + positionInRange) +import Ide.Types (PluginDescriptor (pluginHandlers, pluginRules), + PluginId, + defaultPluginDescriptor, + mkPluginHandler) +import Language.LSP.Server (LspM) +import Language.LSP.Types (List (List), + NormalizedFilePath, + Position (..), + ResponseError, + SMethod (STextDocumentSelectionRange), + SelectionRange (..), + SelectionRangeParams (..), + TextDocumentIdentifier (TextDocumentIdentifier), + Uri) +import Prelude hiding (log, span) -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = (defaultPluginDescriptor plId) +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor recorder plId = (defaultPluginDescriptor plId) { pluginHandlers = mkPluginHandler STextDocumentSelectionRange selectionRangeHandler + -- TODO @sloorush add folding range + -- <> mkPluginHandler STextDocumentFoldingRange foldingRangeHandler + , pluginRules = codeRangeRule (cmapWithPrio LogCodeRange recorder) } +data Log = LogCodeRange CodeRange.Log + +instance Pretty Log where + pretty log = case log of + LogCodeRange codeRangeLog -> pretty codeRangeLog + selectionRangeHandler :: IdeState -> PluginId -> SelectionRangeParams -> LspM c (Either ResponseError (List SelectionRange)) selectionRangeHandler ide _ SelectionRangeParams{..} = do - liftIO $ logDebug logger $ "requesting selection range for file: " <> T.pack (show uri) pluginResponse $ do filePath <- ExceptT . pure . maybeToEither "fail to convert uri to file path" $ toNormalizedFilePath' <$> uriToFilePath' uri @@ -75,27 +74,45 @@ selectionRangeHandler ide _ SelectionRangeParams{..} = do positions :: [Position] List positions = _positions - logger = ideLogger ide - getSelectionRanges :: NormalizedFilePath -> [Position] -> ExceptT String IdeAction [SelectionRange] getSelectionRanges file positions = do - (HAR{hieAst, refMap}, positionMapping) <- maybeToExceptT "fail to get hie ast" $ useE GetHieAst file - -- 'positionMapping' should be applied to the input positions before using them + (codeRange, positionMapping) <- maybeToExceptT "fail to get code range" $ useE GetCodeRange file + -- 'positionMapping' should be appied to the input before using them positions' <- maybeToExceptT "fail to apply position mapping to input positions" . MaybeT . pure $ traverse (fromCurrentPosition positionMapping) positions - ast <- maybeToExceptT "fail to get ast for current file" . MaybeT . pure $ - -- in GHC 9, the 'FastString' in 'HieASTs' is replaced by a newtype wrapper around 'LexicalFastString' - -- so we use 'coerce' to make it work in both GHC 8 and 9 - getAsts hieAst Map.!? (coerce . mkFastString . fromNormalizedFilePath) file - - let ast' = runReader (preProcessAST ast) (PreProcessEnv refMap) - let selectionRanges = findSelectionRangesByPositions (astPathsLeafToRoot ast') positions' + let selectionRanges = flip fmap positions' $ \pos -> + -- codeRange doesn't cover all portions of text in the file, so we need a default value + let defaultSelectionRange = SelectionRange (Range pos pos) Nothing + in reverseSelectionRange . fromMaybe defaultSelectionRange . findPosition' pos $ codeRange -- 'positionMapping' should be applied to the output ranges before returning them maybeToExceptT "fail to apply position mapping to output positions" . MaybeT . pure $ traverse (toCurrentSelectionRange positionMapping) selectionRanges +-- Find 'Position' in 'CodeRange'. Producing an inverse 'SelectionRange' +findPosition' :: Position -> CodeRange -> Maybe SelectionRange +findPosition' pos (CodeRange range children) = + if positionInRange pos range + then Just $ case mapMaybe (findPosition' pos) children of + [childSelectionRange] -> SelectionRange range (Just childSelectionRange) + _ -> SelectionRange range Nothing + else Nothing + +-- Reverse 'SelectionRange'. Just like 'reverse' for list. +reverseSelectionRange :: SelectionRange -> SelectionRange +reverseSelectionRange = go (SelectionRange invalidRange Nothing) + where + go :: SelectionRange -> SelectionRange -> SelectionRange + go acc (SelectionRange r Nothing) = SelectionRange r (checkRange acc) + go acc (SelectionRange r (Just parent)) = go (SelectionRange r (checkRange acc)) parent + + checkRange :: SelectionRange -> Maybe SelectionRange + checkRange r@(SelectionRange range _) = if range == invalidRange then Nothing else Just r + + invalidRange :: Range + invalidRange = Range (Position (-1) (-1)) (Position (-1) (-1)) + -- | Likes 'toCurrentPosition', but works on 'SelectionRange' toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange toCurrentSelectionRange positionMapping SelectionRange{..} = do @@ -104,42 +121,3 @@ toCurrentSelectionRange positionMapping SelectionRange{..} = do _range = newRange, _parent = _parent >>= toCurrentSelectionRange positionMapping } - --- | Build all paths from ast leaf to root -astPathsLeafToRoot :: HieAST a -> [SelectionRange] -astPathsLeafToRoot = mapMaybe (spansToSelectionRange . nubOrd) . go [[]] - where - go :: [[Span]] -> HieAST a -> [[Span]] - go acc (Node _ span []) = fmap (span:) acc - go acc (Node _ span children) = concatMap (go (fmap (span:) acc)) children - -spansToSelectionRange :: [Span] -> Maybe SelectionRange -spansToSelectionRange [] = Nothing -spansToSelectionRange (span:spans) = Just $ - SelectionRange {_range = realSrcSpanToRange span, _parent = spansToSelectionRange spans} - -{-| -For each position, find the selection range that contains it, without taking each selection range's -parent into account. These selection ranges are un-divisible, representing the leaf nodes in original AST, so they -won't overlap. --} -findSelectionRangesByPositions :: [SelectionRange] -- ^ all possible selection ranges - -> [Position] -- ^ requested positions - -> [SelectionRange] -findSelectionRangesByPositions selectionRanges = fmap findByPosition - {- - Performance Tips: - Doing a linear search from the first selection range for each position is not optimal. - If it becomes too slow for a large file and many positions, you may optimize the implementation. - Assume the number of selection range is n, then the following techniques may be applied: - 1. For each position, we may treat HieAST as a position indexed tree to search it in O(log(n)). - 2. For all positions, a searched position will narrow the search range for other positions. - -} - where - findByPosition :: Position -> SelectionRange - findByPosition p = fromMaybe SelectionRange{_range = Range p p, _parent = Nothing} $ - find (isPositionInSelectionRange p) selectionRanges - - isPositionInSelectionRange :: Position -> SelectionRange -> Bool - isPositionInSelectionRange p SelectionRange{_range} = - let Range sp ep = _range in sp <= p && p <= ep diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs index 9fd6ab24c2..ca7d926da0 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs @@ -31,7 +31,7 @@ import Development.IDE.GHC.Compat.Util (FastString) import Prelude hiding (span) {-| -Extra arguments for 'preaProcessAST', meant to be used in a 'Reader' context. We use 'Reader' to combine +Extra arguments for 'preProcessAST'. It's expected to be used in a 'Reader' context -} newtype PreProcessEnv a = PreProcessEnv { preProcessEnvRefMap :: RefMap a diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs new file mode 100644 index 0000000000..4953ffd7ec --- /dev/null +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +module Ide.Plugin.SelectionRange.CodeRange + ( CodeRange (..) + , GetCodeRange(..) + , codeRangeRule + , Log + , useExcept + ) where + +import Control.DeepSeq (NFData) +import Control.Monad.Except (ExceptT (..), + runExceptT) +import Control.Monad.Reader (runReader) +import Control.Monad.Trans.Maybe (MaybeT (MaybeT), + maybeToExceptT) +import Data.Coerce (coerce) +import Data.Data (Typeable) +import Data.Hashable +import qualified Data.Map.Strict as Map +import Development.IDE +import Development.IDE.Core.Rules (toIdeResult) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.GHC.Compat (Annotated, + HieAST (..), + HieASTs (getAsts), + ParsedSource, RefMap) +import Development.IDE.GHC.Compat.Util +import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource)) +import GHC.Generics (Generic) +import Ide.Plugin.SelectionRange.ASTPreProcess (PreProcessEnv (..), + preProcessAST) +import Prelude hiding (log) + +data Log = LogShake Shake.Log + | LogBadDependency BadDependencyLog + | LogNoAST + +instance Pretty Log where + pretty log = case log of + LogShake shakeLog -> pretty shakeLog + LogBadDependency badDependencyLog -> pretty badDependencyLog + LogNoAST -> "no HieAst exist for file" + +data BadDependencyLog = forall rule. Show rule => BadDependencyLog rule + +instance Pretty BadDependencyLog where + pretty (BadDependencyLog rule) = "can not get result from rule " <> pretty (show rule) + +data CodeRange = CodeRange Range [CodeRange] + deriving (Show, Generic) + +instance NFData CodeRange + +buildCodeRange :: HieAST a -> RefMap a -> Annotated ParsedSource -> CodeRange +buildCodeRange ast refMap _ = + -- We work on 'HieAST', then convert it to 'CodeRange', so that applications such as selection range and folding + -- range don't need to care about 'HieAST' + -- TODO @sloorush actually use 'Annotated ParsedSource' to handle structures not in 'HieAST' properly (for example comments) + let ast' = runReader (preProcessAST ast) (PreProcessEnv refMap) + in simplify . astToCodeRange $ ast' + +astToCodeRange :: HieAST a -> CodeRange +astToCodeRange (Node _ sp []) = CodeRange (realSrcSpanToRange sp) [] +astToCodeRange (Node _ sp children) = CodeRange (realSrcSpanToRange sp) (fmap astToCodeRange children) + +-- Remove redundant nodes in 'CodeRange' tree +simplify :: CodeRange -> CodeRange +simplify r@(CodeRange range1 [CodeRange range2 children]) + | range1 == range2 = CodeRange range1 children + | otherwise = r +simplify r = r + +data GetCodeRange = GetCodeRange + deriving (Eq, Show, Typeable, Generic) + +instance Hashable GetCodeRange +instance NFData GetCodeRange + +type instance RuleResult GetCodeRange = CodeRange + +-- | Like use, but report absense in 'ExceptT' +useExcept :: IdeRule k v => (BadDependencyLog -> msg) -> k -> NormalizedFilePath -> ExceptT msg Action v +useExcept f rule = maybeToExceptT (f (BadDependencyLog rule)) . MaybeT . use rule + +codeRangeRule :: Recorder (WithPriority Log) -> Rules () +codeRangeRule recorder = + define (cmapWithPrio LogShake recorder) $ \GetCodeRange file -> handleError recorder $ do + -- We need both 'HieAST' (for basic AST) and api annotations (for comments and some keywords). + -- See https://gitlab.haskell.org/ghc/ghc/-/wikis/api-annotations + HAR{hieAst, refMap} <- useExcept LogBadDependency GetHieAst file + ast <- maybeToExceptT LogNoAST . MaybeT . pure $ + getAsts hieAst Map.!? (coerce . mkFastString . fromNormalizedFilePath) file + annPS <- useExcept LogBadDependency GetAnnotatedParsedSource file + pure $ buildCodeRange ast refMap annPS + +-- | Handle error in 'Action'. Returns an 'IdeResult' with no value and no diagnostics on error. (but writes log) +handleError :: Recorder (WithPriority msg) -> ExceptT msg Action a -> Action (IdeResult a) +handleError recorder action' = do + valueEither <- runExceptT action' + case valueEither of + Left msg -> do + logWith recorder Error msg + pure $ toIdeResult (Left []) + Right value -> pure $ toIdeResult (Right value) diff --git a/plugins/hls-selection-range-plugin/test/Main.hs b/plugins/hls-selection-range-plugin/test/Main.hs index ac0335a0f6..66d8379eee 100644 --- a/plugins/hls-selection-range-plugin/test/Main.hs +++ b/plugins/hls-selection-range-plugin/test/Main.hs @@ -2,29 +2,36 @@ module Main (main) where -import Control.Lens hiding (List, (<.>)) -import Data.ByteString.Lazy (ByteString) -import qualified Data.ByteString.Lazy.Char8 as LBSChar8 -import Data.String (fromString) -import Ide.Plugin.SelectionRange (descriptor) +import Control.Lens hiding (List, (<.>)) +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy.Char8 as LBSChar8 +import Data.String (fromString) +import Development.IDE.Types.Logger (Priority (Debug), + Recorder (Recorder), + WithPriority (WithPriority), + makeDefaultStderrRecorder, + pretty) +import Ide.Plugin.SelectionRange (Log, descriptor) import Language.LSP.Types.Lens -import System.FilePath ((<.>), ()) +import System.FilePath ((<.>), ()) import Test.Hls -plugin :: PluginDescriptor IdeState -plugin = descriptor "selectionRange" +plugin :: Recorder (WithPriority Log) -> PluginDescriptor IdeState +plugin recorder = descriptor recorder "selectionRange" main :: IO () -main = defaultTestRunner $ - testGroup "Selection Range" - [ goldenTest "Import" [(4, 36), (1, 8)] - , goldenTest "Function" [(5, 19), (5, 12), (4, 4), (3, 5)] - ] +main = do + recorder <- contramap (fmap pretty) <$> makeDefaultStderrRecorder Nothing Debug + defaultTestRunner $ + testGroup "Selection Range" + [ goldenTest recorder "Import" [(4, 36), (1, 8)] + , goldenTest recorder "Function" [(5, 19), (5, 12), (4, 4), (3, 5)] + ] -- | build a golden test for -goldenTest :: TestName -> [(UInt, UInt)] -> TestTree -goldenTest testName positions = goldenGitDiff testName (testDataDir testName <.> "golden" <.> "txt") $ do - res <- runSessionWithServer plugin testDataDir $ do +goldenTest :: Recorder (WithPriority Log) -> TestName -> [(UInt, UInt)] -> TestTree +goldenTest recorder testName positions = goldenGitDiff testName (testDataDir testName <.> "golden" <.> "txt") $ do + res <- runSessionWithServer (plugin recorder) testDataDir $ do doc <- openDoc (testName <.> "hs") "haskell" resp <- request STextDocumentSelectionRange $ SelectionRangeParams Nothing Nothing doc (List $ fmap (uncurry Position . (\(x, y) -> (x-1, y-1))) positions) From 52e0c156010ba7c86e3d2c88be5497a3c818e5f8 Mon Sep 17 00:00:00 2001 From: kokobd Date: Fri, 1 Jul 2022 17:16:22 +0800 Subject: [PATCH 10/20] refine selection range --- hls-plugin-api/src/Ide/PluginUtils.hs | 2 +- hls-plugin-api/test/Ide/PluginUtilsTest.hs | 2 + .../hls-selection-range-plugin.cabal | 2 + .../src/Ide/Plugin/SelectionRange.hs | 61 ++++++--- .../Ide/Plugin/SelectionRange/CodeRange.hs | 128 +++++++++++++----- 5 files changed, 141 insertions(+), 54 deletions(-) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 19303516ac..1210138f9a 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -223,7 +223,7 @@ subRange smallRange range = && positionInRange (_end smallRange) range positionInRange :: Position -> Range -> Bool -positionInRange p (Range sp ep) = sp <= p && p <= ep +positionInRange p (Range sp ep) = sp <= p && p < ep -- Range's end position is exclusive, see https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#range -- --------------------------------------------------------------------- diff --git a/hls-plugin-api/test/Ide/PluginUtilsTest.hs b/hls-plugin-api/test/Ide/PluginUtilsTest.hs index 19a832f165..c6bedfdf28 100644 --- a/hls-plugin-api/test/Ide/PluginUtilsTest.hs +++ b/hls-plugin-api/test/Ide/PluginUtilsTest.hs @@ -20,6 +20,8 @@ positionInRangeTest = testGroup "positionInRange" positionInRange (Position 1 0) (Range (Position 1 1) (Position 1 6)) @?= False , testCase "single line, in range" $ positionInRange (Position 1 5) (Range (Position 1 1) (Position 1 6)) @?= True + , testCase "single line, at the end" $ + positionInRange (Position 1 5) (Range (Position 1 1) (Position 1 5)) @?= False , testCase "multiline, in range" $ positionInRange (Position 3 5) (Range (Position 1 1) (Position 5 6)) @?= True , testCase "multiline, out of range" $ diff --git a/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal b/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal index f7ad9713ac..5c7fb62f80 100644 --- a/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal +++ b/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal @@ -43,6 +43,8 @@ library , semigroupoids , hashable , deepseq + , vector + , lens test-suite tests type: exitcode-stdio-1.0 diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs index 5bab05338a..7d6ef11015 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs @@ -9,7 +9,11 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Maybe (MaybeT (MaybeT), maybeToExceptT) import Data.Either.Extra (maybeToEither) -import Data.Maybe (fromMaybe, mapMaybe) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Maybe (fromMaybe) +import Data.Vector (Vector) +import qualified Data.Vector as V import Development.IDE (IdeAction, IdeState (shakeExtras), Range (Range), Recorder, @@ -37,6 +41,7 @@ import Language.LSP.Server (LspM) import Language.LSP.Types (List (List), NormalizedFilePath, Position (..), + Range (_start), ResponseError, SMethod (STextDocumentSelectionRange), SelectionRange (..), @@ -82,36 +87,48 @@ getSelectionRanges file positions = do traverse (fromCurrentPosition positionMapping) positions let selectionRanges = flip fmap positions' $ \pos -> - -- codeRange doesn't cover all portions of text in the file, so we need a default value + -- 'codeRange' may not cover all portions of text in the file, we need a default value to make sure + -- other positions can still work. let defaultSelectionRange = SelectionRange (Range pos pos) Nothing - in reverseSelectionRange . fromMaybe defaultSelectionRange . findPosition' pos $ codeRange + in fromMaybe defaultSelectionRange . findPosition pos $ codeRange -- 'positionMapping' should be applied to the output ranges before returning them maybeToExceptT "fail to apply position mapping to output positions" . MaybeT . pure $ traverse (toCurrentSelectionRange positionMapping) selectionRanges --- Find 'Position' in 'CodeRange'. Producing an inverse 'SelectionRange' -findPosition' :: Position -> CodeRange -> Maybe SelectionRange -findPosition' pos (CodeRange range children) = - if positionInRange pos range - then Just $ case mapMaybe (findPosition' pos) children of - [childSelectionRange] -> SelectionRange range (Just childSelectionRange) - _ -> SelectionRange range Nothing - else Nothing - --- Reverse 'SelectionRange'. Just like 'reverse' for list. -reverseSelectionRange :: SelectionRange -> SelectionRange -reverseSelectionRange = go (SelectionRange invalidRange Nothing) +-- | Find 'Position' in 'CodeRange'. +findPosition :: Position -> CodeRange -> Maybe SelectionRange +findPosition pos root = + selectionRangeFromNonEmpty . NonEmpty.reverse -- SelectionRange requires a bottom-up order, so we need to reverse + <$> go root where - go :: SelectionRange -> SelectionRange -> SelectionRange - go acc (SelectionRange r Nothing) = SelectionRange r (checkRange acc) - go acc (SelectionRange r (Just parent)) = go (SelectionRange r (checkRange acc)) parent + -- Helper function for recursion. The range list is built top-down + go :: CodeRange -> Maybe (NonEmpty Range) + go node = + if positionInRange pos range + then case binarySearchPos children of + Just childContainingPos -> fmap (range NonEmpty.<|) (go childContainingPos) + Nothing -> Just $ range NonEmpty.:| [] -- NonEmpty.singleton doesn't exist in GHC 8.8.4 + else Nothing + where + range = _codeRange_range node + children = _codeRange_children node - checkRange :: SelectionRange -> Maybe SelectionRange - checkRange r@(SelectionRange range _) = if range == invalidRange then Nothing else Just r + binarySearchPos :: Vector CodeRange -> Maybe CodeRange + binarySearchPos v + | V.null v = Nothing + | V.length v == 1, + Just r <- V.headM v = if positionInRange pos (_codeRange_range r) then Just r else Nothing + | otherwise = do + let (left, right) = V.splitAt (V.length v `div` 2) v + startOfRight <- _start . _codeRange_range <$> V.headM right + if pos < startOfRight then binarySearchPos left else binarySearchPos right - invalidRange :: Range - invalidRange = Range (Position (-1) (-1)) (Position (-1) (-1)) +-- | Construct 'SelectionRange' from 'NonEmpty' 'Range' +selectionRangeFromNonEmpty :: NonEmpty Range -> SelectionRange +selectionRangeFromNonEmpty ranges + | (r, remaining) <- NonEmpty.uncons ranges = + SelectionRange r (fmap selectionRangeFromNonEmpty remaining) -- | Likes 'toCurrentPosition', but works on 'SelectionRange' toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs index 4953ffd7ec..a87e3869fc 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs @@ -1,27 +1,39 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Ide.Plugin.SelectionRange.CodeRange ( CodeRange (..) + , codeRange_range + , codeRange_children , GetCodeRange(..) , codeRangeRule , Log - , useExcept ) where import Control.DeepSeq (NFData) +import qualified Control.Lens as Lens import Control.Monad.Except (ExceptT (..), runExceptT) import Control.Monad.Reader (runReader) +import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (MaybeT), maybeToExceptT) +import Control.Monad.Trans.Writer.CPS import Data.Coerce (coerce) import Data.Data (Typeable) +import Data.Foldable (traverse_) +import Data.Function (on, (&)) import Data.Hashable +import Data.List (sort) import qualified Data.Map.Strict as Map +import Data.Vector (Vector) +import qualified Data.Vector as V import Development.IDE import Development.IDE.Core.Rules (toIdeResult) import qualified Development.IDE.Core.Shake as Shake @@ -34,46 +46,100 @@ import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSour import GHC.Generics (Generic) import Ide.Plugin.SelectionRange.ASTPreProcess (PreProcessEnv (..), preProcessAST) +import Language.LSP.Types.Lens (HasEnd (end), + HasStart (start)) import Prelude hiding (log) data Log = LogShake Shake.Log - | LogBadDependency BadDependencyLog | LogNoAST + | LogFoundInterleaving CodeRange CodeRange instance Pretty Log where pretty log = case log of - LogShake shakeLog -> pretty shakeLog - LogBadDependency badDependencyLog -> pretty badDependencyLog - LogNoAST -> "no HieAst exist for file" + LogShake shakeLog -> pretty shakeLog + LogNoAST -> "no HieAst exist for file" + LogFoundInterleaving r1 r2 -> + let prettyRange = pretty . show . _codeRange_range + in "CodeRange interleave: " <> prettyRange r1 <> " & " <> prettyRange r2 + +-- | A tree representing code ranges in a file. This can be useful for features like selection range and folding range +data CodeRange = CodeRange { + -- | Range for current level + _codeRange_range :: !Range, + -- | A vector of children, sorted by their ranges in ascending order. + -- Children are guaranteed not to interleave, but some gaps may exist among them. + _codeRange_children :: !(Vector CodeRange) + } + deriving (Show, Generic) -data BadDependencyLog = forall rule. Show rule => BadDependencyLog rule +instance NFData CodeRange -instance Pretty BadDependencyLog where - pretty (BadDependencyLog rule) = "can not get result from rule " <> pretty (show rule) +Lens.makeLenses ''CodeRange -data CodeRange = CodeRange Range [CodeRange] - deriving (Show, Generic) +instance Eq CodeRange where + (==) = (==) `on` _codeRange_range -instance NFData CodeRange +instance Ord CodeRange where + compare :: CodeRange -> CodeRange -> Ordering + compare = compare `on` _codeRange_range -buildCodeRange :: HieAST a -> RefMap a -> Annotated ParsedSource -> CodeRange -buildCodeRange ast refMap _ = +-- | Construct a 'CodeRange'. A valid CodeRange will be returned in any case. If anything go wrong, +-- a list of warnings will be returned as 'Log' +buildCodeRange :: HieAST a -> RefMap a -> Annotated ParsedSource -> Writer [Log] CodeRange +buildCodeRange ast refMap _ = do -- We work on 'HieAST', then convert it to 'CodeRange', so that applications such as selection range and folding -- range don't need to care about 'HieAST' -- TODO @sloorush actually use 'Annotated ParsedSource' to handle structures not in 'HieAST' properly (for example comments) let ast' = runReader (preProcessAST ast) (PreProcessEnv refMap) - in simplify . astToCodeRange $ ast' - -astToCodeRange :: HieAST a -> CodeRange -astToCodeRange (Node _ sp []) = CodeRange (realSrcSpanToRange sp) [] -astToCodeRange (Node _ sp children) = CodeRange (realSrcSpanToRange sp) (fmap astToCodeRange children) - --- Remove redundant nodes in 'CodeRange' tree + codeRange <- astToCodeRange ast' + pure $ simplify codeRange + +astToCodeRange :: HieAST a -> Writer [Log] CodeRange +astToCodeRange (Node _ sp []) = pure $ CodeRange (realSrcSpanToRange sp) mempty +astToCodeRange (Node _ sp children) = do + children' <- removeInterleaving . sort =<< traverse astToCodeRange children + pure $ CodeRange (realSrcSpanToRange sp) (V.fromList children') + +-- | Remove interleaving of the list of 'CodeRange's. +removeInterleaving :: [CodeRange] -> Writer [Log] [CodeRange] +removeInterleaving [] = pure [] +removeInterleaving (x1:xs) = do + remaining <- removeInterleaving xs + (:remaining) <$> case remaining of + [] -> pure x1 + -- Given that the CodeRange is already sorted on it's Range, and the Ord instance of Range + -- compares it's start position first, the start position must be already in an ascending order. + -- Then, if the end position of a node is larger than it's next neighbour's start position, an interleaving + -- must exist. + -- (Note: LSP Range's end position is exclusive) + x2:_ -> if x1 Lens.^. codeRange_range . end > x2 Lens.^. codeRange_range . start + then do + let codeRangeEnd :: Lens.Lens' CodeRange Position + codeRangeEnd = codeRange_range . end + x1' :: CodeRange + x1' = x1 & codeRangeEnd Lens..~ (x2 Lens.^. codeRangeEnd) + tell [LogFoundInterleaving x1 x2] + pure x1' + else pure x1 + +-- | Remove redundant nodes in 'CodeRange' tree simplify :: CodeRange -> CodeRange -simplify r@(CodeRange range1 [CodeRange range2 children]) - | range1 == range2 = CodeRange range1 children - | otherwise = r -simplify r = r +simplify r = + case onlyChild of + -- If a node has the exact same range as it's parent, and it has no sibling, then it can be removed. + Just onlyChild' -> + if _codeRange_range onlyChild' == curRange + then simplify (r { _codeRange_children = _codeRange_children onlyChild' }) + else withChildrenSimplified + Nothing -> withChildrenSimplified + where + curRange = _codeRange_range r + + onlyChild :: Maybe CodeRange = + let children = _codeRange_children r + in if V.length children == 1 then V.headM children else Nothing + + withChildrenSimplified = r { _codeRange_children = simplify <$> _codeRange_children r } data GetCodeRange = GetCodeRange deriving (Eq, Show, Typeable, Generic) @@ -83,20 +149,20 @@ instance NFData GetCodeRange type instance RuleResult GetCodeRange = CodeRange --- | Like use, but report absense in 'ExceptT' -useExcept :: IdeRule k v => (BadDependencyLog -> msg) -> k -> NormalizedFilePath -> ExceptT msg Action v -useExcept f rule = maybeToExceptT (f (BadDependencyLog rule)) . MaybeT . use rule - codeRangeRule :: Recorder (WithPriority Log) -> Rules () codeRangeRule recorder = define (cmapWithPrio LogShake recorder) $ \GetCodeRange file -> handleError recorder $ do -- We need both 'HieAST' (for basic AST) and api annotations (for comments and some keywords). -- See https://gitlab.haskell.org/ghc/ghc/-/wikis/api-annotations - HAR{hieAst, refMap} <- useExcept LogBadDependency GetHieAst file + HAR{hieAst, refMap} <- lift $ use_ GetHieAst file ast <- maybeToExceptT LogNoAST . MaybeT . pure $ getAsts hieAst Map.!? (coerce . mkFastString . fromNormalizedFilePath) file - annPS <- useExcept LogBadDependency GetAnnotatedParsedSource file - pure $ buildCodeRange ast refMap annPS + annPS <- lift $ use_ GetAnnotatedParsedSource file + + let (codeRange, warnings) = runWriter (buildCodeRange ast refMap annPS) + traverse_ (logWith recorder Warning) warnings + + pure codeRange -- | Handle error in 'Action'. Returns an 'IdeResult' with no value and no diagnostics on error. (but writes log) handleError :: Recorder (WithPriority msg) -> ExceptT msg Action a -> Action (IdeResult a) From 5fde9635ebc886bdc2747d430fab5b80bbaf7660 Mon Sep 17 00:00:00 2001 From: kokobd Date: Mon, 4 Jul 2022 17:34:13 +0800 Subject: [PATCH 11/20] add CodeKind to CodeRange --- ghcide/src/Development/IDE/GHC/Compat.hs | 178 +++++++++++------- .../src/Ide/Plugin/SelectionRange.hs | 5 +- .../Plugin/SelectionRange/ASTPreProcess.hs | 98 ++++++---- .../Ide/Plugin/SelectionRange/CodeRange.hs | 37 ++-- 4 files changed, 198 insertions(+), 120 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 1c2876f736..8bb3c5fd1c 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -32,10 +32,14 @@ module Development.IDE.GHC.Compat( myCoreToStgExpr, #endif + FastStringCompat, nodeInfo', getNodeIds, - nodeInfoFromSource, + sourceNodeInfo, + generatedNodeInfo, + simpleNodeInfoCompat, isAnnotationInNodeInfo, + nodeAnnotations, mkAstNode, combineRealSrcSpans, @@ -94,7 +98,6 @@ module Development.IDE.GHC.Compat( module UniqSet, module UniqDFM, getDependentMods, - diffBinds, flattenBinds, mkRnEnv2, emptyInScopeSet, @@ -113,6 +116,7 @@ module Development.IDE.GHC.Compat( #endif ) where +import Data.Bifunctor import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.ExactPrint @@ -125,58 +129,74 @@ import Development.IDE.GHC.Compat.Units import Development.IDE.GHC.Compat.Util import GHC hiding (HasSrcSpan, ModLocation, - RealSrcSpan, getLoc, - lookupName, exprType) + RealSrcSpan, exprType, + getLoc, lookupName) + +import Data.Coerce (coerce) +import Data.String (IsString (fromString)) + + #if MIN_VERSION_ghc(9,0,0) -import GHC.Driver.Hooks (hscCompileCoreExprHook) -import GHC.Core (CoreExpr, CoreProgram, Unfolding(..), noUnfolding, flattenBinds) -import qualified GHC.Core.Opt.Pipeline as GHC -import GHC.Core.Tidy (tidyExpr) -import GHC.Types.Var.Env (emptyTidyEnv, mkRnEnv2, emptyInScopeSet) -import qualified GHC.CoreToStg.Prep as GHC -import GHC.CoreToStg.Prep (corePrepPgm) -import GHC.Core.Lint (lintInteractiveExpr) +import GHC.Core.Lint (lintInteractiveExpr) +import qualified GHC.Core.Opt.Pipeline as GHC +import GHC.Core.Tidy (tidyExpr) +import GHC.CoreToStg.Prep (corePrepPgm) +import qualified GHC.CoreToStg.Prep as GHC +import GHC.Driver.Hooks (hscCompileCoreExprHook) #if MIN_VERSION_ghc(9,2,0) -import GHC.Unit.Home.ModInfo (lookupHpt, HomePackageTable) -import GHC.Runtime.Context (icInteractiveModule) -import GHC.Unit.Module.Deps (Dependencies(dep_mods)) -import GHC.Linker.Types (isObjectLinkable) -import GHC.Linker.Loader (loadExpr) +import GHC.Linker.Loader (loadExpr) +import GHC.Linker.Types (isObjectLinkable) +import GHC.Runtime.Context (icInteractiveModule) +import GHC.Unit.Home.ModInfo (HomePackageTable, + lookupHpt) +import GHC.Unit.Module.Deps (Dependencies (dep_mods)) #else -import GHC.CoreToByteCode (coreExprToBCOs) -import GHC.Driver.Types (Dependencies(dep_mods), icInteractiveModule, lookupHpt, HomePackageTable) -import GHC.Runtime.Linker (linkExpr) -#endif -import GHC.ByteCode.Asm (bcoFreeNames) -import GHC.Types.Annotations (Annotation(..), AnnTarget(ModuleTarget), extendAnnEnvList) -import GHC.Types.Unique.DSet as UniqDSet -import GHC.Types.Unique.Set as UniqSet -import GHC.Types.Unique.DFM as UniqDFM +import GHC.CoreToByteCode (coreExprToBCOs) +import GHC.Driver.Types (Dependencies (dep_mods), + HomePackageTable, + icInteractiveModule, + lookupHpt) +import GHC.Runtime.Linker (linkExpr) +#endif +import GHC.ByteCode.Asm (bcoFreeNames) +import GHC.Types.Annotations (AnnTarget (ModuleTarget), + Annotation (..), + extendAnnEnvList) +import GHC.Types.Unique.DFM as UniqDFM +import GHC.Types.Unique.DSet as UniqDSet +import GHC.Types.Unique.Set as UniqSet #else -import Hooks (hscCompileCoreExprHook) -import CoreSyn (CoreExpr, flattenBinds, Unfolding(..), noUnfolding) -import qualified SimplCore as GHC -import CoreTidy (tidyExpr) -import VarEnv (emptyTidyEnv, mkRnEnv2, emptyInScopeSet) -import CorePrep (corePrepExpr, corePrepPgm) -import CoreLint (lintInteractiveExpr) -import ByteCodeGen (coreExprToBCOs) -import HscTypes (icInteractiveModule, HomePackageTable, lookupHpt, Dependencies(dep_mods)) -import Linker (linkExpr) -import ByteCodeAsm (bcoFreeNames) -import Annotations (Annotation(..), AnnTarget(ModuleTarget), extendAnnEnvList) -import UniqDSet -import UniqSet -import UniqDFM +import Annotations (AnnTarget (ModuleTarget), + Annotation (..), + extendAnnEnvList) +import ByteCodeAsm (bcoFreeNames) +import ByteCodeGen (coreExprToBCOs) +import CoreLint (lintInteractiveExpr) +import CorePrep (corePrepExpr, + corePrepPgm) +import CoreSyn (CoreExpr, + Unfolding (..), + flattenBinds, + noUnfolding) +import CoreTidy (tidyExpr) +import Hooks (hscCompileCoreExprHook) +import Linker (linkExpr) +import qualified SimplCore as GHC +import UniqDFM +import UniqDSet +import UniqSet +import VarEnv (emptyInScopeSet, + emptyTidyEnv, mkRnEnv2) #endif #if MIN_VERSION_ghc(9,0,0) +import GHC.Core import GHC.Data.StringBuffer import GHC.Driver.Session hiding (ExposePackage) import qualified GHC.Types.SrcLoc as SrcLoc +import GHC.Types.Var.Env import GHC.Utils.Error #if MIN_VERSION_ghc(9,2,0) -import Data.Bifunctor import GHC.Driver.Env as Env import GHC.Unit.Module.ModIface import GHC.Unit.Module.ModSummary @@ -209,41 +229,32 @@ import System.IO import Compat.HieAst (enrichHie) import Compat.HieBin -import Compat.HieTypes +import Compat.HieTypes hiding (nodeAnnotations) +import qualified Compat.HieTypes as GHC (nodeAnnotations) import Compat.HieUtils import qualified Data.ByteString as BS import Data.IORef import Data.List (foldl') import qualified Data.Map as Map -import qualified Data.Set as Set - -#if MIN_VERSION_ghc(9,0,0) import qualified Data.Set as S -#endif #if !MIN_VERSION_ghc(8,10,0) import Bag (unitBag) #endif #if MIN_VERSION_ghc(9,2,0) -import GHC.Types.CostCentre -import GHC.Stg.Syntax -import GHC.Types.IPE -import GHC.Stg.Syntax -import GHC.Types.IPE -import GHC.Types.CostCentre -import GHC.Core -import GHC.Builtin.Uniques -import GHC.Runtime.Interpreter -import GHC.StgToByteCode -import GHC.Stg.Pipeline -import GHC.ByteCode.Types -import GHC.Linker.Loader (loadDecls) -import GHC.Data.Maybe -import GHC.CoreToStg -import GHC.Core.Utils -import GHC.Types.Var.Env +import GHC.Builtin.Uniques +import GHC.ByteCode.Types +import GHC.CoreToStg +import GHC.Data.Maybe +import GHC.Linker.Loader (loadDecls) +import GHC.Runtime.Interpreter +import GHC.Stg.Pipeline +import GHC.Stg.Syntax +import GHC.StgToByteCode +import GHC.Types.CostCentre +import GHC.Types.IPE #endif type ModIfaceAnnotation = Annotation @@ -506,11 +517,18 @@ nodeInfo' = nodeInfo -- unhelpfulSpanFS = id #endif -nodeInfoFromSource :: HieAST a -> Maybe (NodeInfo a) +sourceNodeInfo :: HieAST a -> Maybe (NodeInfo a) +#if MIN_VERSION_ghc(9,0,0) +sourceNodeInfo = Map.lookup SourceInfo . getSourcedNodeInfo . sourcedNodeInfo +#else +sourceNodeInfo = Just . nodeInfo +#endif + +generatedNodeInfo :: HieAST a -> Maybe (NodeInfo a) #if MIN_VERSION_ghc(9,0,0) -nodeInfoFromSource = Map.lookup SourceInfo . getSourcedNodeInfo . sourcedNodeInfo +generatedNodeInfo = Map.lookup GeneratedInfo . getSourcedNodeInfo . sourcedNodeInfo #else -nodeInfoFromSource = Just . nodeInfo +generatedNodeInfo = sourceNodeInfo -- before ghc 9.0, we don't distinguish the source #endif data GhcVersion @@ -553,11 +571,31 @@ runPp = const SysTools.runPp #endif -isAnnotationInNodeInfo :: (FastString, FastString) -> NodeInfo a -> Bool +simpleNodeInfoCompat :: FastStringCompat -> FastStringCompat -> NodeInfo a +simpleNodeInfoCompat ctor typ = simpleNodeInfo (coerce ctor) (coerce typ) + +isAnnotationInNodeInfo :: (FastStringCompat, FastStringCompat) -> NodeInfo a -> Bool +isAnnotationInNodeInfo p = S.member p . nodeAnnotations + +nodeAnnotations :: NodeInfo a -> S.Set (FastStringCompat, FastStringCompat) +#if MIN_VERSION_ghc(9,2,0) +nodeAnnotations = S.map (\(NodeAnnotation ctor typ) -> (coerce ctor, coerce typ)) . GHC.nodeAnnotations +#else +nodeAnnotations = S.map (bimap coerce coerce) . GHC.nodeAnnotations +#endif + +#if MIN_VERSION_ghc(9,2,0) +newtype FastStringCompat = FastStringCompat LexicalFastString +#else +newtype FastStringCompat = FastStringCompat FastString +#endif + deriving (Show, Eq, Ord) + +instance IsString FastStringCompat where #if MIN_VERSION_ghc(9,2,0) -isAnnotationInNodeInfo (ctor, typ) = Set.member (NodeAnnotation ctor typ) . nodeAnnotations + fromString = FastStringCompat . LexicalFastString . fromString #else -isAnnotationInNodeInfo p = Set.member p . nodeAnnotations + fromString = FastStringCompat . fromString #endif mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs index 7d6ef11015..3964eac861 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs @@ -87,8 +87,7 @@ getSelectionRanges file positions = do traverse (fromCurrentPosition positionMapping) positions let selectionRanges = flip fmap positions' $ \pos -> - -- 'codeRange' may not cover all portions of text in the file, we need a default value to make sure - -- other positions can still work. + -- We need a default selection range if the lookup fails, so that other positions can still have valid results. let defaultSelectionRange = SelectionRange (Range pos pos) Nothing in fromMaybe defaultSelectionRange . findPosition pos $ codeRange @@ -96,7 +95,7 @@ getSelectionRanges file positions = do maybeToExceptT "fail to apply position mapping to output positions" . MaybeT . pure $ traverse (toCurrentSelectionRange positionMapping) selectionRanges --- | Find 'Position' in 'CodeRange'. +-- | Find 'Position' in 'CodeRange'. This can fail, if the given position is not covered by the 'CodeRange'. findPosition :: Position -> CodeRange -> Maybe SelectionRange findPosition pos root = selectionRangeFromNonEmpty . NonEmpty.reverse -- SelectionRange requires a bottom-up order, so we need to reverse diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs index ca7d926da0..e7fdeb6058 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs @@ -4,31 +4,24 @@ module Ide.Plugin.SelectionRange.ASTPreProcess ( preProcessAST , PreProcessEnv(..) + , isCustomNode + , CustomNodeType(..) ) where -import Control.Monad.Reader (Reader, asks) -import Data.Foldable (find, foldl') -import Data.Functor.Identity (Identity (Identity, runIdentity)) -import Data.List (groupBy) -import Data.List.NonEmpty (NonEmpty) -import qualified Data.List.NonEmpty as NonEmpty -import qualified Data.Map.Strict as Map -import Data.Maybe (mapMaybe) -import Data.Semigroup.Foldable (foldlM1) -import qualified Data.Set as Set -import Development.IDE.GHC.Compat (ContextInfo (MatchBind, TyDecl, ValBind), - HieAST (..), Identifier, - IdentifierDetails (identInfo), - NodeInfo (NodeInfo, nodeIdentifiers), - RealSrcSpan, RefMap, Span, - combineRealSrcSpans, - flattenAst, - isAnnotationInNodeInfo, - mkAstNode, nodeInfoFromSource, - realSrcSpanEnd, - realSrcSpanStart) -import Development.IDE.GHC.Compat.Util (FastString) -import Prelude hiding (span) +import Control.Monad.Reader (Reader, asks) +import Data.Foldable +import Data.Functor.Identity (Identity (Identity, runIdentity)) +import Data.List (groupBy) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Semigroup (First (First, getFirst)) +import Data.Semigroup.Foldable (foldlM1) +import qualified Data.Set as Set +import Development.IDE.GHC.Compat hiding (nodeInfo) +import Prelude hiding (span) {-| Extra arguments for 'preProcessAST'. It's expected to be used in a 'Reader' context @@ -52,6 +45,47 @@ If it goes more complex, it may be more appropriate to split different manipulat preProcessAST :: HieAST a -> Reader (PreProcessEnv a) (HieAST a) preProcessAST node = mergeImports node >>= mergeSignatureWithDefinition +{-| +Create a custom node in 'HieAST'. By "custom", we mean this node doesn't actually exist in the original 'HieAST' +provided by GHC, but created to suite the needs of hls-code-range-plugin. +-} +createCustomNode :: CustomNodeType -> NonEmpty (HieAST a) -> HieAST a +createCustomNode customNodeType children = mkAstNode customNodeInfo span' (NonEmpty.toList children) + where + span' :: RealSrcSpan + span' = runIdentity . foldlM1 (\x y -> Identity (combineRealSrcSpans x y)) . fmap nodeSpan $ children + + customNodeInfo = simpleNodeInfoCompat "HlsCustom" (customNodeTypeToFastString customNodeType) + +isCustomNode :: HieAST a -> Maybe CustomNodeType +isCustomNode node = do + nodeInfo <- generatedNodeInfo node + getFirst <$> foldMap go (nodeAnnotations nodeInfo) + where + go :: (FastStringCompat, FastStringCompat) -> Maybe (First CustomNodeType) + go (k, v) + | k == "HlsCustom", Just v' <- revCustomNodeTypeMapping Map.!? v = Just (First v') + | otherwise = Nothing + +data CustomNodeType = + -- | a group of imports + CustomNodeImportsGroup + -- | adjacent type signature and value definition are paired under a custom parent node + | CustomNodeAdjacentSignatureDefinition + deriving (Show, Eq, Ord) + +customNodeTypeMapping :: Map CustomNodeType FastStringCompat +customNodeTypeMapping = Map.fromList + [ (CustomNodeImportsGroup, "Imports") + , (CustomNodeAdjacentSignatureDefinition, "AdjacentSignatureDefinition") + ] + +revCustomNodeTypeMapping :: Map FastStringCompat CustomNodeType +revCustomNodeTypeMapping = Map.fromList . fmap (\(k, v) -> (v, k)) . Map.toList $ customNodeTypeMapping + +customNodeTypeToFastString :: CustomNodeType -> FastStringCompat +customNodeTypeToFastString k = fromMaybe "" (customNodeTypeMapping Map.!? k) + {-| Combines adjacent import declarations under a new parent node, so that the user will have an extra step selecting the whole import area while expanding/shrinking the selection range. @@ -67,17 +101,11 @@ mergeImports node = pure $ node { nodeChildren = children } merge :: [HieAST a] -> Maybe (HieAST a) merge [] = Nothing merge [x] = Just x - merge (x:xs) = Just $ createVirtualNode (x NonEmpty.:| xs) + merge (x:xs) = Just $ createCustomNode CustomNodeImportsGroup (x NonEmpty.:| xs) nodeIsImport :: HieAST a -> Bool nodeIsImport = isAnnotationInAstNode ("ImportDecl", "ImportDecl") -createVirtualNode :: NonEmpty (HieAST a) -> HieAST a -createVirtualNode children = mkAstNode (NodeInfo mempty mempty mempty) span' (NonEmpty.toList children) - where - span' :: RealSrcSpan - span' = runIdentity . foldlM1 (\x y -> Identity (combineRealSrcSpans x y)) . fmap nodeSpan $ children - {-| Combine type signature with variable definition under a new parent node, if the signature is placed right before the definition. This allows the user to have a step selecting both type signature and its accompanying definition. @@ -110,7 +138,7 @@ mergeAdjacentSigDef refMap (n1, n2) = do -- Does that identifier appear in the second AST node as a definition? If so, we combines the two nodes. refs <- Map.lookup typeSigId refMap if any (isIdentADef (nodeSpan n2)) refs - then pure . createVirtualNode $ n1 NonEmpty.:| [n2] + then pure . createCustomNode CustomNodeAdjacentSignatureDefinition $ n1 NonEmpty.:| [n2] else Nothing where checkAnnotation :: Maybe () @@ -136,7 +164,7 @@ identifierForTypeSig node = nodes = flattenAst node extractIdentifier :: HieAST a -> Maybe Identifier - extractIdentifier node' = nodeInfoFromSource node' >>= + extractIdentifier node' = sourceNodeInfo node' >>= (fmap fst . find (\(_, detail) -> TyDecl `Set.member` identInfo detail) . Map.toList . nodeIdentifiers) @@ -147,7 +175,7 @@ isIdentADef outerSpan (span, detail) = && isDef where isDef :: Bool - isDef = any isContextInfoDef . Set.toList . identInfo $ detail + isDef = any isContextInfoDef . toList . identInfo $ detail -- Does the 'ContextInfo' represents a variable/function definition? isContextInfoDef :: ContextInfo -> Bool @@ -155,5 +183,5 @@ isIdentADef outerSpan (span, detail) = isContextInfoDef MatchBind = True isContextInfoDef _ = False -isAnnotationInAstNode :: (FastString, FastString) -> HieAST a -> Bool -isAnnotationInAstNode p = maybe False (isAnnotationInNodeInfo p) . nodeInfoFromSource +isAnnotationInAstNode :: (FastStringCompat, FastStringCompat) -> HieAST a -> Bool +isAnnotationInAstNode p = maybe False (isAnnotationInNodeInfo p) . sourceNodeInfo diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs index a87e3869fc..eddaf2c407 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE InstanceSigs #-} @@ -11,6 +12,7 @@ module Ide.Plugin.SelectionRange.CodeRange ( CodeRange (..) , codeRange_range , codeRange_children + , codeRange_kind , GetCodeRange(..) , codeRangeRule , Log @@ -44,7 +46,9 @@ import Development.IDE.GHC.Compat (Annotated, import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource)) import GHC.Generics (Generic) -import Ide.Plugin.SelectionRange.ASTPreProcess (PreProcessEnv (..), +import Ide.Plugin.SelectionRange.ASTPreProcess (CustomNodeType (..), + PreProcessEnv (..), + isCustomNode, preProcessAST) import Language.LSP.Types.Lens (HasEnd (end), HasStart (start)) @@ -68,11 +72,21 @@ data CodeRange = CodeRange { _codeRange_range :: !Range, -- | A vector of children, sorted by their ranges in ascending order. -- Children are guaranteed not to interleave, but some gaps may exist among them. - _codeRange_children :: !(Vector CodeRange) + _codeRange_children :: !(Vector CodeRange), + -- The kind of current code range + _codeRange_kind :: CodeRangeKind } - deriving (Show, Generic) - -instance NFData CodeRange + deriving (Show, Generic, NFData) + +-- | 'CodeKind' represents the kind of a code range +data CodeRangeKind = + -- | ordinary code + CodeKindRegion + -- | the group of imports + | CodeKindImports + -- | a comment + | CodeKindComment + deriving (Show, Generic, NFData) Lens.makeLenses ''CodeRange @@ -95,10 +109,11 @@ buildCodeRange ast refMap _ = do pure $ simplify codeRange astToCodeRange :: HieAST a -> Writer [Log] CodeRange -astToCodeRange (Node _ sp []) = pure $ CodeRange (realSrcSpanToRange sp) mempty -astToCodeRange (Node _ sp children) = do +astToCodeRange (Node _ sp []) = pure $ CodeRange (realSrcSpanToRange sp) mempty CodeKindRegion +astToCodeRange node@(Node _ sp children) = do children' <- removeInterleaving . sort =<< traverse astToCodeRange children - pure $ CodeRange (realSrcSpanToRange sp) (V.fromList children') + let codeKind = if Just CustomNodeImportsGroup == isCustomNode node then CodeKindImports else CodeKindRegion + pure $ CodeRange (realSrcSpanToRange sp) (V.fromList children') codeKind -- | Remove interleaving of the list of 'CodeRange's. removeInterleaving :: [CodeRange] -> Writer [Log] [CodeRange] @@ -114,10 +129,8 @@ removeInterleaving (x1:xs) = do -- (Note: LSP Range's end position is exclusive) x2:_ -> if x1 Lens.^. codeRange_range . end > x2 Lens.^. codeRange_range . start then do - let codeRangeEnd :: Lens.Lens' CodeRange Position - codeRangeEnd = codeRange_range . end - x1' :: CodeRange - x1' = x1 & codeRangeEnd Lens..~ (x2 Lens.^. codeRangeEnd) + -- set x1.end to x2.start + let x1' :: CodeRange = x1 & codeRange_range . end Lens..~ (x2 Lens.^. codeRange_range . start) tell [LogFoundInterleaving x1 x2] pure x1' else pure x1 From 28a82788ce1c349f643cc3f0e269c524c88647a9 Mon Sep 17 00:00:00 2001 From: kokobd Date: Mon, 4 Jul 2022 17:51:13 +0800 Subject: [PATCH 12/20] rename hls-selection-range-plugin to hls-code-range-plugin --- .github/workflows/hackage.yml | 2 +- .github/workflows/test.yml | 4 +- CODEOWNERS | 2 +- cabal.project | 2 +- docs/features.md | 2 +- docs/supported-versions.md | 2 +- exe/Plugins.hs | 8 +-- haskell-language-server.cabal | 14 ++--- .../LICENSE | 0 .../hls-code-range-plugin.cabal} | 10 +-- .../src/Ide/Plugin/CodeRange.hs} | 12 ++-- .../Ide/Plugin/CodeRange}/ASTPreProcess.hs | 4 +- .../src/Ide/Plugin/CodeRange/Rules.hs} | 62 +++++++++---------- .../test/Main.hs | 2 +- .../test/testdata/Function.golden.txt | 0 .../test/testdata/Function.hs | 0 .../test/testdata/Import.golden.txt | 0 .../test/testdata/Import.hs | 0 .../test/testdata/hie.yaml | 0 stack-lts16.yaml | 2 +- stack-lts19.yaml | 2 +- stack.yaml | 2 +- 22 files changed, 65 insertions(+), 67 deletions(-) rename plugins/{hls-selection-range-plugin => hls-code-range-plugin}/LICENSE (100%) rename plugins/{hls-selection-range-plugin/hls-selection-range-plugin.cabal => hls-code-range-plugin/hls-code-range-plugin.cabal} (87%) rename plugins/{hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs => hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs} (95%) rename plugins/{hls-selection-range-plugin/src/Ide/Plugin/SelectionRange => hls-code-range-plugin/src/Ide/Plugin/CodeRange}/ASTPreProcess.hs (98%) rename plugins/{hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs => hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs} (74%) rename plugins/{hls-selection-range-plugin => hls-code-range-plugin}/test/Main.hs (97%) rename plugins/{hls-selection-range-plugin => hls-code-range-plugin}/test/testdata/Function.golden.txt (100%) rename plugins/{hls-selection-range-plugin => hls-code-range-plugin}/test/testdata/Function.hs (100%) rename plugins/{hls-selection-range-plugin => hls-code-range-plugin}/test/testdata/Import.golden.txt (100%) rename plugins/{hls-selection-range-plugin => hls-code-range-plugin}/test/testdata/Import.hs (100%) rename plugins/{hls-selection-range-plugin => hls-code-range-plugin}/test/testdata/hie.yaml (100%) diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index f90518f5d1..09b1f57de7 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -36,7 +36,7 @@ jobs: "hls-refine-imports-plugin", "hls-rename-plugin", "hls-retrie-plugin", "hls-splice-plugin", "hls-tactics-plugin", "hls-call-hierarchy-plugin", "hls-alternate-number-format-plugin", - "hls-qualify-imported-names-plugin", "hls-selection-range-plugin", + "hls-qualify-imported-names-plugin", "hls-code-range-plugin", "haskell-language-server"] ghc: [ "9.0.2" , "8.10.7" diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 951f7c7a11..c57c4de3cd 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -236,8 +236,8 @@ jobs: run: cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" - if: matrix.test - name: Test hls-selection-range-plugin test suite - run: cabal test hls-selection-range-plugin --test-options="$TEST_OPTS" || cabal test hls-selection-range-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-selection-range-plugin --test-options="$TEST_OPTS" + name: Test hls-code-range-plugin test suite + run: cabal test hls-code-range-plugin --test-options="$TEST_OPTS" || cabal test hls-code-range-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-code-range-plugin --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-change-type-signature test suite diff --git a/CODEOWNERS b/CODEOWNERS index b54ff268c3..70dc00b939 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -25,7 +25,7 @@ /plugins/hls-refine-imports-plugin /plugins/hls-rename-plugin @OliverMadine /plugins/hls-retrie-plugin @pepeiborra -/plugins/hls-selection-range-plugin @kokobd +/plugins/hls-code-range-plugin @kokobd /plugins/hls-splice-plugin @konn /plugins/hls-stylish-haskell-plugin @Ailrun /plugins/hls-tactics-plugin @isovector diff --git a/cabal.project b/cabal.project index eb5147ba70..b050ad74ee 100644 --- a/cabal.project +++ b/cabal.project @@ -26,7 +26,7 @@ packages: ./plugins/hls-call-hierarchy-plugin ./plugins/hls-alternate-number-format-plugin ./plugins/hls-qualify-imported-names-plugin - ./plugins/hls-selection-range-plugin + ./plugins/hls-code-range-plugin ./plugins/hls-change-type-signature-plugin ./plugins/hls-gadt-plugin diff --git a/docs/features.md b/docs/features.md index 0bf1d16487..ecdeac2338 100644 --- a/docs/features.md +++ b/docs/features.md @@ -317,7 +317,7 @@ Shows module name matching file path, and applies it with a click. ## Selection range -Provided by: `hls-selection-range-plugin` +Provided by: `hls-code-range-plugin` Provides haskell specific [shrink/expand selection](https://code.visualstudio.com/docs/editor/codebasics#shrinkexpand-selection) diff --git a/docs/supported-versions.md b/docs/supported-versions.md index 2140906abf..52492647b7 100644 --- a/docs/supported-versions.md +++ b/docs/supported-versions.md @@ -56,7 +56,7 @@ Sometimes a plugin will be supported in the prebuilt binaries but not in a HLS b | `hls-splice-plugin` | 9.2 | | `hls-stylish-haskell-plugin` | | | `hls-tactics-plugin` | 9.2 | -| `hls-selection-range-plugin` | | +| `hls-code-range-plugin` | | | `hls-gadt-plugin` | | ### Using deprecated GHC versions diff --git a/exe/Plugins.hs b/exe/Plugins.hs index 88147e1ed8..6fbf6cd1dd 100644 --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -76,8 +76,8 @@ import qualified Ide.Plugin.Splice as Splice import qualified Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat #endif -#if selectionRange -import qualified Ide.Plugin.SelectionRange as SelectionRange +#if codeRange +import qualified Ide.Plugin.CodeRange as CodeRange #endif #if changeTypeSignature @@ -190,8 +190,8 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins #if alternateNumberFormat AlternateNumberFormat.descriptor pluginRecorder : #endif -#if selectionRange - SelectionRange.descriptor pluginRecorder "selectionRange" : +#if codeRange + CodeRange.descriptor pluginRecorder "codeRange" : #endif #if changeTypeSignature ChangeTypeSignature.descriptor : diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 970bb6b8fb..4b6d8f483b 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -176,8 +176,8 @@ flag qualifyImportedNames default: True manual: True -flag selectionRange - description: Enable selectionRange plugin +flag codeRange + description: Enable Code Range plugin default: True manual: True @@ -304,10 +304,10 @@ common qualifyImportedNames build-depends: hls-qualify-imported-names-plugin ^>=1.0 cpp-options: -DqualifyImportedNames -common selectionRange - if flag(selectionRange) - build-depends: hls-selection-range-plugin ^>= 1.0 - cpp-options: -DselectionRange +common codeRange + if flag(codeRange) + build-depends: hls-code-range-plugin ^>= 1.0 + cpp-options: -DcodeRange common changeTypeSignature if flag(changeTypeSignature) @@ -369,7 +369,7 @@ executable haskell-language-server , splice , alternateNumberFormat , qualifyImportedNames - , selectionRange + , codeRange , gadt , floskell , fourmolu diff --git a/plugins/hls-selection-range-plugin/LICENSE b/plugins/hls-code-range-plugin/LICENSE similarity index 100% rename from plugins/hls-selection-range-plugin/LICENSE rename to plugins/hls-code-range-plugin/LICENSE diff --git a/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal similarity index 87% rename from plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal rename to plugins/hls-code-range-plugin/hls-code-range-plugin.cabal index 5c7fb62f80..753cb006ca 100644 --- a/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal +++ b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal @@ -1,5 +1,5 @@ cabal-version: 2.4 -name: hls-selection-range-plugin +name: hls-code-range-plugin version: 1.0.0.0 synopsis: HLS Plugin to support smart selection range @@ -22,10 +22,10 @@ extra-source-files: library exposed-modules: - Ide.Plugin.SelectionRange - Ide.Plugin.SelectionRange.CodeRange + Ide.Plugin.CodeRange + Ide.Plugin.CodeRange.Rules other-modules: - Ide.Plugin.SelectionRange.ASTPreProcess + Ide.Plugin.CodeRange.ASTPreProcess ghc-options: -Wall hs-source-dirs: src default-language: Haskell2010 @@ -56,7 +56,7 @@ test-suite tests , base , containers , filepath - , hls-selection-range-plugin + , hls-code-range-plugin , hls-test-utils ^>=1.2 || ^>=1.3 , ghcide ^>=1.6 || ^>=1.7 , lsp diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs similarity index 95% rename from plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs rename to plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs index 3964eac861..ff164e2c07 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module Ide.Plugin.SelectionRange (descriptor, Log) where +module Ide.Plugin.CodeRange (descriptor, Log) where import Control.Monad.Except (ExceptT (ExceptT), runExceptT) @@ -27,10 +27,10 @@ import Development.IDE.Core.PositionMapping (PositionMapping, fromCurrentPosition, toCurrentRange) import Development.IDE.Types.Logger (Pretty (..)) -import Ide.Plugin.SelectionRange.CodeRange (CodeRange (..), +import Ide.Plugin.CodeRange.Rules (CodeRange (..), GetCodeRange (..), codeRangeRule) -import qualified Ide.Plugin.SelectionRange.CodeRange as CodeRange +import qualified Ide.Plugin.CodeRange.Rules as Rules (Log) import Ide.PluginUtils (pluginResponse, positionInRange) import Ide.Types (PluginDescriptor (pluginHandlers, pluginRules), @@ -55,14 +55,14 @@ descriptor recorder plId = (defaultPluginDescriptor plId) { pluginHandlers = mkPluginHandler STextDocumentSelectionRange selectionRangeHandler -- TODO @sloorush add folding range -- <> mkPluginHandler STextDocumentFoldingRange foldingRangeHandler - , pluginRules = codeRangeRule (cmapWithPrio LogCodeRange recorder) + , pluginRules = codeRangeRule (cmapWithPrio LogRules recorder) } -data Log = LogCodeRange CodeRange.Log +data Log = LogRules Rules.Log instance Pretty Log where pretty log = case log of - LogCodeRange codeRangeLog -> pretty codeRangeLog + LogRules codeRangeLog -> pretty codeRangeLog selectionRangeHandler :: IdeState -> PluginId -> SelectionRangeParams -> LspM c (Either ResponseError (List SelectionRange)) selectionRangeHandler ide _ SelectionRangeParams{..} = do diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/ASTPreProcess.hs similarity index 98% rename from plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs rename to plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/ASTPreProcess.hs index e7fdeb6058..d44ed3debd 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/ASTPreProcess.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Ide.Plugin.SelectionRange.ASTPreProcess +module Ide.Plugin.CodeRange.ASTPreProcess ( preProcessAST , PreProcessEnv(..) , isCustomNode @@ -177,7 +177,7 @@ isIdentADef outerSpan (span, detail) = isDef :: Bool isDef = any isContextInfoDef . toList . identInfo $ detail - -- Does the 'ContextInfo' represents a variable/function definition? + -- Determines if the 'ContextInfo' represents a variable/function definition isContextInfoDef :: ContextInfo -> Bool isContextInfoDef ValBind{} = True isContextInfoDef MatchBind = True diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs similarity index 74% rename from plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs rename to plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs index eddaf2c407..c6435e7e10 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/CodeRange.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs @@ -8,7 +8,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Ide.Plugin.SelectionRange.CodeRange +module Ide.Plugin.CodeRange.Rules ( CodeRange (..) , codeRange_range , codeRange_children @@ -18,41 +18,39 @@ module Ide.Plugin.SelectionRange.CodeRange , Log ) where -import Control.DeepSeq (NFData) -import qualified Control.Lens as Lens -import Control.Monad.Except (ExceptT (..), - runExceptT) -import Control.Monad.Reader (runReader) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Maybe (MaybeT (MaybeT), - maybeToExceptT) +import Control.DeepSeq (NFData) +import qualified Control.Lens as Lens +import Control.Monad.Except (ExceptT (..), runExceptT) +import Control.Monad.Reader (runReader) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (MaybeT (MaybeT), + maybeToExceptT) import Control.Monad.Trans.Writer.CPS -import Data.Coerce (coerce) -import Data.Data (Typeable) -import Data.Foldable (traverse_) -import Data.Function (on, (&)) +import Data.Coerce (coerce) +import Data.Data (Typeable) +import Data.Foldable (traverse_) +import Data.Function (on, (&)) import Data.Hashable -import Data.List (sort) -import qualified Data.Map.Strict as Map -import Data.Vector (Vector) -import qualified Data.Vector as V +import Data.List (sort) +import qualified Data.Map.Strict as Map +import Data.Vector (Vector) +import qualified Data.Vector as V import Development.IDE -import Development.IDE.Core.Rules (toIdeResult) -import qualified Development.IDE.Core.Shake as Shake -import Development.IDE.GHC.Compat (Annotated, - HieAST (..), - HieASTs (getAsts), - ParsedSource, RefMap) +import Development.IDE.Core.Rules (toIdeResult) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.GHC.Compat (Annotated, HieAST (..), + HieASTs (getAsts), + ParsedSource, RefMap) import Development.IDE.GHC.Compat.Util -import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource)) -import GHC.Generics (Generic) -import Ide.Plugin.SelectionRange.ASTPreProcess (CustomNodeType (..), - PreProcessEnv (..), - isCustomNode, - preProcessAST) -import Language.LSP.Types.Lens (HasEnd (end), - HasStart (start)) -import Prelude hiding (log) +import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource)) +import GHC.Generics (Generic) +import Ide.Plugin.CodeRange.ASTPreProcess (CustomNodeType (..), + PreProcessEnv (..), + isCustomNode, + preProcessAST) +import Language.LSP.Types.Lens (HasEnd (end), + HasStart (start)) +import Prelude hiding (log) data Log = LogShake Shake.Log | LogNoAST diff --git a/plugins/hls-selection-range-plugin/test/Main.hs b/plugins/hls-code-range-plugin/test/Main.hs similarity index 97% rename from plugins/hls-selection-range-plugin/test/Main.hs rename to plugins/hls-code-range-plugin/test/Main.hs index 66d8379eee..eeb652a8e6 100644 --- a/plugins/hls-selection-range-plugin/test/Main.hs +++ b/plugins/hls-code-range-plugin/test/Main.hs @@ -11,7 +11,7 @@ import Development.IDE.Types.Logger (Priority (Debug), WithPriority (WithPriority), makeDefaultStderrRecorder, pretty) -import Ide.Plugin.SelectionRange (Log, descriptor) +import Ide.Plugin.CodeRange (Log, descriptor) import Language.LSP.Types.Lens import System.FilePath ((<.>), ()) import Test.Hls diff --git a/plugins/hls-selection-range-plugin/test/testdata/Function.golden.txt b/plugins/hls-code-range-plugin/test/testdata/Function.golden.txt similarity index 100% rename from plugins/hls-selection-range-plugin/test/testdata/Function.golden.txt rename to plugins/hls-code-range-plugin/test/testdata/Function.golden.txt diff --git a/plugins/hls-selection-range-plugin/test/testdata/Function.hs b/plugins/hls-code-range-plugin/test/testdata/Function.hs similarity index 100% rename from plugins/hls-selection-range-plugin/test/testdata/Function.hs rename to plugins/hls-code-range-plugin/test/testdata/Function.hs diff --git a/plugins/hls-selection-range-plugin/test/testdata/Import.golden.txt b/plugins/hls-code-range-plugin/test/testdata/Import.golden.txt similarity index 100% rename from plugins/hls-selection-range-plugin/test/testdata/Import.golden.txt rename to plugins/hls-code-range-plugin/test/testdata/Import.golden.txt diff --git a/plugins/hls-selection-range-plugin/test/testdata/Import.hs b/plugins/hls-code-range-plugin/test/testdata/Import.hs similarity index 100% rename from plugins/hls-selection-range-plugin/test/testdata/Import.hs rename to plugins/hls-code-range-plugin/test/testdata/Import.hs diff --git a/plugins/hls-selection-range-plugin/test/testdata/hie.yaml b/plugins/hls-code-range-plugin/test/testdata/hie.yaml similarity index 100% rename from plugins/hls-selection-range-plugin/test/testdata/hie.yaml rename to plugins/hls-code-range-plugin/test/testdata/hie.yaml diff --git a/stack-lts16.yaml b/stack-lts16.yaml index 6d4189fb68..0bde88a567 100644 --- a/stack-lts16.yaml +++ b/stack-lts16.yaml @@ -28,7 +28,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-alternate-number-format-plugin - - ./plugins/hls-selection-range-plugin + - ./plugins/hls-code-range-plugin - ./plugins/hls-change-type-signature-plugin - ./plugins/hls-gadt-plugin diff --git a/stack-lts19.yaml b/stack-lts19.yaml index 91a56f4e9d..48f834ddcb 100644 --- a/stack-lts19.yaml +++ b/stack-lts19.yaml @@ -28,7 +28,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-alternate-number-format-plugin - - ./plugins/hls-selection-range-plugin + - ./plugins/hls-code-range-plugin - ./plugins/hls-change-type-signature-plugin - ./plugins/hls-gadt-plugin diff --git a/stack.yaml b/stack.yaml index 78398e6882..438328b03a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -28,7 +28,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-alternate-number-format-plugin -- ./plugins/hls-selection-range-plugin +- ./plugins/hls-code-range-plugin - ./plugins/hls-change-type-signature-plugin - ./plugins/hls-gadt-plugin From 7599641df62d4bcba43ed417554148fc535655c5 Mon Sep 17 00:00:00 2001 From: kokobd Date: Tue, 5 Jul 2022 03:02:46 +0000 Subject: [PATCH 13/20] update docs about selection range --- docs/features.md | 4 ++-- docs/supported-versions.md | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/features.md b/docs/features.md index ecdeac2338..58fa945299 100644 --- a/docs/features.md +++ b/docs/features.md @@ -320,10 +320,10 @@ Shows module name matching file path, and applies it with a click. Provided by: `hls-code-range-plugin` Provides haskell specific -[shrink/expand selection](https://code.visualstudio.com/docs/editor/codebasics#shrinkexpand-selection) +[shrink/expand selection](https://code.visualstudio.com/docs/editor/codebasics#_shrinkexpand-selection) support. -![Selection range demo](https://user-images.githubusercontent.com/16440269/150301502-4c002605-9f8d-43f5-86d3-28846942c4ff.mov) +![Selection range demo](https://user-images.githubusercontent.com/16440269/177240833-7dc8fe39-b446-477e-b5b1-7fc303608d4f.gif) ## Rename diff --git a/docs/supported-versions.md b/docs/supported-versions.md index 52492647b7..9c0c947b0b 100644 --- a/docs/supported-versions.md +++ b/docs/supported-versions.md @@ -37,7 +37,7 @@ Sometimes a plugin will be supported in the prebuilt binaries but not in a HLS b | Plugin | Unsupported GHC versions | |-------------------------------------|--------------------------| | `hls-alternate-number-plugin` | | -| `hls-brittany-plugin` | 9.2 | +| `hls-brittany-plugin` | 9.2 | | `hls-call-hierarchy-plugin` | | | `hls-class-plugin` | | | `hls-eval-plugin` | | @@ -56,7 +56,7 @@ Sometimes a plugin will be supported in the prebuilt binaries but not in a HLS b | `hls-splice-plugin` | 9.2 | | `hls-stylish-haskell-plugin` | | | `hls-tactics-plugin` | 9.2 | -| `hls-code-range-plugin` | | +| `hls-code-range-plugin` | | | `hls-gadt-plugin` | | ### Using deprecated GHC versions From e52656780cb4a0effdcdf01998dbcfc9dfb7b715 Mon Sep 17 00:00:00 2001 From: kokobd Date: Tue, 5 Jul 2022 03:12:52 +0000 Subject: [PATCH 14/20] cleanup RuleTypes.hs --- ghcide/src/Development/IDE/Core/RuleTypes.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index a196609e37..2a10be92eb 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -28,14 +28,13 @@ import Development.IDE.GHC.Compat hiding (HieFileResult) import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.CoreFile -import Development.IDE.GHC.Util (fingerprintToBS) +import Development.IDE.GHC.Util import Development.IDE.Graph import Development.IDE.Import.DependencyInformation import Development.IDE.Types.HscEnvEq (HscEnvEq) import Development.IDE.Types.KnownTargets import GHC.Generics (Generic) -import qualified Data.Binary as B import Data.ByteString (ByteString) import Data.Text (Text) import Development.IDE.Import.FindImports (ArtifactsLocation) From 825b589436a2b021e71a53b3464d6056783302c1 Mon Sep 17 00:00:00 2001 From: kokobd Date: Tue, 5 Jul 2022 03:22:17 +0000 Subject: [PATCH 15/20] add the missing bang pattern --- plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs index c6435e7e10..d6aebad1f9 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs @@ -72,7 +72,7 @@ data CodeRange = CodeRange { -- Children are guaranteed not to interleave, but some gaps may exist among them. _codeRange_children :: !(Vector CodeRange), -- The kind of current code range - _codeRange_kind :: CodeRangeKind + _codeRange_kind :: !CodeRangeKind } deriving (Show, Generic, NFData) From 376df649cb22cf677a71c4fa8cdfaef5e0786d72 Mon Sep 17 00:00:00 2001 From: kokobd Date: Tue, 5 Jul 2022 04:59:06 +0000 Subject: [PATCH 16/20] fix subRange --- hls-plugin-api/src/Ide/PluginUtils.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 1210138f9a..e182253abb 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -218,9 +218,7 @@ fullRange s = Range startPos endPos lastLine = fromIntegral $ length $ T.lines s subRange :: Range -> Range -> Bool -subRange smallRange range = - positionInRange (_start smallRange) range - && positionInRange (_end smallRange) range +subRange smallRange range = _start smallRange >= _start range && _end smallRange <= _end range positionInRange :: Position -> Range -> Bool positionInRange p (Range sp ep) = sp <= p && p < ep -- Range's end position is exclusive, see https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#range From bb13fc40288ac6361bb41cf56649932c08cc17e4 Mon Sep 17 00:00:00 2001 From: kokobd Date: Wed, 6 Jul 2022 10:28:28 +0000 Subject: [PATCH 17/20] add some unit tests to CodeRange.Rules --- .../hls-code-range-plugin.cabal | 4 + .../src/Ide/Plugin/CodeRange/Rules.hs | 8 +- .../test/Ide/Plugin/CodeRange/RulesTest.hs | 50 +++++++++++++ .../test/Ide/Plugin/CodeRangeTest.hs | 7 ++ plugins/hls-code-range-plugin/test/Main.hs | 73 ++++++++++--------- .../{ => selection-range}/Function.golden.txt | 0 .../{ => selection-range}/Function.hs | 0 .../{ => selection-range}/Import.golden.txt | 0 .../testdata/{ => selection-range}/Import.hs | 0 .../testdata/{ => selection-range}/hie.yaml | 0 10 files changed, 108 insertions(+), 34 deletions(-) create mode 100644 plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs create mode 100644 plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRangeTest.hs rename plugins/hls-code-range-plugin/test/testdata/{ => selection-range}/Function.golden.txt (100%) rename plugins/hls-code-range-plugin/test/testdata/{ => selection-range}/Function.hs (100%) rename plugins/hls-code-range-plugin/test/testdata/{ => selection-range}/Import.golden.txt (100%) rename plugins/hls-code-range-plugin/test/testdata/{ => selection-range}/Import.hs (100%) rename plugins/hls-code-range-plugin/test/testdata/{ => selection-range}/hie.yaml (100%) diff --git a/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal index 753cb006ca..e1a041ec55 100644 --- a/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal +++ b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal @@ -51,6 +51,9 @@ test-suite tests default-language: Haskell2010 hs-source-dirs: test main-is: Main.hs + other-modules: + Ide.Plugin.CodeRangeTest + Ide.Plugin.CodeRange.RulesTest ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: , base @@ -64,3 +67,4 @@ test-suite tests , text , bytestring , lens + , tasty-hunit diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs index d6aebad1f9..f17d122c33 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs @@ -9,13 +9,19 @@ {-# LANGUAGE TypeFamilies #-} module Ide.Plugin.CodeRange.Rules - ( CodeRange (..) + ( + -- * Public Functions + CodeRange (..) , codeRange_range , codeRange_children , codeRange_kind + , CodeRangeKind(..) , GetCodeRange(..) , codeRangeRule , Log + + -- * Internal Functions + , simplify ) where import Control.DeepSeq (NFData) diff --git a/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs b/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs new file mode 100644 index 0000000000..cadb063c39 --- /dev/null +++ b/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedLists #-} + +module Ide.Plugin.CodeRange.RulesTest (testTree) where + +import Ide.Plugin.CodeRange.Rules +import Test.Hls +import Test.Tasty.HUnit + +testTree :: TestTree +testTree = + testGroup "Rules" [ + testGroup "simplify" $ + let simpleCodeRange startCol endCol children = + CodeRange (Range (Position 1 startCol) (Position 1 endCol)) children CodeKindRegion + in [ + testCase "one level should not change" $ + let codeRange = simpleCodeRange 1 5 [] + in codeRange @=? simplify codeRange, + testCase "dedup 3 nested layers" $ + let input = + simpleCodeRange 1 10 [ + simpleCodeRange 1 5 [], + simpleCodeRange 5 10 [ + simpleCodeRange 5 10 [ + simpleCodeRange 5 10 [ + simpleCodeRange 6 10 [] + ] + ] + ] + ] + want = + simpleCodeRange 1 10 [ + simpleCodeRange 1 5 [], + simpleCodeRange 5 10 [ + simpleCodeRange 6 10 [] + ] + ] + in want @=? simplify input, + testCase "should not dedup node that has multiple children" $ + let input = + simpleCodeRange 1 10 [ + simpleCodeRange 1 10 [], + simpleCodeRange 2 10 [] + ] + in simplify input @?= input, + testCase "dedup simple two layers" $ + let input = simpleCodeRange 1 10 [ simpleCodeRange 1 10 []] + in simplify input @?= simpleCodeRange 1 10 [] + ] + ] diff --git a/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRangeTest.hs b/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRangeTest.hs new file mode 100644 index 0000000000..046fd9732c --- /dev/null +++ b/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRangeTest.hs @@ -0,0 +1,7 @@ +module Ide.Plugin.CodeRangeTest (testTree) where + +import Ide.Plugin.CodeRange +import Test.Hls + +testTree :: TestTree +testTree = undefined diff --git a/plugins/hls-code-range-plugin/test/Main.hs b/plugins/hls-code-range-plugin/test/Main.hs index eeb652a8e6..397dad0e39 100644 --- a/plugins/hls-code-range-plugin/test/Main.hs +++ b/plugins/hls-code-range-plugin/test/Main.hs @@ -2,35 +2,42 @@ module Main (main) where -import Control.Lens hiding (List, (<.>)) -import Data.ByteString.Lazy (ByteString) -import qualified Data.ByteString.Lazy.Char8 as LBSChar8 -import Data.String (fromString) -import Development.IDE.Types.Logger (Priority (Debug), - Recorder (Recorder), - WithPriority (WithPriority), - makeDefaultStderrRecorder, - pretty) -import Ide.Plugin.CodeRange (Log, descriptor) +import Control.Lens hiding (List, (<.>)) +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy.Char8 as LBSChar8 +import Data.String (fromString) +import Development.IDE.Types.Logger (Priority (Debug), + Recorder (Recorder), + WithPriority (WithPriority), + makeDefaultStderrRecorder, + pretty) +import Ide.Plugin.CodeRange (Log, descriptor) +import qualified Ide.Plugin.CodeRange.RulesTest +import qualified Ide.Plugin.CodeRangeTest import Language.LSP.Types.Lens -import System.FilePath ((<.>), ()) +import System.FilePath ((<.>), ()) import Test.Hls plugin :: Recorder (WithPriority Log) -> PluginDescriptor IdeState -plugin recorder = descriptor recorder "selectionRange" +plugin recorder = descriptor recorder "codeRange" main :: IO () main = do recorder <- contramap (fmap pretty) <$> makeDefaultStderrRecorder Nothing Debug defaultTestRunner $ - testGroup "Selection Range" - [ goldenTest recorder "Import" [(4, 36), (1, 8)] - , goldenTest recorder "Function" [(5, 19), (5, 12), (4, 4), (3, 5)] + testGroup "Code Range" [ + testGroup "Integration Tests" [ + makeSelectionRangeGoldenTest recorder "Import" [(4, 36), (1, 8)], + makeSelectionRangeGoldenTest recorder "Function" [(5, 19), (5, 12), (4, 4), (3, 5)] + ], + testGroup "Unit Tests" [ + -- Ide.Plugin.CodeRangeTest.testTree, + Ide.Plugin.CodeRange.RulesTest.testTree ] + ] --- | build a golden test for -goldenTest :: Recorder (WithPriority Log) -> TestName -> [(UInt, UInt)] -> TestTree -goldenTest recorder testName positions = goldenGitDiff testName (testDataDir testName <.> "golden" <.> "txt") $ do +makeSelectionRangeGoldenTest :: Recorder (WithPriority Log) -> TestName -> [(UInt, UInt)] -> TestTree +makeSelectionRangeGoldenTest recorder testName positions = goldenGitDiff testName (testDataDir testName <.> "golden" <.> "txt") $ do res <- runSessionWithServer (plugin recorder) testDataDir $ do doc <- openDoc (testName <.> "hs") "haskell" resp <- request STextDocumentSelectionRange $ SelectionRangeParams Nothing Nothing doc @@ -40,20 +47,20 @@ goldenTest recorder testName positions = goldenGitDiff testName (testDataDir case res of Left err -> assertFailure (show err) Right golden -> pure golden + where + testDataDir :: FilePath + testDataDir = "test" "testdata" "selection-range" -testDataDir :: FilePath -testDataDir = "test" "testdata" - -showSelectionRangesForTest :: List SelectionRange -> ByteString -showSelectionRangesForTest (List selectionRanges) = LBSChar8.intercalate "\n" $ fmap showSelectionRangeForTest selectionRanges + showSelectionRangesForTest :: List SelectionRange -> ByteString + showSelectionRangesForTest (List selectionRanges) = LBSChar8.intercalate "\n" $ fmap showSelectionRangeForTest selectionRanges -showSelectionRangeForTest :: SelectionRange -> ByteString -showSelectionRangeForTest selectionRange = go True (Just selectionRange) - where - go :: Bool -> Maybe SelectionRange -> ByteString - go _ Nothing = "" - go isFirst (Just (SelectionRange (Range sp ep) parent)) = - (if isFirst then "" else " => ") <> showPosition sp <> " " <> showPosition ep <> go False parent - showPosition :: Position -> ByteString - showPosition (Position line col) = "(" <> showLBS (line + 1) <> "," <> showLBS (col + 1) <> ")" - showLBS = fromString . show + showSelectionRangeForTest :: SelectionRange -> ByteString + showSelectionRangeForTest selectionRange = go True (Just selectionRange) + where + go :: Bool -> Maybe SelectionRange -> ByteString + go _ Nothing = "" + go isFirst (Just (SelectionRange (Range sp ep) parent)) = + (if isFirst then "" else " => ") <> showPosition sp <> " " <> showPosition ep <> go False parent + showPosition :: Position -> ByteString + showPosition (Position line col) = "(" <> showLBS (line + 1) <> "," <> showLBS (col + 1) <> ")" + showLBS = fromString . show diff --git a/plugins/hls-code-range-plugin/test/testdata/Function.golden.txt b/plugins/hls-code-range-plugin/test/testdata/selection-range/Function.golden.txt similarity index 100% rename from plugins/hls-code-range-plugin/test/testdata/Function.golden.txt rename to plugins/hls-code-range-plugin/test/testdata/selection-range/Function.golden.txt diff --git a/plugins/hls-code-range-plugin/test/testdata/Function.hs b/plugins/hls-code-range-plugin/test/testdata/selection-range/Function.hs similarity index 100% rename from plugins/hls-code-range-plugin/test/testdata/Function.hs rename to plugins/hls-code-range-plugin/test/testdata/selection-range/Function.hs diff --git a/plugins/hls-code-range-plugin/test/testdata/Import.golden.txt b/plugins/hls-code-range-plugin/test/testdata/selection-range/Import.golden.txt similarity index 100% rename from plugins/hls-code-range-plugin/test/testdata/Import.golden.txt rename to plugins/hls-code-range-plugin/test/testdata/selection-range/Import.golden.txt diff --git a/plugins/hls-code-range-plugin/test/testdata/Import.hs b/plugins/hls-code-range-plugin/test/testdata/selection-range/Import.hs similarity index 100% rename from plugins/hls-code-range-plugin/test/testdata/Import.hs rename to plugins/hls-code-range-plugin/test/testdata/selection-range/Import.hs diff --git a/plugins/hls-code-range-plugin/test/testdata/hie.yaml b/plugins/hls-code-range-plugin/test/testdata/selection-range/hie.yaml similarity index 100% rename from plugins/hls-code-range-plugin/test/testdata/hie.yaml rename to plugins/hls-code-range-plugin/test/testdata/selection-range/hie.yaml From 9a6e253bb22814310200c9801f6aa8b1a6ef3b25 Mon Sep 17 00:00:00 2001 From: kokobd Date: Thu, 7 Jul 2022 06:41:27 +0000 Subject: [PATCH 18/20] add tests for removeInterleaving --- .../hls-code-range-plugin.cabal | 2 + .../src/Ide/Plugin/CodeRange/Rules.hs | 19 ++++-- .../test/Ide/Plugin/CodeRange/RulesTest.hs | 64 ++++++++++++++----- 3 files changed, 61 insertions(+), 24 deletions(-) diff --git a/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal index e1a041ec55..87d69e7564 100644 --- a/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal +++ b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal @@ -68,3 +68,5 @@ test-suite tests , bytestring , lens , tasty-hunit + , transformers + , vector diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs index f17d122c33..c137e22a35 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs @@ -18,14 +18,16 @@ module Ide.Plugin.CodeRange.Rules , CodeRangeKind(..) , GetCodeRange(..) , codeRangeRule - , Log + , Log(..) -- * Internal Functions + , removeInterleaving , simplify ) where import Control.DeepSeq (NFData) import qualified Control.Lens as Lens +import Control.Monad (foldM) import Control.Monad.Except (ExceptT (..), runExceptT) import Control.Monad.Reader (runReader) import Control.Monad.Trans.Class (lift) @@ -61,6 +63,7 @@ import Prelude hiding (log) data Log = LogShake Shake.Log | LogNoAST | LogFoundInterleaving CodeRange CodeRange + deriving Show instance Pretty Log where pretty log = case log of @@ -121,23 +124,25 @@ astToCodeRange node@(Node _ sp children) = do -- | Remove interleaving of the list of 'CodeRange's. removeInterleaving :: [CodeRange] -> Writer [Log] [CodeRange] -removeInterleaving [] = pure [] -removeInterleaving (x1:xs) = do - remaining <- removeInterleaving xs - (:remaining) <$> case remaining of - [] -> pure x1 +removeInterleaving = fmap reverse . foldM go [] + where + -- we want to traverse from left to right (to make the logs easier to read) + go :: [CodeRange] -> CodeRange -> Writer [Log] [CodeRange] + go [] x = pure [x] + go (x1:acc) x2 = do -- Given that the CodeRange is already sorted on it's Range, and the Ord instance of Range -- compares it's start position first, the start position must be already in an ascending order. -- Then, if the end position of a node is larger than it's next neighbour's start position, an interleaving -- must exist. -- (Note: LSP Range's end position is exclusive) - x2:_ -> if x1 Lens.^. codeRange_range . end > x2 Lens.^. codeRange_range . start + x1' <- if x1 Lens.^. codeRange_range . end > x2 Lens.^. codeRange_range . start then do -- set x1.end to x2.start let x1' :: CodeRange = x1 & codeRange_range . end Lens..~ (x2 Lens.^. codeRange_range . start) tell [LogFoundInterleaving x1 x2] pure x1' else pure x1 + pure $ x2:x1':acc -- | Remove redundant nodes in 'CodeRange' tree simplify :: CodeRange -> CodeRange diff --git a/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs b/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs index cadb063c39..70476d7470 100644 --- a/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs +++ b/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs @@ -2,6 +2,9 @@ module Ide.Plugin.CodeRange.RulesTest (testTree) where +import Control.Monad.Trans.Writer.CPS +import Data.Bifunctor (Bifunctor (first, second)) +import qualified Data.Vector as V import Ide.Plugin.CodeRange.Rules import Test.Hls import Test.Tasty.HUnit @@ -9,42 +12,69 @@ import Test.Tasty.HUnit testTree :: TestTree testTree = testGroup "Rules" [ + testGroup "removeInterleaving" $ + let check :: [CodeRange] -> ([CodeRange], [Log]) -> Assertion + check input want = + second (fmap LogEq) (runWriter (removeInterleaving input)) @?= second (fmap LogEq) want + mkNode :: UInt -> UInt -> CodeRange + mkNode startCol endCol = + CodeRange (Range (Position 1 startCol) (Position 1 endCol)) [] CodeKindRegion + in [ + testCase "empty list" $ check [] ([], []), + testCase "one" $ check [mkNode 1 5] ([mkNode 1 5], []), + testCase "two, without intersection" $ check [mkNode 1 5, mkNode 5 6] ([mkNode 1 5, mkNode 5 6], []), + testCase "two, with intersection" $ let (x, y) = (mkNode 1 5, mkNode 2 4) + in check [x, y] ([mkNode 1 2, mkNode 2 4], [LogFoundInterleaving x y]), + testCase "three, with intersection" $ let (x, y, z) = (mkNode 1 10, mkNode 2 6, mkNode 4 12) + in check [x, y, z] ([mkNode 1 2, mkNode 2 4, mkNode 4 12], + [LogFoundInterleaving x y, LogFoundInterleaving y z]) + ], testGroup "simplify" $ - let simpleCodeRange startCol endCol children = + let mkNode :: UInt -> UInt -> V.Vector CodeRange -> CodeRange + mkNode startCol endCol children = CodeRange (Range (Position 1 startCol) (Position 1 endCol)) children CodeKindRegion in [ testCase "one level should not change" $ - let codeRange = simpleCodeRange 1 5 [] + let codeRange = mkNode 1 5 [] in codeRange @=? simplify codeRange, testCase "dedup 3 nested layers" $ let input = - simpleCodeRange 1 10 [ - simpleCodeRange 1 5 [], - simpleCodeRange 5 10 [ - simpleCodeRange 5 10 [ - simpleCodeRange 5 10 [ - simpleCodeRange 6 10 [] + mkNode 1 10 [ + mkNode 1 5 [], + mkNode 5 10 [ + mkNode 5 10 [ + mkNode 5 10 [ + mkNode 6 10 [] ] ] ] ] want = - simpleCodeRange 1 10 [ - simpleCodeRange 1 5 [], - simpleCodeRange 5 10 [ - simpleCodeRange 6 10 [] + mkNode 1 10 [ + mkNode 1 5 [], + mkNode 5 10 [ + mkNode 6 10 [] ] ] in want @=? simplify input, testCase "should not dedup node that has multiple children" $ let input = - simpleCodeRange 1 10 [ - simpleCodeRange 1 10 [], - simpleCodeRange 2 10 [] + mkNode 1 10 [ + mkNode 1 10 [], + mkNode 2 10 [] ] in simplify input @?= input, testCase "dedup simple two layers" $ - let input = simpleCodeRange 1 10 [ simpleCodeRange 1 10 []] - in simplify input @?= simpleCodeRange 1 10 [] + let input = mkNode 1 10 [ mkNode 1 10 []] + in simplify input @?= mkNode 1 10 [] ] ] + +newtype LogEq = LogEq Log + deriving Show + +instance Eq LogEq where + LogEq (LogShake _) == LogEq (LogShake _) = True + LogEq LogNoAST == LogEq LogNoAST = True + LogEq (LogFoundInterleaving left right) == LogEq (LogFoundInterleaving left' right') = + left == left' && right == right' From 338a1fb0c9dcd83d39ceff00f01e98946793c7be Mon Sep 17 00:00:00 2001 From: kokobd Date: Thu, 7 Jul 2022 18:16:53 +0800 Subject: [PATCH 19/20] add even more tests --- .../hls-code-range-plugin.cabal | 20 ++++---- .../src/Ide/Plugin/CodeRange.hs | 31 ++++++------ .../src/Ide/Plugin/CodeRange/Rules.hs | 6 +-- .../test/Ide/Plugin/CodeRange/RulesTest.hs | 2 +- .../test/Ide/Plugin/CodeRangeTest.hs | 49 ++++++++++++++++++- plugins/hls-code-range-plugin/test/Main.hs | 2 +- 6 files changed, 76 insertions(+), 34 deletions(-) diff --git a/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal index 87d69e7564..07dc37e433 100644 --- a/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal +++ b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal @@ -33,18 +33,18 @@ library , aeson , base >=4.12 && <5 , containers + , deepseq + , extra , ghcide ^>=1.6 || ^>=1.7 + , hashable , hls-plugin-api ^>=1.3 || ^>=1.4 + , lens , lsp - , transformers , mtl - , text - , extra , semigroupoids - , hashable - , deepseq + , text + , transformers , vector - , lens test-suite tests type: exitcode-stdio-1.0 @@ -57,16 +57,16 @@ test-suite tests ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: , base + , bytestring , containers , filepath + , ghcide ^>=1.6 || ^>=1.7 , hls-code-range-plugin , hls-test-utils ^>=1.2 || ^>=1.3 - , ghcide ^>=1.6 || ^>=1.7 + , lens , lsp , lsp-test - , text - , bytestring - , lens , tasty-hunit + , text , transformers , vector diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs index ff164e2c07..0a48a3467b 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs @@ -1,7 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module Ide.Plugin.CodeRange (descriptor, Log) where +module Ide.Plugin.CodeRange ( + descriptor + , Log + + -- * Internal + , findPosition + ) where import Control.Monad.Except (ExceptT (ExceptT), runExceptT) @@ -9,8 +15,6 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Maybe (MaybeT (MaybeT), maybeToExceptT) import Data.Either.Extra (maybeToEither) -import Data.List.NonEmpty (NonEmpty) -import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (fromMaybe) import Data.Vector (Vector) import qualified Data.Vector as V @@ -97,21 +101,20 @@ getSelectionRanges file positions = do -- | Find 'Position' in 'CodeRange'. This can fail, if the given position is not covered by the 'CodeRange'. findPosition :: Position -> CodeRange -> Maybe SelectionRange -findPosition pos root = - selectionRangeFromNonEmpty . NonEmpty.reverse -- SelectionRange requires a bottom-up order, so we need to reverse - <$> go root +findPosition pos root = go Nothing root where -- Helper function for recursion. The range list is built top-down - go :: CodeRange -> Maybe (NonEmpty Range) - go node = + go :: Maybe SelectionRange -> CodeRange -> Maybe SelectionRange + go acc node = if positionInRange pos range - then case binarySearchPos children of - Just childContainingPos -> fmap (range NonEmpty.<|) (go childContainingPos) - Nothing -> Just $ range NonEmpty.:| [] -- NonEmpty.singleton doesn't exist in GHC 8.8.4 + then maybe acc' (go acc') (binarySearchPos children) + -- If all children doesn't contain pos, acc' will be returned. + -- acc' will be Nothing only if we are in the root level. else Nothing where range = _codeRange_range node children = _codeRange_children node + acc' = Just $ maybe (SelectionRange range Nothing) (SelectionRange range . Just) acc binarySearchPos :: Vector CodeRange -> Maybe CodeRange binarySearchPos v @@ -123,12 +126,6 @@ findPosition pos root = startOfRight <- _start . _codeRange_range <$> V.headM right if pos < startOfRight then binarySearchPos left else binarySearchPos right --- | Construct 'SelectionRange' from 'NonEmpty' 'Range' -selectionRangeFromNonEmpty :: NonEmpty Range -> SelectionRange -selectionRangeFromNonEmpty ranges - | (r, remaining) <- NonEmpty.uncons ranges = - SelectionRange r (fmap selectionRangeFromNonEmpty remaining) - -- | Likes 'toCurrentPosition', but works on 'SelectionRange' toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange toCurrentSelectionRange positionMapping SelectionRange{..} = do diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs index c137e22a35..8a573d9ebb 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs @@ -9,9 +9,7 @@ {-# LANGUAGE TypeFamilies #-} module Ide.Plugin.CodeRange.Rules - ( - -- * Public Functions - CodeRange (..) + ( CodeRange (..) , codeRange_range , codeRange_children , codeRange_kind @@ -20,7 +18,7 @@ module Ide.Plugin.CodeRange.Rules , codeRangeRule , Log(..) - -- * Internal Functions + -- * Internal , removeInterleaving , simplify ) where diff --git a/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs b/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs index 70476d7470..473d5b7f77 100644 --- a/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs +++ b/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRange/RulesTest.hs @@ -11,7 +11,7 @@ import Test.Tasty.HUnit testTree :: TestTree testTree = - testGroup "Rules" [ + testGroup "CodeRange.Rules" [ testGroup "removeInterleaving" $ let check :: [CodeRange] -> ([CodeRange], [Log]) -> Assertion check input want = diff --git a/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRangeTest.hs b/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRangeTest.hs index 046fd9732c..73bebf3a2a 100644 --- a/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRangeTest.hs +++ b/plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRangeTest.hs @@ -1,7 +1,54 @@ +{-# LANGUAGE OverloadedLists #-} + module Ide.Plugin.CodeRangeTest (testTree) where +import qualified Data.Vector as V import Ide.Plugin.CodeRange +import Ide.Plugin.CodeRange.Rules import Test.Hls +import Test.Tasty.HUnit testTree :: TestTree -testTree = undefined +testTree = + testGroup "CodeRange" [ + testGroup "findPosition" $ + let check :: Position -> CodeRange -> Maybe SelectionRange -> Assertion + check position codeRange = (findPosition position codeRange @?=) + + mkCodeRange :: Position -> Position -> V.Vector CodeRange -> CodeRange + mkCodeRange start end children = CodeRange (Range start end) children CodeKindRegion + in [ + testCase "not in range" $ check + (Position 10 1) + (mkCodeRange (Position 1 1) (Position 5 10) []) + Nothing, + testCase "in top level range" $ check + (Position 3 8) + (mkCodeRange (Position 1 1) (Position 5 10) []) + (Just $ SelectionRange (Range (Position 1 1) (Position 5 10)) Nothing), + testCase "in the gap between children, in parent" $ check + (Position 3 6) + (mkCodeRange (Position 1 1) (Position 5 10) [ + mkCodeRange (Position 1 1) (Position 3 6) [], + mkCodeRange (Position 3 7) (Position 5 10) [] + ]) + (Just $ SelectionRange (Range (Position 1 1) (Position 5 10)) Nothing), + testCase "before all children, in parent" $ check + (Position 1 1) + (mkCodeRange (Position 1 1) (Position 5 10) [ + mkCodeRange (Position 1 2) (Position 3 6) [], + mkCodeRange (Position 3 7) (Position 5 10) [] + ]) + (Just $ SelectionRange (Range (Position 1 1) (Position 5 10)) Nothing), + testCase "in children, in parent" $ check + (Position 2 1) + (mkCodeRange (Position 1 1) (Position 5 10) [ + mkCodeRange (Position 1 2) (Position 3 6) [], + mkCodeRange (Position 3 7) (Position 5 10) [] + ]) + (Just $ SelectionRange (Range (Position 1 2) (Position 3 6)) $ Just + ( SelectionRange (Range (Position 1 1) (Position 5 10)) Nothing + ) + ) + ] + ] diff --git a/plugins/hls-code-range-plugin/test/Main.hs b/plugins/hls-code-range-plugin/test/Main.hs index 397dad0e39..bffc3f716e 100644 --- a/plugins/hls-code-range-plugin/test/Main.hs +++ b/plugins/hls-code-range-plugin/test/Main.hs @@ -31,7 +31,7 @@ main = do makeSelectionRangeGoldenTest recorder "Function" [(5, 19), (5, 12), (4, 4), (3, 5)] ], testGroup "Unit Tests" [ - -- Ide.Plugin.CodeRangeTest.testTree, + Ide.Plugin.CodeRangeTest.testTree, Ide.Plugin.CodeRange.RulesTest.testTree ] ] From 2314f8629758491a9215bc914fcc8ea50190c891 Mon Sep 17 00:00:00 2001 From: kokobd Date: Fri, 8 Jul 2022 10:47:07 +0800 Subject: [PATCH 20/20] fix extra sources --- plugins/hls-code-range-plugin/hls-code-range-plugin.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal index 07dc37e433..e51ad55268 100644 --- a/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal +++ b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal @@ -16,9 +16,9 @@ category: Development build-type: Simple extra-source-files: LICENSE - test/testdata/*.hs - test/testdata/*.yaml - test/testdata/*.txt + test/testdata/selection-range/*.hs + test/testdata/selection-range/*.yaml + test/testdata/selection-range/*.txt library exposed-modules: