1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE TypeOperators #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE KindSignatures #-}
5 {-# LANGUAGE DataKinds #-}
7 {-# LANGUAGE RankNTypes #-}
8 {-# LANGUAGE PolyKinds #-}
9 {-# LANGUAGE ScopedTypeVariables #-}
10 {-# LANGUAGE ExistentialQuantification #-}
13 Module : Language.Haskell.LSP.Test
14 Description : A functional testing framework for LSP servers.
15 Maintainer : luke_lau@icloud.com
16 Stability : experimental
17 Portability : non-portable
19 Provides the framework to start functionally testing
20 <https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>.
21 You should import "Language.Haskell.LSP.Types" alongside this.
23 module Language.Haskell.LSP.Test
28 , runSessionWithConfig
29 , runSessionWithHandles
35 , module Language.Haskell.LSP.Test.Exceptions
44 , module Language.Haskell.LSP.Test.Parsing
46 -- | Quick helper functions for common tasks.
63 , waitForDiagnosticsSource
65 , getCurrentDiagnostics
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.Text as T
106 import qualified Data.Text.IO as T
109 import qualified Data.HashMap.Strict as HashMap
112 import Language.Haskell.LSP.Types
113 import Language.Haskell.LSP.Types.Lens hiding
114 (id, capabilities, message, executeCommand, applyEdit, rename)
115 import qualified Language.Haskell.LSP.Types.Lens as LSP
116 import qualified Language.Haskell.LSP.Types.Capabilities as C
117 import Language.Haskell.LSP.VFS
118 import Language.Haskell.LSP.Test.Compat
119 import Language.Haskell.LSP.Test.Decoding
120 import Language.Haskell.LSP.Test.Exceptions
121 import Language.Haskell.LSP.Test.Parsing
122 import Language.Haskell.LSP.Test.Session
123 import Language.Haskell.LSP.Test.Server
124 import System.Environment
126 import System.Directory
127 import System.FilePath
128 import System.Process (ProcessHandle)
129 import qualified System.FilePath.Glob as Glob
131 -- | Starts a new session.
133 -- > runSession "hie" fullCaps "path/to/root/dir" $ do
134 -- > doc <- openDoc "Desktop/simple.hs" "haskell"
135 -- > diags <- waitForDiagnostics
136 -- > let pos = Position 12 5
137 -- > params = TextDocumentPositionParams doc
138 -- > hover <- request TextDocumentHover params
139 runSession :: String -- ^ The command to run the server.
140 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
141 -> FilePath -- ^ The filepath to the root directory for the session.
142 -> Session a -- ^ The session to run.
144 runSession = runSessionWithConfig def
146 -- | Starts a new sesion with a custom configuration.
147 runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
148 -> String -- ^ The command to run the server.
149 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
150 -> FilePath -- ^ The filepath to the root directory for the session.
151 -> Session a -- ^ The session to run.
153 runSessionWithConfig config' serverExe caps rootDir session = do
154 config <- envOverrideConfig config'
155 withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
156 runSessionWithHandles' (Just serverProc) serverIn serverOut config caps rootDir session
158 -- | Starts a new session, using the specified handles to communicate with the
159 -- server. You can use this to host the server within the same process.
160 -- An example with haskell-lsp might look like:
162 -- > (hinRead, hinWrite) <- createPipe
163 -- > (houtRead, houtWrite) <- createPipe
165 -- > forkIO $ void $ runWithHandles hinRead houtWrite initCallbacks handlers def
166 -- > Test.runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
168 runSessionWithHandles :: Handle -- ^ The input handle
169 -> Handle -- ^ The output handle
171 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
172 -> FilePath -- ^ The filepath to the root directory for the session.
173 -> Session a -- ^ The session to run.
175 runSessionWithHandles = runSessionWithHandles' Nothing
178 runSessionWithHandles' :: Maybe ProcessHandle
179 -> Handle -- ^ The input handle
180 -> Handle -- ^ The output handle
182 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
183 -> FilePath -- ^ The filepath to the root directory for the session.
184 -> Session a -- ^ The session to run.
186 runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir session = do
187 pid <- getCurrentProcessID
188 absRootDir <- canonicalizePath rootDir
190 config <- envOverrideConfig config'
192 let initializeParams = InitializeParams Nothing
194 (Just lspTestClientInfo)
195 (Just $ T.pack absRootDir)
196 (Just $ filePathToUri absRootDir)
200 (List <$> initialWorkspaceFolders config)
201 runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
202 -- Wrap the session around initialize and shutdown calls
203 -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
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 (Nothing :: Maybe Value) >> 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 :: ApplyWorkspaceEditRequest -> Bool
289 checkDocumentChanges req =
290 let changes = req ^. params . edit . documentChanges
291 maybeDocs = fmap (fmap (^. textDocument . uri)) changes
293 Just docs -> (doc ^. uri) `elem` docs
295 checkChanges :: ApplyWorkspaceEditRequest -> Bool
297 let mMap = req ^. params . edit . changes
298 in maybe False (HashMap.member (doc ^. uri)) mMap
300 -- | Sends a request to the server and waits for its response.
301 -- Will skip any messages in between the request and the response
303 -- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
305 -- Note: will skip any messages in between the request and the response.
306 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
307 request m = sendRequest m >=> skipManyTill anyMessage . responseForId m
309 -- | The same as 'sendRequest', but discard the response.
310 request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
311 request_ p = void . request p
313 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
315 :: SClientMethod m -- ^ The request method.
316 -> MessageParams m -- ^ The request parameters.
317 -> Session (LspId m) -- ^ The id of the request that was sent.
318 sendRequest method params = do
319 idn <- curReqId <$> get
320 modify $ \c -> c { curReqId = idn+1 }
323 let mess = RequestMessage "2.0" id method params
325 -- Update the request map
326 reqMap <- requestMap <$> ask
327 liftIO $ modifyMVar_ reqMap $
328 \r -> return $ fromJust $ updateRequestMap r id method
330 ~() <- case splitClientMethod method of
331 IsClientReq -> sendMessage mess
332 IsClientEither -> sendMessage $ ReqMess mess
336 -- | Sends a notification to the server.
337 sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
338 -> MessageParams m -- ^ The notification parameters.
340 -- Open a virtual file if we send a did open text document notification
341 sendNotification STextDocumentDidOpen params = do
342 let n = NotificationMessage "2.0" STextDocumentDidOpen params
343 oldVFS <- vfs <$> get
344 let (newVFS,_) = openVFS oldVFS n
345 modify (\s -> s { vfs = newVFS })
348 -- Close a virtual file if we send a close text document notification
349 sendNotification STextDocumentDidClose params = do
350 let n = NotificationMessage "2.0" STextDocumentDidClose params
351 oldVFS <- vfs <$> get
352 let (newVFS,_) = closeVFS oldVFS n
353 modify (\s -> s { vfs = newVFS })
356 sendNotification STextDocumentDidChange params = do
357 let n = NotificationMessage "2.0" STextDocumentDidChange params
358 oldVFS <- vfs <$> get
359 let (newVFS,_) = changeFromClientVFS oldVFS n
360 modify (\s -> s { vfs = newVFS })
363 sendNotification method params =
364 case splitClientMethod method of
365 IsClientNot -> sendMessage (NotificationMessage "2.0" method params)
366 IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
368 -- | Sends a response to the server.
369 sendResponse :: ToJSON (ResponseParams m) => ResponseMessage m -> Session ()
370 sendResponse = sendMessage
372 -- | Returns the initialize response that was received from the server.
373 -- The initialize requests and responses are not included the session,
374 -- so if you need to test it use this.
375 initializeResponse :: Session InitializeResponse
376 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
378 -- | /Creates/ a new text document. This is different from 'openDoc'
379 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
380 -- know that a file was created within the workspace, __provided that the server
381 -- has registered for it__, and the file matches any patterns the server
383 -- It /does not/ actually create a file on disk, but is useful for convincing
384 -- the server that one does exist.
387 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
388 -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
389 -> T.Text -- ^ The content of the text document to create.
390 -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
391 createDoc file languageId contents = do
392 dynCaps <- curDynCaps <$> get
393 rootDir <- asks rootDir
394 caps <- asks sessionCapabilities
395 absFile <- liftIO $ canonicalizePath (rootDir </> file)
396 let pred :: SomeRegistration -> [Registration WorkspaceDidChangeWatchedFiles]
397 pred (SomeRegistration r@(Registration _ SWorkspaceDidChangeWatchedFiles _)) = [r]
399 regs = concatMap pred $ Map.elems dynCaps
400 watchHits :: FileSystemWatcher -> Bool
401 watchHits (FileSystemWatcher pattern kind) =
402 -- If WatchKind is exlcuded, defaults to all true as per spec
403 fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
405 fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
406 -- If the pattern is absolute then match against the absolute fp
408 | isAbsolute pattern = absFile
411 createHits (WatchKind create _ _) = create
413 regHits :: Registration WorkspaceDidChangeWatchedFiles -> Bool
414 regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. registerOptions . watchers)
417 caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
419 shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
422 sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
423 List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
424 openDoc' file languageId contents
426 -- | Opens a text document that /exists on disk/, and sends a
427 -- textDocument/didOpen notification to the server.
428 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
429 openDoc file languageId = do
431 let fp = rootDir context </> file
432 contents <- liftIO $ T.readFile fp
433 openDoc' file languageId contents
435 -- | This is a variant of `openDoc` that takes the file content as an argument.
436 -- Use this is the file exists /outside/ of the current workspace.
437 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
438 openDoc' file languageId contents = do
440 let fp = rootDir context </> file
441 uri = filePathToUri fp
442 item = TextDocumentItem uri (T.pack languageId) 0 contents
443 sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
444 pure $ TextDocumentIdentifier uri
446 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
447 closeDoc :: TextDocumentIdentifier -> Session ()
449 let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
450 sendNotification STextDocumentDidClose params
452 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
453 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
454 changeDoc docId changes = do
455 verDoc <- getVersionedDoc docId
456 let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
457 sendNotification STextDocumentDidChange params
459 -- | Gets the Uri for the file corrected to the session directory.
460 getDocUri :: FilePath -> Session Uri
463 let fp = rootDir context </> file
464 return $ filePathToUri fp
466 -- | Waits for diagnostics to be published and returns them.
467 waitForDiagnostics :: Session [Diagnostic]
468 waitForDiagnostics = do
469 diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics)
470 let (List diags) = diagsNot ^. params . LSP.diagnostics
473 -- | The same as 'waitForDiagnostics', but will only match a specific
474 -- 'Language.Haskell.LSP.Types._source'.
475 waitForDiagnosticsSource :: String -> Session [Diagnostic]
476 waitForDiagnosticsSource src = do
477 diags <- waitForDiagnostics
478 let res = filter matches diags
480 then waitForDiagnosticsSource src
483 matches :: Diagnostic -> Bool
484 matches d = d ^. source == Just (T.pack src)
486 -- | Expects a 'PublishDiagnosticsNotification' and throws an
487 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
489 noDiagnostics :: Session ()
491 diagsNot <- message STextDocumentPublishDiagnostics
492 when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
494 -- | Returns the symbols in a document.
495 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
496 getDocumentSymbols doc = do
497 ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) :: Session DocumentSymbolsResponse
499 Right (L (List xs)) -> return (Left xs)
500 Right (R (List xs)) -> return (Right xs)
501 Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
503 -- | Returns the code actions in the specified range.
504 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
505 getCodeActions doc range = do
506 ctx <- getCodeActionContext doc
507 rsp <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx)
509 case rsp ^. result of
510 Right (List xs) -> return xs
511 Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
513 -- | Returns all the code actions in a document by
514 -- querying the code actions at each of the current
515 -- diagnostics' positions.
516 getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
517 getAllCodeActions doc = do
518 ctx <- getCodeActionContext doc
520 foldM (go ctx) [] =<< getCurrentDiagnostics doc
523 go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
525 ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. range) ctx)
528 Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
529 Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
531 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
532 getCodeActionContext doc = do
533 curDiags <- getCurrentDiagnostics doc
534 return $ CodeActionContext (List curDiags) Nothing
536 -- | Returns the current diagnostics that have been sent to the client.
537 -- Note that this does not wait for more to come in.
538 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
539 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
541 -- | Executes a command.
542 executeCommand :: Command -> Session ()
543 executeCommand cmd = do
544 let args = decode $ encode $ fromJust $ cmd ^. arguments
545 execParams = ExecuteCommandParams Nothing (cmd ^. command) args
546 request_ SWorkspaceExecuteCommand execParams
548 -- | Executes a code action.
549 -- Matching with the specification, if a code action
550 -- contains both an edit and a command, the edit will
552 executeCodeAction :: CodeAction -> Session ()
553 executeCodeAction action = do
554 maybe (return ()) handleEdit $ action ^. edit
555 maybe (return ()) executeCommand $ action ^. command
557 where handleEdit :: WorkspaceEdit -> Session ()
559 -- Its ok to pass in dummy parameters here as they aren't used
560 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e)
561 in updateState (FromServerMess SWorkspaceApplyEdit req)
563 -- | Adds the current version to the document, as tracked by the session.
564 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
565 getVersionedDoc (TextDocumentIdentifier uri) = do
566 fs <- vfsMap . vfs <$> get
568 case fs Map.!? toNormalizedUri uri of
569 Just vf -> Just (virtualFileVersion vf)
571 return (VersionedTextDocumentIdentifier uri ver)
573 -- | Applys an edit to the document and returns the updated document version.
574 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
575 applyEdit doc edit = do
577 verDoc <- getVersionedDoc doc
579 caps <- asks sessionCapabilities
581 let supportsDocChanges = fromMaybe False $ do
582 let mWorkspace = caps ^. LSP.workspace
583 C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
584 C.WorkspaceEditClientCapabilities mDocChanges _ _ <- mEdit
587 let wEdit = if supportsDocChanges
589 let docEdit = TextDocumentEdit verDoc (List [edit])
590 in WorkspaceEdit Nothing (Just (List [docEdit]))
592 let changes = HashMap.singleton (doc ^. uri) (List [edit])
593 in WorkspaceEdit (Just changes) Nothing
595 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
596 updateState (FromServerMess SWorkspaceApplyEdit req)
598 -- version may have changed
601 -- | Returns the completions for the position in the document.
602 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
603 getCompletions doc pos = do
604 rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing)
606 case getResponseResult rsp of
607 L (List items) -> return items
608 R (CompletionList _ (List items)) -> return items
610 -- | Returns the references for the position in the document.
611 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
612 -> Position -- ^ The position to lookup.
613 -> Bool -- ^ Whether to include declarations as references.
614 -> Session (List Location) -- ^ The locations of the references.
615 getReferences doc pos inclDecl =
616 let ctx = ReferenceContext inclDecl
617 params = ReferenceParams doc pos Nothing Nothing ctx
618 in getResponseResult <$> request STextDocumentReferences params
620 -- | Returns the declarations(s) for the term at the specified position.
621 getDeclarations :: TextDocumentIdentifier -- ^ The document the term is in.
622 -> Position -- ^ The position the term is at.
623 -> Session ([Location] |? [LocationLink])
624 getDeclarations = getDeclarationyRequest STextDocumentDeclaration DeclarationParams
626 -- | Returns the definition(s) for the term at the specified position.
627 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
628 -> Position -- ^ The position the term is at.
629 -> Session ([Location] |? [LocationLink])
630 getDefinitions = getDeclarationyRequest STextDocumentDefinition DefinitionParams
632 -- | Returns the type definition(s) for the term at the specified position.
633 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
634 -> Position -- ^ The position the term is at.
635 -> Session ([Location] |? [LocationLink])
636 getTypeDefinitions = getDeclarationyRequest STextDocumentTypeDefinition TypeDefinitionParams
638 -- | Returns the type definition(s) for the term at the specified position.
639 getImplementations :: TextDocumentIdentifier -- ^ The document the term is in.
640 -> Position -- ^ The position the term is at.
641 -> Session ([Location] |? [LocationLink])
642 getImplementations = getDeclarationyRequest STextDocumentImplementation ImplementationParams
645 getDeclarationyRequest :: (ResponseParams m ~ (Location |? (List Location |? List LocationLink)))
647 -> (TextDocumentIdentifier
649 -> Maybe ProgressToken
650 -> Maybe ProgressToken
652 -> TextDocumentIdentifier
654 -> Session ([Location] |? [LocationLink])
655 getDeclarationyRequest method paramCons doc pos = do
656 let params = paramCons doc pos Nothing Nothing
657 rsp <- request method params
658 case getResponseResult rsp of
659 L loc -> pure (L [loc])
660 R (L (List locs)) -> pure (L locs)
661 R (R (List locLinks)) -> pure (R locLinks)
663 -- | Renames the term at the specified position.
664 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
665 rename doc pos newName = do
666 let params = RenameParams doc pos Nothing (T.pack newName)
667 rsp <- request STextDocumentRename params :: Session RenameResponse
668 let wEdit = getResponseResult rsp
669 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
670 updateState (FromServerMess SWorkspaceApplyEdit req)
672 -- | Returns the hover information at the specified position.
673 getHover :: TextDocumentIdentifier -> Position -> Session Hover
675 let params = HoverParams doc pos Nothing
676 in getResponseResult <$> request STextDocumentHover params
678 -- | Returns the highlighted occurences of the term at the specified position
679 getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
680 getHighlights doc pos =
681 let params = DocumentHighlightParams doc pos Nothing Nothing
682 in getResponseResult <$> request STextDocumentDocumentHighlight params
684 -- | Checks the response for errors and throws an exception if needed.
685 -- Returns the result if successful.
686 getResponseResult :: ResponseMessage m -> ResponseParams m
687 getResponseResult rsp =
688 case rsp ^. result of
690 Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
692 -- | Applies formatting to the specified document.
693 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
694 formatDoc doc opts = do
695 let params = DocumentFormattingParams Nothing doc opts
696 edits <- getResponseResult <$> request STextDocumentFormatting params
697 applyTextEdits doc edits
699 -- | Applies formatting to the specified range in a document.
700 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
701 formatRange doc opts range = do
702 let params = DocumentRangeFormattingParams Nothing doc range opts
703 edits <- getResponseResult <$> request STextDocumentRangeFormatting params
704 applyTextEdits doc edits
706 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
707 applyTextEdits doc edits =
708 let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
709 -- Send a dummy message to updateState so it can do bookkeeping
710 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
711 in updateState (FromServerMess SWorkspaceApplyEdit req)
713 -- | Returns the code lenses for the specified document.
714 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
715 getCodeLenses tId = do
716 rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId) :: Session CodeLensResponse
717 case getResponseResult rsp of
720 -- | Returns a list of capabilities that the server has requested to /dynamically/
721 -- register during the 'Session'.
724 getRegisteredCapabilities :: Session [SomeRegistration]
725 getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get