Fix #3847 (#3854)

* Fix #3847 * Add unit test cases for `Ide.PluginUtils.extractTextInRange`. * More detailed comment about the issue. --------- Co-authored-by: Michael Peyton Jones <[email protected]> Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
haskell · Nov 14, 2023 · afac9b1 · afac9b1
1 parent 1c884ea
commit afac9b1
Show file tree

Hide file tree

Showing 2 changed files with 68 additions and 2 deletions.
diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs
@@ -236,7 +236,20 @@ usePropertyLsp kn pId p = do
 extractTextInRange :: Range -> T.Text -> T.Text
 extractTextInRange (Range (Position sl sc) (Position el ec)) s = newS
   where
-    focusLines = take (fromIntegral $ el - sl + 1) $ drop (fromIntegral sl) $ T.lines s
+    focusLines =
+      T.lines s
+        -- NOTE: Always append an empty line to the end to ensure there are
+        -- sufficient lines to take from.
+        --
+        -- There is a situation that when the end position is placed at the line
+        -- below the last line, if we simply do `drop` and then `take`, there
+        -- will be `el - sl` lines left, not `el - sl + 1` lines. And then
+        -- the last line of code will be emptied unexpectedly.
+        --
+        -- For details, see https://github.com/haskell/haskell-language-server/issues/3847
+        & (++ [""])
+        & drop (fromIntegral sl)
+        & take (fromIntegral $ el - sl + 1)
     -- NOTE: We have to trim the last line first to handle the single-line case
     newS =
       focusLines

diff --git a/hls-plugin-api/test/Ide/PluginUtilsTest.hs b/hls-plugin-api/test/Ide/PluginUtilsTest.hs
@@ -9,7 +9,8 @@ import           Data.Char                   (isPrint)
 import qualified Data.Set                    as Set
 import qualified Data.Text                   as T
 import qualified Ide.Plugin.RangeMap         as RangeMap
-import           Ide.PluginUtils             (positionInRange, unescape)
+import           Ide.PluginUtils             (extractTextInRange,
+                                              positionInRange, unescape)
 import           Language.LSP.Protocol.Types (Position (..), Range (Range),
                                               UInt, isSubrangeOf)
 import           Test.Tasty
@@ -19,6 +20,7 @@ import           Test.Tasty.QuickCheck
 tests :: TestTree
 tests = testGroup "PluginUtils"
     [ unescapeTest
+    , extractTextInRangeTest
     , localOption (QuickCheckMaxSize 10000) $
         testProperty "RangeMap-List filtering identical" $
           prop_rangemapListEq @Int
@@ -42,6 +44,57 @@ unescapeTest = testGroup "unescape"
         unescape "\"\\n\\t\"" @?= "\"\\n\\t\""
     ]
 
+extractTextInRangeTest :: TestTree
+extractTextInRangeTest = testGroup "extractTextInRange"
+    [ testCase "inline range" $
+        extractTextInRange
+            ( Range (Position 0 3) (Position 3 5) )
+            src
+        @?= T.intercalate "\n"
+                [ "ule Main where"
+                , ""
+                , "main :: IO ()"
+                , "main "
+                ]
+    , testCase "inline range with empty content" $
+        extractTextInRange
+            ( Range (Position 0 0) (Position 0 1) )
+            emptySrc
+        @?= ""
+    , testCase "multiline range with empty content" $
+        extractTextInRange
+            ( Range (Position 0 0) (Position 1 0) )
+            emptySrc
+        @?= "\n"
+    , testCase "multiline range" $
+        extractTextInRange
+            ( Range (Position 1 0) (Position 4 0) )
+            src
+        @?= T.unlines
+                [ ""
+                , "main :: IO ()"
+                , "main = do"
+                ]
+    , testCase "multiline range with end pos at the line below the last line" $
+        extractTextInRange
+            ( Range (Position 2 0) (Position 5 0) )
+            src
+        @?= T.unlines
+                [ "main :: IO ()"
+                , "main = do"
+                , "    putStrLn \"hello, world\""
+                ]
+    ]
+    where
+        src = T.unlines
+                [ "module Main where"
+                , ""
+                , "main :: IO ()"
+                , "main = do"
+                , "    putStrLn \"hello, world\""
+                ]
+        emptySrc = "\n"
+
 genRange :: Gen Range
 genRange = oneof [ genRangeInline, genRangeMultiline ]