fix: duplicate start line foldingranges and remove single line

foldingranges

Author: sloorush

plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs

@@ -79,7 +79,7 @@ foldingRangeHandler ide _ FoldingRangeParams{..} = do
                 toNormalizedFilePath' <$> uriToFilePath' uri
         foldingRanges <- ExceptT . liftIO . runIdeAction "FoldingRange" (shakeExtras ide) . runExceptT $
             getFoldingRanges filePath
-        pure . List $ foldingRanges
+        pure . List $ removeDupStartLineFoldings foldingRanges
     where
         uri :: Uri
         TextDocumentIdentifier uri = _textDocument
@@ -164,11 +164,20 @@ findFoldingRanges r@(CodeRange _ children _) =
 createFoldingRange :: CodeRange -> Maybe FoldingRange
 createFoldingRange (CodeRange (Range (Position lineStart charStart) (Position lineEnd charEnd)) _ ck) = do
     let frk = crkToFrk ck
-
-    case frk of
+    if lineStart == lineEnd
+        then Nothing
+    else case frk of
         Just _  -> Just (FoldingRange lineStart (Just charStart) lineEnd (Just charEnd) frk)
         Nothing -> Nothing
 
+-- Removes all small foldings that start from the same line
+removeDupStartLineFoldings :: [FoldingRange] -> [FoldingRange]
+removeDupStartLineFoldings [] = []
+removeDupStartLineFoldings [x] = [x]
+removeDupStartLineFoldings (frx@(FoldingRange x _ _ _ _):xs@((FoldingRange y _ _ _ _):xs2))
+    | x == y = removeDupStartLineFoldings ([frx]++xs2)
+    | otherwise = frx : removeDupStartLineFoldings xs
+
 -- | Likes 'toCurrentPosition', but works on 'SelectionRange'
 toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange
 toCurrentSelectionRange positionMapping SelectionRange{..} = do

plugins/hls-code-range-plugin/test/Ide/Plugin/CodeRangeTest.hs

@@ -88,7 +88,7 @@ testTree =
                 -- Single line
                 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
@@ -106,6 +106,10 @@ testTree =
             -- General test
             testCase "Test General Code Block" $ check
                 (mkCodeRange (Position 1 1) (Position 5 10) [] CodeKindRegion)
-                (Just (FoldingRange 1 (Just 1) 5 (Just 10) (Just FoldingRangeRegion)))
+                (Just (FoldingRange 1 (Just 1) 5 (Just 10) (Just FoldingRangeRegion))),
+            -- General test
+            testCase "Test Same Start Line" $ check
+                (mkCodeRange (Position 1 1) (Position 1 10) [] CodeKindRegion)
+                Nothing
         ]
     ]

plugins/hls-code-range-plugin/test/testdata/folding-range/Function.golden.txt

@@ -1,20 +1,2 @@
 ((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
+((5, 0) : (7, 21)) : FoldingRangeRegion