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 TextDocumentHover 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 haskell-lsp might look like:
161 -- > (hinRead, hinWrite) <- createPipe
162 -- > (houtRead, houtWrite) <- createPipe
164 -- > forkIO $ void $ runWithHandles hinRead houtWrite initCallbacks handlers def
165 -- > Test.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 -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
203 initReqId <- sendRequest SInitialize initializeParams
205 -- Because messages can be sent in between the request and response,
206 -- collect them and then...
207 (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId SInitialize initReqId)
209 case initRspMsg ^. LSP.result of
210 Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error)
213 initRspVar <- initRsp <$> ask
214 liftIO $ putMVar initRspVar initRspMsg
215 sendNotification SInitialized (Just InitializedParams)
217 case lspConfig config of
218 Just cfg -> sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
221 -- ... relay them back to the user Session so they can match on them!
222 -- As long as they are allowed.
223 forM_ inBetween checkLegalBetweenMessage
224 msgChan <- asks messageChan
225 liftIO $ writeList2Chan msgChan (ServerMessage <$> inBetween)
227 -- Run the actual test
230 -- | Asks the server to shutdown and exit politely
231 exitServer :: Session ()
232 exitServer = request_ SShutdown Empty >> sendNotification SExit Empty
234 -- | Listens to the server output until the shutdown ack,
235 -- makes sure it matches the record and signals any semaphores
236 listenServer :: Handle -> SessionContext -> IO ()
237 listenServer serverOut context = do
238 msgBytes <- getNextMessage serverOut
240 msg <- modifyMVar (requestMap context) $ \reqMap ->
241 pure $ decodeFromServerMsg reqMap msgBytes
242 writeChan (messageChan context) (ServerMessage msg)
245 (FromServerRsp SShutdown _) -> return ()
246 _ -> listenServer serverOut context
248 -- | Is this message allowed to be sent by the server between the intialize
249 -- request and response?
250 -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
251 checkLegalBetweenMessage :: FromServerMessage -> Session ()
252 checkLegalBetweenMessage (FromServerMess SWindowShowMessage _) = pure ()
253 checkLegalBetweenMessage (FromServerMess SWindowLogMessage _) = pure ()
254 checkLegalBetweenMessage (FromServerMess STelemetryEvent _) = pure ()
255 checkLegalBetweenMessage (FromServerMess SWindowShowMessageRequest _) = pure ()
256 checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
258 -- | Check environment variables to override the config
259 envOverrideConfig :: SessionConfig -> IO SessionConfig
260 envOverrideConfig cfg = do
261 logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
262 logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
263 return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
264 where checkEnv :: String -> IO (Maybe Bool)
265 checkEnv s = fmap convertVal <$> lookupEnv s
266 convertVal "0" = False
269 -- | The current text contents of a document.
270 documentContents :: TextDocumentIdentifier -> Session T.Text
271 documentContents doc = do
273 let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
274 return (virtualFileText file)
276 -- | Parses an ApplyEditRequest, checks that it is for the passed document
277 -- and returns the new content
278 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
279 getDocumentEdit doc = do
280 req <- message SWorkspaceApplyEdit
282 unless (checkDocumentChanges req || checkChanges req) $
283 liftIO $ throw (IncorrectApplyEditRequest (show req))
287 checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
288 checkDocumentChanges req =
289 let changes = req ^. params . edit . documentChanges
290 maybeDocs = fmap (fmap (^. textDocument . uri)) changes
292 Just docs -> (doc ^. uri) `elem` docs
294 checkChanges :: ApplyWorkspaceEditRequest -> Bool
296 let mMap = req ^. params . edit . changes
297 in maybe False (HashMap.member (doc ^. uri)) mMap
299 -- | Sends a request to the server and waits for its response.
300 -- Will skip any messages in between the request and the response
302 -- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
304 -- Note: will skip any messages in between the request and the response.
305 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
306 request m = sendRequest m >=> skipManyTill anyMessage . responseForId m
308 -- | The same as 'sendRequest', but discard the response.
309 request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
310 request_ p = void . request p
312 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
314 :: SClientMethod m -- ^ The request method.
315 -> MessageParams m -- ^ The request parameters.
316 -> Session (LspId m) -- ^ The id of the request that was sent.
317 sendRequest method params = do
318 idn <- curReqId <$> get
319 modify $ \c -> c { curReqId = idn+1 }
322 let mess = RequestMessage "2.0" id method params
324 -- Update the request map
325 reqMap <- requestMap <$> ask
326 liftIO $ modifyMVar_ reqMap $
327 \r -> return $ fromJust $ updateRequestMap r id method
329 ~() <- case splitClientMethod method of
330 IsClientReq -> sendMessage mess
331 IsClientEither -> sendMessage $ ReqMess mess
335 -- | Sends a notification to the server.
336 sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
337 -> MessageParams m -- ^ The notification parameters.
339 -- Open a virtual file if we send a did open text document notification
340 sendNotification STextDocumentDidOpen params = do
341 let n = NotificationMessage "2.0" STextDocumentDidOpen params
342 oldVFS <- vfs <$> get
343 let (newVFS,_) = openVFS oldVFS n
344 modify (\s -> s { vfs = newVFS })
347 -- Close a virtual file if we send a close text document notification
348 sendNotification STextDocumentDidClose params = do
349 let n = NotificationMessage "2.0" STextDocumentDidClose params
350 oldVFS <- vfs <$> get
351 let (newVFS,_) = closeVFS oldVFS n
352 modify (\s -> s { vfs = newVFS })
355 sendNotification STextDocumentDidChange params = do
356 let n = NotificationMessage "2.0" STextDocumentDidChange params
357 oldVFS <- vfs <$> get
358 let (newVFS,_) = changeFromClientVFS oldVFS n
359 modify (\s -> s { vfs = newVFS })
362 sendNotification method params =
363 case splitClientMethod method of
364 IsClientNot -> sendMessage (NotificationMessage "2.0" method params)
365 IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
367 -- | Sends a response to the server.
368 sendResponse :: ToJSON (ResponseResult m) => ResponseMessage m -> Session ()
369 sendResponse = sendMessage
371 -- | Returns the initialize response that was received from the server.
372 -- The initialize requests and responses are not included the session,
373 -- so if you need to test it use this.
374 initializeResponse :: Session InitializeResponse
375 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
377 -- | /Creates/ a new text document. This is different from 'openDoc'
378 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
379 -- know that a file was created within the workspace, __provided that the server
380 -- has registered for it__, and the file matches any patterns the server
382 -- It /does not/ actually create a file on disk, but is useful for convincing
383 -- the server that one does exist.
386 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
387 -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
388 -> T.Text -- ^ The content of the text document to create.
389 -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
390 createDoc file languageId contents = do
391 dynCaps <- curDynCaps <$> get
392 rootDir <- asks rootDir
393 caps <- asks sessionCapabilities
394 absFile <- liftIO $ canonicalizePath (rootDir </> file)
395 let pred :: SomeRegistration -> [Registration WorkspaceDidChangeWatchedFiles]
396 pred (SomeRegistration r@(Registration _ SWorkspaceDidChangeWatchedFiles _)) = [r]
398 regs = concatMap pred $ Map.elems dynCaps
399 watchHits :: FileSystemWatcher -> Bool
400 watchHits (FileSystemWatcher pattern kind) =
401 -- If WatchKind is exlcuded, defaults to all true as per spec
402 fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
404 fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
405 -- If the pattern is absolute then match against the absolute fp
407 | isAbsolute pattern = absFile
410 createHits (WatchKind create _ _) = create
412 regHits :: Registration WorkspaceDidChangeWatchedFiles -> Bool
413 regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. registerOptions . watchers)
416 caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
418 shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
421 sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
422 List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
423 openDoc' file languageId contents
425 -- | Opens a text document that /exists on disk/, and sends a
426 -- textDocument/didOpen notification to the server.
427 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
428 openDoc file languageId = do
430 let fp = rootDir context </> file
431 contents <- liftIO $ T.readFile fp
432 openDoc' file languageId contents
434 -- | This is a variant of `openDoc` that takes the file content as an argument.
435 -- Use this is the file exists /outside/ of the current workspace.
436 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
437 openDoc' file languageId contents = do
439 let fp = rootDir context </> file
440 uri = filePathToUri fp
441 item = TextDocumentItem uri (T.pack languageId) 0 contents
442 sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
443 pure $ TextDocumentIdentifier uri
445 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
446 closeDoc :: TextDocumentIdentifier -> Session ()
448 let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
449 sendNotification STextDocumentDidClose params
451 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
452 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
453 changeDoc docId changes = do
454 verDoc <- getVersionedDoc docId
455 let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
456 sendNotification STextDocumentDidChange params
458 -- | Gets the Uri for the file corrected to the session directory.
459 getDocUri :: FilePath -> Session Uri
462 let fp = rootDir context </> file
463 return $ filePathToUri fp
465 -- | Waits for diagnostics to be published and returns them.
466 waitForDiagnostics :: Session [Diagnostic]
467 waitForDiagnostics = do
468 diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics)
469 let (List diags) = diagsNot ^. params . LSP.diagnostics
472 -- | The same as 'waitForDiagnostics', but will only match a specific
473 -- 'Language.LSP.Types._source'.
474 waitForDiagnosticsSource :: String -> Session [Diagnostic]
475 waitForDiagnosticsSource src = do
476 diags <- waitForDiagnostics
477 let res = filter matches diags
479 then waitForDiagnosticsSource src
482 matches :: Diagnostic -> Bool
483 matches d = d ^. source == Just (T.pack src)
485 -- | Expects a 'PublishDiagnosticsNotification' and throws an
486 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
488 noDiagnostics :: Session ()
490 diagsNot <- message STextDocumentPublishDiagnostics
491 when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
493 -- | Returns the symbols in a document.
494 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
495 getDocumentSymbols doc = do
496 ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) :: Session DocumentSymbolsResponse
498 Right (InL (List xs)) -> return (Left xs)
499 Right (InR (List xs)) -> return (Right xs)
500 Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
502 -- | Returns the code actions in the specified range.
503 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
504 getCodeActions doc range = do
505 ctx <- getCodeActionContext doc
506 rsp <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx)
508 case rsp ^. result of
509 Right (List xs) -> return xs
510 Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
512 -- | Returns all the code actions in a document by
513 -- querying the code actions at each of the current
514 -- diagnostics' positions.
515 getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
516 getAllCodeActions doc = do
517 ctx <- getCodeActionContext doc
519 foldM (go ctx) [] =<< getCurrentDiagnostics doc
522 go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
524 ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. range) ctx)
527 Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
528 Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
530 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
531 getCodeActionContext doc = do
532 curDiags <- getCurrentDiagnostics doc
533 return $ CodeActionContext (List curDiags) Nothing
535 -- | Returns the current diagnostics that have been sent to the client.
536 -- Note that this does not wait for more to come in.
537 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
538 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
540 -- | Executes a command.
541 executeCommand :: Command -> Session ()
542 executeCommand cmd = do
543 let args = decode $ encode $ fromJust $ cmd ^. arguments
544 execParams = ExecuteCommandParams Nothing (cmd ^. command) args
545 void $ sendRequest SWorkspaceExecuteCommand execParams
547 -- | Executes a code action.
548 -- Matching with the specification, if a code action
549 -- contains both an edit and a command, the edit will
551 executeCodeAction :: CodeAction -> Session ()
552 executeCodeAction action = do
553 maybe (return ()) handleEdit $ action ^. edit
554 maybe (return ()) executeCommand $ action ^. command
556 where handleEdit :: WorkspaceEdit -> Session ()
558 -- Its ok to pass in dummy parameters here as they aren't used
559 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e)
560 in updateState (FromServerMess SWorkspaceApplyEdit req)
562 -- | Adds the current version to the document, as tracked by the session.
563 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
564 getVersionedDoc (TextDocumentIdentifier uri) = do
565 fs <- vfsMap . vfs <$> get
567 case fs Map.!? toNormalizedUri uri of
568 Just vf -> Just (virtualFileVersion vf)
570 return (VersionedTextDocumentIdentifier uri ver)
572 -- | Applys an edit to the document and returns the updated document version.
573 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
574 applyEdit doc edit = do
576 verDoc <- getVersionedDoc doc
578 caps <- asks sessionCapabilities
580 let supportsDocChanges = fromMaybe False $ do
581 let mWorkspace = caps ^. LSP.workspace
582 C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
583 C.WorkspaceEditClientCapabilities mDocChanges _ _ <- mEdit
586 let wEdit = if supportsDocChanges
588 let docEdit = TextDocumentEdit verDoc (List [edit])
589 in WorkspaceEdit Nothing (Just (List [docEdit]))
591 let changes = HashMap.singleton (doc ^. uri) (List [edit])
592 in WorkspaceEdit (Just changes) Nothing
594 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
595 updateState (FromServerMess SWorkspaceApplyEdit req)
597 -- version may have changed
600 -- | Returns the completions for the position in the document.
601 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
602 getCompletions doc pos = do
603 rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing)
605 case getResponseResult rsp of
606 InL (List items) -> return items
607 InR (CompletionList _ (List items)) -> return items
609 -- | Returns the references for the position in the document.
610 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
611 -> Position -- ^ The position to lookup.
612 -> Bool -- ^ Whether to include declarations as references.
613 -> Session (List Location) -- ^ The locations of the references.
614 getReferences doc pos inclDecl =
615 let ctx = ReferenceContext inclDecl
616 params = ReferenceParams doc pos Nothing Nothing ctx
617 in getResponseResult <$> request STextDocumentReferences params
619 -- | Returns the declarations(s) for the term at the specified position.
620 getDeclarations :: TextDocumentIdentifier -- ^ The document the term is in.
621 -> Position -- ^ The position the term is at.
622 -> Session ([Location] |? [LocationLink])
623 getDeclarations = getDeclarationyRequest STextDocumentDeclaration DeclarationParams
625 -- | Returns the definition(s) for the term at the specified position.
626 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
627 -> Position -- ^ The position the term is at.
628 -> Session ([Location] |? [LocationLink])
629 getDefinitions = getDeclarationyRequest STextDocumentDefinition DefinitionParams
631 -- | Returns the type definition(s) for the term at the specified position.
632 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
633 -> Position -- ^ The position the term is at.
634 -> Session ([Location] |? [LocationLink])
635 getTypeDefinitions = getDeclarationyRequest STextDocumentTypeDefinition TypeDefinitionParams
637 -- | Returns the type definition(s) for the term at the specified position.
638 getImplementations :: TextDocumentIdentifier -- ^ The document the term is in.
639 -> Position -- ^ The position the term is at.
640 -> Session ([Location] |? [LocationLink])
641 getImplementations = getDeclarationyRequest STextDocumentImplementation ImplementationParams
644 getDeclarationyRequest :: (ResponseResult m ~ (Location |? (List Location |? List LocationLink)))
646 -> (TextDocumentIdentifier
648 -> Maybe ProgressToken
649 -> Maybe ProgressToken
651 -> TextDocumentIdentifier
653 -> Session ([Location] |? [LocationLink])
654 getDeclarationyRequest method paramCons doc pos = do
655 let params = paramCons doc pos Nothing Nothing
656 rsp <- request method params
657 case getResponseResult rsp of
658 InL loc -> pure (InL [loc])
659 InR (InL (List locs)) -> pure (InL locs)
660 InR (InR (List locLinks)) -> pure (InR locLinks)
662 -- | Renames the term at the specified position.
663 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
664 rename doc pos newName = do
665 let params = RenameParams doc pos Nothing (T.pack newName)
666 rsp <- request STextDocumentRename params :: Session RenameResponse
667 let wEdit = getResponseResult rsp
668 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
669 updateState (FromServerMess SWorkspaceApplyEdit req)
671 -- | Returns the hover information at the specified position.
672 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
674 let params = HoverParams doc pos Nothing
675 in getResponseResult <$> request STextDocumentHover params
677 -- | Returns the highlighted occurences of the term at the specified position
678 getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
679 getHighlights doc pos =
680 let params = DocumentHighlightParams doc pos Nothing Nothing
681 in getResponseResult <$> request STextDocumentDocumentHighlight params
683 -- | Checks the response for errors and throws an exception if needed.
684 -- Returns the result if successful.
685 getResponseResult :: ResponseMessage m -> ResponseResult m
686 getResponseResult rsp =
687 case rsp ^. result of
689 Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
691 -- | Applies formatting to the specified document.
692 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
693 formatDoc doc opts = do
694 let params = DocumentFormattingParams Nothing doc opts
695 edits <- getResponseResult <$> request STextDocumentFormatting params
696 applyTextEdits doc edits
698 -- | Applies formatting to the specified range in a document.
699 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
700 formatRange doc opts range = do
701 let params = DocumentRangeFormattingParams Nothing doc range opts
702 edits <- getResponseResult <$> request STextDocumentRangeFormatting params
703 applyTextEdits doc edits
705 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
706 applyTextEdits doc edits =
707 let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
708 -- Send a dummy message to updateState so it can do bookkeeping
709 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
710 in updateState (FromServerMess SWorkspaceApplyEdit req)
712 -- | Returns the code lenses for the specified document.
713 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
714 getCodeLenses tId = do
715 rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId) :: Session CodeLensResponse
716 case getResponseResult rsp of
719 -- | Returns a list of capabilities that the server has requested to /dynamically/
720 -- register during the 'Session'.
723 getRegisteredCapabilities :: Session [SomeRegistration]
724 getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get