test: add integration test for folding ranges

Author: sloorush

plugins/hls-code-range-plugin/test/Main.hs

@@ -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

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

@@ -0,0 +1,20 @@
+((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

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

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

plugins/hls-code-range-plugin/test/testdata/folding-range/hie.yaml

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