{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
-- ** Initialization
, initializeResponse
-- ** Documents
+ , createDoc
, openDoc
- , openDoc'
, closeDoc
, changeDoc
, documentContents
, applyEdit
-- ** Code lenses
, getCodeLenses
+ -- ** Capabilities
+ , getRegisteredCapabilities
) where
import Control.Applicative.Combinators
import Control.Monad
import Control.Monad.IO.Class
import Control.Exception
-import Control.Lens hiding ((.=), List)
+import Control.Lens hiding ((.=), List, Empty)
+import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Aeson
import Data.Default
import qualified Data.HashMap.Strict as HashMap
-import qualified Data.Map as Map
+import Data.List
import Data.Maybe
import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Lens hiding
(id, capabilities, message, executeCommand, applyEdit, rename)
import qualified Language.Haskell.LSP.Types.Lens as LSP
import qualified Language.Haskell.LSP.Types.Capabilities as C
-import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Test.Compat
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Parsing
import Language.Haskell.LSP.Test.Session
import Language.Haskell.LSP.Test.Server
+import System.Environment
import System.IO
import System.Directory
import System.FilePath
-import qualified Data.Rope.UTF16 as Rope
+import qualified System.FilePath.Glob as Glob
-- | Starts a new session.
--
-> FilePath -- ^ The filepath to the root directory for the session.
-> Session a -- ^ The session to run.
-> IO a
-runSessionWithConfig config serverExe caps rootDir session = do
+runSessionWithConfig config' serverExe caps rootDir session = do
pid <- getCurrentProcessID
absRootDir <- canonicalizePath rootDir
+ config <- envOverrideConfig config'
+
let initializeParams = InitializeParams (Just pid)
(Just $ T.pack absRootDir)
(Just $ filePathToUri absRootDir)
withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
runSessionWithHandles serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
-- Wrap the session around initialize and shutdown calls
- initRspMsg <- request Initialize initializeParams :: Session InitializeResponse
+ -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
+ initReqId <- sendRequest SInitialize initializeParams
+
+ -- Because messages can be sent in between the request and response,
+ -- collect them and then...
+ (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId initReqId)
- liftIO $ maybe (return ()) (putStrLn . ("Error while initializing: " ++) . show ) (initRspMsg ^. LSP.error)
+ case initRspMsg ^. LSP.result of
+ Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error)
+ Right _ -> pure ()
initRspVar <- initRsp <$> ask
liftIO $ putMVar initRspVar initRspMsg
- sendNotification Initialized InitializedParams
+ sendNotification SInitialized (Just InitializedParams)
case lspConfig config of
- Just cfg -> sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
+ Just cfg -> sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
Nothing -> return ()
+ -- ... relay them back to the user Session so they can match on them!
+ -- As long as they are allowed.
+ forM_ inBetween checkLegalBetweenMessage
+ msgChan <- asks messageChan
+ liftIO $ writeList2Chan msgChan (ServerMessage <$> inBetween)
+
-- Run the actual test
session
where
-- | Asks the server to shutdown and exit politely
exitServer :: Session ()
- exitServer = request_ Shutdown (Nothing :: Maybe Value) >> sendNotification Exit ExitParams
+ exitServer = request_ SShutdown (Nothing :: Maybe Value) >> sendNotification SExit (Just Empty)
-- | Listens to the server output until the shutdown ack,
-- makes sure it matches the record and signals any semaphores
writeChan (messageChan context) (ServerMessage msg)
case msg of
- (RspShutdown _) -> return ()
+ (FromServerRsp SShutdown _) -> return ()
_ -> listenServer serverOut context
+ -- | Is this message allowed to be sent by the server between the intialize
+ -- request and response?
+ -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
+ checkLegalBetweenMessage :: FromServerMessage -> Session ()
+ checkLegalBetweenMessage (FromServerMess SWindowShowMessage _) = pure ()
+ checkLegalBetweenMessage (FromServerMess SWindowLogMessage _) = pure ()
+ checkLegalBetweenMessage (FromServerMess STelemetryEvent _) = pure ()
+ checkLegalBetweenMessage (FromServerMess SWindowShowMessageRequest _) = pure ()
+ checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
+
+ -- | Check environment variables to override the config
+ envOverrideConfig :: SessionConfig -> IO SessionConfig
+ envOverrideConfig cfg = do
+ logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
+ logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
+ return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
+ where checkEnv :: String -> IO (Maybe Bool)
+ checkEnv s = fmap convertVal <$> lookupEnv s
+ convertVal "0" = False
+ convertVal _ = True
+
-- | The current text contents of a document.
documentContents :: TextDocumentIdentifier -> Session T.Text
documentContents doc = do
vfs <- vfs <$> get
let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
- return $ Rope.toText $ Language.Haskell.LSP.VFS._text file
+ return (virtualFileText file)
-- | Parses an ApplyEditRequest, checks that it is for the passed document
-- and returns the new content
getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
getDocumentEdit doc = do
- req <- message :: Session ApplyWorkspaceEditRequest
+ req <- message SWorkspaceApplyEdit
unless (checkDocumentChanges req || checkChanges req) $
liftIO $ throw (IncorrectApplyEditRequest (show req))
-- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
-- @
-- Note: will skip any messages in between the request and the response.
-request :: (ToJSON params, FromJSON a) => ClientMethod -> params -> Session (ResponseMessage a)
+request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request m = sendRequest m >=> skipManyTill anyMessage . responseForId
-- | 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))
+request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
+request_ p = void . request p
-- | 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.
+ :: SClientMethod m -- ^ The request method.
+ -> MessageParams m -- ^ The request parameters.
+ -> Session (LspId m) -- ^ The id of the request that was sent.
sendRequest method params = do
- id <- curReqId <$> get
- modify $ \c -> c { curReqId = nextId id }
+ idn <- curReqId <$> get
+ modify $ \c -> c { curReqId = idn+1 }
+ let id = IdInt idn
- let req = RequestMessage' "2.0" id method params
+ let mess = RequestMessage "2.0" id method params
-- Update the request map
reqMap <- requestMap <$> ask
liftIO $ modifyMVar_ reqMap $
- \r -> return $ updateRequestMap r id method
+ \r -> return $ fromJust $ updateRequestMap r id method
- sendMessage req
+ ~() <- case splitClientMethod method of
+ IsClientReq -> sendMessage mess
+ IsClientEither -> sendMessage $ ReqMess mess
return id
- where nextId (IdInt i) = IdInt (i + 1)
- nextId (IdString s) = IdString $ T.pack $ show $ read (T.unpack s) + 1
-
--- | A custom type for request message that doesn't
--- need a response type, allows us to infer the request
--- message type without using proxies.
-data RequestMessage' a = RequestMessage' T.Text LspId ClientMethod a
-
-instance ToJSON a => ToJSON (RequestMessage' a) where
- toJSON (RequestMessage' rpc id method params) =
- object ["jsonrpc" .= rpc, "id" .= id, "method" .= method, "params" .= params]
-
-
-- | Sends a notification to the server.
-sendNotification :: ToJSON a
- => ClientMethod -- ^ The notification method.
- -> a -- ^ The notification parameters.
+sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
+ -> MessageParams m -- ^ The notification parameters.
-> Session ()
-
-- Open a virtual file if we send a did open text document notification
-sendNotification TextDocumentDidOpen params = do
- let params' = fromJust $ decode $ encode params
- n :: DidOpenTextDocumentNotification
- n = NotificationMessage "2.0" TextDocumentDidOpen params'
+sendNotification STextDocumentDidOpen params = do
+ let n = NotificationMessage "2.0" STextDocumentDidOpen params
oldVFS <- vfs <$> get
let (newVFS,_) = openVFS oldVFS n
modify (\s -> s { vfs = newVFS })
sendMessage n
-- Close a virtual file if we send a close text document notification
-sendNotification TextDocumentDidClose params = do
- let params' = fromJust $ decode $ encode params
- n :: DidCloseTextDocumentNotification
- n = NotificationMessage "2.0" TextDocumentDidClose params'
+sendNotification STextDocumentDidClose params = do
+ let n = NotificationMessage "2.0" STextDocumentDidClose params
oldVFS <- vfs <$> get
let (newVFS,_) = closeVFS oldVFS n
modify (\s -> s { vfs = newVFS })
sendMessage n
-sendNotification TextDocumentDidChange params = do
- let params' = fromJust $ decode $ encode params
- n :: DidChangeTextDocumentNotification
- n = NotificationMessage "2.0" TextDocumentDidChange params'
+sendNotification STextDocumentDidChange params = do
+ let n = NotificationMessage "2.0" STextDocumentDidChange params
oldVFS <- vfs <$> get
let (newVFS,_) = changeFromClientVFS oldVFS n
modify (\s -> s { vfs = newVFS })
sendMessage n
-sendNotification method params = sendMessage (NotificationMessage "2.0" method params)
+sendNotification method params =
+ case splitClientMethod method of
+ IsClientNot -> sendMessage (NotificationMessage "2.0" method params)
+ IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
-- | Sends a response to the server.
-sendResponse :: ToJSON a => ResponseMessage a -> Session ()
+sendResponse :: ToJSON (ResponseParams m) => ResponseMessage m -> Session ()
sendResponse = sendMessage
-- | Returns the initialize response that was received from the server.
initializeResponse :: Session InitializeResponse
initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
--- | Opens a text document and sends a notification to the client.
+-- | /Creates/ a new text document. This is different from 'openDoc'
+-- as it sends a workspace/didChangeWatchedFiles notification letting the server
+-- know that a file was created within the workspace, __provided that the server
+-- has registered for it__, and the file matches any patterns the server
+-- registered for.
+-- It /does not/ actually create a file on disk, but is useful for convincing
+-- the server that one does exist.
+--
+-- @since 11.0.0.0
+createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
+ -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
+ -> T.Text -- ^ The content of the text document to create.
+ -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
+createDoc file languageId contents = do
+ dynCaps <- curDynCaps <$> get
+ rootDir <- asks rootDir
+ caps <- asks sessionCapabilities
+ absFile <- liftIO $ canonicalizePath (rootDir </> file)
+ let regs = filter (\r -> r ^. method == SomeClientMethod SWorkspaceDidChangeWatchedFiles) $
+ Map.elems dynCaps
+ watchHits :: FileSystemWatcher -> Bool
+ watchHits (FileSystemWatcher pattern kind) =
+ -- If WatchKind is exlcuded, defaults to all true as per spec
+ fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
+
+ fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
+ -- If the pattern is absolute then match against the absolute fp
+ where relOrAbs
+ | isAbsolute pattern = absFile
+ | otherwise = file
+
+ createHits (WatchKind create _ _) = create
+
+ regHits :: SomeRegistration -> Bool
+ regHits reg = isJust $ do
+ opts <- reg ^. registerOptions
+ fileWatchOpts <- case fromJSON opts :: Result DidChangeWatchedFilesRegistrationOptions of
+ Success x -> Just x
+ Error _ -> Nothing
+ if foldl' (\acc w -> acc || watchHits w) False (fileWatchOpts ^. watchers)
+ then Just ()
+ else Nothing
+
+ clientCapsSupports =
+ caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
+ == Just True
+ shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
+
+ when shouldSend $
+ sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
+ List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
+ openDoc' file languageId contents
+
+-- | Opens a text document that /exists on disk/, and sends a
+-- textDocument/didOpen notification to the server.
openDoc :: FilePath -> String -> Session TextDocumentIdentifier
openDoc file languageId = do
context <- ask
openDoc' file languageId contents
-- | This is a variant of `openDoc` that takes the file content as an argument.
+-- Use this is the file exists /outside/ of the current workspace.
openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
openDoc' file languageId contents = do
context <- ask
let fp = rootDir context </> file
uri = filePathToUri fp
item = TextDocumentItem uri (T.pack languageId) 0 contents
- sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams item)
+ sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
pure $ TextDocumentIdentifier uri
--- | Closes a text document and sends a notification to the client.
+-- | Closes a text document and sends a textDocument/didOpen notification to the server.
closeDoc :: TextDocumentIdentifier -> Session ()
closeDoc docId = do
let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
- sendNotification TextDocumentDidClose params
+ sendNotification STextDocumentDidClose params
--- | Changes a text document and sends a notification to the client
+-- | Changes a text document and sends a textDocument/didOpen notification to the server.
changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
changeDoc docId changes = do
verDoc <- getVersionedDoc docId
let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
- sendNotification TextDocumentDidChange params
+ sendNotification STextDocumentDidChange params
-- | Gets the Uri for the file corrected to the session directory.
getDocUri :: FilePath -> Session Uri
-- | Waits for diagnostics to be published and returns them.
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics = do
- diagsNot <- skipManyTill anyMessage message :: Session PublishDiagnosticsNotification
+ diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics)
let (List diags) = diagsNot ^. params . LSP.diagnostics
return diags
-- returned.
noDiagnostics :: Session ()
noDiagnostics = do
- diagsNot <- message :: Session PublishDiagnosticsNotification
+ diagsNot <- message STextDocumentPublishDiagnostics
when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
-- | Returns the symbols in a document.
getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
getDocumentSymbols doc = do
- ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse
- maybe (return ()) (throw . UnexpectedResponseError rspLid) mErr
- case mRes of
- Just (DSDocumentSymbols (List xs)) -> return (Left xs)
- Just (DSSymbolInformation (List xs)) -> return (Right xs)
- Nothing -> Prelude.error "No result and no error in DocumentSymbolsResponse"
+ ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse
+ case res of
+ Right (L (List xs)) -> return (Left xs)
+ Right (R (List xs)) -> return (Right xs)
+ Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
-- | Returns the code actions in the specified range.
-getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
+getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getCodeActions doc range = do
ctx <- getCodeActionContext doc
- rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx Nothing)
+ rsp <- request STextDocumentCodeAction (CodeActionParams doc range ctx Nothing)
case rsp ^. result of
- Just (List xs) -> return xs
- _ -> throw (UnexpectedResponseError (rsp ^. LSP.id) (fromJust $ rsp ^. LSP.error))
+ Right (List xs) -> return xs
+ Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
-- | Returns all the code actions in a document by
-- querying the code actions at each of the current
-- diagnostics' positions.
-getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult]
+getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
getAllCodeActions doc = do
ctx <- getCodeActionContext doc
foldM (go ctx) [] =<< getCurrentDiagnostics doc
where
- go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
+ go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
go ctx acc diag = do
- ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing)
+ ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing)
- case mErr of
- Just e -> throw (UnexpectedResponseError rspLid e)
- Nothing ->
- let Just (List cmdOrCAs) = mRes
- in return (acc ++ cmdOrCAs)
+ case res of
+ Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
+ Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext doc = do
executeCommand cmd = do
let args = decode $ encode $ fromJust $ cmd ^. arguments
execParams = ExecuteCommandParams (cmd ^. command) args Nothing
- request_ WorkspaceExecuteCommand execParams
+ request_ SWorkspaceExecuteCommand execParams
-- | Executes a code action.
-- Matching with the specification, if a code action
where handleEdit :: WorkspaceEdit -> Session ()
handleEdit e =
-- Its ok to pass in dummy parameters here as they aren't used
- let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams e)
- in updateState (ReqApplyWorkspaceEdit req)
+ let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams e)
+ in updateState (FromServerMess SWorkspaceApplyEdit req)
-- | Adds the current version to the document, as tracked by the session.
getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
caps <- asks sessionCapabilities
let supportsDocChanges = fromMaybe False $ do
- let mWorkspace = C._workspace caps
+ let mWorkspace = caps ^. LSP.workspace
C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
mDocChanges
let changes = HashMap.singleton (doc ^. uri) (List [edit])
in WorkspaceEdit (Just changes) Nothing
- let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
- updateState (ReqApplyWorkspaceEdit req)
+ let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
+ updateState (FromServerMess SWorkspaceApplyEdit req)
-- version may have changed
getVersionedDoc doc
-- | Returns the completions for the position in the document.
getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions doc pos = do
- rsp <- request TextDocumentCompletion (TextDocumentPositionParams doc pos Nothing)
+ rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing)
case getResponseResult rsp of
- Completions (List items) -> return items
- CompletionList (CompletionListType _ (List items)) -> return items
+ L (List items) -> return items
+ R (CompletionList _ (List items)) -> return items
-- | Returns the references for the position in the document.
getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
-> Position -- ^ The position to lookup.
-> Bool -- ^ Whether to include declarations as references.
- -> Session [Location] -- ^ The locations of the references.
+ -> Session (List Location) -- ^ The locations of the references.
getReferences doc pos inclDecl =
let ctx = ReferenceContext inclDecl
params = ReferenceParams doc pos ctx Nothing
- in getResponseResult <$> request TextDocumentReferences params
+ in getResponseResult <$> request STextDocumentReferences params
-- | Returns the definition(s) for the term at the specified position.
getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
-> Session [Location] -- ^ The location(s) of the definitions
getDefinitions doc pos = do
let params = TextDocumentPositionParams doc pos Nothing
- rsp <- request TextDocumentDefinition params :: Session DefinitionResponse
+ rsp <- request STextDocumentDefinition params :: Session DefinitionResponse
case getResponseResult rsp of
- SingleLoc loc -> pure [loc]
- MultiLoc locs -> pure locs
+ L loc -> pure [loc]
+ R locs -> pure locs
-- | Returns the type definition(s) for the term at the specified position.
getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
-> Position -- ^ The position the term is at.
- -> Session [Location] -- ^ The location(s) of the definitions
+ -> Session (Location |? List Location |? List LocationLink) -- ^ The location(s) of the definitions
getTypeDefinitions doc pos =
let params = TextDocumentPositionParams doc pos Nothing
- in getResponseResult <$> request TextDocumentTypeDefinition params
+ rsp <- request STextDocumentTypeDefinition params :: Session TypeDefinitionResponse
+ case getResponseResult rsp of
+ L loc -> pure [loc]
+ R locs -> pure locs
-- | 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) Nothing
- rsp <- request TextDocumentRename params :: Session RenameResponse
+ rsp <- request STextDocumentRename params :: Session RenameResponse
let wEdit = getResponseResult rsp
- req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
- updateState (ReqApplyWorkspaceEdit req)
+ req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
+ updateState (FromServerMess SWorkspaceApplyEdit req)
-- | Returns the hover information at the specified position.
getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
getHover doc pos =
let params = TextDocumentPositionParams doc pos Nothing
- in getResponseResult <$> request TextDocumentHover params
+ in getResponseResult <$> request STextDocumentHover params
-- | Returns the highlighted occurences of the term at the specified position
-getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
+getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
getHighlights doc pos =
let params = TextDocumentPositionParams doc pos Nothing
- in getResponseResult <$> request TextDocumentDocumentHighlight params
+ in getResponseResult <$> request STextDocumentDocumentHighlight params
-- | Checks the response for errors and throws an exception if needed.
-- Returns the result if successful.
-getResponseResult :: ResponseMessage a -> a
-getResponseResult rsp = fromMaybe exc (rsp ^. result)
- where exc = throw $ UnexpectedResponseError (rsp ^. LSP.id)
- (fromJust $ rsp ^. LSP.error)
+getResponseResult :: ResponseMessage m -> ResponseParams m
+getResponseResult rsp =
+ case rsp ^. result of
+ Right x -> x
+ Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
-- | Applies formatting to the specified document.
formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
formatDoc doc opts = do
let params = DocumentFormattingParams doc opts Nothing
- edits <- getResponseResult <$> request TextDocumentFormatting params
+ edits <- getResponseResult <$> request STextDocumentFormatting 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 Nothing
- edits <- getResponseResult <$> request TextDocumentRangeFormatting params
+ edits <- getResponseResult <$> request STextDocumentRangeFormatting params
applyTextEdits doc edits
applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits doc edits =
let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
- req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
- in updateState (ReqApplyWorkspaceEdit req)
+ -- Send a dummy message to updateState so it can do bookkeeping
+ req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
+ in updateState (FromServerMess SWorkspaceApplyEdit req)
-- | Returns the code lenses for the specified document.
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses tId = do
- rsp <- request TextDocumentCodeLens (CodeLensParams tId Nothing) :: Session CodeLensResponse
+ rsp <- request STextDocumentCodeLens (CodeLensParams tId Nothing) :: Session CodeLensResponse
case getResponseResult rsp of
List res -> pure res
+
+-- | Returns a list of capabilities that the server has requested to /dynamically/
+-- register during the 'Session'.
+--
+-- @since 0.11.0.0
+getRegisteredCapabilities :: Session [SomeRegistration]
+getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get
projects / lsp-test.git / blobdiff