Skip to content

Commit 18227b3

Browse files
Test and fix for issue 1213 (#1223)
* test for issue 1213 * fix for issue 1213 Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
1 parent d22c4b6 commit 18227b3

File tree

3 files changed

+54
-7
lines changed

3 files changed

+54
-7
lines changed

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

+39-2
Original file line numberDiff line numberDiff line change
@@ -208,6 +208,7 @@ import Language.Haskell.LSP.Types (
208208
_textDocument
209209
),
210210
Command (_arguments, _title),
211+
Position (..),
211212
ServerMethod (
212213
WorkspaceApplyEdit
213214
),
@@ -414,14 +415,47 @@ runEvalCmd lsp st EvalParams{..} =
414415
(st, fp)
415416
tests
416417

417-
let workspaceEditsMap = Map.fromList [(_uri, List edits)]
418+
let workspaceEditsMap = Map.fromList [(_uri, List $ addFinalReturn mdlText edits)]
418419
let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing
419420

420421
return (WorkspaceApplyEdit, ApplyWorkspaceEditParams workspaceEdits)
421422
in perf "evalCmd" $
422423
withIndefiniteProgress lsp "Evaluating" Cancellable $
423424
response' cmd
424425

426+
{-
427+
>>> import Language.Haskell.LSP.Types(applyTextEdit)
428+
>>> aTest s = let Right [sec] = allSections (tokensFrom s) in head. sectionTests $ sec
429+
>>> mdl = "module Test where\n-- >>> 2+2"
430+
431+
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.
432+
433+
>>> let [e1,e2] = addFinalReturn mdl [asEdit (aTest mdl) ["4"]] in applyTextEdit e2 (applyTextEdit e1 mdl)
434+
"module Test where\n-- >>> 2+2\n4\n"
435+
436+
>>> applyTextEdit (head $ addFinalReturn mdl [asEdit (aTest mdl) ["4"]]) mdl
437+
"module Test where\n-- >>> 2+2\n"
438+
439+
>>> addFinalReturn mdl [asEdit (aTest mdl) ["4"]]
440+
[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"}]
441+
442+
>>> asEdit (aTest mdl) ["4"]
443+
TextEdit {_range = Range {_start = Position {_line = 2, _character = 0}, _end = Position {_line = 2, _character = 0}}, _newText = "4\n"}
444+
-}
445+
addFinalReturn :: Text -> [TextEdit] -> [TextEdit]
446+
addFinalReturn mdlText edits
447+
| not (null edits) && not (T.null mdlText) && T.last mdlText /= '\n' =
448+
finalReturn mdlText : edits
449+
| otherwise = edits
450+
451+
finalReturn :: Text -> TextEdit
452+
finalReturn txt =
453+
let ls = T.lines txt
454+
l = length ls -1
455+
c = T.length . last $ ls
456+
p = Position l c
457+
in TextEdit (Range p p) "\n"
458+
425459
moduleText :: (IsString e, MonadIO m) => LspFuncs c -> Uri -> ExceptT e m Text
426460
moduleText lsp uri =
427461
handleMaybeM "mdlText" $
@@ -455,7 +489,7 @@ runTests e@(_st, _) tests = do
455489

456490
let checkedResult = testCheck (section, unLoc test) rs
457491

458-
let edit = TextEdit (resultRange test) (T.unlines . map pad $ checkedResult)
492+
let edit = asEdit test (map pad checkedResult)
459493
dbg "TEST EDIT" edit
460494
return edit
461495

@@ -467,6 +501,9 @@ runTests e@(_st, _) tests = do
467501
"Add QuickCheck to your cabal dependencies to run this test."
468502
runTest e df test = evals e df (asStatements test)
469503

504+
asEdit :: Loc Test -> [Text] -> TextEdit
505+
asEdit test resultLines = TextEdit (resultRange test) (T.unlines resultLines)
506+
470507
{-
471508
The result of evaluating a test line can be:
472509
* a value

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

+11-5
Original file line numberDiff line numberDiff line change
@@ -147,6 +147,13 @@ tests =
147147
, testCase
148148
"Prelude has no special treatment, it is imported as stated in the module"
149149
$ goldenTest "TPrelude.hs"
150+
, testCase "Test on last line insert results correctly" $ do
151+
runSession hlsCommand fullCaps evalPath $
152+
liftIO $ do
153+
let mdl = "TLastLine.hs"
154+
-- Write the test file, to make sure that it has no final line return
155+
writeFile (evalPath </> mdl) $ "module TLastLine where\n\n-- >>> take 3 [1..]"
156+
goldenTest mdl
150157
#if __GLASGOW_HASKELL__ >= 808
151158
, testCase "CPP support" $ goldenTest "TCPP.hs"
152159
, testCase "Literate Haskell Bird Style" $ goldenTest "TLHS.lhs"
@@ -161,11 +168,11 @@ goldenTest = goldenTestBy isEvalTest
161168
Compare results with the contents of corresponding '.expected' file (and creates it, if missing)
162169
-}
163170
goldenTestBy :: (CodeLens -> Bool) -> FilePath -> IO ()
164-
goldenTestBy f input = runSession hlsCommand fullCaps evalPath $ do
171+
goldenTestBy fltr input = runSession hlsCommand fullCaps evalPath $ do
165172
doc <- openDoc input "haskell"
166173

167174
-- Execute lenses backwards, to avoid affecting their position in the source file
168-
codeLenses <- reverse <$> getCodeLensesBy f doc
175+
codeLenses <- reverse <$> getCodeLensesBy fltr doc
169176
-- liftIO $ print codeLenses
170177

171178
-- Execute sequentially
@@ -180,9 +187,8 @@ goldenTestBy f input = runSession hlsCommand fullCaps evalPath $ do
180187
-- Write expected file if missing
181188
missingExpected <- not <$> doesFileExist expectedFile
182189
when missingExpected $ T.writeFile expectedFile edited
183-
184-
expected <- liftIO $ T.readFile expectedFile
185-
liftIO $ edited @?= expected
190+
expected <- T.readFile expectedFile
191+
edited @?= expected
186192

187193
getEvalCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
188194
getEvalCodeLenses = getCodeLensesBy isEvalTest
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
module TLastLine where
2+
3+
-- >>> take 3 [1..]
4+
-- [1,2,3]

0 commit comments

Comments
 (0)