From: Luke Lau Date: Thu, 15 Oct 2020 17:54:29 +0000 (+0100) Subject: Updating again for lsp X-Git-Tag: 0.13.0.0~7^2~4 X-Git-Url: https://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=b1910277907e46b9e9f051bc97134a1c33a52f83 Updating again for lsp --- diff --git a/cabal.project b/cabal.project index abe0905..5b9e063 100644 --- 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 4021547..3eda63e 100644 --- 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 95937c5..1f5581d 100644 --- 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 6a6cf15..6c5f1d0 100644 --- 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 60d3a38..9527af4 100644 --- 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