Add javascript langserver testing

Also improve error reporting

diff --git a/.travis.yml b/.travis.yml
index 7c0f6003af084ce441e6c0495aaa546927d121da..3b57dbab2c33ca137a76a65911c0d708c3009134 100644 (file)
--- 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 086a34c9257465d8ef284f66e5138486dbc91832..17a39c5a9702a9e2146514c65165220270ff516f 100644 (file)
--- 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 f8d63060cd269e71ab4757eb7695cf1b36b43a33..5d0a64b6429aed3a20cba013a9ccf8fa1cfb70a4 100644 (file)
--- 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 49c24c9ae52715862a05baf0cfbe294ef04a6a82..3496322ca6ff0f8d95bd799fb23ffc219484c04e 100644 (file)
--- 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 8de2811463b7a32bb62e7581ebd6b4c2bddf8d1e..76fa9bc997b85c0a17983d6800d98d791efaddda 100644 (file)
--- 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 a639e38dbb1dd222bc5b202a513623d0a3b53f97..16c8d01cdb57be9f4710a98df48ad00c121c6fa3 100644 (file)
--- 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 (file)
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