diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index 0d6957aa12..12bb331b55 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -32,7 +32,7 @@ jobs: "hls-refine-imports-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-qualify-imported-names-plugin", "hls-selection-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 51a5479109..e26842b26e 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -234,6 +234,10 @@ jobs: name: Test hls-qualify-imported-names-plugin test suite 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" + test_post_job: if: always() runs-on: ubuntu-latest diff --git a/cabal-ghc90.project b/cabal-ghc90.project index 3ef649ff8b..6e9ff499bb 100644 --- a/cabal-ghc90.project +++ b/cabal-ghc90.project @@ -26,6 +26,7 @@ packages: ./plugins/hls-ormolu-plugin ./plugins/hls-call-hierarchy-plugin ./plugins/hls-alternate-number-format-plugin + ./plugins/hls-selection-range-plugin tests: true @@ -35,7 +36,7 @@ package * write-ghc-environment-files: never -index-state: 2022-01-11T22:05:45Z +index-state: 2022-01-21T11:23:29Z constraints: -- These plugins don't work on GHC9 yet diff --git a/cabal-ghc921.project b/cabal-ghc921.project index fc08879367..e10700f81a 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -26,6 +26,7 @@ packages: ./plugins/hls-ormolu-plugin ./plugins/hls-call-hierarchy-plugin ./plugins/hls-alternate-number-format-plugin + ./plugins/hls-selection-range-plugin with-compiler: ghc-9.2.1 @@ -37,7 +38,7 @@ package * write-ghc-environment-files: never -index-state: 2022-01-11T22:05:45Z +index-state: 2022-01-21T11:23:29Z constraints: -- These plugins don't build/work on GHC92 yet diff --git a/cabal.project b/cabal.project index 66b4e41302..96fb8153f0 100644 --- a/cabal.project +++ b/cabal.project @@ -26,6 +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 -- Standard location for temporary packages needed for particular environments -- For example it is used in the project gitlab mirror to help in the MAcOS M1 build script @@ -40,7 +41,7 @@ package * write-ghc-environment-files: never -index-state: 2022-01-11T22:05:45Z +index-state: 2022-01-21T11:23:29Z constraints: hyphenation +embed diff --git a/docs/features.md b/docs/features.md index ad72367ed0..78d8ccc411 100644 --- a/docs/features.md +++ b/docs/features.md @@ -18,6 +18,7 @@ Many of these are standard LSP features, but a lot of special features are provi | [Highlight references](#highlight-references) | `textDocument/documentHighlight` | | [Code actions](#code-actions) | `textDocument/codeAction` | | [Code lenses](#code-lenses) | `textDocument/codeLens` | +| [Selection range](#selection-range) | `textDocument/selectionRange` | The individual sections below also identify which [HLS plugin](./what-is-hls.md#hls-plugins) is responsible for providing the given functionality, which is useful if you want to raise an issue report or contribute! Additionally, not all plugins are supported on all versions of GHC, see the [GHC version support page](supported-versions.md) for details. @@ -141,7 +142,7 @@ Code action kind: `quickfix` Rewrites imported names to be qualified. ![Qualify Imported Names Demo](../plugins/hls-qualify-imported-names-plugin/qualify-imported-names-demo.gif) - + For usage see the ![readme](../plugins/hls-qualify-imported-names-plugin/README.md). ### Refine import @@ -239,6 +240,13 @@ Shows module name matching file path, and applies it with a click. ![Module Name Demo](https://user-images.githubusercontent.com/54035/110860755-78ad8680-82bd-11eb-9845-9ea4b1cc1f76.gif) +## Selection range +Provided by: `hls-selection-range-plugin` + +Provides haskell specific +[shrink/expand selection](https://code.visualstudio.com/docs/editor/codebasics#shrinkexpand-selection) +support. + ## Missing features The following features are supported by the LSP specification but not implemented in HLS. @@ -251,7 +259,6 @@ Contributions welcome! | Jump to implementation | Unclear if useful | `textDocument/implementation` | | Renaming | [Parital implementation](https://github.com/haskell/haskell-language-server/issues/2193) | `textDocument/rename`, `textDocument/prepareRename` | | Folding | Unimplemented | `textDocument/foldingRange` | -| Selection range | Unimplemented | `textDocument/selectionRange` | | Semantic tokens | Unimplemented | `textDocument/semanticTokens` | | Linked editing | Unimplemented | `textDocument/linkedEditingRange` | | Document links | Unimplemented | `textDocument/documentLink` | diff --git a/docs/supported-versions.md b/docs/supported-versions.md index caf0f9f3ce..21afba0582 100644 --- a/docs/supported-versions.md +++ b/docs/supported-versions.md @@ -50,6 +50,7 @@ As such, the functionality provided by those plugins is not available in HLS whe | `hls-splice-plugin` | 9.2 | | `hls-stylish-haskell-plugin` | 9.0, 9.2 | | `hls-tactics-plugin` | 9.2 | +| `hls-selection-range-plugin` | | ### Using deprecated GHC versions diff --git a/exe/Plugins.hs b/exe/Plugins.hs index 4974677877..3934b61de8 100644 --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -72,6 +72,10 @@ import Ide.Plugin.Splice as Splice import Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat #endif +#if selectionRange +import Ide.Plugin.SelectionRange as SelectionRange +#endif + -- formatters #if floskell @@ -167,6 +171,9 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins #endif #if alternateNumberFormat AlternateNumberFormat.descriptor "alternateNumberFormat" : +#endif +#if selectionRange + SelectionRange.descriptor "selectionRange" : #endif -- The ghcide descriptors should come last so that the notification handlers -- (which restart the Shake build) run after everything else diff --git a/flake.lock b/flake.lock index dc7b690ee8..ade3851966 100644 --- a/flake.lock +++ b/flake.lock @@ -110,7 +110,7 @@ "retrie": "retrie" }, "locked": { - "narHash": "sha256-gVzFEW0y/uPHJaGJ6w7VZc3QDhH6latvmYHJuzaXDa0=", + "narHash": "sha256-/F3itZJSZDnaxRGpkTffHDkxC7PloYqxVTW//bP3i20=", "path": "./flake_hackage", "type": "path" }, @@ -158,13 +158,13 @@ "lsp-types": { "flake": false, "locked": { - "narHash": "sha256-K1CeV6o5mmrXubATCh19iFatJ1RtPwpY5lxD8rf/SIw=", + "narHash": "sha256-HGg4upgirM6/px+vflY5S0Y79gAIDpl32Ad9mbbzTdU=", "type": "tarball", - "url": "https://hackage.haskell.org/package/lsp-types-1.4.0.0/lsp-types-1.4.0.0.tar.gz" + "url": "https://hackage.haskell.org/package/lsp-types-1.4.0.1/lsp-types-1.4.0.1.tar.gz" }, "original": { "type": "tarball", - "url": "https://hackage.haskell.org/package/lsp-types-1.4.0.0/lsp-types-1.4.0.0.tar.gz" + "url": "https://hackage.haskell.org/package/lsp-types-1.4.0.1/lsp-types-1.4.0.1.tar.gz" } }, "nixpkgs": { diff --git a/flake_hackage/flake.nix b/flake_hackage/flake.nix index 3b91d2e04f..212cf1e7f7 100644 --- a/flake_hackage/flake.nix +++ b/flake_hackage/flake.nix @@ -7,7 +7,7 @@ flake = false; }; lsp-types = { - url = "https://hackage.haskell.org/package/lsp-types-1.4.0.0/lsp-types-1.4.0.0.tar.gz"; + url = "https://hackage.haskell.org/package/lsp-types-1.4.0.1/lsp-types-1.4.0.1.tar.gz"; flake = false; }; lsp-test = { diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 163fd9e678..bf7c714f37 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -64,7 +64,7 @@ library lens, list-t, hiedb == 0.4.1.*, - lsp-types ^>= 1.4.0.0, + lsp-types ^>= 1.4.0.1, lsp ^>= 1.4.0.0 , monoid-subclasses, mtl, diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 4b52ee1868..76c5c055dd 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -32,6 +32,10 @@ module Development.IDE.GHC.Compat( nodeInfo', getNodeIds, + nodeInfoFromSource, + isAnnotationInNodeInfo, + mkAstNode, + combineRealSrcSpans, isQualifiedImport, GhcVersion(..), @@ -67,71 +71,75 @@ module Development.IDE.GHC.Compat( runPp, ) where -import GHC hiding (HasSrcSpan, ModLocation, getLoc, - lookupName, RealSrcSpan) -import Development.IDE.GHC.Compat.Core -import Development.IDE.GHC.Compat.Env -import Development.IDE.GHC.Compat.ExactPrint -import Development.IDE.GHC.Compat.Iface -import Development.IDE.GHC.Compat.Logger -import Development.IDE.GHC.Compat.Outputable -import Development.IDE.GHC.Compat.Parser -import Development.IDE.GHC.Compat.Plugins -import Development.IDE.GHC.Compat.Units -import Development.IDE.GHC.Compat.Util +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.ExactPrint +import Development.IDE.GHC.Compat.Iface +import Development.IDE.GHC.Compat.Logger +import Development.IDE.GHC.Compat.Outputable +import Development.IDE.GHC.Compat.Parser +import Development.IDE.GHC.Compat.Plugins +import Development.IDE.GHC.Compat.Units +import Development.IDE.GHC.Compat.Util +import GHC hiding (HasSrcSpan, + ModLocation, + RealSrcSpan, getLoc, + lookupName) #if MIN_VERSION_ghc(9,0,0) import GHC.Data.StringBuffer -import GHC.Driver.Session hiding (ExposePackage) +import GHC.Driver.Session hiding (ExposePackage) +import qualified GHC.Types.SrcLoc as SrcLoc import GHC.Utils.Error #if MIN_VERSION_ghc(9,2,0) import Data.Bifunctor -import GHC.Unit.Module.ModSummary -import GHC.Driver.Env as Env +import GHC.Driver.Env as Env import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModSummary #else import GHC.Driver.Types #endif import GHC.Iface.Env -import GHC.Iface.Make (mkIfaceExports) -import qualified GHC.SysTools.Tasks as SysTools -import qualified GHC.Types.Avail as Avail +import GHC.Iface.Make (mkIfaceExports) +import qualified GHC.SysTools.Tasks as SysTools +import qualified GHC.Types.Avail as Avail #else -import DynFlags hiding (ExposePackage) -import HscTypes -import MkIface hiding (writeIfaceFile) import qualified Avail +import DynFlags hiding (ExposePackage) +import HscTypes +import MkIface hiding (writeIfaceFile) #if MIN_VERSION_ghc(8,8,0) -import StringBuffer (hPutStringBuffer) +import StringBuffer (hPutStringBuffer) #endif import qualified SysTools #if !MIN_VERSION_ghc(8,8,0) -import SrcLoc (RealLocated) import qualified EnumSet +import SrcLoc (RealLocated) import Foreign.ForeignPtr import System.IO #endif #endif -import Compat.HieAst (enrichHie) +import Compat.HieAst (enrichHie) import Compat.HieBin import Compat.HieTypes import Compat.HieUtils -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS import Data.IORef -import qualified Data.Map as Map -import Data.List (foldl') +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 +import qualified Data.Set as S #endif #if !MIN_VERSION_ghc(8,10,0) -import Bag (unitBag) +import Bag (unitBag) #endif #if !MIN_VERSION_ghc(9,2,0) @@ -334,6 +342,13 @@ nodeInfo' = nodeInfo -- unhelpfulSpanFS = id #endif +nodeInfoFromSource :: HieAST a -> Maybe (NodeInfo a) +#if MIN_VERSION_ghc(9,0,0) +nodeInfoFromSource = Map.lookup SourceInfo . getSourcedNodeInfo . sourcedNodeInfo +#else +nodeInfoFromSource = Just . nodeInfo +#endif + data GhcVersion = GHC86 | GHC88 @@ -373,3 +388,31 @@ runPp = #else const SysTools.runPp #endif + +isAnnotationInNodeInfo :: (FastString, FastString) -> NodeInfo a -> Bool +#if MIN_VERSION_ghc(9,2,0) +isAnnotationInNodeInfo (ctor, typ) = Set.member (NodeAnnotation ctor typ) . nodeAnnotations +#else +isAnnotationInNodeInfo p = Set.member p . nodeAnnotations +#endif + +mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a +#if MIN_VERSION_ghc(9,0,0) +mkAstNode n = Node (SourcedNodeInfo $ Map.singleton GeneratedInfo n) +#else +mkAstNode = Node +#endif + +combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan +#if MIN_VERSION_ghc(9,2,0) +combineRealSrcSpans = SrcLoc.combineRealSrcSpans +#else +combineRealSrcSpans span1 span2 + = mkRealSrcSpan (mkRealSrcLoc file line_start col_start) (mkRealSrcLoc file line_end col_end) + where + (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1) + (srcSpanStartLine span2, srcSpanStartCol span2) + (line_end, col_end) = max (srcSpanEndLine span1, srcSpanEndCol span1) + (srcSpanEndLine span2, srcSpanEndCol span2) + file = srcSpanFile span1 +#endif diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 73dd7690e7..b4a3efbf4e 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -176,6 +176,11 @@ flag qualifyImportedNames default: True manual: True +flag selectionRange + description: Enable selectionRange plugin + default: True + manual: True + -- formatters flag floskell @@ -283,6 +288,11 @@ common qualifyImportedNames build-depends: hls-qualify-imported-names-plugin ^>=1.0.0.0 cpp-options: -DqualifyImportedNames +common selectionRange + if flag(selectionRange) + build-depends: hls-selection-range-plugin ^>=1.0.0.0 + cpp-options: -DselectionRange + -- formatters common floskell @@ -332,6 +342,7 @@ executable haskell-language-server , splice , alternateNumberFormat , qualifyImportedNames + , selectionRange , floskell , fourmolu , ormolu diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 00dcb4b335..8aaafd9849 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -100,58 +100,62 @@ instance A.ToJSON Config where -- This provides a regular naming scheme for all plugin config. data PluginConfig = PluginConfig - { plcGlobalOn :: !Bool - , plcCallHierarchyOn :: !Bool - , plcCodeActionsOn :: !Bool - , plcCodeLensOn :: !Bool - , plcDiagnosticsOn :: !Bool - , plcHoverOn :: !Bool - , plcSymbolsOn :: !Bool - , plcCompletionOn :: !Bool - , plcRenameOn :: !Bool - , plcConfig :: !A.Object + { plcGlobalOn :: !Bool + , plcCallHierarchyOn :: !Bool + , plcCodeActionsOn :: !Bool + , plcCodeLensOn :: !Bool + , plcDiagnosticsOn :: !Bool + , plcHoverOn :: !Bool + , plcSymbolsOn :: !Bool + , plcCompletionOn :: !Bool + , plcRenameOn :: !Bool + , plcSelectionRangeOn :: !Bool + , plcConfig :: !A.Object } deriving (Show,Eq) instance Default PluginConfig where def = PluginConfig - { plcGlobalOn = True - , plcCallHierarchyOn = True - , plcCodeActionsOn = True - , plcCodeLensOn = True - , plcDiagnosticsOn = True - , plcHoverOn = True - , plcSymbolsOn = True - , plcCompletionOn = True - , plcRenameOn = True - , plcConfig = mempty + { plcGlobalOn = True + , plcCallHierarchyOn = True + , plcCodeActionsOn = True + , plcCodeLensOn = True + , plcDiagnosticsOn = True + , plcHoverOn = True + , plcSymbolsOn = True + , plcCompletionOn = True + , plcRenameOn = True + , plcSelectionRangeOn = True + , plcConfig = mempty } instance A.ToJSON PluginConfig where - toJSON (PluginConfig g ch ca cl d h s c rn cfg) = r + toJSON (PluginConfig g ch ca cl d h s c rn sr cfg) = r where - r = object [ "globalOn" .= g - , "callHierarchyOn" .= ch - , "codeActionsOn" .= ca - , "codeLensOn" .= cl - , "diagnosticsOn" .= d - , "hoverOn" .= h - , "symbolsOn" .= s - , "completionOn" .= c - , "renameOn" .= rn - , "config" .= cfg + r = object [ "globalOn" .= g + , "callHierarchyOn" .= ch + , "codeActionsOn" .= ca + , "codeLensOn" .= cl + , "diagnosticsOn" .= d + , "hoverOn" .= h + , "symbolsOn" .= s + , "completionOn" .= c + , "renameOn" .= rn + , "selectionRangeOn" .= sr + , "config" .= cfg ] instance A.FromJSON PluginConfig where parseJSON = A.withObject "PluginConfig" $ \o -> PluginConfig - <$> o .:? "globalOn" .!= plcGlobalOn def - <*> o .:? "callHierarchyOn" .!= plcCallHierarchyOn def - <*> o .:? "codeActionsOn" .!= plcCodeActionsOn def - <*> o .:? "codeLensOn" .!= plcCodeLensOn def - <*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ - <*> o .:? "hoverOn" .!= plcHoverOn def - <*> o .:? "symbolsOn" .!= plcSymbolsOn def - <*> o .:? "completionOn" .!= plcCompletionOn def - <*> o .:? "renameOn" .!= plcRenameOn def - <*> o .:? "config" .!= plcConfig def + <$> o .:? "globalOn" .!= plcGlobalOn def + <*> o .:? "callHierarchyOn" .!= plcCallHierarchyOn def + <*> o .:? "codeActionsOn" .!= plcCodeActionsOn def + <*> o .:? "codeLensOn" .!= plcCodeLensOn def + <*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ + <*> o .:? "hoverOn" .!= plcHoverOn def + <*> o .:? "symbolsOn" .!= plcSymbolsOn def + <*> o .:? "completionOn" .!= plcCompletionOn def + <*> o .:? "renameOn" .!= plcRenameOn def + <*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn def + <*> o .:? "config" .!= plcConfig def -- --------------------------------------------------------------------- diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index c15d2ce08d..0fb06387d4 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -280,6 +280,10 @@ instance PluginMethod TextDocumentRangeFormatting where instance PluginMethod TextDocumentPrepareCallHierarchy where pluginEnabled _ = pluginEnabledConfig plcCallHierarchyOn +instance PluginMethod TextDocumentSelectionRange where + pluginEnabled _ = pluginEnabledConfig plcSelectionRangeOn + combineResponses _ _ _ _ (x :| _) = x + instance PluginMethod CallHierarchyIncomingCalls where pluginEnabled _ = pluginEnabledConfig plcCallHierarchyOn diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal index 5eb4c7cfaa..a6f5dec9d3 100644 --- a/hls-test-utils/hls-test-utils.cabal +++ b/hls-test-utils/hls-test-utils.cabal @@ -49,7 +49,7 @@ library , lens , lsp ^>=1.4 , lsp-test ^>=0.14 - , lsp-types ^>=1.4 + , lsp-types ^>=1.4.0.1 , tasty , tasty-expected-failure , tasty-golden diff --git a/plugins/hls-haddock-comments-plugin/test/testdata/test/testdata/QualFunction.expected.hs b/plugins/hls-haddock-comments-plugin/test/testdata/test/testdata/QualFunction.expected.hs new file mode 100644 index 0000000000..e91170424b --- /dev/null +++ b/plugins/hls-haddock-comments-plugin/test/testdata/test/testdata/QualFunction.expected.hs @@ -0,0 +1,6 @@ +module QualFunction where + +f :: (Show a, Show b) => a -- ^ + -> b -- ^ + -> String +f x y = show x <> show y diff --git a/plugins/hls-selection-range-plugin/LICENSE b/plugins/hls-selection-range-plugin/LICENSE new file mode 100644 index 0000000000..261eeb9e9f --- /dev/null +++ b/plugins/hls-selection-range-plugin/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal b/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal new file mode 100644 index 0000000000..f7f557e758 --- /dev/null +++ b/plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal @@ -0,0 +1,60 @@ +cabal-version: 2.4 +name: hls-selection-range-plugin +version: 1.0.0.0 +synopsis: + HLS Plugin to support smart selection range + +description: + Please see the README on GitHub at + +license: Apache-2.0 +license-file: LICENSE +author: kokobd +maintainer: kokobd + +category: Development +build-type: Simple +extra-source-files: + LICENSE + test/testdata/*.hs + test/testdata/*.yaml + test/testdata/*.txt + +library + exposed-modules: + Ide.Plugin.SelectionRange + other-modules: + Ide.Plugin.SelectionRange.ASTPreProcess + ghc-options: -Wall + hs-source-dirs: src + default-language: Haskell2010 + build-depends: + , aeson + , base >=4.12 && <5 + , containers + , ghcide ^>=1.5.0 + , hls-plugin-api >=1.1 && <1.3 + , lsp + , transformers + , mtl + , text + , extra + , semigroupoids + +test-suite tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + , base + , containers + , filepath + , hls-selection-range-plugin + , hls-test-utils >=1.0 && <1.2 + , lsp + , lsp-test + , text + , bytestring + , lens diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs new file mode 100644 index 0000000000..3e25e41b55 --- /dev/null +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Ide.Plugin.SelectionRange (descriptor) 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 (response) +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) + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) + { pluginHandlers = mkPluginHandler STextDocumentSelectionRange selectionRangeHandler + } + +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) + response $ do + filePath <- ExceptT . pure . maybeToEither "fail to convert uri to file path" $ + toNormalizedFilePath' <$> uriToFilePath' uri + selectionRanges <- ExceptT . liftIO . runIdeAction "SelectionRange" (shakeExtras ide) . runExceptT $ + getSelectionRanges filePath positions + pure . List $ selectionRanges + where + uri :: Uri + TextDocumentIdentifier uri = _textDocument + + 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 + 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' + + -- '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 + +-- | Likes 'toCurrentPosition', but works on 'SelectionRange' +toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange +toCurrentSelectionRange positionMapping SelectionRange{..} = do + newRange <- toCurrentRange positionMapping _range + pure $ SelectionRange { + _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 new file mode 100644 index 0000000000..9fd6ab24c2 --- /dev/null +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs @@ -0,0 +1,159 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Ide.Plugin.SelectionRange.ASTPreProcess + ( preProcessAST + , PreProcessEnv(..) + ) 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) + +{-| +Extra arguments for 'preaProcessAST', meant to be used in a 'Reader' context. We use 'Reader' to combine +-} +newtype PreProcessEnv a = PreProcessEnv + { preProcessEnvRefMap :: RefMap a + } + +{-| +Before converting the HieAST to selection range, we need to run some passes on it. Each pass potentially modifies +the AST to handle some special cases. + +'preProcessAST' combines the passes. Refer to 'mergeImports' or 'mergeSignatureWithDefinition' as +a concrete example example. + +Adding another manipulation to the AST is simple, just implement a function of type +`HieAST a -> Reader (PreProcessEnv a) (HieAST a)`, and append it to 'preProcessAST' with `>>=`. + +If it goes more complex, it may be more appropriate to split different manipulations to different modules. +-} +preProcessAST :: HieAST a -> Reader (PreProcessEnv a) (HieAST a) +preProcessAST node = mergeImports node >>= mergeSignatureWithDefinition + +{-| +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. +-} +mergeImports :: forall a. HieAST a -> Reader (PreProcessEnv a) (HieAST a) +mergeImports node = pure $ node { nodeChildren = children } + where + children :: [HieAST a] + children = mapMaybe merge + . groupBy (\x y -> nodeIsImport x && nodeIsImport y) + . nodeChildren $ node + + merge :: [HieAST a] -> Maybe (HieAST a) + merge [] = Nothing + merge [x] = Just x + merge (x:xs) = Just $ createVirtualNode (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. +-} +mergeSignatureWithDefinition :: HieAST a -> Reader (PreProcessEnv a) (HieAST a) +mergeSignatureWithDefinition node = do + refMap <- asks preProcessEnvRefMap + -- Do this recursively for children, so that non top level functions can be handled. + children' <- traverse mergeSignatureWithDefinition (nodeChildren node) + pure $ node { nodeChildren = reverse $ foldl' (go refMap) [] children' } + where + -- For every two adjacent nodes, we try to combine them into one. + go :: RefMap a -> [HieAST a] -> HieAST a -> [HieAST a] + go _ [] node' = [node'] + go refMap (prev:others) node' = + case mergeAdjacentSigDef refMap (prev, node') of + Nothing -> node':prev:others + Just comb -> comb:others + +-- | Merge adjacent type signature and variable/function definition, if the type signature belongs to that variable or +-- function. +-- +-- The implementation potentially has some corner cases not handled properly. +mergeAdjacentSigDef :: RefMap a -> (HieAST a, HieAST a) -> Maybe (HieAST a) +mergeAdjacentSigDef refMap (n1, n2) = do + -- Let's check the node's annotation. There should be a function binding following its type signature. + checkAnnotation + -- Find the identifier of the type signature. + typeSigId <- identifierForTypeSig n1 + -- 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] + else Nothing + where + checkAnnotation :: Maybe () + checkAnnotation = + if ("TypeSig", "Sig") `isAnnotationInAstNode` n1 && + (("FunBind", "HsBindLR") `isAnnotationInAstNode` n2 || ("VarBind", "HsBindLR") `isAnnotationInAstNode` n2) + then Just () + else Nothing + +{-| +Given the AST node of a type signature, tries to find the identifier of it. +-} +identifierForTypeSig :: forall a. HieAST a -> Maybe Identifier +identifierForTypeSig node = + {- + It seems that the identifier lives in one of the children, so we search for the first 'TyDecl' node in + its children recursively. + -} + case mapMaybe extractIdentifier nodes of + [] -> Nothing + (ident:_) -> Just ident + where + nodes = flattenAst node + + extractIdentifier :: HieAST a -> Maybe Identifier + extractIdentifier node' = nodeInfoFromSource node' >>= + (fmap fst . find (\(_, detail) -> TyDecl `Set.member` identInfo detail) + . Map.toList . nodeIdentifiers) + +-- | Determines if the given occurence of an identifier is a function/variable definition in the outer span +isIdentADef :: Span -> (Span, IdentifierDetails a) -> Bool +isIdentADef outerSpan (span, detail) = + realSrcSpanStart span >= realSrcSpanStart outerSpan && realSrcSpanEnd span <= realSrcSpanEnd outerSpan + && isDef + where + isDef :: Bool + isDef = any isContextInfoDef . Set.toList . identInfo $ detail + + -- Does the 'ContextInfo' represents a variable/function definition? + isContextInfoDef :: ContextInfo -> Bool + isContextInfoDef ValBind{} = True + isContextInfoDef MatchBind = True + isContextInfoDef _ = False + +isAnnotationInAstNode :: (FastString, FastString) -> HieAST a -> Bool +isAnnotationInAstNode p = maybe False (isAnnotationInNodeInfo p) . nodeInfoFromSource diff --git a/plugins/hls-selection-range-plugin/test/Main.hs b/plugins/hls-selection-range-plugin/test/Main.hs new file mode 100644 index 0000000000..ac0335a0f6 --- /dev/null +++ b/plugins/hls-selection-range-plugin/test/Main.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} + +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 Language.LSP.Types.Lens +import System.FilePath ((<.>), ()) +import Test.Hls + +plugin :: PluginDescriptor IdeState +plugin = descriptor "selectionRange" + +main :: IO () +main = defaultTestRunner $ + testGroup "Selection Range" + [ goldenTest "Import" [(4, 36), (1, 8)] + , goldenTest "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 + doc <- openDoc (testName <.> "hs") "haskell" + resp <- request STextDocumentSelectionRange $ SelectionRangeParams Nothing Nothing doc + (List $ fmap (uncurry Position . (\(x, y) -> (x-1, y-1))) positions) + let res = resp ^. result + pure $ fmap showSelectionRangesForTest res + case res of + Left err -> assertFailure (show err) + Right golden -> pure golden + +testDataDir :: FilePath +testDataDir = "test" "testdata" + +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 diff --git a/plugins/hls-selection-range-plugin/test/testdata/Function.golden.txt b/plugins/hls-selection-range-plugin/test/testdata/Function.golden.txt new file mode 100644 index 0000000000..48e84dc2df --- /dev/null +++ b/plugins/hls-selection-range-plugin/test/testdata/Function.golden.txt @@ -0,0 +1,4 @@ +(5,16) (5,20) => (5,16) (5,40) => (5,14) (11,20) => (5,1) (11,20) => (4,1) (11,20) => (3,1) (11,20) => (3,1) (14,15) +(5,12) (5,13) => (5,1) (11,20) => (4,1) (11,20) => (3,1) (11,20) => (3,1) (14,15) +(4,1) (4,9) => (4,1) (4,29) => (4,1) (11,20) => (3,1) (11,20) => (3,1) (14,15) +(3,1) (3,9) => (3,1) (3,61) => (3,1) (11,20) => (3,1) (14,15) \ No newline at end of file diff --git a/plugins/hls-selection-range-plugin/test/testdata/Function.hs b/plugins/hls-selection-range-plugin/test/testdata/Function.hs new file mode 100644 index 0000000000..4df95779a0 --- /dev/null +++ b/plugins/hls-selection-range-plugin/test/testdata/Function.hs @@ -0,0 +1,14 @@ +module FuncMultiMatch where + +someFunc :: Integral a => a -> String -> Maybe (Int, String) +someFunc _ "magic" = Nothing +someFunc x y = Just (fromIntegral x, y) + where + go :: Int -> Int + go 0 = -1 + go x = x + 1 + + hi = "greeting" + +otherFunc :: String -> String +otherFunc = id diff --git a/plugins/hls-selection-range-plugin/test/testdata/Import.golden.txt b/plugins/hls-selection-range-plugin/test/testdata/Import.golden.txt new file mode 100644 index 0000000000..43f39edf7d --- /dev/null +++ b/plugins/hls-selection-range-plugin/test/testdata/Import.golden.txt @@ -0,0 +1,2 @@ +(4,33) (4,38) => (4,32) (4,47) => (4,1) (4,47) => (3,1) (4,47) +(1,8) (1,8) \ No newline at end of file diff --git a/plugins/hls-selection-range-plugin/test/testdata/Import.hs b/plugins/hls-selection-range-plugin/test/testdata/Import.hs new file mode 100644 index 0000000000..9159c29d49 --- /dev/null +++ b/plugins/hls-selection-range-plugin/test/testdata/Import.hs @@ -0,0 +1,4 @@ +module MultiPositions where + +import Data.List (find) +import qualified Data.Foldable (foldl, foldl') diff --git a/plugins/hls-selection-range-plugin/test/testdata/hie.yaml b/plugins/hls-selection-range-plugin/test/testdata/hie.yaml new file mode 100644 index 0000000000..bf7a576fe2 --- /dev/null +++ b/plugins/hls-selection-range-plugin/test/testdata/hie.yaml @@ -0,0 +1,5 @@ +cradle: + direct: + arguments: + - "Import" + - "Function" diff --git a/stack-8.10.6.yaml b/stack-8.10.6.yaml index 6863e2a43c..321f143bcd 100644 --- a/stack-8.10.6.yaml +++ b/stack-8.10.6.yaml @@ -30,6 +30,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-alternate-number-format-plugin + - ./plugins/hls-selection-range-plugin ghc-options: "$everything": -haddock @@ -47,8 +48,8 @@ extra-deps: - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - lsp-1.4.0.0 + - lsp-types-1.4.0.1 - lsp-test-0.14.0.2 - - lsp-types-1.4.0.0 - monad-dijkstra-0.1.1.3@sha256:d2fc098d7c122555e726830a12ae0423ac187f89de9228f32e56e2f6fc2238e1,1900 - optparse-applicative-0.15.1.0@sha256:29ff6146aabf54d46c4c8788e8d1eadaea27c94f6d360c690c5f6c93dac4b07e,4810 - refinery-0.4.0.0@sha256:fe3a43add8ff1db5cfffee7e7694c86128b1dfe62c541f26e25a8eadf9585610,1663 diff --git a/stack-8.10.7.yaml b/stack-8.10.7.yaml index 804a9ad284..f373a37ea5 100644 --- a/stack-8.10.7.yaml +++ b/stack-8.10.7.yaml @@ -31,6 +31,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-alternate-number-format-plugin + - ./plugins/hls-selection-range-plugin ghc-options: "$everything": -haddock @@ -48,8 +49,8 @@ extra-deps: - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - lsp-1.4.0.0 + - lsp-types-1.4.0.1 - lsp-test-0.14.0.2 - - lsp-types-1.4.0.0 - monad-dijkstra-0.1.1.3@sha256:d2fc098d7c122555e726830a12ae0423ac187f89de9228f32e56e2f6fc2238e1,1900 - optparse-applicative-0.15.1.0@sha256:29ff6146aabf54d46c4c8788e8d1eadaea27c94f6d360c690c5f6c93dac4b07e,4810 - refinery-0.4.0.0@sha256:fe3a43add8ff1db5cfffee7e7694c86128b1dfe62c541f26e25a8eadf9585610,1663 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 088f1d4149..121998bfc6 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -28,6 +28,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-alternate-number-format-plugin + - ./plugins/hls-selection-range-plugin ghc-options: "$everything": -haddock @@ -105,8 +106,8 @@ extra-deps: - unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082 - resourcet-1.2.3 - lsp-1.4.0.0 + - lsp-types-1.4.0.1 - lsp-test-0.14.0.2 - - lsp-types-1.4.0.0 - mod-0.1.2.2 - semirings-0.6 - stm-containers-1.1.0.4 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 5e63618afe..ce00d47573 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -28,6 +28,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-alternate-number-format-plugin + - ./plugins/hls-selection-range-plugin ghc-options: "$everything": -haddock @@ -81,8 +82,8 @@ extra-deps: - some-1.0.1@sha256:26e5bab7276f48b25ea8660d3fd1166c0f20fd497dac879a40f408e23211f93e,2055 - unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082 - lsp-1.4.0.0 + - lsp-types-1.4.0.1 - lsp-test-0.14.0.2 - - lsp-types-1.4.0.0 - stm-containers-1.1.0.4 - stm-hamt-1.2.0.6@sha256:fba86ccb4b45c5706c19b0e1315ba63dcac3b5d71de945ec001ba921fae80061,3972 - primitive-extras-0.10.1 diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml index bda42f3e00..2f75afbaee 100644 --- a/stack-9.0.1.yaml +++ b/stack-9.0.1.yaml @@ -28,6 +28,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-alternate-number-format-plugin +- ./plugins/hls-selection-range-plugin extra-deps: - aeson-2.0.3.0 @@ -49,6 +50,9 @@ extra-deps: - monad-dijkstra-0.1.1.3 - multistate-0.8.0.3 - retrie-1.1.0.0 +- lsp-1.4.0.0 +- lsp-types-1.4.0.1 +- lsp-test-0.14.0.2 - refinery-0.4.0.0 # shake-bench dependencies diff --git a/stack-9.0.2.yaml b/stack-9.0.2.yaml index 841b11c2fe..df94686560 100644 --- a/stack-9.0.2.yaml +++ b/stack-9.0.2.yaml @@ -28,6 +28,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-alternate-number-format-plugin +- ./plugins/hls-selection-range-plugin extra-deps: - aeson-2.0.3.0 @@ -50,6 +51,9 @@ extra-deps: - multistate-0.8.0.3 - refinery-0.4.0.0 - retrie-1.1.0.0 +- lsp-1.4.0.0 +- lsp-types-1.4.0.1 +- lsp-test-0.14.0.2 - unix-compat-0.5.4 # shake-bench dependencies diff --git a/stack-9.2.1.yaml b/stack-9.2.1.yaml index 3929e3d041..8bcf7b4b3d 100644 --- a/stack-9.2.1.yaml +++ b/stack-9.2.1.yaml @@ -29,6 +29,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin # - ./plugins/hls-alternate-number-format-plugin +- ./plugins/hls-selection-range-plugin extra-deps: - aeson-2.0.3.0 diff --git a/stack.yaml b/stack.yaml index 804a9ad284..f373a37ea5 100644 --- a/stack.yaml +++ b/stack.yaml @@ -31,6 +31,7 @@ packages: - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-alternate-number-format-plugin + - ./plugins/hls-selection-range-plugin ghc-options: "$everything": -haddock @@ -48,8 +49,8 @@ extra-deps: - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - lsp-1.4.0.0 + - lsp-types-1.4.0.1 - lsp-test-0.14.0.2 - - lsp-types-1.4.0.0 - monad-dijkstra-0.1.1.3@sha256:d2fc098d7c122555e726830a12ae0423ac187f89de9228f32e56e2f6fc2238e1,1900 - optparse-applicative-0.15.1.0@sha256:29ff6146aabf54d46c4c8788e8d1eadaea27c94f6d360c690c5f6c93dac4b07e,4810 - refinery-0.4.0.0@sha256:fe3a43add8ff1db5cfffee7e7694c86128b1dfe62c541f26e25a8eadf9585610,1663