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
65 , getIncompleteProgressSessions
95 , getRegisteredCapabilities
98 import Control.Applicative.Combinators
99 import Control.Concurrent
101 import Control.Monad.IO.Class
102 import Control.Exception
103 import Control.Lens hiding ((.=), List, Empty)
104 import qualified Data.Map.Strict as Map
105 import qualified Data.Set as Set
106 import qualified Data.Text as T
107 import qualified Data.Text.IO as T
110 import qualified Data.HashMap.Strict as HashMap
113 import Language.LSP.Types
114 import Language.LSP.Types.Lens hiding
115 (id, capabilities, message, executeCommand, applyEdit, rename)
116 import qualified Language.LSP.Types.Lens as LSP
117 import qualified Language.LSP.Types.Capabilities as C
118 import Language.LSP.VFS
119 import Language.LSP.Test.Compat
120 import Language.LSP.Test.Decoding
121 import Language.LSP.Test.Exceptions
122 import Language.LSP.Test.Parsing
123 import Language.LSP.Test.Session
124 import Language.LSP.Test.Server
125 import System.Environment
127 import System.Directory
128 import System.FilePath
129 import System.Process (ProcessHandle)
130 import qualified System.FilePath.Glob as Glob
132 -- | Starts a new session.
134 -- > runSession "hie" fullCaps "path/to/root/dir" $ do
135 -- > doc <- openDoc "Desktop/simple.hs" "haskell"
136 -- > diags <- waitForDiagnostics
137 -- > let pos = Position 12 5
138 -- > params = TextDocumentPositionParams doc
139 -- > hover <- request STextdocumentHover params
140 runSession :: String -- ^ The command to run the server.
141 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
142 -> FilePath -- ^ The filepath to the root directory for the session.
143 -> Session a -- ^ The session to run.
145 runSession = runSessionWithConfig def
147 -- | Starts a new sesion with a custom configuration.
148 runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
149 -> String -- ^ The command to run the server.
150 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
151 -> FilePath -- ^ The filepath to the root directory for the session.
152 -> Session a -- ^ The session to run.
154 runSessionWithConfig config' serverExe caps rootDir session = do
155 config <- envOverrideConfig config'
156 withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
157 runSessionWithHandles' (Just serverProc) serverIn serverOut config caps rootDir session
159 -- | Starts a new session, using the specified handles to communicate with the
160 -- server. You can use this to host the server within the same process.
161 -- An example with lsp might look like:
163 -- > (hinRead, hinWrite) <- createPipe
164 -- > (houtRead, houtWrite) <- createPipe
166 -- > forkIO $ void $ runServerWithHandles hinRead houtWrite serverDefinition
167 -- > runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
169 runSessionWithHandles :: Handle -- ^ The input handle
170 -> Handle -- ^ The output handle
172 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
173 -> FilePath -- ^ The filepath to the root directory for the session.
174 -> Session a -- ^ The session to run.
176 runSessionWithHandles = runSessionWithHandles' Nothing
179 runSessionWithHandles' :: Maybe ProcessHandle
180 -> Handle -- ^ The input handle
181 -> Handle -- ^ The output handle
183 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
184 -> FilePath -- ^ The filepath to the root directory for the session.
185 -> Session a -- ^ The session to run.
187 runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir session = do
188 pid <- getCurrentProcessID
189 absRootDir <- canonicalizePath rootDir
191 config <- envOverrideConfig config'
193 let initializeParams = InitializeParams Nothing
195 (Just lspTestClientInfo)
196 (Just $ T.pack absRootDir)
197 (Just $ filePathToUri absRootDir)
201 (List <$> initialWorkspaceFolders config)
202 runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
203 -- Wrap the session around initialize and shutdown calls
204 initReqId <- sendRequest SInitialize initializeParams
206 -- Because messages can be sent in between the request and response,
207 -- collect them and then...
208 (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId SInitialize initReqId)
210 case initRspMsg ^. LSP.result of
211 Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error)
214 initRspVar <- initRsp <$> ask
215 liftIO $ putMVar initRspVar initRspMsg
216 sendNotification SInitialized (Just InitializedParams)
218 case lspConfig config of
219 Just cfg -> sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
222 -- ... relay them back to the user Session so they can match on them!
223 -- As long as they are allowed.
224 forM_ inBetween checkLegalBetweenMessage
225 msgChan <- asks messageChan
226 liftIO $ writeList2Chan msgChan (ServerMessage <$> inBetween)
228 -- Run the actual test
231 -- | Asks the server to shutdown and exit politely
232 exitServer :: Session ()
233 exitServer = request_ SShutdown Empty >> sendNotification SExit Empty
235 -- | Listens to the server output until the shutdown ack,
236 -- makes sure it matches the record and signals any semaphores
237 listenServer :: Handle -> SessionContext -> IO ()
238 listenServer serverOut context = do
239 msgBytes <- getNextMessage serverOut
241 msg <- modifyMVar (requestMap context) $ \reqMap ->
242 pure $ decodeFromServerMsg reqMap msgBytes
243 writeChan (messageChan context) (ServerMessage msg)
246 (FromServerRsp SShutdown _) -> return ()
247 _ -> listenServer serverOut context
249 -- | Is this message allowed to be sent by the server between the intialize
250 -- request and response?
251 -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
252 checkLegalBetweenMessage :: FromServerMessage -> Session ()
253 checkLegalBetweenMessage (FromServerMess SWindowShowMessage _) = pure ()
254 checkLegalBetweenMessage (FromServerMess SWindowLogMessage _) = pure ()
255 checkLegalBetweenMessage (FromServerMess STelemetryEvent _) = pure ()
256 checkLegalBetweenMessage (FromServerMess SWindowShowMessageRequest _) = pure ()
257 checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
259 -- | Check environment variables to override the config
260 envOverrideConfig :: SessionConfig -> IO SessionConfig
261 envOverrideConfig cfg = do
262 logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
263 logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
264 return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
265 where checkEnv :: String -> IO (Maybe Bool)
266 checkEnv s = fmap convertVal <$> lookupEnv s
267 convertVal "0" = False
270 -- | The current text contents of a document.
271 documentContents :: TextDocumentIdentifier -> Session T.Text
272 documentContents doc = do
274 let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
275 return (virtualFileText file)
277 -- | Parses an ApplyEditRequest, checks that it is for the passed document
278 -- and returns the new content
279 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
280 getDocumentEdit doc = do
281 req <- message SWorkspaceApplyEdit
283 unless (checkDocumentChanges req || checkChanges req) $
284 liftIO $ throw (IncorrectApplyEditRequest (show req))
288 checkDocumentChanges req =
289 let changes = req ^. params . edit . documentChanges
290 maybeDocs = fmap (fmap documentChangeUri) changes
292 Just docs -> (doc ^. uri) `elem` docs
295 let mMap = req ^. params . edit . changes
296 in maybe False (HashMap.member (doc ^. uri)) mMap
298 -- | Sends a request to the server and waits for its response.
299 -- Will skip any messages in between the request and the response
301 -- rsp <- request STextDocumentDocumentSymbol params
303 -- Note: will skip any messages in between the request and the response.
304 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
305 request m = sendRequest m >=> skipManyTill anyMessage . responseForId m
307 -- | The same as 'sendRequest', but discard the response.
308 request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
309 request_ p = void . request p
311 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
313 :: SClientMethod m -- ^ The request method.
314 -> MessageParams m -- ^ The request parameters.
315 -> Session (LspId m) -- ^ The id of the request that was sent.
316 sendRequest method params = do
317 idn <- curReqId <$> get
318 modify $ \c -> c { curReqId = idn+1 }
321 let mess = RequestMessage "2.0" id method params
323 -- Update the request map
324 reqMap <- requestMap <$> ask
325 liftIO $ modifyMVar_ reqMap $
326 \r -> return $ fromJust $ updateRequestMap r id method
328 ~() <- case splitClientMethod method of
329 IsClientReq -> sendMessage mess
330 IsClientEither -> sendMessage $ ReqMess mess
334 -- | Sends a notification to the server.
335 sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
336 -> MessageParams m -- ^ The notification parameters.
338 -- Open a virtual file if we send a did open text document notification
339 sendNotification STextDocumentDidOpen params = do
340 let n = NotificationMessage "2.0" STextDocumentDidOpen params
341 oldVFS <- vfs <$> get
342 let (newVFS,_) = openVFS oldVFS n
343 modify (\s -> s { vfs = newVFS })
346 -- Close a virtual file if we send a close text document notification
347 sendNotification STextDocumentDidClose params = do
348 let n = NotificationMessage "2.0" STextDocumentDidClose params
349 oldVFS <- vfs <$> get
350 let (newVFS,_) = closeVFS oldVFS n
351 modify (\s -> s { vfs = newVFS })
354 sendNotification STextDocumentDidChange params = do
355 let n = NotificationMessage "2.0" STextDocumentDidChange params
356 oldVFS <- vfs <$> get
357 let (newVFS,_) = changeFromClientVFS oldVFS n
358 modify (\s -> s { vfs = newVFS })
361 sendNotification method params =
362 case splitClientMethod method of
363 IsClientNot -> sendMessage (NotificationMessage "2.0" method params)
364 IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
366 -- | Sends a response to the server.
367 sendResponse :: ToJSON (ResponseResult m) => ResponseMessage m -> Session ()
368 sendResponse = sendMessage
370 -- | Returns the initialize response that was received from the server.
371 -- The initialize requests and responses are not included the session,
372 -- so if you need to test it use this.
373 initializeResponse :: Session (ResponseMessage Initialize)
374 initializeResponse = ask >>= (liftIO . readMVar) . initRsp
376 -- | /Creates/ a new text document. This is different from 'openDoc'
377 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
378 -- know that a file was created within the workspace, __provided that the server
379 -- has registered for it__, and the file matches any patterns the server
381 -- It /does not/ actually create a file on disk, but is useful for convincing
382 -- the server that one does exist.
385 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
386 -> T.Text -- ^ The text document's language identifier, e.g. @"haskell"@.
387 -> T.Text -- ^ The content of the text document to create.
388 -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
389 createDoc file languageId contents = do
390 dynCaps <- curDynCaps <$> get
391 rootDir <- asks rootDir
392 caps <- asks sessionCapabilities
393 absFile <- liftIO $ canonicalizePath (rootDir </> file)
394 let pred :: SomeRegistration -> [Registration WorkspaceDidChangeWatchedFiles]
395 pred (SomeRegistration r@(Registration _ SWorkspaceDidChangeWatchedFiles _)) = [r]
397 regs = concatMap pred $ Map.elems dynCaps
398 watchHits :: FileSystemWatcher -> Bool
399 watchHits (FileSystemWatcher pattern kind) =
400 -- If WatchKind is exlcuded, defaults to all true as per spec
401 fileMatches (T.unpack pattern) && createHits (fromMaybe (WatchKind True True True) kind)
403 fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
404 -- If the pattern is absolute then match against the absolute fp
406 | isAbsolute pattern = absFile
409 createHits (WatchKind create _ _) = create
411 regHits :: Registration WorkspaceDidChangeWatchedFiles -> Bool
412 regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. registerOptions . watchers)
415 caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
417 shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
420 sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
421 List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
422 openDoc' file languageId contents
424 -- | Opens a text document that /exists on disk/, and sends a
425 -- textDocument/didOpen notification to the server.
426 openDoc :: FilePath -> T.Text -> Session TextDocumentIdentifier
427 openDoc file languageId = do
429 let fp = rootDir context </> file
430 contents <- liftIO $ T.readFile fp
431 openDoc' file languageId contents
433 -- | This is a variant of `openDoc` that takes the file content as an argument.
434 -- Use this is the file exists /outside/ of the current workspace.
435 openDoc' :: FilePath -> T.Text -> T.Text -> Session TextDocumentIdentifier
436 openDoc' file languageId contents = do
438 let fp = rootDir context </> file
439 uri = filePathToUri fp
440 item = TextDocumentItem uri languageId 0 contents
441 sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
442 pure $ TextDocumentIdentifier uri
444 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
445 closeDoc :: TextDocumentIdentifier -> Session ()
447 let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
448 sendNotification STextDocumentDidClose params
450 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
451 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
452 changeDoc docId changes = do
453 verDoc <- getVersionedDoc docId
454 let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
455 sendNotification STextDocumentDidChange params
457 -- | Gets the Uri for the file corrected to the session directory.
458 getDocUri :: FilePath -> Session Uri
461 let fp = rootDir context </> file
462 return $ filePathToUri fp
464 -- | Waits for diagnostics to be published and returns them.
465 waitForDiagnostics :: Session [Diagnostic]
466 waitForDiagnostics = do
467 diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics)
468 let (List diags) = diagsNot ^. params . LSP.diagnostics
471 -- | The same as 'waitForDiagnostics', but will only match a specific
472 -- 'Language.LSP.Types._source'.
473 waitForDiagnosticsSource :: String -> Session [Diagnostic]
474 waitForDiagnosticsSource src = do
475 diags <- waitForDiagnostics
476 let res = filter matches diags
478 then waitForDiagnosticsSource src
481 matches :: Diagnostic -> Bool
482 matches d = d ^. source == Just (T.pack src)
484 -- | Expects a 'PublishDiagnosticsNotification' and throws an
485 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
487 noDiagnostics :: Session ()
489 diagsNot <- message STextDocumentPublishDiagnostics
490 when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
492 -- | Returns the symbols in a document.
493 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
494 getDocumentSymbols doc = do
495 ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc)
497 Right (InL (List xs)) -> return (Left xs)
498 Right (InR (List xs)) -> return (Right xs)
499 Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
501 -- | Returns the code actions in the specified range.
502 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
503 getCodeActions doc range = do
504 ctx <- getCodeActionContext doc
505 rsp <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx)
507 case rsp ^. result of
508 Right (List xs) -> return xs
509 Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
511 -- | Returns all the code actions in a document by
512 -- querying the code actions at each of the current
513 -- diagnostics' positions.
514 getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
515 getAllCodeActions doc = do
516 ctx <- getCodeActionContext doc
518 foldM (go ctx) [] =<< getCurrentDiagnostics doc
521 go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
523 ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. range) ctx)
526 Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
527 Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
529 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
530 getCodeActionContext doc = do
531 curDiags <- getCurrentDiagnostics doc
532 return $ CodeActionContext (List curDiags) Nothing
534 -- | Returns the current diagnostics that have been sent to the client.
535 -- Note that this does not wait for more to come in.
536 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
537 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
539 -- | Returns the tokens of all progress sessions that have started but not yet ended.
540 getIncompleteProgressSessions :: Session (Set.Set ProgressToken)
541 getIncompleteProgressSessions = curProgressSessions <$> get
543 -- | Executes a command.
544 executeCommand :: Command -> Session ()
545 executeCommand cmd = do
546 let args = decode $ encode $ fromJust $ cmd ^. arguments
547 execParams = ExecuteCommandParams Nothing (cmd ^. command) args
548 void $ sendRequest SWorkspaceExecuteCommand execParams
550 -- | Executes a code action.
551 -- Matching with the specification, if a code action
552 -- contains both an edit and a command, the edit will
554 executeCodeAction :: CodeAction -> Session ()
555 executeCodeAction action = do
556 maybe (return ()) handleEdit $ action ^. edit
557 maybe (return ()) executeCommand $ action ^. command
559 where handleEdit :: WorkspaceEdit -> Session ()
561 -- Its ok to pass in dummy parameters here as they aren't used
562 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e)
563 in updateState (FromServerMess SWorkspaceApplyEdit req)
565 -- | Adds the current version to the document, as tracked by the session.
566 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
567 getVersionedDoc (TextDocumentIdentifier uri) = do
568 fs <- vfsMap . vfs <$> get
570 case fs Map.!? toNormalizedUri uri of
571 Just vf -> Just (virtualFileVersion vf)
573 return (VersionedTextDocumentIdentifier uri ver)
575 -- | Applys an edit to the document and returns the updated document version.
576 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
577 applyEdit doc edit = do
579 verDoc <- getVersionedDoc doc
581 caps <- asks sessionCapabilities
583 let supportsDocChanges = fromMaybe False $ do
584 let mWorkspace = caps ^. LSP.workspace
585 C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
586 C.WorkspaceEditClientCapabilities mDocChanges _ _ <- mEdit
589 let wEdit = if supportsDocChanges
591 let docEdit = TextDocumentEdit verDoc (List [edit])
592 in WorkspaceEdit Nothing (Just (List [InL docEdit]))
594 let changes = HashMap.singleton (doc ^. uri) (List [edit])
595 in WorkspaceEdit (Just changes) Nothing
597 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
598 updateState (FromServerMess SWorkspaceApplyEdit req)
600 -- version may have changed
603 -- | Returns the completions for the position in the document.
604 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
605 getCompletions doc pos = do
606 rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing)
608 case getResponseResult rsp of
609 InL (List items) -> return items
610 InR (CompletionList _ (List items)) -> return items
612 -- | Returns the references for the position in the document.
613 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
614 -> Position -- ^ The position to lookup.
615 -> Bool -- ^ Whether to include declarations as references.
616 -> Session (List Location) -- ^ The locations of the references.
617 getReferences doc pos inclDecl =
618 let ctx = ReferenceContext inclDecl
619 params = ReferenceParams doc pos Nothing Nothing ctx
620 in getResponseResult <$> request STextDocumentReferences params
622 -- | Returns the declarations(s) for the term at the specified position.
623 getDeclarations :: TextDocumentIdentifier -- ^ The document the term is in.
624 -> Position -- ^ The position the term is at.
625 -> Session ([Location] |? [LocationLink])
626 getDeclarations = getDeclarationyRequest STextDocumentDeclaration DeclarationParams
628 -- | Returns the definition(s) for the term at the specified position.
629 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
630 -> Position -- ^ The position the term is at.
631 -> Session ([Location] |? [LocationLink])
632 getDefinitions = getDeclarationyRequest STextDocumentDefinition DefinitionParams
634 -- | Returns the type definition(s) for the term at the specified position.
635 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
636 -> Position -- ^ The position the term is at.
637 -> Session ([Location] |? [LocationLink])
638 getTypeDefinitions = getDeclarationyRequest STextDocumentTypeDefinition TypeDefinitionParams
640 -- | Returns the type definition(s) for the term at the specified position.
641 getImplementations :: TextDocumentIdentifier -- ^ The document the term is in.
642 -> Position -- ^ The position the term is at.
643 -> Session ([Location] |? [LocationLink])
644 getImplementations = getDeclarationyRequest STextDocumentImplementation ImplementationParams
647 getDeclarationyRequest :: (ResponseResult m ~ (Location |? (List Location |? List LocationLink)))
649 -> (TextDocumentIdentifier
651 -> Maybe ProgressToken
652 -> Maybe ProgressToken
654 -> TextDocumentIdentifier
656 -> Session ([Location] |? [LocationLink])
657 getDeclarationyRequest method paramCons doc pos = do
658 let params = paramCons doc pos Nothing Nothing
659 rsp <- request method params
660 case getResponseResult rsp of
661 InL loc -> pure (InL [loc])
662 InR (InL (List locs)) -> pure (InL locs)
663 InR (InR (List locLinks)) -> pure (InR locLinks)
665 -- | Renames the term at the specified position.
666 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
667 rename doc pos newName = do
668 let params = RenameParams doc pos Nothing (T.pack newName)
669 rsp <- request STextDocumentRename params
670 let wEdit = getResponseResult rsp
671 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
672 updateState (FromServerMess SWorkspaceApplyEdit req)
674 -- | Returns the hover information at the specified position.
675 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
677 let params = HoverParams doc pos Nothing
678 in getResponseResult <$> request STextDocumentHover params
680 -- | Returns the highlighted occurences of the term at the specified position
681 getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
682 getHighlights doc pos =
683 let params = DocumentHighlightParams doc pos Nothing Nothing
684 in getResponseResult <$> request STextDocumentDocumentHighlight params
686 -- | Checks the response for errors and throws an exception if needed.
687 -- Returns the result if successful.
688 getResponseResult :: ResponseMessage m -> ResponseResult m
689 getResponseResult rsp =
690 case rsp ^. result of
692 Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
694 -- | Applies formatting to the specified document.
695 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
696 formatDoc doc opts = do
697 let params = DocumentFormattingParams Nothing doc opts
698 edits <- getResponseResult <$> request STextDocumentFormatting params
699 applyTextEdits doc edits
701 -- | Applies formatting to the specified range in a document.
702 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
703 formatRange doc opts range = do
704 let params = DocumentRangeFormattingParams Nothing doc range opts
705 edits <- getResponseResult <$> request STextDocumentRangeFormatting params
706 applyTextEdits doc edits
708 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
709 applyTextEdits doc edits =
710 let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
711 -- Send a dummy message to updateState so it can do bookkeeping
712 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
713 in updateState (FromServerMess SWorkspaceApplyEdit req)
715 -- | Returns the code lenses for the specified document.
716 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
717 getCodeLenses tId = do
718 rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId)
719 case getResponseResult rsp of
722 -- | Returns a list of capabilities that the server has requested to /dynamically/
723 -- register during the 'Session'.
726 getRegisteredCapabilities :: Session [SomeRegistration]
727 getRegisteredCapabilities = Map.elems . curDynCaps <$> get