1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE TypeOperators #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE KindSignatures #-}
6 {-# LANGUAGE RankNTypes #-}
7 {-# LANGUAGE TypeInType #-}
8 {-# LANGUAGE ScopedTypeVariables #-}
9 {-# LANGUAGE ExistentialQuantification #-}
12 Module : Language.LSP.Test
13 Description : A functional testing framework for LSP servers.
14 Maintainer : luke_lau@icloud.com
15 Stability : experimental
16 Portability : non-portable
18 Provides the framework to start functionally testing
19 <https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>.
20 You should import "Language.LSP.Types" alongside this.
22 module Language.LSP.Test
27 , runSessionWithConfig
28 , runSessionWithHandles
34 , module Language.LSP.Test.Exceptions
43 , module Language.LSP.Test.Parsing
45 -- | Quick helper functions for common tasks.
62 , waitForDiagnosticsSource
64 , getCurrentDiagnostics
94 , getRegisteredCapabilities
97 import Control.Applicative.Combinators
98 import Control.Concurrent
100 import Control.Monad.IO.Class
101 import Control.Exception
102 import Control.Lens hiding ((.=), List, Empty)
103 import qualified Data.Map.Strict as Map
104 import qualified Data.Text as T
105 import qualified Data.Text.IO as T
108 import qualified Data.HashMap.Strict as HashMap
111 import Language.LSP.Types
112 import Language.LSP.Types.Lens hiding
113 (id, capabilities, message, executeCommand, applyEdit, rename)
114 import qualified Language.LSP.Types.Lens as LSP
115 import qualified Language.LSP.Types.Capabilities as C
116 import Language.LSP.VFS
117 import Language.LSP.Test.Compat
118 import Language.LSP.Test.Decoding
119 import Language.LSP.Test.Exceptions
120 import Language.LSP.Test.Parsing
121 import Language.LSP.Test.Session
122 import Language.LSP.Test.Server
123 import System.Environment
125 import System.Directory
126 import System.FilePath
127 import System.Process (ProcessHandle)
128 import qualified System.FilePath.Glob as Glob
130 -- | Starts a new session.
132 -- > runSession "hie" fullCaps "path/to/root/dir" $ do
133 -- > doc <- openDoc "Desktop/simple.hs" "haskell"
134 -- > diags <- waitForDiagnostics
135 -- > let pos = Position 12 5
136 -- > params = TextDocumentPositionParams doc
137 -- > hover <- request STextdocumentHover params
138 runSession :: String -- ^ The command to run the server.
139 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
140 -> FilePath -- ^ The filepath to the root directory for the session.
141 -> Session a -- ^ The session to run.
143 runSession = runSessionWithConfig def
145 -- | Starts a new sesion with a custom configuration.
146 runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
147 -> String -- ^ The command to run the server.
148 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
149 -> FilePath -- ^ The filepath to the root directory for the session.
150 -> Session a -- ^ The session to run.
152 runSessionWithConfig config' serverExe caps rootDir session = do
153 config <- envOverrideConfig config'
154 withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
155 runSessionWithHandles' (Just serverProc) serverIn serverOut config caps rootDir session
157 -- | Starts a new session, using the specified handles to communicate with the
158 -- server. You can use this to host the server within the same process.
159 -- An example with lsp might look like:
161 -- > (hinRead, hinWrite) <- createPipe
162 -- > (houtRead, houtWrite) <- createPipe
164 -- > forkIO $ void $ runServerWithHandles hinRead houtWrite serverDefinition
165 -- > runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
167 runSessionWithHandles :: Handle -- ^ The input handle
168 -> Handle -- ^ The output handle
170 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
171 -> FilePath -- ^ The filepath to the root directory for the session.
172 -> Session a -- ^ The session to run.
174 runSessionWithHandles = runSessionWithHandles' Nothing
177 runSessionWithHandles' :: Maybe ProcessHandle
178 -> Handle -- ^ The input handle
179 -> Handle -- ^ The output handle
181 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
182 -> FilePath -- ^ The filepath to the root directory for the session.
183 -> Session a -- ^ The session to run.
185 runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir session = do
186 pid <- getCurrentProcessID
187 absRootDir <- canonicalizePath rootDir
189 config <- envOverrideConfig config'
191 let initializeParams = InitializeParams Nothing
193 (Just lspTestClientInfo)
194 (Just $ T.pack absRootDir)
195 (Just $ filePathToUri absRootDir)
199 (List <$> initialWorkspaceFolders config)
200 runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
201 -- Wrap the session around initialize and shutdown calls
202 initReqId <- sendRequest SInitialize initializeParams
204 -- Because messages can be sent in between the request and response,
205 -- collect them and then...
206 (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId SInitialize initReqId)
208 case initRspMsg ^. LSP.result of
209 Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error)
212 initRspVar <- initRsp <$> ask
213 liftIO $ putMVar initRspVar initRspMsg
214 sendNotification SInitialized (Just InitializedParams)
216 case lspConfig config of
217 Just cfg -> sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
220 -- ... relay them back to the user Session so they can match on them!
221 -- As long as they are allowed.
222 forM_ inBetween checkLegalBetweenMessage
223 msgChan <- asks messageChan
224 liftIO $ writeList2Chan msgChan (ServerMessage <$> inBetween)
226 -- Run the actual test
229 -- | Asks the server to shutdown and exit politely
230 exitServer :: Session ()
231 exitServer = request_ SShutdown Empty >> sendNotification SExit Empty
233 -- | Listens to the server output until the shutdown ack,
234 -- makes sure it matches the record and signals any semaphores
235 listenServer :: Handle -> SessionContext -> IO ()
236 listenServer serverOut context = do
237 msgBytes <- getNextMessage serverOut
239 msg <- modifyMVar (requestMap context) $ \reqMap ->
240 pure $ decodeFromServerMsg reqMap msgBytes
241 writeChan (messageChan context) (ServerMessage msg)
244 (FromServerRsp SShutdown _) -> return ()
245 _ -> listenServer serverOut context
247 -- | Is this message allowed to be sent by the server between the intialize
248 -- request and response?
249 -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
250 checkLegalBetweenMessage :: FromServerMessage -> Session ()
251 checkLegalBetweenMessage (FromServerMess SWindowShowMessage _) = pure ()
252 checkLegalBetweenMessage (FromServerMess SWindowLogMessage _) = pure ()
253 checkLegalBetweenMessage (FromServerMess STelemetryEvent _) = pure ()
254 checkLegalBetweenMessage (FromServerMess SWindowShowMessageRequest _) = pure ()
255 checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
257 -- | Check environment variables to override the config
258 envOverrideConfig :: SessionConfig -> IO SessionConfig
259 envOverrideConfig cfg = do
260 logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
261 logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
262 return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
263 where checkEnv :: String -> IO (Maybe Bool)
264 checkEnv s = fmap convertVal <$> lookupEnv s
265 convertVal "0" = False
268 -- | The current text contents of a document.
269 documentContents :: TextDocumentIdentifier -> Session T.Text
270 documentContents doc = do
272 let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
273 return (virtualFileText file)
275 -- | Parses an ApplyEditRequest, checks that it is for the passed document
276 -- and returns the new content
277 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
278 getDocumentEdit doc = do
279 req <- message SWorkspaceApplyEdit
281 unless (checkDocumentChanges req || checkChanges req) $
282 liftIO $ throw (IncorrectApplyEditRequest (show req))
286 checkDocumentChanges req =
287 let changes = req ^. params . edit . documentChanges
288 maybeDocs = fmap (fmap documentChangeUri) changes
290 Just docs -> (doc ^. uri) `elem` docs
293 let mMap = req ^. params . edit . changes
294 in maybe False (HashMap.member (doc ^. uri)) mMap
296 -- | Sends a request to the server and waits for its response.
297 -- Will skip any messages in between the request and the response
299 -- rsp <- request STextDocumentDocumentSymbol params
301 -- Note: will skip any messages in between the request and the response.
302 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
303 request m = sendRequest m >=> skipManyTill anyMessage . responseForId m
305 -- | The same as 'sendRequest', but discard the response.
306 request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
307 request_ p = void . request p
309 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
311 :: SClientMethod m -- ^ The request method.
312 -> MessageParams m -- ^ The request parameters.
313 -> Session (LspId m) -- ^ The id of the request that was sent.
314 sendRequest method params = do
315 idn <- curReqId <$> get
316 modify $ \c -> c { curReqId = idn+1 }
319 let mess = RequestMessage "2.0" id method params
321 -- Update the request map
322 reqMap <- requestMap <$> ask
323 liftIO $ modifyMVar_ reqMap $
324 \r -> return $ fromJust $ updateRequestMap r id method
326 ~() <- case splitClientMethod method of
327 IsClientReq -> sendMessage mess
328 IsClientEither -> sendMessage $ ReqMess mess
332 -- | Sends a notification to the server.
333 sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
334 -> MessageParams m -- ^ The notification parameters.
336 -- Open a virtual file if we send a did open text document notification
337 sendNotification STextDocumentDidOpen params = do
338 let n = NotificationMessage "2.0" STextDocumentDidOpen params
339 oldVFS <- vfs <$> get
340 let (newVFS,_) = openVFS oldVFS n
341 modify (\s -> s { vfs = newVFS })
344 -- Close a virtual file if we send a close text document notification
345 sendNotification STextDocumentDidClose params = do
346 let n = NotificationMessage "2.0" STextDocumentDidClose params
347 oldVFS <- vfs <$> get
348 let (newVFS,_) = closeVFS oldVFS n
349 modify (\s -> s { vfs = newVFS })
352 sendNotification STextDocumentDidChange params = do
353 let n = NotificationMessage "2.0" STextDocumentDidChange params
354 oldVFS <- vfs <$> get
355 let (newVFS,_) = changeFromClientVFS oldVFS n
356 modify (\s -> s { vfs = newVFS })
359 sendNotification method params =
360 case splitClientMethod method of
361 IsClientNot -> sendMessage (NotificationMessage "2.0" method params)
362 IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
364 -- | Sends a response to the server.
365 sendResponse :: ToJSON (ResponseResult m) => ResponseMessage m -> Session ()
366 sendResponse = sendMessage
368 -- | Returns the initialize response that was received from the server.
369 -- The initialize requests and responses are not included the session,
370 -- so if you need to test it use this.
371 initializeResponse :: Session (ResponseMessage Initialize)
372 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
374 -- | /Creates/ a new text document. This is different from 'openDoc'
375 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
376 -- know that a file was created within the workspace, __provided that the server
377 -- has registered for it__, and the file matches any patterns the server
379 -- It /does not/ actually create a file on disk, but is useful for convincing
380 -- the server that one does exist.
383 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
384 -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
385 -> T.Text -- ^ The content of the text document to create.
386 -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
387 createDoc file languageId contents = do
388 dynCaps <- curDynCaps <$> get
389 rootDir <- asks rootDir
390 caps <- asks sessionCapabilities
391 absFile <- liftIO $ canonicalizePath (rootDir </> file)
392 let pred :: SomeRegistration -> [Registration WorkspaceDidChangeWatchedFiles]
393 pred (SomeRegistration r@(Registration _ SWorkspaceDidChangeWatchedFiles _)) = [r]
395 regs = concatMap pred $ Map.elems dynCaps
396 watchHits :: FileSystemWatcher -> Bool
397 watchHits (FileSystemWatcher pattern kind) =
398 -- If WatchKind is exlcuded, defaults to all true as per spec
399 fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
401 fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
402 -- If the pattern is absolute then match against the absolute fp
404 | isAbsolute pattern = absFile
407 createHits (WatchKind create _ _) = create
409 regHits :: Registration WorkspaceDidChangeWatchedFiles -> Bool
410 regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. registerOptions . watchers)
413 caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
415 shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
418 sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
419 List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
420 openDoc' file languageId contents
422 -- | Opens a text document that /exists on disk/, and sends a
423 -- textDocument/didOpen notification to the server.
424 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
425 openDoc file languageId = do
427 let fp = rootDir context </> file
428 contents <- liftIO $ T.readFile fp
429 openDoc' file languageId contents
431 -- | This is a variant of `openDoc` that takes the file content as an argument.
432 -- Use this is the file exists /outside/ of the current workspace.
433 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
434 openDoc' file languageId contents = do
436 let fp = rootDir context </> file
437 uri = filePathToUri fp
438 item = TextDocumentItem uri (T.pack languageId) 0 contents
439 sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
440 pure $ TextDocumentIdentifier uri
442 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
443 closeDoc :: TextDocumentIdentifier -> Session ()
445 let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
446 sendNotification STextDocumentDidClose params
448 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
449 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
450 changeDoc docId changes = do
451 verDoc <- getVersionedDoc docId
452 let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
453 sendNotification STextDocumentDidChange params
455 -- | Gets the Uri for the file corrected to the session directory.
456 getDocUri :: FilePath -> Session Uri
459 let fp = rootDir context </> file
460 return $ filePathToUri fp
462 -- | Waits for diagnostics to be published and returns them.
463 waitForDiagnostics :: Session [Diagnostic]
464 waitForDiagnostics = do
465 diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics)
466 let (List diags) = diagsNot ^. params . LSP.diagnostics
469 -- | The same as 'waitForDiagnostics', but will only match a specific
470 -- 'Language.LSP.Types._source'.
471 waitForDiagnosticsSource :: String -> Session [Diagnostic]
472 waitForDiagnosticsSource src = do
473 diags <- waitForDiagnostics
474 let res = filter matches diags
476 then waitForDiagnosticsSource src
479 matches :: Diagnostic -> Bool
480 matches d = d ^. source == Just (T.pack src)
482 -- | Expects a 'PublishDiagnosticsNotification' and throws an
483 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
485 noDiagnostics :: Session ()
487 diagsNot <- message STextDocumentPublishDiagnostics
488 when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
490 -- | Returns the symbols in a document.
491 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
492 getDocumentSymbols doc = do
493 ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc)
495 Right (InL (List xs)) -> return (Left xs)
496 Right (InR (List xs)) -> return (Right xs)
497 Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
499 -- | Returns the code actions in the specified range.
500 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
501 getCodeActions doc range = do
502 ctx <- getCodeActionContext doc
503 rsp <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx)
505 case rsp ^. result of
506 Right (List xs) -> return xs
507 Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
509 -- | Returns all the code actions in a document by
510 -- querying the code actions at each of the current
511 -- diagnostics' positions.
512 getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
513 getAllCodeActions doc = do
514 ctx <- getCodeActionContext doc
516 foldM (go ctx) [] =<< getCurrentDiagnostics doc
519 go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
521 ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. range) ctx)
524 Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
525 Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
527 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
528 getCodeActionContext doc = do
529 curDiags <- getCurrentDiagnostics doc
530 return $ CodeActionContext (List curDiags) Nothing
532 -- | Returns the current diagnostics that have been sent to the client.
533 -- Note that this does not wait for more to come in.
534 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
535 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
537 -- | Executes a command.
538 executeCommand :: Command -> Session ()
539 executeCommand cmd = do
540 let args = decode $ encode $ fromJust $ cmd ^. arguments
541 execParams = ExecuteCommandParams Nothing (cmd ^. command) args
542 void $ sendRequest SWorkspaceExecuteCommand execParams
544 -- | Executes a code action.
545 -- Matching with the specification, if a code action
546 -- contains both an edit and a command, the edit will
548 executeCodeAction :: CodeAction -> Session ()
549 executeCodeAction action = do
550 maybe (return ()) handleEdit $ action ^. edit
551 maybe (return ()) executeCommand $ action ^. command
553 where handleEdit :: WorkspaceEdit -> Session ()
555 -- Its ok to pass in dummy parameters here as they aren't used
556 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e)
557 in updateState (FromServerMess SWorkspaceApplyEdit req)
559 -- | Adds the current version to the document, as tracked by the session.
560 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
561 getVersionedDoc (TextDocumentIdentifier uri) = do
562 fs <- vfsMap . vfs <$> get
564 case fs Map.!? toNormalizedUri uri of
565 Just vf -> Just (virtualFileVersion vf)
567 return (VersionedTextDocumentIdentifier uri ver)
569 -- | Applys an edit to the document and returns the updated document version.
570 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
571 applyEdit doc edit = do
573 verDoc <- getVersionedDoc doc
575 caps <- asks sessionCapabilities
577 let supportsDocChanges = fromMaybe False $ do
578 let mWorkspace = caps ^. LSP.workspace
579 C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
580 C.WorkspaceEditClientCapabilities mDocChanges _ _ <- mEdit
583 let wEdit = if supportsDocChanges
585 let docEdit = TextDocumentEdit verDoc (List [edit])
586 in WorkspaceEdit Nothing (Just (List [InL docEdit]))
588 let changes = HashMap.singleton (doc ^. uri) (List [edit])
589 in WorkspaceEdit (Just changes) Nothing
591 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
592 updateState (FromServerMess SWorkspaceApplyEdit req)
594 -- version may have changed
597 -- | Returns the completions for the position in the document.
598 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
599 getCompletions doc pos = do
600 rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing)
602 case getResponseResult rsp of
603 InL (List items) -> return items
604 InR (CompletionList _ (List items)) -> return items
606 -- | Returns the references for the position in the document.
607 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
608 -> Position -- ^ The position to lookup.
609 -> Bool -- ^ Whether to include declarations as references.
610 -> Session (List Location) -- ^ The locations of the references.
611 getReferences doc pos inclDecl =
612 let ctx = ReferenceContext inclDecl
613 params = ReferenceParams doc pos Nothing Nothing ctx
614 in getResponseResult <$> request STextDocumentReferences params
616 -- | Returns the declarations(s) for the term at the specified position.
617 getDeclarations :: TextDocumentIdentifier -- ^ The document the term is in.
618 -> Position -- ^ The position the term is at.
619 -> Session ([Location] |? [LocationLink])
620 getDeclarations = getDeclarationyRequest STextDocumentDeclaration DeclarationParams
622 -- | Returns the definition(s) for the term at the specified position.
623 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
624 -> Position -- ^ The position the term is at.
625 -> Session ([Location] |? [LocationLink])
626 getDefinitions = getDeclarationyRequest STextDocumentDefinition DefinitionParams
628 -- | Returns the type definition(s) for the term at the specified position.
629 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
630 -> Position -- ^ The position the term is at.
631 -> Session ([Location] |? [LocationLink])
632 getTypeDefinitions = getDeclarationyRequest STextDocumentTypeDefinition TypeDefinitionParams
634 -- | Returns the type definition(s) for the term at the specified position.
635 getImplementations :: TextDocumentIdentifier -- ^ The document the term is in.
636 -> Position -- ^ The position the term is at.
637 -> Session ([Location] |? [LocationLink])
638 getImplementations = getDeclarationyRequest STextDocumentImplementation ImplementationParams
641 getDeclarationyRequest :: (ResponseResult m ~ (Location |? (List Location |? List LocationLink)))
643 -> (TextDocumentIdentifier
645 -> Maybe ProgressToken
646 -> Maybe ProgressToken
648 -> TextDocumentIdentifier
650 -> Session ([Location] |? [LocationLink])
651 getDeclarationyRequest method paramCons doc pos = do
652 let params = paramCons doc pos Nothing Nothing
653 rsp <- request method params
654 case getResponseResult rsp of
655 InL loc -> pure (InL [loc])
656 InR (InL (List locs)) -> pure (InL locs)
657 InR (InR (List locLinks)) -> pure (InR locLinks)
659 -- | Renames the term at the specified position.
660 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
661 rename doc pos newName = do
662 let params = RenameParams doc pos Nothing (T.pack newName)
663 rsp <- request STextDocumentRename params
664 let wEdit = getResponseResult rsp
665 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
666 updateState (FromServerMess SWorkspaceApplyEdit req)
668 -- | Returns the hover information at the specified position.
669 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
671 let params = HoverParams doc pos Nothing
672 in getResponseResult <$> request STextDocumentHover params
674 -- | Returns the highlighted occurences of the term at the specified position
675 getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
676 getHighlights doc pos =
677 let params = DocumentHighlightParams doc pos Nothing Nothing
678 in getResponseResult <$> request STextDocumentDocumentHighlight params
680 -- | Checks the response for errors and throws an exception if needed.
681 -- Returns the result if successful.
682 getResponseResult :: ResponseMessage m -> ResponseResult m
683 getResponseResult rsp =
684 case rsp ^. result of
686 Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
688 -- | Applies formatting to the specified document.
689 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
690 formatDoc doc opts = do
691 let params = DocumentFormattingParams Nothing doc opts
692 edits <- getResponseResult <$> request STextDocumentFormatting params
693 applyTextEdits doc edits
695 -- | Applies formatting to the specified range in a document.
696 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
697 formatRange doc opts range = do
698 let params = DocumentRangeFormattingParams Nothing doc range opts
699 edits <- getResponseResult <$> request STextDocumentRangeFormatting params
700 applyTextEdits doc edits
702 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
703 applyTextEdits doc edits =
704 let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
705 -- Send a dummy message to updateState so it can do bookkeeping
706 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
707 in updateState (FromServerMess SWorkspaceApplyEdit req)
709 -- | Returns the code lenses for the specified document.
710 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
711 getCodeLenses tId = do
712 rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId)
713 case getResponseResult rsp of
716 -- | Returns a list of capabilities that the server has requested to /dynamically/
717 -- register during the 'Session'.
720 getRegisteredCapabilities :: Session [SomeRegistration]
721 getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get