From: Luke Lau Date: Sat, 9 Jun 2018 03:13:04 +0000 (-0400) Subject: Fix embarassing error with publishDiagnosticsNotification X-Git-Tag: 0.1.0.0~78 X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=88c70a40654c7152fb50b2a4e171fbdc00324f51 Fix embarassing error with publishDiagnosticsNotification Generalize message combinators --- diff --git a/haskell-lsp-test.cabal b/haskell-lsp-test.cabal index 22b43aa..cc2eb6f 100644 --- a/haskell-lsp-test.cabal +++ b/haskell-lsp-test.cabal @@ -23,14 +23,14 @@ library , haskell-lsp , aeson , bytestring - , conduit-parse , conduit + , conduit-parse , containers , data-default , directory , filepath , lens - , parsers + , parser-combinators , process , text , transformers @@ -57,6 +57,9 @@ test-suite tests , directory , haskell-lsp-test , haskell-lsp + , conduit + , conduit-parse + other-modules: ParsingTests default-language: Haskell2010 executable example diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index c16ae84..2e0926a 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -33,31 +33,21 @@ module Language.Haskell.LSP.Test , choice , option , optional - , skipOptional , between , some , many , sepBy , sepBy1 - , sepByNonEmpty , sepEndBy1 - , sepEndByNonEmpty , sepEndBy , endBy1 - , endByNonEmpty , endBy , count - , chainl - , chainr - , chainl1 - , chainr1 , manyTill - , try - , () , skipMany , skipSome - , unexpected - , notFollowedBy + , skipManyTill + , skipSomeTill , (<|>) , satisfy -- * Utilities @@ -67,6 +57,7 @@ module Language.Haskell.LSP.Test ) where import Control.Applicative +import Control.Applicative.Combinators import Control.Monad import Control.Monad.IO.Class import Control.Concurrent @@ -87,7 +78,6 @@ import System.Directory import System.FilePath import Language.Haskell.LSP.Test.Decoding import Language.Haskell.LSP.Test.Parsing -import Text.Parser.Combinators -- | Starts a new session. runSession :: FilePath -- ^ The filepath to the root directory for the session. diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs index 81e5cbe..fdd01c2 100644 --- a/src/Language/Haskell/LSP/Test/Parsing.hs +++ b/src/Language/Haskell/LSP/Test/Parsing.hs @@ -31,6 +31,7 @@ newtype SessionState = SessionState } type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m)) + -- | A session representing one instance of launching and connecting to a server. -- -- You can send and receive messages to the server within 'Session' via 'getMessage', @@ -45,19 +46,19 @@ type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m)) type Session = ParserStateReader FromServerMessage SessionState SessionContext IO -- | Matches if the message is a notification. -notification :: Session FromServerMessage +notification :: Monad m => ConduitParser FromServerMessage m FromServerMessage notification = satisfy isServerNotification -- | Matches if the message is a request. -request :: Session FromServerMessage +request :: Monad m => ConduitParser FromServerMessage m FromServerMessage request = satisfy isServerRequest -- | Matches if the message is a response. -response :: Session FromServerMessage +response :: Monad m => ConduitParser FromServerMessage m FromServerMessage response = satisfy isServerResponse -- | Matches if the message is a log message notification or a show message notification/request. -loggingNotification :: Session FromServerMessage +loggingNotification :: Monad m => ConduitParser FromServerMessage m FromServerMessage loggingNotification = satisfy shouldSkip where shouldSkip (NotLogMessage _) = True @@ -65,11 +66,11 @@ loggingNotification = satisfy shouldSkip shouldSkip (ReqShowMessage _) = True shouldSkip _ = False -publishDiagnosticsNotification :: Session PublishDiagnosticsNotification +publishDiagnosticsNotification :: Monad m => ConduitParser FromServerMessage m PublishDiagnosticsNotification publishDiagnosticsNotification = do - (NotPublishDiagnostics diags) <- satisfy test + NotPublishDiagnostics diags <- satisfy test return diags - where test (NotPublishDiagnostics _) = False + where test (NotPublishDiagnostics _) = True test _ = False satisfy :: Monad m => (a -> Bool) -> ConduitParser a m a diff --git a/test/ParsingTests.hs b/test/ParsingTests.hs new file mode 100644 index 0000000..7824ef3 --- /dev/null +++ b/test/ParsingTests.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} +module ParsingTests where + +import Control.Lens hiding (List) +import Language.Haskell.LSP.Messages +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types +import Data.Conduit +import Data.Conduit.Parser +import Test.Hspec + +parsingSpec :: Spec +parsingSpec = + describe "diagnostics" $ do + let testDiag = NotPublishDiagnostics + (NotificationMessage "2.0" + TextDocumentPublishDiagnostics + (PublishDiagnosticsParams (Uri "foo") + (List []))) + it "get picked up" $ do + let + source = yield testDiag + session = do + diags <- publishDiagnosticsNotification + return $ diags ^. params . uri + runConduit (source .| runConduitParser session) `shouldReturn` Uri "foo" + it "get picked up after skipping others before" $ do + let testDiag = NotPublishDiagnostics + (NotificationMessage "2.0" + TextDocumentPublishDiagnostics + (PublishDiagnosticsParams (Uri "foo") + (List []))) + notTestDiag = NotLogMessage (NotificationMessage "2.0" WindowLogMessage (LogMessageParams MtLog "foo")) + source = yield notTestDiag >> yield testDiag + session = do + diags <- skipManyTill notification publishDiagnosticsNotification + return $ diags ^. params . uri + runConduit (source .| runConduitParser session) `shouldReturn` Uri "foo" \ No newline at end of file diff --git a/test/Test.hs b/test/Test.hs index 1fd58da..652485e 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -9,9 +9,10 @@ import Language.Haskell.LSP.Test import Language.Haskell.LSP.Test.Replay import Language.Haskell.LSP.Types import Language.Haskell.LSP.Messages +import ParsingTests main = hspec $ do - describe "manual session validation" $ + describe "manual session validation" $ do it "passes a test" $ runSession "test/recordings/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" @@ -36,8 +37,18 @@ main = hspec $ do mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4) mainSymbol ^. containerName `shouldBe` Nothing + it "fails a test" $ + -- TODO: Catch the exception in haskell-lsp-test and provide nicer output + let session = runSession "test/recordings/renamePass" $ do + openDoc "Desktop/simple.hs" "haskell" + skipMany loggingNotification + request + in session `shouldThrow` anyException + describe "replay session" $ do it "passes a test" $ replaySession "test/recordings/renamePass" `shouldReturn` True it "fails a test" $ replaySession "test/recordings/renameFail" `shouldReturn` False + + parsingSpec \ No newline at end of file