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 -- extract Uri out from DocumentChange
287 documentChangeUri :: DocumentChange -> Uri
288 documentChangeUri (InL x) = x ^. textDocument . uri
289 documentChangeUri (InR (InL x)) = x ^. uri
290 documentChangeUri (InR (InR (InL x))) = x ^. oldUri
291 documentChangeUri (InR (InR (InR x))) = x ^. uri
293 checkDocumentChanges req =
294 let changes = req ^. params . edit . documentChanges
295 maybeDocs = fmap (fmap documentChangeUri) changes
297 Just docs -> (doc ^. uri) `elem` docs
300 let mMap = req ^. params . edit . changes
301 in maybe False (HashMap.member (doc ^. uri)) mMap
303 -- | Sends a request to the server and waits for its response.
304 -- Will skip any messages in between the request and the response
306 -- rsp <- request STextDocumentDocumentSymbol params
308 -- Note: will skip any messages in between the request and the response.
309 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
310 request m = sendRequest m >=> skipManyTill anyMessage . responseForId m
312 -- | The same as 'sendRequest', but discard the response.
313 request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
314 request_ p = void . request p
316 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
318 :: SClientMethod m -- ^ The request method.
319 -> MessageParams m -- ^ The request parameters.
320 -> Session (LspId m) -- ^ The id of the request that was sent.
321 sendRequest method params = do
322 idn <- curReqId <$> get
323 modify $ \c -> c { curReqId = idn+1 }
326 let mess = RequestMessage "2.0" id method params
328 -- Update the request map
329 reqMap <- requestMap <$> ask
330 liftIO $ modifyMVar_ reqMap $
331 \r -> return $ fromJust $ updateRequestMap r id method
333 ~() <- case splitClientMethod method of
334 IsClientReq -> sendMessage mess
335 IsClientEither -> sendMessage $ ReqMess mess
339 -- | Sends a notification to the server.
340 sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
341 -> MessageParams m -- ^ The notification parameters.
343 -- Open a virtual file if we send a did open text document notification
344 sendNotification STextDocumentDidOpen params = do
345 let n = NotificationMessage "2.0" STextDocumentDidOpen params
346 oldVFS <- vfs <$> get
347 let (newVFS,_) = openVFS oldVFS n
348 modify (\s -> s { vfs = newVFS })
351 -- Close a virtual file if we send a close text document notification
352 sendNotification STextDocumentDidClose params = do
353 let n = NotificationMessage "2.0" STextDocumentDidClose params
354 oldVFS <- vfs <$> get
355 let (newVFS,_) = closeVFS oldVFS n
356 modify (\s -> s { vfs = newVFS })
359 sendNotification STextDocumentDidChange params = do
360 let n = NotificationMessage "2.0" STextDocumentDidChange params
361 oldVFS <- vfs <$> get
362 let (newVFS,_) = changeFromClientVFS oldVFS n
363 modify (\s -> s { vfs = newVFS })
366 sendNotification method params =
367 case splitClientMethod method of
368 IsClientNot -> sendMessage (NotificationMessage "2.0" method params)
369 IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
371 -- | Sends a response to the server.
372 sendResponse :: ToJSON (ResponseResult m) => ResponseMessage m -> Session ()
373 sendResponse = sendMessage
375 -- | Returns the initialize response that was received from the server.
376 -- The initialize requests and responses are not included the session,
377 -- so if you need to test it use this.
378 initializeResponse :: Session (ResponseMessage Initialize)
379 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
381 -- | /Creates/ a new text document. This is different from 'openDoc'
382 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
383 -- know that a file was created within the workspace, __provided that the server
384 -- has registered for it__, and the file matches any patterns the server
386 -- It /does not/ actually create a file on disk, but is useful for convincing
387 -- the server that one does exist.
390 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
391 -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
392 -> T.Text -- ^ The content of the text document to create.
393 -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
394 createDoc file languageId contents = do
395 dynCaps <- curDynCaps <$> get
396 rootDir <- asks rootDir
397 caps <- asks sessionCapabilities
398 absFile <- liftIO $ canonicalizePath (rootDir </> file)
399 let pred :: SomeRegistration -> [Registration WorkspaceDidChangeWatchedFiles]
400 pred (SomeRegistration r@(Registration _ SWorkspaceDidChangeWatchedFiles _)) = [r]
402 regs = concatMap pred $ Map.elems dynCaps
403 watchHits :: FileSystemWatcher -> Bool
404 watchHits (FileSystemWatcher pattern kind) =
405 -- If WatchKind is exlcuded, defaults to all true as per spec
406 fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
408 fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
409 -- If the pattern is absolute then match against the absolute fp
411 | isAbsolute pattern = absFile
414 createHits (WatchKind create _ _) = create
416 regHits :: Registration WorkspaceDidChangeWatchedFiles -> Bool
417 regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. registerOptions . watchers)
420 caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
422 shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
425 sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
426 List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
427 openDoc' file languageId contents
429 -- | Opens a text document that /exists on disk/, and sends a
430 -- textDocument/didOpen notification to the server.
431 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
432 openDoc file languageId = do
434 let fp = rootDir context </> file
435 contents <- liftIO $ T.readFile fp
436 openDoc' file languageId contents
438 -- | This is a variant of `openDoc` that takes the file content as an argument.
439 -- Use this is the file exists /outside/ of the current workspace.
440 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
441 openDoc' file languageId contents = do
443 let fp = rootDir context </> file
444 uri = filePathToUri fp
445 item = TextDocumentItem uri (T.pack languageId) 0 contents
446 sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
447 pure $ TextDocumentIdentifier uri
449 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
450 closeDoc :: TextDocumentIdentifier -> Session ()
452 let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
453 sendNotification STextDocumentDidClose params
455 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
456 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
457 changeDoc docId changes = do
458 verDoc <- getVersionedDoc docId
459 let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
460 sendNotification STextDocumentDidChange params
462 -- | Gets the Uri for the file corrected to the session directory.
463 getDocUri :: FilePath -> Session Uri
466 let fp = rootDir context </> file
467 return $ filePathToUri fp
469 -- | Waits for diagnostics to be published and returns them.
470 waitForDiagnostics :: Session [Diagnostic]
471 waitForDiagnostics = do
472 diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics)
473 let (List diags) = diagsNot ^. params . LSP.diagnostics
476 -- | The same as 'waitForDiagnostics', but will only match a specific
477 -- 'Language.LSP.Types._source'.
478 waitForDiagnosticsSource :: String -> Session [Diagnostic]
479 waitForDiagnosticsSource src = do
480 diags <- waitForDiagnostics
481 let res = filter matches diags
483 then waitForDiagnosticsSource src
486 matches :: Diagnostic -> Bool
487 matches d = d ^. source == Just (T.pack src)
489 -- | Expects a 'PublishDiagnosticsNotification' and throws an
490 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
492 noDiagnostics :: Session ()
494 diagsNot <- message STextDocumentPublishDiagnostics
495 when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
497 -- | Returns the symbols in a document.
498 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
499 getDocumentSymbols doc = do
500 ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc)
502 Right (InL (List xs)) -> return (Left xs)
503 Right (InR (List xs)) -> return (Right xs)
504 Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
506 -- | Returns the code actions in the specified range.
507 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
508 getCodeActions doc range = do
509 ctx <- getCodeActionContext doc
510 rsp <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx)
512 case rsp ^. result of
513 Right (List xs) -> return xs
514 Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
516 -- | Returns all the code actions in a document by
517 -- querying the code actions at each of the current
518 -- diagnostics' positions.
519 getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
520 getAllCodeActions doc = do
521 ctx <- getCodeActionContext doc
523 foldM (go ctx) [] =<< getCurrentDiagnostics doc
526 go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
528 ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. range) ctx)
531 Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
532 Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
534 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
535 getCodeActionContext doc = do
536 curDiags <- getCurrentDiagnostics doc
537 return $ CodeActionContext (List curDiags) Nothing
539 -- | Returns the current diagnostics that have been sent to the client.
540 -- Note that this does not wait for more to come in.
541 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
542 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
544 -- | Executes a command.
545 executeCommand :: Command -> Session ()
546 executeCommand cmd = do
547 let args = decode $ encode $ fromJust $ cmd ^. arguments
548 execParams = ExecuteCommandParams Nothing (cmd ^. command) args
549 void $ sendRequest SWorkspaceExecuteCommand execParams
551 -- | Executes a code action.
552 -- Matching with the specification, if a code action
553 -- contains both an edit and a command, the edit will
555 executeCodeAction :: CodeAction -> Session ()
556 executeCodeAction action = do
557 maybe (return ()) handleEdit $ action ^. edit
558 maybe (return ()) executeCommand $ action ^. command
560 where handleEdit :: WorkspaceEdit -> Session ()
562 -- Its ok to pass in dummy parameters here as they aren't used
563 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e)
564 in updateState (FromServerMess SWorkspaceApplyEdit req)
566 -- | Adds the current version to the document, as tracked by the session.
567 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
568 getVersionedDoc (TextDocumentIdentifier uri) = do
569 fs <- vfsMap . vfs <$> get
571 case fs Map.!? toNormalizedUri uri of
572 Just vf -> Just (virtualFileVersion vf)
574 return (VersionedTextDocumentIdentifier uri ver)
576 -- | Applys an edit to the document and returns the updated document version.
577 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
578 applyEdit doc edit = do
580 verDoc <- getVersionedDoc doc
582 caps <- asks sessionCapabilities
584 let supportsDocChanges = fromMaybe False $ do
585 let mWorkspace = caps ^. LSP.workspace
586 C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
587 C.WorkspaceEditClientCapabilities mDocChanges _ _ <- mEdit
590 let wEdit = if supportsDocChanges
592 let docEdit = TextDocumentEdit verDoc (List [edit])
593 in WorkspaceEdit Nothing (Just (List [InL docEdit]))
595 let changes = HashMap.singleton (doc ^. uri) (List [edit])
596 in WorkspaceEdit (Just changes) Nothing
598 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
599 updateState (FromServerMess SWorkspaceApplyEdit req)
601 -- version may have changed
604 -- | Returns the completions for the position in the document.
605 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
606 getCompletions doc pos = do
607 rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing)
609 case getResponseResult rsp of
610 InL (List items) -> return items
611 InR (CompletionList _ (List items)) -> return items
613 -- | Returns the references for the position in the document.
614 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
615 -> Position -- ^ The position to lookup.
616 -> Bool -- ^ Whether to include declarations as references.
617 -> Session (List Location) -- ^ The locations of the references.
618 getReferences doc pos inclDecl =
619 let ctx = ReferenceContext inclDecl
620 params = ReferenceParams doc pos Nothing Nothing ctx
621 in getResponseResult <$> request STextDocumentReferences params
623 -- | Returns the declarations(s) for the term at the specified position.
624 getDeclarations :: TextDocumentIdentifier -- ^ The document the term is in.
625 -> Position -- ^ The position the term is at.
626 -> Session ([Location] |? [LocationLink])
627 getDeclarations = getDeclarationyRequest STextDocumentDeclaration DeclarationParams
629 -- | Returns the definition(s) for the term at the specified position.
630 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
631 -> Position -- ^ The position the term is at.
632 -> Session ([Location] |? [LocationLink])
633 getDefinitions = getDeclarationyRequest STextDocumentDefinition DefinitionParams
635 -- | Returns the type definition(s) for the term at the specified position.
636 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
637 -> Position -- ^ The position the term is at.
638 -> Session ([Location] |? [LocationLink])
639 getTypeDefinitions = getDeclarationyRequest STextDocumentTypeDefinition TypeDefinitionParams
641 -- | Returns the type definition(s) for the term at the specified position.
642 getImplementations :: TextDocumentIdentifier -- ^ The document the term is in.
643 -> Position -- ^ The position the term is at.
644 -> Session ([Location] |? [LocationLink])
645 getImplementations = getDeclarationyRequest STextDocumentImplementation ImplementationParams
648 getDeclarationyRequest :: (ResponseResult m ~ (Location |? (List Location |? List LocationLink)))
650 -> (TextDocumentIdentifier
652 -> Maybe ProgressToken
653 -> Maybe ProgressToken
655 -> TextDocumentIdentifier
657 -> Session ([Location] |? [LocationLink])
658 getDeclarationyRequest method paramCons doc pos = do
659 let params = paramCons doc pos Nothing Nothing
660 rsp <- request method params
661 case getResponseResult rsp of
662 InL loc -> pure (InL [loc])
663 InR (InL (List locs)) -> pure (InL locs)
664 InR (InR (List locLinks)) -> pure (InR locLinks)
666 -- | Renames the term at the specified position.
667 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
668 rename doc pos newName = do
669 let params = RenameParams doc pos Nothing (T.pack newName)
670 rsp <- request STextDocumentRename params
671 let wEdit = getResponseResult rsp
672 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
673 updateState (FromServerMess SWorkspaceApplyEdit req)
675 -- | Returns the hover information at the specified position.
676 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
678 let params = HoverParams doc pos Nothing
679 in getResponseResult <$> request STextDocumentHover params
681 -- | Returns the highlighted occurences of the term at the specified position
682 getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
683 getHighlights doc pos =
684 let params = DocumentHighlightParams doc pos Nothing Nothing
685 in getResponseResult <$> request STextDocumentDocumentHighlight params
687 -- | Checks the response for errors and throws an exception if needed.
688 -- Returns the result if successful.
689 getResponseResult :: ResponseMessage m -> ResponseResult m
690 getResponseResult rsp =
691 case rsp ^. result of
693 Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
695 -- | Applies formatting to the specified document.
696 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
697 formatDoc doc opts = do
698 let params = DocumentFormattingParams Nothing doc opts
699 edits <- getResponseResult <$> request STextDocumentFormatting params
700 applyTextEdits doc edits
702 -- | Applies formatting to the specified range in a document.
703 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
704 formatRange doc opts range = do
705 let params = DocumentRangeFormattingParams Nothing doc range opts
706 edits <- getResponseResult <$> request STextDocumentRangeFormatting params
707 applyTextEdits doc edits
709 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
710 applyTextEdits doc edits =
711 let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
712 -- Send a dummy message to updateState so it can do bookkeeping
713 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
714 in updateState (FromServerMess SWorkspaceApplyEdit req)
716 -- | Returns the code lenses for the specified document.
717 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
718 getCodeLenses tId = do
719 rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId)
720 case getResponseResult rsp of
723 -- | Returns a list of capabilities that the server has requested to /dynamically/
724 -- register during the 'Session'.
727 getRegisteredCapabilities :: Session [SomeRegistration]
728 getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get