From cdb1ba7038c32bac71a3bc783effc1e07049a985 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Wed, 1 Aug 2018 12:55:55 +0100 Subject: [PATCH] Rename sendRequest to request, sendRequest' to sendRequest --- example/Main.hs | 4 +- lsp-test.cabal | 4 +- src/Language/Haskell/LSP/Test.hs | 80 +++++++++---------- src/Language/Haskell/LSP/Test/Capabilities.hs | 7 +- src/Language/Haskell/LSP/Test/Exceptions.hs | 2 + src/Language/Haskell/LSP/Test/Replay.hs | 1 + src/Language/Haskell/LSP/Test/Session.hs | 1 + test/Test.hs | 6 +- 8 files changed, 54 insertions(+), 51 deletions(-) diff --git a/example/Main.hs b/example/Main.hs index 7ee3f92..1e2e3ba 100644 --- a/example/Main.hs +++ b/example/Main.hs @@ -11,8 +11,8 @@ main = runSession "hie --lsp" fullCaps "test/data/renamePass" $ do -- Send requests and notifications and receive responses let params = DocumentSymbolParams docItem - response <- sendRequest TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse - liftIO $ print response + rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse + liftIO $ print rsp -- Or use one of the helper functions getDocumentSymbols docItem >>= liftIO . print diff --git a/lsp-test.cabal b/lsp-test.cabal index df4833d..07169a5 100644 --- a/lsp-test.cabal +++ b/lsp-test.cabal @@ -18,7 +18,6 @@ extra-source-files: README.md library hs-source-dirs: src exposed-modules: Language.Haskell.LSP.Test - , Language.Haskell.LSP.Test.Capabilities , Language.Haskell.LSP.Test.Replay reexported-modules: haskell-lsp:Language.Haskell.LSP.Types , haskell-lsp:Language.Haskell.LSP.Types.Capabilities @@ -49,7 +48,8 @@ library build-depends: Win32 else build-depends: unix - other-modules: Language.Haskell.LSP.Test.Compat + other-modules: Language.Haskell.LSP.Test.Capabilities + Language.Haskell.LSP.Test.Compat Language.Haskell.LSP.Test.Decoding Language.Haskell.LSP.Test.Exceptions Language.Haskell.LSP.Test.Files diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index 568ead8..17cdd85 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -3,34 +3,35 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} --- | --- Module : Language.Haskell.LSP.Test --- Description : A functional testing framework for LSP servers. --- Maintainer : luke_lau@icloud.com --- Stability : experimental --- --- A framework for testing --- --- functionally. - +{-| +Module : Language.Haskell.LSP.Test +Description : A functional testing framework for LSP servers. +Maintainer : luke_lau@icloud.com +Stability : experimental +Portability : POSIX + +A framework for testing + +functionally. +-} module Language.Haskell.LSP.Test ( -- * Sessions - runSession - , runSessionWithHandles + Session + , runSession + -- ** Config , runSessionWithConfig - , Session , SessionConfig(..) , defaultConfig + , module Language.Haskell.LSP.Test.Capabilities + -- ** Exceptions , SessionException(..) , anySessionException , withTimeout - -- * Capabilities - , fullCaps -- * Sending + , request + , request_ , sendRequest - , sendRequest_ - , sendRequest' , sendNotification , sendRequestMessage , sendNotification' @@ -143,7 +144,7 @@ runSessionWithConfig config serverExe caps rootDir session = do runSessionWithHandles serverIn serverOut listenServer config caps rootDir $ do -- Wrap the session around initialize and shutdown calls - initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse + initRspMsg <- request Initialize initializeParams :: Session InitializeResponse liftIO $ maybe (return ()) (putStrLn . ("Error while initializing: " ++) . show ) (initRspMsg ^. LSP.error) @@ -203,25 +204,25 @@ getDocumentEdit doc = do in maybe False (HashMap.member (doc ^. uri)) mMap -- | Sends a request to the server and waits for its response. +-- Will skip any messages in between the request and the response -- @ --- rsp <- sendRequest TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse +-- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse -- @ -- Note: will skip any messages in between the request and the response. -sendRequest :: (ToJSON params, FromJSON a) => ClientMethod -> params -> Session (ResponseMessage a) -sendRequest m = sendRequest' m >=> skipManyTill anyMessage . responseForId +request :: (ToJSON params, FromJSON a) => ClientMethod -> params -> Session (ResponseMessage a) +request m = sendRequest m >=> skipManyTill anyMessage . responseForId --- | Send a request to the server and wait for its response, --- but discard it. -sendRequest_ :: ToJSON params => ClientMethod -> params -> Session () -sendRequest_ p = void . (sendRequest p :: ToJSON params => params -> Session (ResponseMessage Value)) +-- | The same as 'sendRequest', but discard the response. +request_ :: ToJSON params => ClientMethod -> params -> Session () +request_ p = void . (request p :: ToJSON params => params -> Session (ResponseMessage Value)) --- | Sends a request to the server without waiting on the response. -sendRequest' +-- | Sends a request to the server. Unlike 'request', this doesn't wait for the response. +sendRequest :: ToJSON params => ClientMethod -- ^ The request method. -> params -- ^ The request parameters. -> Session LspId -- ^ The id of the request that was sent. -sendRequest' method params = do +sendRequest method params = do id <- curReqId <$> get modify $ \c -> c { curReqId = nextId id } @@ -362,7 +363,7 @@ noDiagnostics = do -- | Returns the symbols in a document. getDocumentSymbols :: TextDocumentIdentifier -> Session [SymbolInformation] getDocumentSymbols doc = do - ResponseMessage _ rspLid mRes mErr <- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc) + ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc) maybe (return ()) (throw . UnexpectedResponseError rspLid) mErr let (Just (List symbols)) = mRes return symbols @@ -380,7 +381,7 @@ getAllCodeActions doc = do where go :: CodeActionContext -> [CommandOrCodeAction] -> Diagnostic -> Session [CommandOrCodeAction] go ctx acc diag = do - ResponseMessage _ rspLid mRes mErr <- sendRequest TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx) + ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx) case mErr of Just e -> throw (UnexpectedResponseError rspLid e) @@ -393,7 +394,7 @@ executeCommand :: Command -> Session () executeCommand cmd = do let args = decode $ encode $ fromJust $ cmd ^. arguments execParams = ExecuteCommandParams (cmd ^. command) args - sendRequest_ WorkspaceExecuteCommand execParams + request_ WorkspaceExecuteCommand execParams -- | Executes a code action. -- Matching with the specification, if a code action @@ -451,7 +452,7 @@ applyEdit doc edit = do -- | Returns the completions for the position in the document. getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem] getCompletions doc pos = do - rsp <- sendRequest TextDocumentCompletion (TextDocumentPositionParams doc pos) + rsp <- request TextDocumentCompletion (TextDocumentPositionParams doc pos) case getResponseResult rsp of Completions (List items) -> return items @@ -465,7 +466,7 @@ getReferences :: TextDocumentIdentifier -- ^ The document to lookup in. getReferences doc pos inclDecl = let ctx = ReferenceContext inclDecl params = ReferenceParams doc pos ctx - in getResponseResult <$> sendRequest TextDocumentReferences params + in getResponseResult <$> request TextDocumentReferences params -- | Returns the definition(s) for the term at the specified position. getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in. @@ -473,13 +474,13 @@ getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in. -> Session [Location] -- ^ The location(s) of the definitions getDefinitions doc pos = let params = TextDocumentPositionParams doc pos - in getResponseResult <$> sendRequest TextDocumentDefinition params + in getResponseResult <$> request TextDocumentDefinition params -- ^ Renames the term at the specified position. rename :: TextDocumentIdentifier -> Position -> String -> Session () rename doc pos newName = do let params = RenameParams doc pos (T.pack newName) - rsp <- sendRequest TextDocumentRename params :: Session RenameResponse + rsp <- request TextDocumentRename params :: Session RenameResponse let wEdit = getResponseResult rsp req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit) updateState (ReqApplyWorkspaceEdit req) @@ -488,13 +489,13 @@ rename doc pos newName = do getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover) getHover doc pos = let params = TextDocumentPositionParams doc pos - in getResponseResult <$> sendRequest TextDocumentHover params + in getResponseResult <$> request TextDocumentHover params -- | Returns the highlighted occurences of the term at the specified position getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight] getHighlights doc pos = let params = TextDocumentPositionParams doc pos - in getResponseResult <$> sendRequest TextDocumentDocumentHighlight params + in getResponseResult <$> request TextDocumentDocumentHighlight params -- | Checks the response for errors and throws an exception if needed. -- Returns the result if successful. @@ -507,14 +508,14 @@ getResponseResult rsp = fromMaybe exc (rsp ^. result) formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session () formatDoc doc opts = do let params = DocumentFormattingParams doc opts - edits <- getResponseResult <$> sendRequest TextDocumentFormatting params + edits <- getResponseResult <$> request TextDocumentFormatting params applyTextEdits doc edits -- | Applies formatting to the specified range in a document. formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session () formatRange doc opts range = do let params = DocumentRangeFormattingParams doc range opts - edits <- getResponseResult <$> sendRequest TextDocumentRangeFormatting params + edits <- getResponseResult <$> request TextDocumentRangeFormatting params applyTextEdits doc edits applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session () @@ -522,4 +523,3 @@ applyTextEdits doc edits = let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit) in updateState (ReqApplyWorkspaceEdit req) - diff --git a/src/Language/Haskell/LSP/Test/Capabilities.hs b/src/Language/Haskell/LSP/Test/Capabilities.hs index 96d5b67..2fd3a99 100644 --- a/src/Language/Haskell/LSP/Test/Capabilities.hs +++ b/src/Language/Haskell/LSP/Test/Capabilities.hs @@ -3,14 +3,13 @@ module Language.Haskell.LSP.Test.Capabilities where import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Capabilities --- | Capabilities for full conformance to the current (v3.10) LSP specification. --- The whole shebang. +-- | The whole shebang. The real deal. +-- Capabilities for full conformance to the current (v3.10) LSP specification. fullCaps :: ClientCapabilities fullCaps = capsForVersion (LSPVersion maxBound maxBound) -- | A specific version of the LSP specification. -data LSPVersion = LSPVersion Int -- ^ Major - Int -- ^ Minor +data LSPVersion = LSPVersion Int Int -- ^ Construct a major.minor version -- | Capabilities for full conformance to the LSP specification up until a version. -- Some important milestones: diff --git a/src/Language/Haskell/LSP/Test/Exceptions.hs b/src/Language/Haskell/LSP/Test/Exceptions.hs index 28903dc..5923d2d 100644 --- a/src/Language/Haskell/LSP/Test/Exceptions.hs +++ b/src/Language/Haskell/LSP/Test/Exceptions.hs @@ -9,6 +9,7 @@ import Data.Algorithm.DiffOutput import Data.List import qualified Data.ByteString.Lazy.Char8 as B +-- | An exception that can be thrown during a 'Haskell.LSP.Test.Session.Session' data SessionException = Timeout | UnexpectedMessage String FromServerMessage | ReplayOutOfOrder FromServerMessage [FromServerMessage] @@ -40,5 +41,6 @@ instance Show SessionException where show (UnexpectedResponseError lid e) = "Received an exepected error in a response for id " ++ show lid ++ ":\n" ++ show e +-- | A predicate that matches on any 'SessionException' anySessionException :: SessionException -> Bool anySessionException = const True diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs index 23e6137..73151d7 100644 --- a/src/Language/Haskell/LSP/Test/Replay.hs +++ b/src/Language/Haskell/LSP/Test/Replay.hs @@ -25,6 +25,7 @@ import Language.Haskell.LSP.Test.Files import Language.Haskell.LSP.Test.Decoding import Language.Haskell.LSP.Test.Messages import Language.Haskell.LSP.Test.Server +import Language.Haskell.LSP.Test.Session -- | Replays a captured client output and diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index 86030df..1fee2be 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -81,6 +81,7 @@ data SessionConfig = SessionConfig , logColor :: Bool -- ^ Add ANSI color to the logged messages, defaults to True. } +-- | The configuration used in 'Language.Haskell.LSP.Test.runSession'. defaultConfig :: SessionConfig defaultConfig = SessionConfig 60 False True True diff --git a/test/Test.hs b/test/Test.hs index 08c21be..1775765 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -113,7 +113,7 @@ main = hspec $ do selector _ = False sesh = do doc <- openDoc "Desktop/simple.hs" "haskell" - sendRequest' TextDocumentDocumentSymbol (DocumentSymbolParams doc) + sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc) skipMany anyNotification message :: Session RenameResponse -- the wrong type in runSession "hie --lsp" fullCaps "test/data/renamePass" sesh @@ -149,7 +149,7 @@ main = hspec $ do (Position 1 14) "Redundant bracket" reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args])) - sendRequest_ WorkspaceExecuteCommand reqParams + request_ WorkspaceExecuteCommand reqParams editReq <- message :: Session ApplyWorkspaceEditRequest liftIO $ do @@ -172,7 +172,7 @@ main = hspec $ do (Position 1 14) "Redundant bracket" reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args])) - sendRequest_ WorkspaceExecuteCommand reqParams + request_ WorkspaceExecuteCommand reqParams contents <- getDocumentEdit doc liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42\n" noDiagnostics -- 2.30.2