X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=test%2FTest.hs;h=16c8d01cdb57be9f4710a98df48ad00c121c6fa3;hb=edee40c4aba2607c652cace2da780c373612665f;hp=2bd8f4e83b8bf75cef7d32a6f0bc808ae7e6379e;hpb=13928a9c66b4a352ae784660877d4fae57ac81d9;p=lsp-test.git diff --git a/test/Test.hs b/test/Test.hs index 2bd8f4e..16c8d01 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -1,39 +1,71 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} import Test.Hspec -import Data.Proxy +import Data.Maybe import Control.Monad.IO.Class import Control.Lens hiding (List) import Language.Haskell.LSP.Test -import Language.Haskell.LSP.Test.Recorded -import Language.Haskell.LSP.TH.DataTypesJSON +import Language.Haskell.LSP.Test.Replay +import Language.Haskell.LSP.Types +import ParsingTests main = hspec $ do - describe "manual session validation" $ + describe "manual session" $ do it "passes a test" $ - runSession "test/recordings/renamePass" $ do - docItem <- getDocItem "Desktop/simple.hs" "haskell" - docId <- TextDocumentIdentifier <$> getDocUri "Desktop/simple.hs" + runSession "hie --lsp" "test/data/renamePass" $ do + doc <- openDoc "Desktop/simple.hs" "haskell" - sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams docItem) + skipMany loggingNotification - (NotificationMessage _ TextDocumentPublishDiagnostics (PublishDiagnosticsParams _ (List diags))) <- - getMessage :: Session PublishDiagnosticsNotification + checkNoDiagnostics - liftIO $ diags `shouldBe` [] + rspSymbols <- documentSymbols doc - sendRequest (Proxy :: Proxy DocumentSymbolRequest) - TextDocumentDocumentSymbol - (DocumentSymbolParams docId) - - (ResponseMessage _ _ (Just (List symbols)) Nothing) <- getMessage :: Session DocumentSymbolsResponse liftIO $ do - let mainSymbol = head symbols + let (List symbols) = fromJust (rspSymbols ^. result) + mainSymbol = head symbols mainSymbol ^. name `shouldBe` "main" mainSymbol ^. kind `shouldBe` SkFunction mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4) mainSymbol ^. containerName `shouldBe` Nothing - describe "replay session" $ + it "fails a test" $ + -- TODO: Catch the exception in haskell-lsp-test and provide nicer output + let session = runSession "hie --lsp" "test/data/renamePass" $ do + openDoc "Desktop/simple.hs" "haskell" + skipMany loggingNotification + anyRequest + in session `shouldThrow` anyException + + describe "replay session" $ do + it "passes a test" $ + replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True + it "fails a test" $ + replaySession "hie --lsp" "test/data/renameFail" `shouldReturn` False + + describe "manual javascript session" $ it "passes a test" $ - replaySession "test/recordings/renamePass" `shouldReturn` True \ No newline at end of file + 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