Functional tests setup for the LSP server (#1396)

* Functional tests setup for the LSP server

* Add nix derivation for lsp-test-0.6.1.0

* Register fixture files

* Enable functional tests on appveyor

* Attempt to fix Position errors

* Fix `dhall-lsp-server` to specify a UTF8 locale

Related to https://github.com/dhall-lang/dhall-haskell/issues/1356#issuecomment-536840612

* Specify utf8 encoding for tests

* Add test for hovering functionality

* Add glob to list fixture files

* Remove extra do
This commit is contained in:
mujx 2019-10-10 05:27:15 +03:00 committed by mergify[bot]
parent 1dba96c2c8
commit 645b71d6b3
19 changed files with 266 additions and 4 deletions

View File

@ -54,7 +54,8 @@ for:
- chcp 65001 && stack test dhall
- stack test dhall-json
- stack test dhall-bash
# - stack test dhall-lsp-server # Disabled while the tests are broken.
# - stack test dhall-lsp-server:doctest # Disabled while the tests are broken.
- stack test dhall-lsp-server:tests
- stack bench dhall --benchmark-arguments "--quick --min-duration=0 --include-first-iter"
-

View File

@ -15,6 +15,7 @@ import Data.Monoid ((<>))
import qualified Data.Version
import qualified Dhall.LSP.Server
import qualified Paths_dhall_lsp_server
import qualified GHC.IO.Encoding
-- | Top-level program options
data Options = Options {
@ -74,5 +75,9 @@ runCommand Options {..} = do
-- | Entry point for the @dhall-lsp-server@ executable
main :: IO ()
main = do options <- Options.Applicative.execParser parserInfoOptions
runCommand options
main = do
GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8
options <- Options.Applicative.execParser parserInfoOptions
runCommand options

View File

@ -13,6 +13,10 @@ build-type: Simple
extra-source-files:
README.md
ChangeLog.md
tests/fixtures/completion/*.dhall
tests/fixtures/diagnostics/*.dhall
tests/fixtures/linting/*.dhall
tests/fixtures/hovering/*.dhall
source-repository head
type: git
@ -102,3 +106,17 @@ Test-Suite doctest
-- See: https://ghc.haskell.org/trac/ghc/ticket/10970
if impl(ghc < 8.0)
Buildable: False
Test-Suite tests
Type: exitcode-stdio-1.0
Hs-Source-Dirs: tests
Main-Is: Main.hs
GHC-Options: -Wall
Build-Depends:
base ,
haskell-lsp-types >= 0.15.0 && < 0.16 ,
lsp-test >= 0.6 && < 0.7 ,
tasty >= 0.11.2 && < 1.3 ,
tasty-hspec >= 1.1 && < 1.2 ,
text >= 0.11 && < 1.3
Default-Language: Haskell2010

View File

@ -0,0 +1,173 @@
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad.IO.Class (liftIO)
import Data.Maybe (fromJust)
import qualified Data.Text as T
import qualified GHC.IO.Encoding
import Language.Haskell.LSP.Test
import Language.Haskell.LSP.Types
( CompletionItem (..),
Diagnostic (..),
DiagnosticSeverity (..),
Hover (..),
HoverContents (..),
MarkupContent (..),
Position (..),
)
import Test.Tasty
import Test.Tasty.Hspec
baseDir :: FilePath -> FilePath
baseDir d = "tests/fixtures/" <> d
hoveringSpec :: FilePath -> Spec
hoveringSpec dir =
describe "Dhall.Hover"
$ it "reports types on hover"
$ runSession "dhall-lsp-server" fullCaps dir
$ do
docId <- openDoc "Types.dhall" "dhall"
let typePos = Position 0 5
functionPos = Position 2 7
extractContents = _contents . fromJust
getValue = T.unpack . _value
typeHover <- getHover docId typePos
funcHover <- getHover docId functionPos
liftIO $ do
case (extractContents typeHover, extractContents funcHover) of
(HoverContents typeContent, HoverContents functionContent) -> do
getValue typeContent `shouldBe` "Type"
getValue functionContent `shouldBe` "{ home : Text, name : Text }"
_ -> error "test failed"
pure ()
lintingSpec :: FilePath -> Spec
lintingSpec fixtureDir =
describe "Dhall.Lint" $ do
it "reports unused bindings"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
_ <- openDoc "UnusedBindings.dhall" "dhall"
diags <- waitForDiagnosticsSource "Dhall.Lint"
_ <-
liftIO $
mapM
( \diag -> do
_severity diag `shouldBe` Just DsHint
T.unpack (_message diag) `shouldContain` "Unused let binding"
)
diags
pure ()
it "reports multiple hints"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
_ <- openDoc "SuperfluousIn.dhall" "dhall"
diags <- waitForDiagnosticsSource "Dhall.Lint"
liftIO $ length diags `shouldBe` 2
let diag1 = head diags
diag2 = diags !! 1
liftIO $ do
_severity diag1 `shouldBe` Just DsHint
T.unpack (_message diag1) `shouldContain` "Superfluous 'in'"
_severity diag2 `shouldBe` Just DsHint
T.unpack (_message diag2) `shouldContain` "Unused let binding"
codeCompletionSpec :: FilePath -> Spec
codeCompletionSpec fixtureDir =
describe "Dhall.Completion" $ do
it "suggests user defined types"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
docId <- openDoc "CustomTypes.dhall" "dhall"
cs <- getCompletions docId (Position {_line = 2, _character = 35})
liftIO $ do
let firstItem = head cs
_label firstItem `shouldBe` "Config"
_detail firstItem `shouldBe` Just "Type"
it "suggests user defined functions"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
docId <- openDoc "CustomFunctions.dhall" "dhall"
cs <- getCompletions docId (Position {_line = 6, _character = 7})
liftIO $ do
let firstItem = head cs
_label firstItem `shouldBe` "makeUser"
_detail firstItem `shouldBe` Just "\8704(user : Text) \8594 { home : Text }"
it "suggests user defined bindings"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
docId <- openDoc "Bindings.dhall" "dhall"
cs <- getCompletions docId (Position {_line = 0, _character = 59})
liftIO $ do
let firstItem = head cs
_label firstItem `shouldBe` "bob"
_detail firstItem `shouldBe` Just "Text"
it "suggests functions from imports"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
docId <- openDoc "ImportedFunctions.dhall" "dhall"
cs <- getCompletions docId (Position {_line = 0, _character = 33})
liftIO $ do
let firstItem = head cs
_label firstItem `shouldBe` "makeUser"
_detail firstItem `shouldBe` Just "\8704(user : Text) \8594 { home : Text }"
diagnosticsSpec :: FilePath -> Spec
diagnosticsSpec fixtureDir = do
describe "Dhall.TypeCheck" $ do
it "reports unbound variables"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
_ <- openDoc "UnboundVar.dhall" "dhall"
[diag] <- waitForDiagnosticsSource "Dhall.TypeCheck"
liftIO $ do
_severity diag `shouldBe` Just DsError
T.unpack (_message diag) `shouldContain` "Unbound variable"
it "reports wrong type"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
_ <- openDoc "WrongType.dhall" "dhall"
[diag] <- waitForDiagnosticsSource "Dhall.TypeCheck"
liftIO $ do
_severity diag `shouldBe` Just DsError
T.unpack (_message diag) `shouldContain` "Expression doesn't match annotation"
describe "Dhall.Import" $ do
it "reports invalid imports"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
_ <- openDoc "InvalidImport.dhall" "dhall"
[diag] <- waitForDiagnosticsSource "Dhall.Import"
liftIO $ do
_severity diag `shouldBe` Just DsError
T.unpack (_message diag) `shouldContain` "Invalid input"
it "reports missing imports"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
_ <- openDoc "MissingImport.dhall" "dhall"
[diag] <- waitForDiagnosticsSource "Dhall.Import"
liftIO $ do
_severity diag `shouldBe` Just DsError
T.unpack (_message diag) `shouldContain` "Missing file"
describe "Dhall.Parser"
$ it "reports invalid syntax"
$ runSession "dhall-lsp-server" fullCaps fixtureDir
$ do
_ <- openDoc "InvalidSyntax.dhall" "dhall"
[diag] <- waitForDiagnosticsSource "Dhall.Parser"
liftIO $ _severity diag `shouldBe` Just DsError
main :: IO ()
main = do
GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8
diagnostics <- testSpec "Diagnostics" (diagnosticsSpec (baseDir "diagnostics"))
linting <- testSpec "Linting" (lintingSpec (baseDir "linting"))
completion <- testSpec "Completion" (codeCompletionSpec (baseDir "completion"))
hovering <- testSpec "Hovering" (hoveringSpec (baseDir "hovering"))
defaultMain
( testGroup "Tests"
[ diagnostics,
linting,
completion,
hovering
]
)

View File

@ -0,0 +1 @@
let alice = "Alice" let bob = "Bob" in { result = bob ++ al }

View File

@ -0,0 +1,7 @@
let makeUser =
λ(user : Text)
→ let home = "/home/${user}"
in { home = home }
in [ m

View File

@ -0,0 +1,3 @@
let Config = { name : Text, age : Natural }
in { name = "alice", age = 20 } : C

View File

@ -0,0 +1 @@
let Lib = ./Library.dhall in Lib.

View File

@ -0,0 +1,3 @@
let makeUser = λ(user : Text) → let home = "/home/${user}" in { home = home }
in { makeUser = makeUser }

View File

@ -0,0 +1 @@
./InvalidSyntax.dhall

View File

@ -0,0 +1 @@
let a = 2 + 2/

View File

@ -0,0 +1 @@
./NonExistent.dhall

View File

@ -0,0 +1 @@
unboundVar

View File

@ -0,0 +1 @@
let a = "dhall" : List Text in a

View File

@ -0,0 +1,11 @@
let User = { name : Text, home : Text }
let mkUser =
λ(_isAdmin : Bool)
→ if _isAdmin
then { name = "admin", home = "/home/admin" }
else { name = "default", home = "/home/user" }
in mkUser True : User

View File

@ -0,0 +1,3 @@
let alice = { name = "Alice", age = 20 }
in let carl = { name = "Carl", age = 22 } in alice

View File

@ -0,0 +1,7 @@
let alice = { name = "Alice", age = 20 }
let bob = { name = "Bob", age = 21 }
let carl = { name = "Carl", age = 22 }
in alice

24
nix/lsp-test.nix Normal file
View File

@ -0,0 +1,24 @@
{ mkDerivation, aeson, aeson-pretty, ansi-terminal, async, base
, bytestring, conduit, conduit-parse, containers, data-default
, Diff, directory, filepath, haskell-lsp, hspec, lens, mtl
, parser-combinators, process, rope-utf16-splay, stdenv, text
, transformers, unix, unordered-containers
}:
mkDerivation {
pname = "lsp-test";
version = "0.6.1.0";
sha256 = "d15103bc8c84f74ff90220b66cacebe4bcd135ef1e31ddd10c808a94484db7a4";
libraryHaskellDepends = [
aeson aeson-pretty ansi-terminal async base bytestring conduit
conduit-parse containers data-default Diff directory filepath
haskell-lsp lens mtl parser-combinators process rope-utf16-splay
text transformers unix unordered-containers
];
testHaskellDepends = [
aeson base data-default haskell-lsp hspec lens text
unordered-containers
];
homepage = "https://github.com/bubba/lsp-test#readme";
description = "Functional test framework for LSP servers";
license = stdenv.lib.licenses.bsd3;
}

View File

@ -20,7 +20,7 @@ extra-deps:
- HsYAML-0.2.0.0@sha256:4e554ee481650156a26a71b40f233979cd943f22ee887b70dae3b8b24de2932f,5273
- HsYAML-aeson-0.2.0.0@sha256:04796abfc01cffded83f37a10e6edba4f0c0a15d45bef44fc5bb4313d9c87757,1791
- ordered-containers-0.2.2@sha256:ebf2be3f592d9cf148ea6b8375f8af97148d44f82d8d04476899285e965afdbf,810
- lsp-test-0.6.1.0@sha256:df0fc403c03b6d036be13de3ff23d9951ae2506080135cd6862eded2c969a6da,3483
nix:
packages:
- ncurses