Updating again for lsp

diff --git a/cabal.project b/cabal.project
index abe09051548a2752baf81e24c78fc938775004b2..5b9e063eb99b390a3da4e02f414877f3ef5e0dc4 100644 (file)
--- a/cabal.project
+++ b/cabal.project
@@ -7,6 +7,6 @@ haddock-quickjump: True
 source-repository-package
     type: git
     location: https://github.com/alanz/lsp.git
-    tag: e0ed7c79f9bd019b06b5fecfc558adcc2b1318a7
+    tag: cedf0a49165c70ca0c4b1f92677e75d1fc129a17
     subdir: .
             lsp-types

diff --git a/src/Language/LSP/Test.hs b/src/Language/LSP/Test.hs
index 40215471600e1e7e7d47887d85251f8b477ebc75..3eda63e90dd6fb39a936a431f68bac7042147da0 100644 (file)
--- a/src/Language/LSP/Test.hs
+++ b/src/Language/LSP/Test.hs
@@ -134,7 +134,7 @@ import qualified System.FilePath.Glob as Glob
 -- >   diags <- waitForDiagnostics
 -- >   let pos = Position 12 5
 -- >       params = TextDocumentPositionParams doc
--- >   hover <- request TextDocumentHover params
+-- >   hover <- request STextdocumentHover params
 runSession :: String -- ^ The command to run the server.
            -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
            -> FilePath -- ^ The filepath to the root directory for the session.
@@ -156,13 +156,13 @@ runSessionWithConfig config' serverExe caps rootDir session = do
 
 -- | Starts a new session, using the specified handles to communicate with the
 -- server. You can use this to host the server within the same process.
--- An example with haskell-lsp might look like:
+-- An example with lsp might look like:
 --
 -- > (hinRead, hinWrite) <- createPipe
 -- > (houtRead, houtWrite) <- createPipe
 -- > 
--- > forkIO $ void $ runWithHandles hinRead houtWrite initCallbacks handlers def
--- > Test.runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
+-- > forkIO $ void $ runServerWithHandles hinRead houtWrite serverDefinition
+-- > runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
 -- >   -- ...
 runSessionWithHandles :: Handle -- ^ The input handle
                       -> Handle -- ^ The output handle
@@ -199,7 +199,6 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio
                                           (List <$> initialWorkspaceFolders config)
   runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
     -- Wrap the session around initialize and shutdown calls
-    -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
     initReqId <- sendRequest SInitialize initializeParams
 
     -- Because messages can be sent in between the request and response,
@@ -284,14 +283,12 @@ getDocumentEdit doc = do
 
   documentContents doc
   where
-    checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
     checkDocumentChanges req =
       let changes = req ^. params . edit . documentChanges
           maybeDocs = fmap (fmap (^. textDocument . uri)) changes
       in case maybeDocs of
         Just docs -> (doc ^. uri) `elem` docs
         Nothing -> False
-    checkChanges :: ApplyWorkspaceEditRequest -> Bool
     checkChanges req =
       let mMap = req ^. params . edit . changes
         in maybe False (HashMap.member (doc ^. uri)) mMap
@@ -299,7 +296,7 @@ getDocumentEdit doc = do
 -- | Sends a request to the server and waits for its response.
 -- Will skip any messages in between the request and the response
 -- @
--- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
+-- rsp <- request STextDocumentDocumentSymbol params
 -- @
 -- Note: will skip any messages in between the request and the response.
 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
@@ -371,7 +368,7 @@ sendResponse = sendMessage
 -- | Returns the initialize response that was received from the server.
 -- The initialize requests and responses are not included the session,
 -- so if you need to test it use this.
-initializeResponse :: Session InitializeResponse
+initializeResponse :: Session (ResponseMessage Initialize)
 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
 
 -- | /Creates/ a new text document. This is different from 'openDoc'
@@ -493,7 +490,7 @@ noDiagnostics = do
 -- | Returns the symbols in a document.
 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
 getDocumentSymbols doc = do
-  ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) :: Session DocumentSymbolsResponse
+  ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc)
   case res of
     Right (InL (List xs)) -> return (Left xs)
     Right (InR (List xs)) -> return (Right xs)
@@ -663,7 +660,7 @@ getDeclarationyRequest method paramCons doc pos = do
 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
 rename doc pos newName = do
   let params = RenameParams doc pos Nothing (T.pack newName)
-  rsp <- request STextDocumentRename params :: Session RenameResponse
+  rsp <- request STextDocumentRename params
   let wEdit = getResponseResult rsp
       req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
   updateState (FromServerMess SWorkspaceApplyEdit req)
@@ -712,7 +709,7 @@ applyTextEdits doc edits =
 -- | Returns the code lenses for the specified document.
 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
 getCodeLenses tId = do
-    rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId) :: Session CodeLensResponse
+    rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId)
     case getResponseResult rsp of
         List res -> pure res
 

diff --git a/src/Language/LSP/Test/Parsing.hs b/src/Language/LSP/Test/Parsing.hs
index 95937c51c11fca122f8d0bafd7735a38f64169c0..1f5581dac73f89073d5562768245825fa9125a2a 100644 (file)
--- a/src/Language/LSP/Test/Parsing.hs
+++ b/src/Language/LSP/Test/Parsing.hs
@@ -198,9 +198,9 @@ loggingNotification = named "Logging notification" $ satisfy shouldSkip
     shouldSkip (FromServerMess SWindowShowMessageRequest _) = True
     shouldSkip _ = False
 
--- | Matches a 'Language.LSP.Test.PublishDiagnosticsNotification'
+-- | Matches a 'Language.LSP.Types.TextDocumentPublishDiagnostics'
 -- (textDocument/publishDiagnostics) notification.
-publishDiagnosticsNotification :: Session PublishDiagnosticsNotification
+publishDiagnosticsNotification :: Session (Message TextDocumentPublishDiagnostics)
 publishDiagnosticsNotification = named "Publish diagnostics notification" $
   satisfyMaybe $ \msg -> case msg of
     FromServerMess STextDocumentPublishDiagnostics diags -> Just diags

diff --git a/src/Language/LSP/Test/Session.hs b/src/Language/LSP/Test/Session.hs
index 6a6cf15a5a484d90a10a4da50217ab277b5d6c5f..6c5f1d0025c1fb14da95828587216013d2ca9430 100644 (file)
--- a/src/Language/LSP/Test/Session.hs
+++ b/src/Language/LSP/Test/Session.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DataKinds #-}
 
 module Language.LSP.Test.Session
   ( Session(..)
@@ -134,7 +135,7 @@ data SessionContext = SessionContext
   -- Keep curTimeoutId in SessionContext, as its tied to messageChan
   , curTimeoutId :: MVar Int -- ^ The current timeout we are waiting on
   , requestMap :: MVar RequestMap
-  , initRsp :: MVar InitializeResponse
+  , initRsp :: MVar (ResponseMessage Initialize)
   , config :: SessionConfig
   , sessionCapabilities :: ClientCapabilities
   }

diff --git a/test/Test.hs b/test/Test.hs
index 60d3a38d0c9ab9016dfa2ba90359020bffc78383..9527af42b1dd20a8636a310b7fb9fcf978ae5487 100644 (file)
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -53,7 +53,7 @@ main = findServer >>= \serverExe -> hspec $ do
                     -- won't receive a request - will timeout
                     -- incoming logging requests shouldn't increase the
                     -- timeout
-                    withTimeout 5 $ skipManyTill anyMessage (message SWorkspaceApplyEdit) :: Session ApplyWorkspaceEditRequest
+                    withTimeout 5 $ skipManyTill anyMessage (message SWorkspaceApplyEdit)
           -- wait just a bit longer than 5 seconds so we have time
           -- to open the document
           in timeout 6000000 sesh `shouldThrow` anySessionException