Feat: Folding Ranges (#3058)

* save some progress: add basic starter code for folding ranges

* save some progress: add function to traverse through coderange and form folding ranges

* save some progress: add parsing of folding ranges

* fix: maybe issue with foldingRanges

* add: generate folding ranges from coderange

* add: plugin request method instance for folding ranges

* ref: alter function and var names

* post review: cleanup crk to frk & fix typo

* fix: find folding ranges function

* format: run formatter and add comments

* fix: return all response results of folding range request

* Revert "format: run formatter and add comments"

This reverts commit e6a2b5ca3e.

* add: removed comments after revert

* fix: formatting

* docs: add folding range to features section and cabal file

* refactor: use destructuring for createFoldingRange function and use characters

* test: add basic unit test for findFoldingRanges function

* test: add tests for children and code kind

* test: add more test cases

* test: add test for createFoldingRange

* test: add integration test for folding ranges

* fix: duplicate start line foldingranges and remove single line
foldingranges

* refactor: duplicate folding range functionality

* fix: formatting in code range plugin

* added more descriptive comments and encorporate code review suggestions

* revert: automatic formatting for selection range test case file

* fix: ignoring children if root fails to provide folding ranges

* remove: redundant match on crkToFrk

* revert: filtering same line foldings and multiple foldings on the same line as it can be handled by clients

* revert: formatting change to selection range test file

* fix: entire file folding because of root node

Co-authored-by: Kobayashi <contact@zelinf.net>
This commit is contained in:
Aarush Bhat 2022-09-21 17:29:57 +05:30 committed by GitHub
parent bd1d0a1675
commit 42bcf9229a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
11 changed files with 265 additions and 27 deletions

View File

@ -4,7 +4,7 @@ This table gives a summary of the features that HLS supports.
Many of these are standard LSP features, but a lot of special features are provided as [code actions](#code-actions) and [code lenses](#code-lenses).
| Feature | [LSP method](./what-is-hls.md#lsp-terminology) |
|-----------------------------------------------------|---------------------------------------------------------------------------------------------------|
| --------------------------------------------------- | ------------------------------------------------------------------------------------------------- |
| [Diagnostics](#diagnostics) | `textDocument/publishDiagnostics` |
| [Hovers](#hovers) | `textDocument/hover` |
| [Jump to definition](#jump-to-definition) | `textDocument/definition` |
@ -100,7 +100,7 @@ Completions for language pragmas.
Format your code with various Haskell code formatters.
| Formatter | Provided by |
|-----------------|------------------------------|
| --------------- | ---------------------------- |
| Brittany | `hls-brittany-plugin` |
| Floskell | `hls-floskell-plugin` |
| Fourmolu | `hls-fourmolu-plugin` |
@ -261,6 +261,7 @@ Change/Update a type signature to match implementation.
Status: Until GHC 9.4, the implementation is ad-hoc and relies on GHC error messages to create a new signature. Not all GHC error messages are supported.
Known Limitations:
- Not all GHC error messages are supported
- Top-level and Function-local bindings with the same names can cause issues, such as incorrect signature changes or no code actions available.
@ -337,6 +338,16 @@ support.
![Selection range demo](https://user-images.githubusercontent.com/16440269/177240833-7dc8fe39-b446-477e-b5b1-7fc303608d4f.gif)
## Folding range
Provided by: `hls-code-range-plugin`
Provides haskell specific
[Folding](https://code.visualstudio.com/docs/editor/codebasics#_folding)
support.
![Folding range demo](https://user-images.githubusercontent.com/54478821/184468510-7c0d5182-c684-48ef-9b39-3866dc2309df.gif)
## Rename
Provided by: `hls-rename-plugin`
@ -354,15 +365,14 @@ Known limitations:
The following features are supported by the LSP specification but not implemented in HLS.
Contributions welcome!
| Feature | Status | [LSP method](./what-is-hls.md#lsp-terminology) |
|------------------------|------------------------------------------------------------------------------------------|-----------------------------------------------------|
| Signature help | Unimplemented | `textDocument/signatureHelp` |
| Jump to declaration | Unclear if useful | `textDocument/declaration` |
| Jump to implementation | Unclear if useful | `textDocument/implementation` |
| Folding | Unimplemented | `textDocument/foldingRange` |
| Semantic tokens | Unimplemented | `textDocument/semanticTokens` |
| Linked editing | Unimplemented | `textDocument/linkedEditingRange` |
| Document links | Unimplemented | `textDocument/documentLink` |
| Document color | Unclear if useful | `textDocument/documentColor` |
| Color presentation | Unclear if useful | `textDocument/colorPresentation` |
| Monikers | Unclear if useful | `textDocument/moniker` |
| Feature | Status | [LSP method](./what-is-hls.md#lsp-terminology) |
| ---------------------- | ----------------- | ---------------------------------------------- |
| Signature help | Unimplemented | `textDocument/signatureHelp` |
| Jump to declaration | Unclear if useful | `textDocument/declaration` |
| Jump to implementation | Unclear if useful | `textDocument/implementation` |
| Semantic tokens | Unimplemented | `textDocument/semanticTokens` |
| Linked editing | Unimplemented | `textDocument/linkedEditingRange` |
| Document links | Unimplemented | `textDocument/documentLink` |
| Document color | Unclear if useful | `textDocument/documentColor` |
| Color presentation | Unclear if useful | `textDocument/colorPresentation` |
| Monikers | Unclear if useful | `textDocument/moniker` |

View File

@ -110,6 +110,7 @@ data PluginConfig =
, plcCompletionOn :: !Bool
, plcRenameOn :: !Bool
, plcSelectionRangeOn :: !Bool
, plcFoldingRangeOn :: !Bool
, plcConfig :: !A.Object
} deriving (Show,Eq)
@ -125,11 +126,12 @@ instance Default PluginConfig where
, plcCompletionOn = True
, plcRenameOn = True
, plcSelectionRangeOn = True
, plcFoldingRangeOn = True
, plcConfig = mempty
}
instance A.ToJSON PluginConfig where
toJSON (PluginConfig g ch ca cl d h s c rn sr cfg) = r
toJSON (PluginConfig g ch ca cl d h s c rn sr fr cfg) = r
where
r = object [ "globalOn" .= g
, "callHierarchyOn" .= ch
@ -141,6 +143,7 @@ instance A.ToJSON PluginConfig where
, "completionOn" .= c
, "renameOn" .= rn
, "selectionRangeOn" .= sr
, "foldingRangeOn" .= fr
, "config" .= cfg
]
@ -156,6 +159,7 @@ instance A.FromJSON PluginConfig where
<*> o .:? "completionOn" .!= plcCompletionOn def
<*> o .:? "renameOn" .!= plcRenameOn def
<*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn def
<*> o .:? "foldingRangeOn" .!= plcFoldingRangeOn def
<*> o .:? "config" .!= plcConfig def
-- ---------------------------------------------------------------------

View File

@ -429,6 +429,13 @@ instance PluginMethod Request TextDocumentSelectionRange where
uri = msgParams ^. J.textDocument . J.uri
pid = pluginId pluginDesc
instance PluginMethod Request TextDocumentFoldingRange where
pluginEnabled _ msgParams pluginDesc conf = pluginResponsible uri pluginDesc
&& pluginEnabledConfig plcFoldingRangeOn pid conf
where
uri = msgParams ^. J.textDocument . J.uri
pid = pluginId pluginDesc
instance PluginMethod Request CallHierarchyIncomingCalls where
-- This method has no URI parameter, thus no call to 'pluginResponsible'
pluginEnabled _ _ pluginDesc conf = pluginEnabledConfig plcCallHierarchyOn pid conf
@ -529,6 +536,9 @@ instance PluginRequestMethod TextDocumentPrepareCallHierarchy where
instance PluginRequestMethod TextDocumentSelectionRange where
combineResponses _ _ _ _ (x :| _) = x
instance PluginRequestMethod TextDocumentFoldingRange where
combineResponses _ _ _ _ x = sconcat x
instance PluginRequestMethod CallHierarchyIncomingCalls where
instance PluginRequestMethod CallHierarchyOutgoingCalls where

View File

@ -2,7 +2,7 @@ cabal-version: 2.4
name: hls-code-range-plugin
version: 1.0.0.0
synopsis:
HLS Plugin to support smart selection range
HLS Plugin to support smart selection range and Folding range
description:
Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>

View File

@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ide.Plugin.CodeRange (
descriptor
@ -7,6 +8,8 @@ module Ide.Plugin.CodeRange (
-- * Internal
, findPosition
, findFoldingRanges
, createFoldingRange
) where
import Control.Monad.Except (ExceptT (ExceptT),
@ -33,7 +36,7 @@ import Development.IDE.Core.PositionMapping (PositionMapping,
import Development.IDE.Types.Logger (Pretty (..))
import Ide.Plugin.CodeRange.Rules (CodeRange (..),
GetCodeRange (..),
codeRangeRule)
codeRangeRule, crkToFrk)
import qualified Ide.Plugin.CodeRange.Rules as Rules (Log)
import Ide.PluginUtils (pluginResponse,
positionInRange)
@ -42,12 +45,14 @@ import Ide.Types (PluginDescriptor (pluginH
defaultPluginDescriptor,
mkPluginHandler)
import Language.LSP.Server (LspM)
import Language.LSP.Types (List (List),
import Language.LSP.Types (FoldingRange (..),
FoldingRangeParams (..),
List (List),
NormalizedFilePath,
Position (..),
Range (_start),
ResponseError,
SMethod (STextDocumentSelectionRange),
SMethod (STextDocumentFoldingRange, STextDocumentSelectionRange),
SelectionRange (..),
SelectionRangeParams (..),
TextDocumentIdentifier (TextDocumentIdentifier),
@ -57,8 +62,7 @@ import Prelude hiding (log, span)
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor recorder plId = (defaultPluginDescriptor plId)
{ pluginHandlers = mkPluginHandler STextDocumentSelectionRange selectionRangeHandler
-- TODO @sloorush add folding range
-- <> mkPluginHandler STextDocumentFoldingRange foldingRangeHandler
<> mkPluginHandler STextDocumentFoldingRange foldingRangeHandler
, pluginRules = codeRangeRule (cmapWithPrio LogRules recorder)
}
@ -68,6 +72,25 @@ instance Pretty Log where
pretty log = case log of
LogRules codeRangeLog -> pretty codeRangeLog
foldingRangeHandler :: IdeState -> PluginId -> FoldingRangeParams -> LspM c (Either ResponseError (List FoldingRange))
foldingRangeHandler ide _ FoldingRangeParams{..} = do
pluginResponse $ do
filePath <- ExceptT . pure . maybeToEither "fail to convert uri to file path" $
toNormalizedFilePath' <$> uriToFilePath' uri
foldingRanges <- ExceptT . liftIO . runIdeAction "FoldingRange" (shakeExtras ide) . runExceptT $
getFoldingRanges filePath
pure . List $ foldingRanges
where
uri :: Uri
TextDocumentIdentifier uri = _textDocument
getFoldingRanges :: NormalizedFilePath -> ExceptT String IdeAction [FoldingRange]
getFoldingRanges file = do
(codeRange, _) <- maybeToExceptT "fail to get code range" $ useE GetCodeRange file
-- removing first node because it folds the entire file
pure $ drop 1 $ findFoldingRanges codeRange
selectionRangeHandler :: IdeState -> PluginId -> SelectionRangeParams -> LspM c (Either ResponseError (List SelectionRange))
selectionRangeHandler ide _ SelectionRangeParams{..} = do
pluginResponse $ do
@ -126,6 +149,39 @@ findPosition pos root = go Nothing root
startOfRight <- _start . _codeRange_range <$> V.headM right
if pos < startOfRight then binarySearchPos left else binarySearchPos right
-- | Traverses through the code range and it children to a folding ranges.
--
-- It starts with the root node, converts that into a folding range then moves towards the children.
-- It converts each child of each root node and parses it to folding range and moves to its children.
--
-- Two cases to that are assumed to be taken care on the client side are:
--
-- 1. When a folding range starts and ends on the same line, it is upto the client if it wants to
-- fold a single line folding or not.
--
-- 2. As we are converting nodes of the ast into folding ranges, there are multiple nodes starting from a single line.
-- A single line of code doesn't mean a single node in AST, so this function removes all the nodes that have a duplicate
-- start line, ie. they start from the same line.
-- Eg. A multi-line function that also has a multi-line if statement starting from the same line should have the folding
-- according to the function.
--
-- We think the client can handle this, if not we could change to remove these in future
--
-- Discussion reference: https://github.com/haskell/haskell-language-server/pull/3058#discussion_r973737211
findFoldingRanges :: CodeRange -> [FoldingRange]
findFoldingRanges r@(CodeRange _ children _) =
let frChildren :: [FoldingRange] = concat $ V.toList $ fmap findFoldingRanges children
in case createFoldingRange r of
Just x -> x:frChildren
Nothing -> frChildren
-- | Parses code range to folding range
createFoldingRange :: CodeRange -> Maybe FoldingRange
createFoldingRange (CodeRange (Range (Position lineStart charStart) (Position lineEnd charEnd)) _ ck) = do
-- Type conversion of codeRangeKind to FoldingRangeKind
let frk = crkToFrk ck
Just (FoldingRange lineStart (Just charStart) lineEnd (Just charEnd) (Just frk))
-- | Likes 'toCurrentPosition', but works on 'SelectionRange'
toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange
toCurrentSelectionRange positionMapping SelectionRange{..} = do

View File

@ -21,6 +21,7 @@ module Ide.Plugin.CodeRange.Rules
-- * Internal
, removeInterleaving
, simplify
, crkToFrk
) where
import Control.DeepSeq (NFData)
@ -52,6 +53,7 @@ import Ide.Plugin.CodeRange.ASTPreProcess (CustomNodeType (..),
PreProcessEnv (..),
isCustomNode,
preProcessAST)
import Language.LSP.Types (FoldingRangeKind (FoldingRangeComment, FoldingRangeImports, FoldingRangeRegion))
import Language.LSP.Types.Lens (HasEnd (end),
HasStart (start))
import Prelude hiding (log)
@ -89,7 +91,7 @@ data CodeRangeKind =
| CodeKindImports
-- | a comment
| CodeKindComment
deriving (Show, Generic, NFData)
deriving (Show, Eq, Generic, NFData)
Lens.makeLenses ''CodeRange
@ -189,3 +191,10 @@ handleError recorder action' = do
logWith recorder Error msg
pure $ toIdeResult (Left [])
Right value -> pure $ toIdeResult (Right value)
-- | Maps type CodeRangeKind to FoldingRangeKind
crkToFrk :: CodeRangeKind -> FoldingRangeKind
crkToFrk crk = case crk of
CodeKindComment -> FoldingRangeComment
CodeKindImports -> FoldingRangeImports
CodeKindRegion -> FoldingRangeRegion

View File

@ -17,7 +17,7 @@ testTree =
mkCodeRange :: Position -> Position -> V.Vector CodeRange -> CodeRange
mkCodeRange start end children = CodeRange (Range start end) children CodeKindRegion
in [
in [
testCase "not in range" $ check
(Position 10 1)
(mkCodeRange (Position 1 1) (Position 5 10) [])
@ -50,5 +50,70 @@ testTree =
( SelectionRange (Range (Position 1 1) (Position 5 10)) Nothing
)
)
]
],
-- TODO: Some more tests can be added on strange cases like
-- 1. lots of blank lines in between type signature and the body
-- 2. lots of blank lines in the function itself
-- etc.
testGroup "findFoldingRanges" $
let check :: CodeRange -> [FoldingRange] -> Assertion
check codeRange = (findFoldingRanges codeRange @?=)
mkCodeRange :: Position -> Position -> V.Vector CodeRange -> CodeRangeKind -> CodeRange
mkCodeRange start end children crk = CodeRange (Range start end) children crk
in [
-- General test
testCase "Test General Code Block" $ check
(mkCodeRange (Position 1 1) (Position 5 10) [] CodeKindRegion)
[FoldingRange 1 (Just 1) 5 (Just 10) (Just FoldingRangeRegion)],
-- Tests for code kind
testCase "Test Code Kind Region" $ check
(mkCodeRange (Position 1 1) (Position 5 10) [] CodeKindRegion)
[FoldingRange 1 (Just 1) 5 (Just 10) (Just FoldingRangeRegion)],
testCase "Test Code Kind Comment" $ check
(mkCodeRange (Position 1 1) (Position 5 10) [] CodeKindComment)
[FoldingRange 1 (Just 1) 5 (Just 10) (Just FoldingRangeComment)],
testCase "Test Code Kind Import" $ check
(mkCodeRange (Position 1 1) (Position 5 10) [] CodeKindImports)
[FoldingRange 1 (Just 1) 5 (Just 10) (Just FoldingRangeImports)],
-- Test for Code Portions with children
testCase "Test Children" $ check
(mkCodeRange (Position 1 1) (Position 5 10) [
mkCodeRange (Position 1 2) (Position 3 6) [] CodeKindRegion,
mkCodeRange (Position 3 7) (Position 5 10) [] CodeKindRegion
] CodeKindRegion)
[FoldingRange 1 (Just 1) 5 (Just 10) (Just FoldingRangeRegion),
FoldingRange 1 (Just 2) 3 (Just 6) (Just FoldingRangeRegion),
FoldingRange 3 (Just 7) 5 (Just 10) (Just FoldingRangeRegion)],
-- Single line returns [] because single line ranges need not be folded
testCase "Test Single Line" $ check
(mkCodeRange (Position 1 0) (Position 1 15) [] CodeKindRegion)
[FoldingRange 1 (Just 0) 1 (Just 15) (Just FoldingRangeRegion)],
-- MultiLine imports
testCase "MultiLine Imports" $ check
(mkCodeRange (Position 1 0) (Position 5 15) [] CodeKindImports)
[FoldingRange 1 (Just 0) 5 (Just 15) (Just FoldingRangeImports)]
],
testGroup "createFoldingRange" $
let check :: CodeRange -> Maybe FoldingRange -> Assertion
check codeRange = (createFoldingRange codeRange @?=)
mkCodeRange :: Position -> Position -> V.Vector CodeRange -> CodeRangeKind -> CodeRange
mkCodeRange start end children crk = CodeRange (Range start end) children crk
in [
-- General tests
testCase "Test General Code Block" $ check
(mkCodeRange (Position 1 1) (Position 5 10) [] CodeKindRegion)
(Just (FoldingRange 1 (Just 1) 5 (Just 10) (Just FoldingRangeRegion))),
-- If a range has the same start and end line it need not be folded so Nothing is expected
testCase "Test Same Start Line" $ check
(mkCodeRange (Position 1 1) (Position 1 10) [] CodeKindRegion)
(Just (FoldingRange 1 (Just 1) 1 (Just 10) (Just FoldingRangeRegion)))
]
]

View File

@ -28,7 +28,8 @@ main = do
testGroup "Code Range" [
testGroup "Integration Tests" [
makeSelectionRangeGoldenTest recorder "Import" [(4, 36), (1, 8)],
makeSelectionRangeGoldenTest recorder "Function" [(5, 19), (5, 12), (4, 4), (3, 5)]
makeSelectionRangeGoldenTest recorder "Function" [(5, 19), (5, 12), (4, 4), (3, 5)],
foldingRangeGoldenTest recorder "Function"
],
testGroup "Unit Tests" [
Ide.Plugin.CodeRangeTest.testTree,
@ -64,3 +65,28 @@ makeSelectionRangeGoldenTest recorder testName positions = goldenGitDiff testNam
showPosition :: Position -> ByteString
showPosition (Position line col) = "(" <> showLBS (line + 1) <> "," <> showLBS (col + 1) <> ")"
showLBS = fromString . show
foldingRangeGoldenTest :: Recorder (WithPriority Log) -> TestName -> TestTree
foldingRangeGoldenTest recorder testName = goldenGitDiff testName (testDataDir </> testName <.> "golden" <.> "txt") $ do
res <- runSessionWithServer (plugin recorder) testDataDir $ do
doc <- openDoc (testName <.> "hs") "haskell"
resp <- request STextDocumentFoldingRange $ FoldingRangeParams Nothing Nothing doc
let res = resp ^. result
pure $ fmap showFoldingRangesForTest res
case res of
Left err -> assertFailure (show err)
Right golden -> pure golden
where
testDataDir :: FilePath
testDataDir = "test" </> "testdata" </> "folding-range"
showFoldingRangesForTest :: List FoldingRange -> ByteString
showFoldingRangesForTest (List foldingRanges) = LBSChar8.intercalate "\n" $ fmap showFoldingRangeForTest foldingRanges
showFoldingRangeForTest :: FoldingRange -> ByteString
showFoldingRangeForTest f@(FoldingRange sl (Just sc) el (Just ec) (Just frk)) = "((" <> showLBS sl <>", "<> showLBS sc <> ")" <> " : " <> "(" <> showLBS el <>", "<> showLBS ec<> ")) : " <> showFRK frk
showLBS = fromString . show
showFRK = fromString . show

View File

@ -0,0 +1,41 @@
((2, 16) : (2, 22)) : FoldingRangeRegion
((4, 0) : (7, 21)) : FoldingRangeRegion
((4, 0) : (4, 25)) : FoldingRangeRegion
((4, 0) : (4, 6)) : FoldingRangeRegion
((4, 10) : (4, 25)) : FoldingRangeRegion
((4, 10) : (4, 17)) : FoldingRangeRegion
((4, 21) : (4, 25)) : FoldingRangeRegion
((5, 0) : (7, 21)) : FoldingRangeRegion
((5, 0) : (5, 6)) : FoldingRangeRegion
((5, 7) : (5, 8)) : FoldingRangeRegion
((5, 9) : (7, 21)) : FoldingRangeRegion
((5, 11) : (7, 21)) : FoldingRangeRegion
((5, 14) : (5, 28)) : FoldingRangeRegion
((5, 14) : (5, 23)) : FoldingRangeRegion
((5, 14) : (5, 15)) : FoldingRangeRegion
((5, 16) : (5, 21)) : FoldingRangeRegion
((5, 22) : (5, 23)) : FoldingRangeRegion
((5, 24) : (5, 26)) : FoldingRangeRegion
((5, 27) : (5, 28)) : FoldingRangeRegion
((6, 16) : (6, 20)) : FoldingRangeRegion
((7, 16) : (7, 21)) : FoldingRangeRegion
((9, 0) : (12, 20)) : FoldingRangeRegion
((9, 0) : (9, 24)) : FoldingRangeRegion
((9, 0) : (9, 5)) : FoldingRangeRegion
((9, 9) : (9, 24)) : FoldingRangeRegion
((9, 9) : (9, 16)) : FoldingRangeRegion
((9, 20) : (9, 24)) : FoldingRangeRegion
((10, 0) : (12, 20)) : FoldingRangeRegion
((10, 0) : (10, 5)) : FoldingRangeRegion
((10, 6) : (10, 7)) : FoldingRangeRegion
((10, 8) : (12, 20)) : FoldingRangeRegion
((10, 10) : (12, 20)) : FoldingRangeRegion
((10, 13) : (10, 27)) : FoldingRangeRegion
((10, 13) : (10, 22)) : FoldingRangeRegion
((10, 13) : (10, 14)) : FoldingRangeRegion
((10, 15) : (10, 20)) : FoldingRangeRegion
((10, 21) : (10, 22)) : FoldingRangeRegion
((10, 23) : (10, 25)) : FoldingRangeRegion
((10, 26) : (10, 27)) : FoldingRangeRegion
((11, 16) : (11, 21)) : FoldingRangeRegion
((12, 16) : (12, 20)) : FoldingRangeRegion

View File

@ -0,0 +1,13 @@
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use module export list" #-}
module Function(isEven) where
isEven :: Integer -> Bool
isEven n = if n `mod` 2 == 0
then True
else False
isOdd :: Integer -> Bool
isOdd n = if n `mod` 2 == 0
then False
else True

View File

@ -0,0 +1,4 @@
cradle:
direct:
arguments:
- "Function"