Rename sendRequest to request, sendRequest' to sendRequest

diff --git a/example/Main.hs b/example/Main.hs
index 7ee3f92cd414db960a5b14d98d3804d1745c6995..1e2e3baf3356b36f6eb09967a02ce2e7fbd12c0a 100644 (file)
--- 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
 
   -- 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
 
   -- Or use one of the helper functions
   getDocumentSymbols docItem >>= liftIO . print

diff --git a/lsp-test.cabal b/lsp-test.cabal
index df4833d37ec02b56ffa87bce621b1f946d69d89c..07169a59474970de94b05ea6fabb616691e4f08d 100644 (file)
--- 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
 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
                      , 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
     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
                        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 568ead8ff592846fbc77e0e41adbaa9e08a2064b..17cdd85028d21c95e41d468a6dc2c1f3997d8c33 100644 (file)
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -3,34 +3,35 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ExistentialQuantification #-}
 
 {-# 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
--- <https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>
--- 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
+<https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>
+functionally.
+-}

 module Language.Haskell.LSP.Test
   (
   -- * Sessions
 module Language.Haskell.LSP.Test
   (
   -- * Sessions

-    runSession
-  , runSessionWithHandles
+    Session
+  , runSession
+  -- ** Config

   , runSessionWithConfig
   , runSessionWithConfig

-  , Session

   , SessionConfig(..)
   , defaultConfig
   , SessionConfig(..)
   , defaultConfig

+  , module Language.Haskell.LSP.Test.Capabilities
+  -- ** Exceptions

   , SessionException(..)
   , anySessionException
   , withTimeout
   , SessionException(..)
   , anySessionException
   , withTimeout

-  -- * Capabilities
-  , fullCaps

   -- * Sending
   -- * Sending

+  , request
+  , request_

   , sendRequest
   , sendRequest

-  , sendRequest_
-  , sendRequest'

   , sendNotification
   , sendRequestMessage
   , sendNotification'
   , 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
     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)
 
 
       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.
         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.
 -- @
 -- 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.
   :: 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 }
 
   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
 -- | 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
   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
   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)
 
       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
 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
 
 -- | 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
 -- | 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
 
   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
 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.
 
 -- | 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
                -> 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)
 
 -- ^ 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)
   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
 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
 
 -- | 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.
 
 -- | 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
 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
   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 ()
   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)
   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 96d5b6708f66222c69f34e0b8d0ff31f468a27df..2fd3a9947017ef244dd549585403df50078717f2 100644 (file)
--- 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
 
 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.
 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:
 
 -- | 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 28903dc76d46ea1d9a4a9c2d7b5202793beeb8f7..5923d2dadb5378452876f5f053facb1d38630f21 100644 (file)
--- 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
 
 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]
 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
 
   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
 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 23e6137637d2b7ac7434a2ea1b7ee932b3c2ae58..73151d75cd8711a0107c65cadff95483014d1d5a 100644 (file)
--- 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.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 
 
 
 -- | 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 86030df68d2345c570e1f07884222816171026e9..1fee2be798f4ebdf504667556d5aa0523bd3e280 100644 (file)
--- 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.
   }
 
   , 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
 
 defaultConfig :: SessionConfig
 defaultConfig = SessionConfig 60 False True True
 

diff --git a/test/Test.hs b/test/Test.hs
index 08c21be300e45fc9b87e766750399fc8b62d5329..1775765ba641a14314bdfd66e309aab007e328b0 100644 (file)
--- 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"
               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
                 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]))
                                 (Position 1 14)
                                 "Redundant bracket"
             reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))

-        sendRequest_ WorkspaceExecuteCommand reqParams
+        request_ WorkspaceExecuteCommand reqParams

 
         editReq <- message :: Session ApplyWorkspaceEditRequest
         liftIO $ do
 
         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]))
                                 (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
         contents <- getDocumentEdit doc
         liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42\n"
         noDiagnostics