projects
/
lsp-test.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
aa0ac8a
)
Updating again for lsp
author
Luke Lau
<luke_lau@icloud.com>
Thu, 15 Oct 2020 17:54:29 +0000
(18:54 +0100)
committer
Luke Lau
<luke_lau@icloud.com>
Thu, 15 Oct 2020 17:54:29 +0000
(18:54 +0100)
cabal.project
patch
|
blob
|
history
src/Language/LSP/Test.hs
patch
|
blob
|
history
src/Language/LSP/Test/Parsing.hs
patch
|
blob
|
history
src/Language/LSP/Test/Session.hs
patch
|
blob
|
history
test/Test.hs
patch
|
blob
|
history
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
source-repository-package
type: git
location: https://github.com/alanz/lsp.git
- tag:
e0ed7c79f9bd019b06b5fecfc558adcc2b1318a
7
+ tag:
cedf0a49165c70ca0c4b1f92677e75d1fc129a1
7
subdir: .
lsp-types
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
-- > diags <- waitForDiagnostics
-- > let pos = Position 12 5
-- > params = TextDocumentPositionParams doc
--- > hover <- request
TextD
ocumentHover params
+-- > hover <- request
STextd
ocumentHover 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.
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.
-- | 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
-- >
--
-- > (hinRead, hinWrite) <- createPipe
-- > (houtRead, houtWrite) <- createPipe
-- >
--- > forkIO $ void $ run
WithHandles hinRead houtWrite initCallbacks handlers def
--- >
Test.
runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
+-- > forkIO $ void $ run
ServerWithHandles hinRead houtWrite serverDefinition
+-- > runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
-- > -- ...
runSessionWithHandles :: Handle -- ^ The input handle
-> Handle -- ^ The output handle
-- > -- ...
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
(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,
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
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
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
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
-- @
-- | 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)
-- @
-- 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.
-- | 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'
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
-- | 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)
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)
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)
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
-- | 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
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
shouldSkip (FromServerMess SWindowShowMessageRequest _) = True
shouldSkip _ = False
--- | Matches a 'Language.LSP.T
est.PublishDiagnosticsNotification
'
+-- | Matches a 'Language.LSP.T
ypes.TextDocumentPublishDiagnostics
'
-- (textDocument/publishDiagnostics) notification.
-- (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
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 MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DataKinds #-}
module Language.LSP.Test.Session
( Session(..)
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
-- 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
}
, 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
-- 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
-- wait just a bit longer than 5 seconds so we have time
-- to open the document
in timeout 6000000 sesh `shouldThrow` anySessionException