Test and fix for issue 1213

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

@@ -208,6 +208,7 @@ import Language.Haskell.LSP.Types (
         _textDocument
     ),
     Command (_arguments, _title),
+    Position (..),
     ServerMethod (
         WorkspaceApplyEdit
     ),
@@ -414,14 +415,47 @@ runEvalCmd lsp st EvalParams{..} =
                                 (st, fp)
                                 tests
 
-            let workspaceEditsMap = Map.fromList [(_uri, List edits)]
+            let workspaceEditsMap = Map.fromList [(_uri, List $ addFinalReturn mdlText edits)]
             let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing
 
             return (WorkspaceApplyEdit, ApplyWorkspaceEditParams workspaceEdits)
      in perf "evalCmd" $
             withIndefiniteProgress lsp "Evaluating" Cancellable $
                 response' cmd
 
+{-
+>>> import Language.Haskell.LSP.Types(applyTextEdit)
+>>> aTest s = let Right [sec] = allSections (tokensFrom s) in head. sectionTests $ sec
+>>> mdl = "module Test where\n-- >>> 2+2"
+
+To avoid https://github.com/haskell/haskell-language-server/issues/1213, `addFinalReturn` adds, if necessary, a final empty line to the document before inserting the tests' results.
+
+>>> let [e1,e2] = addFinalReturn mdl [asEdit (aTest mdl) ["4"]] in applyTextEdit e2 (applyTextEdit e1 mdl)
+"module Test where\n-- >>> 2+2\n4\n"
+
+>>> applyTextEdit (head $ addFinalReturn mdl [asEdit (aTest mdl) ["4"]]) mdl
+"module Test where\n-- >>> 2+2\n"
+
+>>> addFinalReturn mdl [asEdit (aTest mdl) ["4"]]
+[TextEdit {_range = Range {_start = Position {_line = 1, _character = 10}, _end = Position {_line = 1, _character = 10}}, _newText = "\n"},TextEdit {_range = Range {_start = Position {_line = 2, _character = 0}, _end = Position {_line = 2, _character = 0}}, _newText = "4\n"}]
+
+>>> asEdit (aTest mdl) ["4"]
+TextEdit {_range = Range {_start = Position {_line = 2, _character = 0}, _end = Position {_line = 2, _character = 0}}, _newText = "4\n"}
+-}
+addFinalReturn :: Text -> [TextEdit] -> [TextEdit]
+addFinalReturn mdlText edits
+    | not (null edits) && not (T.null mdlText) && T.last mdlText /= '\n' =
+        finalReturn mdlText : edits
+    | otherwise = edits
+
+finalReturn :: Text -> TextEdit
+finalReturn txt =
+    let ls = T.lines txt
+        l = length ls -1
+        c = T.length . last $ ls
+        p = Position l c
+     in TextEdit (Range p p) "\n"
+
 moduleText :: (IsString e, MonadIO m) => LspFuncs c -> Uri -> ExceptT e m Text
 moduleText lsp uri =
     handleMaybeM "mdlText" $
@@ -455,7 +489,7 @@ runTests e@(_st, _) tests = do
 
         let checkedResult = testCheck (section, unLoc test) rs
 
-        let edit = TextEdit (resultRange test) (T.unlines . map pad $ checkedResult)
+        let edit = asEdit test (map pad checkedResult)
         dbg "TEST EDIT" edit
         return edit
 
@@ -467,6 +501,9 @@ runTests e@(_st, _) tests = do
                     "Add QuickCheck to your cabal dependencies to run this test."
     runTest e df test = evals e df (asStatements test)
 
+asEdit :: Loc Test -> [Text] -> TextEdit
+asEdit test resultLines = TextEdit (resultRange test) (T.unlines resultLines)
+
 {-
 The result of evaluating a test line can be:
 * a value

plugins/hls-eval-plugin/test/Eval.hs

@@ -147,6 +147,13 @@ tests =
         , testCase
             "Prelude has no special treatment, it is imported as stated in the module"
             $ goldenTest "TPrelude.hs"
+        , testCase "Test on last line insert results correctly" $ do
+            runSession hlsCommand fullCaps evalPath $
+                liftIO $ do
+                    let mdl = "TLastLine.hs"
+                    -- Write the test file, to make sure that it has no final line return
+                    writeFile (evalPath </> mdl) $ "module TLastLine where\n\n-- >>> take 3 [1..]"
+                    goldenTest mdl
 #if __GLASGOW_HASKELL__ >= 808
             , testCase "CPP support" $ goldenTest "TCPP.hs"
             , testCase "Literate Haskell Bird Style" $ goldenTest "TLHS.lhs"
@@ -161,11 +168,11 @@ goldenTest = goldenTestBy isEvalTest
  Compare results with the contents of corresponding '.expected' file (and creates it, if missing)
 -}
 goldenTestBy :: (CodeLens -> Bool) -> FilePath -> IO ()
-goldenTestBy f input = runSession hlsCommand fullCaps evalPath $ do
+goldenTestBy fltr input = runSession hlsCommand fullCaps evalPath $ do
     doc <- openDoc input "haskell"
 
     -- Execute lenses backwards, to avoid affecting their position in the source file
-    codeLenses <- reverse <$> getCodeLensesBy f doc
+    codeLenses <- reverse <$> getCodeLensesBy fltr doc
     -- liftIO $ print codeLenses
 
     -- Execute sequentially
@@ -180,9 +187,8 @@ goldenTestBy f input = runSession hlsCommand fullCaps evalPath $ do
         -- Write expected file if missing
         missingExpected <- not <$> doesFileExist expectedFile
         when missingExpected $ T.writeFile expectedFile edited
-
-    expected <- liftIO $ T.readFile expectedFile
-    liftIO $ edited @?= expected
+        expected <- T.readFile expectedFile
+        edited @?= expected
 
 getEvalCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
 getEvalCodeLenses = getCodeLensesBy isEvalTest

plugins/hls-eval-plugin/test/testdata/TLastLine.hs.expected

@@ -0,0 +1,4 @@
+module TLastLine where
+
+-- >>> take 3 [1..]
+-- [1,2,3]