diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,12 +1,16 @@ # Revision history for lsp-test +## 0.5.2.0 -- 2019-04-28 + +* Add `satisfy` parser combinator + ## 0.5.1.0 -- 2019-04-22 * Fix unhandled `window/progress` server notifications ## 0.5.1.0 -- 2019-04-07 -* Add getTypeDefinitions (@fendor) +* Add getTypeDefinitions (@fendor) ## 0.5.0.2 -- 2018-12-05 diff --git a/lsp-test.cabal b/lsp-test.cabal --- a/lsp-test.cabal +++ b/lsp-test.cabal @@ -1,5 +1,5 @@ name: lsp-test -version: 0.5.1.4 +version: 0.5.2.0 synopsis: Functional test framework for LSP servers. description: A test framework for writing tests against diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -111,7 +111,7 @@ import qualified Yi.Rope as Rope -- | Starts a new session. --- +-- -- > runSession "hie" fullCaps "path/to/root/dir" $ do -- > doc <- openDoc "Desktop/simple.hs" "haskell" -- > diags <- waitForDiagnostics @@ -351,7 +351,7 @@ matches d = d ^. source == Just (T.pack src) -- | Expects a 'PublishDiagnosticsNotification' and throws an --- 'UnexpectedDiagnosticsException' if there are any diagnostics +-- 'UnexpectedDiagnostics' exception if there are any diagnostics -- returned. noDiagnostics :: Session () noDiagnostics = do @@ -378,8 +378,8 @@ Just (List xs) -> return xs _ -> throw (UnexpectedResponseError (rsp ^. LSP.id) (fromJust $ rsp ^. LSP.error)) --- | Returns all the code actions in a document by --- querying the code actions at each of the current +-- | Returns all the code actions in a document by +-- querying the code actions at each of the current -- diagnostics' positions. getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult] getAllCodeActions doc = do @@ -415,7 +415,7 @@ execParams = ExecuteCommandParams (cmd ^. command) args request_ WorkspaceExecuteCommand execParams --- | Executes a code action. +-- | Executes a code action. -- Matching with the specification, if a code action -- contains both an edit and a command, the edit will -- be applied first. @@ -479,7 +479,7 @@ -- | Returns the references for the position in the document. getReferences :: TextDocumentIdentifier -- ^ The document to lookup in. - -> Position -- ^ The position to lookup. + -> Position -- ^ The position to lookup. -> Bool -- ^ Whether to include declarations as references. -> Session [Location] -- ^ The locations of the references. getReferences doc pos inclDecl = diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs --- a/src/Language/Haskell/LSP/Test/Parsing.hs +++ b/src/Language/Haskell/LSP/Test/Parsing.hs @@ -5,7 +5,8 @@ module Language.Haskell.LSP.Test.Parsing ( -- $receiving - message + satisfy + , message , anyRequest , anyResponse , anyNotification @@ -34,7 +35,7 @@ -- $receiving -- To receive a message, just specify the type that expect: --- +-- -- @ -- msg1 <- message :: Session ApplyWorkspaceEditRequest -- msg2 <- message :: Session HoverResponse @@ -47,22 +48,25 @@ -- -- For example, if you wanted to match either a definition or -- references request: --- +-- -- > defOrImpl = (message :: Session DefinitionRequest) -- > <|> (message :: Session ReferencesRequest) -- -- If you wanted to match any number of telemetry -- notifications immediately followed by a response: --- +-- -- @ -- logThenDiags = -- skipManyTill (message :: Session TelemetryNotification) --- anyResponse +-- anyResponse -- @ +-- | Consumes and returns the next message, if it satisfies the specified predicate. +-- +-- @since 0.5.2.0 satisfy :: (FromServerMessage -> Bool) -> Session FromServerMessage satisfy pred = do - + skipTimeout <- overridingTimeout <$> get timeoutId <- curTimeoutId <$> get unless skipTimeout $ do @@ -85,7 +89,7 @@ return x else empty --- | Matches a message of type 'a'. +-- | Matches a message of type @a@. message :: forall a. (Typeable a, FromJSON a) => Session a message = let parser = decode . encodeMsg :: FromServerMessage -> Maybe a diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -67,10 +67,11 @@ import System.IO -- | 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', --- 'sendRequest' and 'sendNotification'. -- +-- You can send and receive messages to the server within 'Session' via +-- 'Language.Haskell.LSP.Test.message', +-- 'Language.Haskell.LSP.Test.sendRequest' and +-- 'Language.Haskell.LSP.Test.sendNotification'. type Session = ParserStateReader FromServerMessage SessionState SessionContext IO @@ -296,7 +297,7 @@ logMsg LogClient msg liftIO $ B.hPut h (addHeader $ encode msg) --- | Execute a block f that will throw a 'TimeoutException' +-- | Execute a block f that will throw a 'Timeout' exception -- after duration seconds. This will override the global timeout -- for waiting for messages to arrive defined in 'SessionConfig'. withTimeout :: Int -> Session a -> Session a diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -53,7 +53,7 @@ -- wait just a bit longer than 5 seconds so we have time -- to open the document in timeout 6000000 sesh `shouldThrow` anySessionException - + it "doesn't time out" $ let sesh = runSession "hie" fullCaps "test/data/renamePass" $ do openDoc "Desktop/simple.hs" "haskell" @@ -215,12 +215,12 @@ it "increments the version" $ runSession "hie" docChangesCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" VersionedTextDocumentIdentifier _ (Just oldVersion) <- getVersionedDoc doc - let edit = TextEdit (Range (Position 1 1) (Position 1 3)) "foo" + let edit = TextEdit (Range (Position 1 1) (Position 1 3)) "foo" VersionedTextDocumentIdentifier _ (Just newVersion) <- applyEdit doc edit liftIO $ newVersion `shouldBe` oldVersion + 1 it "changes the document contents" $ runSession "hie" fullCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" - let edit = TextEdit (Range (Position 0 0) (Position 0 2)) "foo" + let edit = TextEdit (Range (Position 0 0) (Position 0 2)) "foo" applyEdit doc edit contents <- documentContents doc liftIO $ contents `shouldSatisfy` T.isPrefixOf "foodule" @@ -318,6 +318,13 @@ -- need to evaluate to throw documentContents doc >>= liftIO . print in sesh `shouldThrow` anyException + + describe "satisfy" $ + it "works" $ runSession "hie" fullCaps "test/data" $ do + openDoc "Format.hs" "haskell" + let pred (NotLogMessage _) = True + pred _ = False + void $ satisfy pred mkRange sl sc el ec = Range (Position sl sc) (Position el ec)