From: Luke Lau Date: Mon, 11 Jun 2018 19:45:14 +0000 (-0400) Subject: Add javascript langserver testing X-Git-Tag: 0.1.0.0~73 X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=edee40c4aba2607c652cace2da780c373612665f Add javascript langserver testing Also improve error reporting --- diff --git a/.travis.yml b/.travis.yml index 7c0f600..3b57dba 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -language: c +language: javascript sudo: false @@ -7,11 +7,17 @@ cache: directories: - $HOME/.stack +addons: + apt: + packages: + - npm + before_install: # Download and unpack the stack executable - mkdir -p ~/.local/bin - export PATH=$HOME/.local/bin:$PATH - travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' + - npm update install: - git clone https://github.com/haskell/haskell-ide-engine.git --recursive @@ -21,6 +27,7 @@ install: - stack --no-terminal --skip-ghc-check install -j2 - stack exec hoogle generate - cd .. + - npm i -g javascript-typescript-langserver script: - stack --no-terminal --skip-ghc-check test diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index 086a34c..17a39c5 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -120,8 +120,8 @@ runSessionWithHandler :: (Handle -> Session ()) runSessionWithHandler serverHandler serverExe rootDir session = do absRootDir <- canonicalizePath rootDir - let createProc = (shell serverExe) { std_in = CreatePipe, std_out = CreatePipe } - (Just serverIn, Just serverOut, Nothing, serverProc) <- createProcess createProc + let createProc = (shell serverExe) { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe } + (Just serverIn, Just serverOut, _, serverProc) <- createProcess createProc hSetBuffering serverIn NoBuffering hSetBuffering serverOut NoBuffering diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs index f8d6306..5d0a64b 100644 --- a/src/Language/Haskell/LSP/Test/Decoding.hs +++ b/src/Language/Haskell/LSP/Test/Decoding.hs @@ -84,30 +84,33 @@ getRequestMap = foldl helper HM.empty insert m = HM.insert (m ^. id) (m ^. method) matchResponseMsgType :: ClientMethod -> B.ByteString -> FromServerMessage -matchResponseMsgType req bytes = case req of - Initialize -> RspInitialize $ fromJust $ decode bytes - Shutdown -> RspShutdown $ fromJust $ decode bytes - TextDocumentHover -> RspHover $ fromJust $ decode bytes - TextDocumentCompletion -> RspCompletion $ fromJust $ decode bytes - CompletionItemResolve -> RspCompletionItemResolve $ fromJust $ decode bytes - TextDocumentSignatureHelp -> RspSignatureHelp $ fromJust $ decode bytes - TextDocumentDefinition -> RspDefinition $ fromJust $ decode bytes - TextDocumentReferences -> RspFindReferences $ fromJust $ decode bytes - TextDocumentDocumentHighlight -> RspDocumentHighlights $ fromJust $ decode bytes - TextDocumentDocumentSymbol -> RspDocumentSymbols $ fromJust $ decode bytes - WorkspaceSymbol -> RspWorkspaceSymbols $ fromJust $ decode bytes - TextDocumentCodeAction -> RspCodeAction $ fromJust $ decode bytes - TextDocumentCodeLens -> RspCodeLens $ fromJust $ decode bytes - CodeLensResolve -> RspCodeLensResolve $ fromJust $ decode bytes - TextDocumentFormatting -> RspDocumentFormatting $ fromJust $ decode bytes - TextDocumentRangeFormatting -> RspDocumentRangeFormatting $ fromJust $ decode bytes - TextDocumentOnTypeFormatting -> RspDocumentOnTypeFormatting $ fromJust $ decode bytes - TextDocumentRename -> RspRename $ fromJust $ decode bytes - WorkspaceExecuteCommand -> RspExecuteCommand $ fromJust $ decode bytes - TextDocumentDocumentLink -> RspDocumentLink $ fromJust $ decode bytes - DocumentLinkResolve -> RspDocumentLinkResolve $ fromJust $ decode bytes - TextDocumentWillSaveWaitUntil -> RspWillSaveWaitUntil $ fromJust $ decode bytes - x -> error $ "Not a request: " ++ show x +matchResponseMsgType req = case req of + Initialize -> RspInitialize . decoded + Shutdown -> RspShutdown . decoded + TextDocumentHover -> RspHover . decoded + TextDocumentCompletion -> RspCompletion . decoded + CompletionItemResolve -> RspCompletionItemResolve . decoded + TextDocumentSignatureHelp -> RspSignatureHelp . decoded + TextDocumentDefinition -> RspDefinition . decoded + TextDocumentReferences -> RspFindReferences . decoded + TextDocumentDocumentHighlight -> RspDocumentHighlights . decoded + TextDocumentDocumentSymbol -> RspDocumentSymbols . decoded + WorkspaceSymbol -> RspWorkspaceSymbols . decoded + TextDocumentCodeAction -> RspCodeAction . decoded + TextDocumentCodeLens -> RspCodeLens . decoded + CodeLensResolve -> RspCodeLensResolve . decoded + TextDocumentFormatting -> RspDocumentFormatting . decoded + TextDocumentRangeFormatting -> RspDocumentRangeFormatting . decoded + TextDocumentOnTypeFormatting -> RspDocumentOnTypeFormatting . decoded + TextDocumentRename -> RspRename . decoded + WorkspaceExecuteCommand -> RspExecuteCommand . decoded + TextDocumentDocumentLink -> RspDocumentLink . decoded + DocumentLinkResolve -> RspDocumentLinkResolve . decoded + TextDocumentWillSaveWaitUntil -> RspWillSaveWaitUntil . decoded + x -> error . ((show x ++ " is not a request: ") ++) . show + where decoded x = fromMaybe (error $ "Couldn't decode response for the request type: " + ++ show req ++ "\n" ++ show x) + (decode x) decodeFromServerMsg :: RequestMap -> B.ByteString -> FromServerMessage decodeFromServerMsg reqMap bytes = diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs index 49c24c9..3496322 100644 --- a/src/Language/Haskell/LSP/Test/Parsing.hs +++ b/src/Language/Haskell/LSP/Test/Parsing.hs @@ -8,7 +8,6 @@ import Control.Applicative import Control.Concurrent.Chan import Control.Concurrent.MVar import Control.Monad.Trans.Class -import Control.Monad.IO.Class import Control.Monad.Trans.Reader import Control.Monad.Trans.State import Data.Aeson @@ -17,7 +16,7 @@ import Data.Conduit hiding (await) import Data.Conduit.Parser import Data.Maybe import Language.Haskell.LSP.Messages -import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types hiding (error) import Language.Haskell.LSP.Test.Compat import Language.Haskell.LSP.Test.Decoding import Language.Haskell.LSP.Test.Messages @@ -59,7 +58,7 @@ notification :: forall m a. (Monad m, FromJSON a) => ConduitParser FromServerMes notification = do let parser = decode . encodeMsg :: FromServerMessage -> Maybe (NotificationMessage ServerMethod a) x <- satisfy (isJust . parser) - return $ fromJust $ decode $ encodeMsg x + return $ decodeMsg $ encodeMsg x -- | Matches if the message is a request. anyRequest :: Monad m => ConduitParser FromServerMessage m FromServerMessage @@ -69,7 +68,7 @@ request :: forall m a b. (Monad m, FromJSON a, FromJSON b) => ConduitParser From request = do let parser = decode . encodeMsg :: FromServerMessage -> Maybe (RequestMessage ServerMethod a b) x <- satisfy (isJust . parser) - return $ fromJust $ decode $ encodeMsg x + return $ decodeMsg $ encodeMsg x -- | Matches if the message is a response. anyResponse :: Monad m => ConduitParser FromServerMessage m FromServerMessage @@ -79,13 +78,17 @@ response :: forall m a. (Monad m, FromJSON a) => ConduitParser FromServerMessage response = do let parser = decode . encodeMsg :: FromServerMessage -> Maybe (ResponseMessage a) x <- satisfy (isJust . parser) - return $ fromJust $ decode $ encodeMsg x + return $ decodeMsg $ encodeMsg x -- | A version of encode that encodes FromServerMessages as if they -- weren't wrapped. encodeMsg :: FromServerMessage -> B.ByteString encodeMsg = encode . genericToJSON (defaultOptions { sumEncoding = UntaggedValue }) +decodeMsg :: FromJSON a => B.ByteString -> a +decodeMsg x = fromMaybe (error $ "Unexpected message type\nGot:\n " ++ show x) + (decode x) + -- | Matches if the message is a log message notification or a show message notification/request. loggingNotification :: Monad m => ConduitParser FromServerMessage m FromServerMessage loggingNotification = satisfy shouldSkip diff --git a/stack.yaml b/stack.yaml index 8de2811..76fa9bc 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,7 +6,7 @@ extra-deps: - github: Bubba/haskell-lsp-client commit: b7cf14eb48837a73032e867dab90db1708220c66 - github: Bubba/haskell-lsp - commit: 6849d2b8281c3a6e6f28af4364b4a976b1eb8ba5 + commit: 554b1535ae120f8541f860db5f131372da102bef subdirs: - . - ./haskell-lsp-types diff --git a/test/Test.hs b/test/Test.hs index a639e38..16c8d01 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -12,18 +12,14 @@ import ParsingTests main = hspec $ do describe "manual session" $ do it "passes a test" $ - runSession "hie --lsp" "test/recordings/renamePass" $ do + runSession "hie --lsp" "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" skipMany loggingNotification - diagsNot <- notification :: Session PublishDiagnosticsNotification - - liftIO $ diagsNot ^. params . diagnostics `shouldBe` List [] - - sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc) + checkNoDiagnostics - rspSymbols <- response :: Session DocumentSymbolsResponse + rspSymbols <- documentSymbols doc liftIO $ do let (List symbols) = fromJust (rspSymbols ^. result) @@ -35,7 +31,7 @@ main = hspec $ do it "fails a test" $ -- TODO: Catch the exception in haskell-lsp-test and provide nicer output - let session = runSession "hie --lsp" "test/recordings/renamePass" $ do + let session = runSession "hie --lsp" "test/data/renamePass" $ do openDoc "Desktop/simple.hs" "haskell" skipMany loggingNotification anyRequest @@ -43,8 +39,33 @@ main = hspec $ do describe "replay session" $ do it "passes a test" $ - replaySession "hie --lsp" "test/recordings/renamePass" `shouldReturn` True + replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True it "fails a test" $ - replaySession "hie --lsp" "test/recordings/renameFail" `shouldReturn` False + replaySession "hie --lsp" "test/data/renameFail" `shouldReturn` False + + describe "manual javascript session" $ + it "passes a test" $ + runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do + doc <- openDoc "test.js" "javascript" + + checkNoDiagnostics + + rspSymbols <- documentSymbols doc + + let (List symbols) = fromJust (rspSymbols ^. result) + fooSymbol = head symbols + liftIO $ do + fooSymbol ^. name `shouldBe` "foo" + fooSymbol ^. kind `shouldBe` SkFunction parsingSpec + +checkNoDiagnostics :: Session () +checkNoDiagnostics = do + diagsNot <- notification :: Session PublishDiagnosticsNotification + liftIO $ diagsNot ^. params . diagnostics `shouldBe` List [] + +documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse +documentSymbols doc = do + sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc) + response \ No newline at end of file diff --git a/test/recordings/documentSymbolFail/client.log b/test/data/documentSymbolFail/client.log similarity index 100% rename from test/recordings/documentSymbolFail/client.log rename to test/data/documentSymbolFail/client.log diff --git a/test/recordings/documentSymbolFail/example/Main.hs b/test/data/documentSymbolFail/example/Main.hs similarity index 100% rename from test/recordings/documentSymbolFail/example/Main.hs rename to test/data/documentSymbolFail/example/Main.hs diff --git a/test/recordings/documentSymbolFail/server.log b/test/data/documentSymbolFail/server.log similarity index 100% rename from test/recordings/documentSymbolFail/server.log rename to test/data/documentSymbolFail/server.log diff --git a/test/data/javascriptPass/test.js b/test/data/javascriptPass/test.js new file mode 100644 index 0000000..63fcfaf --- /dev/null +++ b/test/data/javascriptPass/test.js @@ -0,0 +1,5 @@ +var x = 1234 + +function foo() { + console.log("hello world") +} diff --git a/test/recordings/renameFail/Desktop/simple.hs b/test/data/renameFail/Desktop/simple.hs similarity index 100% rename from test/recordings/renameFail/Desktop/simple.hs rename to test/data/renameFail/Desktop/simple.hs diff --git a/test/recordings/renameFail/session.log b/test/data/renameFail/session.log similarity index 100% rename from test/recordings/renameFail/session.log rename to test/data/renameFail/session.log diff --git a/test/recordings/renamePass/Desktop/simple.hs b/test/data/renamePass/Desktop/simple.hs similarity index 100% rename from test/recordings/renamePass/Desktop/simple.hs rename to test/data/renamePass/Desktop/simple.hs diff --git a/test/recordings/renamePass/session.log b/test/data/renamePass/session.log similarity index 100% rename from test/recordings/renamePass/session.log rename to test/data/renamePass/session.log