diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 5194a89a77..1bcb9d593b 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/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,7 +415,7 @@ 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) @@ -422,6 +423,39 @@ runEvalCmd lsp st EvalParams{..} = 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 diff --git a/plugins/hls-eval-plugin/test/Eval.hs b/plugins/hls-eval-plugin/test/Eval.hs index adee21c48f..f9218e70f0 100644 --- a/plugins/hls-eval-plugin/test/Eval.hs +++ b/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 diff --git a/plugins/hls-eval-plugin/test/testdata/TLastLine.hs.expected b/plugins/hls-eval-plugin/test/testdata/TLastLine.hs.expected new file mode 100644 index 0000000000..c91988cc4c --- /dev/null +++ b/plugins/hls-eval-plugin/test/testdata/TLastLine.hs.expected @@ -0,0 +1,4 @@ +module TLastLine where + +-- >>> take 3 [1..] +-- [1,2,3]