Tests

Author: pepeiborra

haskell-language-server.cabal

@@ -274,6 +274,7 @@ test-suite func-test
                       , Deferred
                       , Definition
                       , Diagnostic
+                      , Eval
                       , Format
                       , FunctionalBadProject
                       , FunctionalCodeAction

test/functional/Eval.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Eval (tests) where
+
+import           Control.Applicative.Combinators (skipManyTill)
+import           Control.Monad.IO.Class          (MonadIO (liftIO))
+import qualified Data.Text.IO                    as T
+import           Language.Haskell.LSP.Test
+import           Language.Haskell.LSP.Types      (ApplyWorkspaceEditRequest,
+                                                  CodeLens (CodeLens, _command, _range),
+                                                  Command (_title),
+                                                  Position (..), Range (..))
+import           System.FilePath
+import           Test.Hls.Util
+import           Test.Tasty
+import           Test.Tasty.HUnit
+
+tests :: TestTree
+tests =
+  testGroup
+    "eval"
+    [ testCase "Produces Evaluate code lenses" $ do
+        runSession hieCommand fullCaps evalPath $ do
+          doc <- openDoc "T1.hs" "haskell"
+          lenses <- getCodeLenses doc
+          liftIO $ map (fmap _title . _command) lenses @?= [Just "Evaluate..."],
+      testCase "Produces Refresh code lenses" $ do
+        runSession hieCommand fullCaps evalPath $ do
+          doc <- openDoc "T2.hs" "haskell"
+          lenses <- getCodeLenses doc
+          liftIO $ map (fmap _title . _command) lenses @?= [Just "Refresh..."],
+      testCase "Code lenses have ranges" $ do
+        runSession hieCommand fullCaps evalPath $ do
+          doc <- openDoc "T1.hs" "haskell"
+          lenses <- getCodeLenses doc
+          liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)],
+      testCase "Multi-line expressions have a multi-line range" $ do
+        runSession hieCommand fullCaps evalPath $ do
+          doc <- openDoc "T3.hs" "haskell"
+          lenses <- getCodeLenses doc
+          liftIO $ map _range lenses @?= [Range (Position 3 0) (Position 4 15)],
+      testCase "Executed expressions range covers only the expression" $ do
+        runSession hieCommand fullCaps evalPath $ do
+          doc <- openDoc "T2.hs" "haskell"
+          lenses <- getCodeLenses doc
+          liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)],
+      testCase "Evaluation of expressions" $ goldenTest "T1.hs",
+      testCase "Reevaluation of expressions" $ goldenTest "T2.hs",
+      testCase "Evaluation of expressions w/ imports" $ goldenTest "T3.hs",
+      testCase "Evaluation of expressions w/ lets" $ goldenTest "T4.hs"
+    ]
+
+goldenTest :: FilePath -> IO ()
+goldenTest input = runSession hieCommand fullCaps evalPath $ do
+  doc <- openDoc input "haskell"
+  [CodeLens {_command = Just c}] <- getCodeLenses doc
+  executeCommand c
+  _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message
+  edited <- documentContents doc
+  expected <- liftIO $ T.readFile $ evalPath </> input <.> "expected"
+  liftIO $ edited @?= expected
+
+evalPath :: FilePath
+evalPath = "test/testdata/eval"

test/functional/Main.hs

@@ -10,6 +10,7 @@ import Completion
 import Deferred
 import Definition
 import Diagnostic
+import Eval
 import Format
 import FunctionalBadProject
 import FunctionalCodeAction
@@ -36,6 +37,7 @@ main =
         , Deferred.tests
         , Definition.tests
         , Diagnostic.tests
+        , Eval.tests
         , Format.tests
         , FunctionalBadProject.tests
         , FunctionalCodeAction.tests
@@ -47,4 +49,4 @@ main =
         , Rename.tests
         , Symbol.tests
         , TypeDefinition.tests
-        ]
+        ]

test/testdata/eval/T1.hs

@@ -0,0 +1,7 @@
+module T1 where
+
+import Data.List (unwords)
+
+-- >>> unwords example
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

test/testdata/eval/T1.hs.expected

@@ -0,0 +1,8 @@
+module T1 where
+
+import Data.List (unwords)
+
+-- >>> unwords example
+-- "This is an example of evaluation"
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

test/testdata/eval/T2.hs

@@ -0,0 +1,8 @@
+module T2 where
+
+import Data.List (unwords)
+
+-- >>> unwords example
+-- "Stale output"
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

test/testdata/eval/T2.hs.expected

@@ -0,0 +1,8 @@
+module T2 where
+
+import Data.List (unwords)
+
+-- >>> unwords example
+-- "This is an example of evaluation"
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

test/testdata/eval/T3.hs

@@ -0,0 +1,7 @@
+module T3 where
+
+
+-- >>> import Data.List (unwords)
+-- >>> unwords example
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

test/testdata/eval/T3.hs.expected

@@ -0,0 +1,8 @@
+module T3 where
+
+
+-- >>> import Data.List (unwords)
+-- >>> unwords example
+-- "This is an example of evaluation"
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

test/testdata/eval/T4.hs

@@ -0,0 +1,8 @@
+module T4 where
+
+import Data.List (unwords)
+
+-- >>> let evaluation = " evaluation"
+-- >>> unwords example ++ evaluation
+example :: [String]
+example = ["This","is","an","example","of"]