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
159 runSessionWithHandles :: Handle -- ^ The input handle
160 -> Handle -- ^ The output handle
162 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
163 -> FilePath -- ^ The filepath to the root directory for the session.
164 -> Session a -- ^ The session to run.
166 runSessionWithHandles = runSessionWithHandles' Nothing
169 runSessionWithHandles' :: Maybe ProcessHandle
170 -> Handle -- ^ The input handle
171 -> Handle -- ^ The output handle
173 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
174 -> FilePath -- ^ The filepath to the root directory for the session.
175 -> Session a -- ^ The session to run.
177 runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir session = do
178 pid <- getCurrentProcessID
179 absRootDir <- canonicalizePath rootDir
181 config <- envOverrideConfig config'
183 let initializeParams = InitializeParams Nothing
185 (Just lspTestClientInfo)
186 (Just $ T.pack absRootDir)
187 (Just $ filePathToUri absRootDir)
192 runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
193 -- Wrap the session around initialize and shutdown calls
194 -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
195 initReqId <- sendRequest SInitialize initializeParams
197 -- Because messages can be sent in between the request and response,
198 -- collect them and then...
199 (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId SInitialize initReqId)
201 case initRspMsg ^. LSP.result of
202 Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error)
205 initRspVar <- initRsp <$> ask
206 liftIO $ putMVar initRspVar initRspMsg
207 sendNotification SInitialized (Just InitializedParams)
209 case lspConfig config of
210 Just cfg -> sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
213 -- ... relay them back to the user Session so they can match on them!
214 -- As long as they are allowed.
215 forM_ inBetween checkLegalBetweenMessage
216 msgChan <- asks messageChan
217 liftIO $ writeList2Chan msgChan (ServerMessage <$> inBetween)
219 -- Run the actual test
222 -- | Asks the server to shutdown and exit politely
223 exitServer :: Session ()
224 exitServer = request_ SShutdown (Nothing :: Maybe Value) >> sendNotification SExit Empty
226 -- | Listens to the server output until the shutdown ack,
227 -- makes sure it matches the record and signals any semaphores
228 listenServer :: Handle -> SessionContext -> IO ()
229 listenServer serverOut context = do
230 msgBytes <- getNextMessage serverOut
232 msg <- modifyMVar (requestMap context) $ \reqMap ->
233 pure $ decodeFromServerMsg reqMap msgBytes
234 writeChan (messageChan context) (ServerMessage msg)
237 (FromServerRsp SShutdown _) -> return ()
238 _ -> listenServer serverOut context
240 -- | Is this message allowed to be sent by the server between the intialize
241 -- request and response?
242 -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
243 checkLegalBetweenMessage :: FromServerMessage -> Session ()
244 checkLegalBetweenMessage (FromServerMess SWindowShowMessage _) = pure ()
245 checkLegalBetweenMessage (FromServerMess SWindowLogMessage _) = pure ()
246 checkLegalBetweenMessage (FromServerMess STelemetryEvent _) = pure ()
247 checkLegalBetweenMessage (FromServerMess SWindowShowMessageRequest _) = pure ()
248 checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
250 -- | Check environment variables to override the config
251 envOverrideConfig :: SessionConfig -> IO SessionConfig
252 envOverrideConfig cfg = do
253 logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
254 logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
255 return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
256 where checkEnv :: String -> IO (Maybe Bool)
257 checkEnv s = fmap convertVal <$> lookupEnv s
258 convertVal "0" = False
261 -- | The current text contents of a document.
262 documentContents :: TextDocumentIdentifier -> Session T.Text
263 documentContents doc = do
265 let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
266 return (virtualFileText file)
268 -- | Parses an ApplyEditRequest, checks that it is for the passed document
269 -- and returns the new content
270 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
271 getDocumentEdit doc = do
272 req <- message SWorkspaceApplyEdit
274 unless (checkDocumentChanges req || checkChanges req) $
275 liftIO $ throw (IncorrectApplyEditRequest (show req))
279 checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
280 checkDocumentChanges req =
281 let changes = req ^. params . edit . documentChanges
282 maybeDocs = fmap (fmap (^. textDocument . uri)) changes
284 Just docs -> (doc ^. uri) `elem` docs
286 checkChanges :: ApplyWorkspaceEditRequest -> Bool
288 let mMap = req ^. params . edit . changes
289 in maybe False (HashMap.member (doc ^. uri)) mMap
291 -- | Sends a request to the server and waits for its response.
292 -- Will skip any messages in between the request and the response
294 -- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
296 -- Note: will skip any messages in between the request and the response.
297 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
298 request m = sendRequest m >=> skipManyTill anyMessage . responseForId m
300 -- | The same as 'sendRequest', but discard the response.
301 request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
302 request_ p = void . request p
304 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
306 :: SClientMethod m -- ^ The request method.
307 -> MessageParams m -- ^ The request parameters.
308 -> Session (LspId m) -- ^ The id of the request that was sent.
309 sendRequest method params = do
310 idn <- curReqId <$> get
311 modify $ \c -> c { curReqId = idn+1 }
314 let mess = RequestMessage "2.0" id method params
316 -- Update the request map
317 reqMap <- requestMap <$> ask
318 liftIO $ modifyMVar_ reqMap $
319 \r -> return $ fromJust $ updateRequestMap r id method
321 ~() <- case splitClientMethod method of
322 IsClientReq -> sendMessage mess
323 IsClientEither -> sendMessage $ ReqMess mess
327 -- | Sends a notification to the server.
328 sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
329 -> MessageParams m -- ^ The notification parameters.
331 -- Open a virtual file if we send a did open text document notification
332 sendNotification STextDocumentDidOpen params = do
333 let n = NotificationMessage "2.0" STextDocumentDidOpen params
334 oldVFS <- vfs <$> get
335 let (newVFS,_) = openVFS oldVFS n
336 modify (\s -> s { vfs = newVFS })
339 -- Close a virtual file if we send a close text document notification
340 sendNotification STextDocumentDidClose params = do
341 let n = NotificationMessage "2.0" STextDocumentDidClose params
342 oldVFS <- vfs <$> get
343 let (newVFS,_) = closeVFS oldVFS n
344 modify (\s -> s { vfs = newVFS })
347 sendNotification STextDocumentDidChange params = do
348 let n = NotificationMessage "2.0" STextDocumentDidChange params
349 oldVFS <- vfs <$> get
350 let (newVFS,_) = changeFromClientVFS oldVFS n
351 modify (\s -> s { vfs = newVFS })
354 sendNotification method params =
355 case splitClientMethod method of
356 IsClientNot -> sendMessage (NotificationMessage "2.0" method params)
357 IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
359 -- | Sends a response to the server.
360 sendResponse :: ToJSON (ResponseParams m) => ResponseMessage m -> Session ()
361 sendResponse = sendMessage
363 -- | Returns the initialize response that was received from the server.
364 -- The initialize requests and responses are not included the session,
365 -- so if you need to test it use this.
366 initializeResponse :: Session InitializeResponse
367 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
369 -- | /Creates/ a new text document. This is different from 'openDoc'
370 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
371 -- know that a file was created within the workspace, __provided that the server
372 -- has registered for it__, and the file matches any patterns the server
374 -- It /does not/ actually create a file on disk, but is useful for convincing
375 -- the server that one does exist.
378 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
379 -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
380 -> T.Text -- ^ The content of the text document to create.
381 -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
382 createDoc file languageId contents = do
383 dynCaps <- curDynCaps <$> get
384 rootDir <- asks rootDir
385 caps <- asks sessionCapabilities
386 absFile <- liftIO $ canonicalizePath (rootDir </> file)
387 let pred :: SomeRegistration -> [Registration WorkspaceDidChangeWatchedFiles]
388 pred (SomeRegistration r@(Registration _ SWorkspaceDidChangeWatchedFiles _)) = [r]
390 regs = concatMap pred $ Map.elems dynCaps
391 watchHits :: FileSystemWatcher -> Bool
392 watchHits (FileSystemWatcher pattern kind) =
393 -- If WatchKind is exlcuded, defaults to all true as per spec
394 fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
396 fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
397 -- If the pattern is absolute then match against the absolute fp
399 | isAbsolute pattern = absFile
402 createHits (WatchKind create _ _) = create
404 regHits :: Registration WorkspaceDidChangeWatchedFiles -> Bool
405 regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. registerOptions . watchers)
408 caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
410 shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
413 sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
414 List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
415 openDoc' file languageId contents
417 -- | Opens a text document that /exists on disk/, and sends a
418 -- textDocument/didOpen notification to the server.
419 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
420 openDoc file languageId = do
422 let fp = rootDir context </> file
423 contents <- liftIO $ T.readFile fp
424 openDoc' file languageId contents
426 -- | This is a variant of `openDoc` that takes the file content as an argument.
427 -- Use this is the file exists /outside/ of the current workspace.
428 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
429 openDoc' file languageId contents = do
431 let fp = rootDir context </> file
432 uri = filePathToUri fp
433 item = TextDocumentItem uri (T.pack languageId) 0 contents
434 sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
435 pure $ TextDocumentIdentifier uri
437 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
438 closeDoc :: TextDocumentIdentifier -> Session ()
440 let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
441 sendNotification STextDocumentDidClose params
443 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
444 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
445 changeDoc docId changes = do
446 verDoc <- getVersionedDoc docId
447 let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
448 sendNotification STextDocumentDidChange params
450 -- | Gets the Uri for the file corrected to the session directory.
451 getDocUri :: FilePath -> Session Uri
454 let fp = rootDir context </> file
455 return $ filePathToUri fp
457 -- | Waits for diagnostics to be published and returns them.
458 waitForDiagnostics :: Session [Diagnostic]
459 waitForDiagnostics = do
460 diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics)
461 let (List diags) = diagsNot ^. params . LSP.diagnostics
464 -- | The same as 'waitForDiagnostics', but will only match a specific
465 -- 'Language.Haskell.LSP.Types._source'.
466 waitForDiagnosticsSource :: String -> Session [Diagnostic]
467 waitForDiagnosticsSource src = do
468 diags <- waitForDiagnostics
469 let res = filter matches diags
471 then waitForDiagnosticsSource src
474 matches :: Diagnostic -> Bool
475 matches d = d ^. source == Just (T.pack src)
477 -- | Expects a 'PublishDiagnosticsNotification' and throws an
478 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
480 noDiagnostics :: Session ()
482 diagsNot <- message STextDocumentPublishDiagnostics
483 when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
485 -- | Returns the symbols in a document.
486 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
487 getDocumentSymbols doc = do
488 ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) :: Session DocumentSymbolsResponse
490 Right (L (List xs)) -> return (Left xs)
491 Right (R (List xs)) -> return (Right xs)
492 Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
494 -- | Returns the code actions in the specified range.
495 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
496 getCodeActions doc range = do
497 ctx <- getCodeActionContext doc
498 rsp <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx)
500 case rsp ^. result of
501 Right (List xs) -> return xs
502 Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
504 -- | Returns all the code actions in a document by
505 -- querying the code actions at each of the current
506 -- diagnostics' positions.
507 getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
508 getAllCodeActions doc = do
509 ctx <- getCodeActionContext doc
511 foldM (go ctx) [] =<< getCurrentDiagnostics doc
514 go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
516 ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. range) ctx)
519 Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
520 Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
522 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
523 getCodeActionContext doc = do
524 curDiags <- getCurrentDiagnostics doc
525 return $ CodeActionContext (List curDiags) Nothing
527 -- | Returns the current diagnostics that have been sent to the client.
528 -- Note that this does not wait for more to come in.
529 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
530 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
532 -- | Executes a command.
533 executeCommand :: Command -> Session ()
534 executeCommand cmd = do
535 let args = decode $ encode $ fromJust $ cmd ^. arguments
536 execParams = ExecuteCommandParams Nothing (cmd ^. command) args
537 request_ SWorkspaceExecuteCommand execParams
539 -- | Executes a code action.
540 -- Matching with the specification, if a code action
541 -- contains both an edit and a command, the edit will
543 executeCodeAction :: CodeAction -> Session ()
544 executeCodeAction action = do
545 maybe (return ()) handleEdit $ action ^. edit
546 maybe (return ()) executeCommand $ action ^. command
548 where handleEdit :: WorkspaceEdit -> Session ()
550 -- Its ok to pass in dummy parameters here as they aren't used
551 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e)
552 in updateState (FromServerMess SWorkspaceApplyEdit req)
554 -- | Adds the current version to the document, as tracked by the session.
555 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
556 getVersionedDoc (TextDocumentIdentifier uri) = do
557 fs <- vfsMap . vfs <$> get
559 case fs Map.!? toNormalizedUri uri of
560 Just vf -> Just (virtualFileVersion vf)
562 return (VersionedTextDocumentIdentifier uri ver)
564 -- | Applys an edit to the document and returns the updated document version.
565 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
566 applyEdit doc edit = do
568 verDoc <- getVersionedDoc doc
570 caps <- asks sessionCapabilities
572 let supportsDocChanges = fromMaybe False $ do
573 let mWorkspace = caps ^. LSP.workspace
574 C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
575 C.WorkspaceEditClientCapabilities mDocChanges _ _ <- mEdit
578 let wEdit = if supportsDocChanges
580 let docEdit = TextDocumentEdit verDoc (List [edit])
581 in WorkspaceEdit Nothing (Just (List [docEdit]))
583 let changes = HashMap.singleton (doc ^. uri) (List [edit])
584 in WorkspaceEdit (Just changes) Nothing
586 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
587 updateState (FromServerMess SWorkspaceApplyEdit req)
589 -- version may have changed
592 -- | Returns the completions for the position in the document.
593 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
594 getCompletions doc pos = do
595 rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing)
597 case getResponseResult rsp of
598 L (List items) -> return items
599 R (CompletionList _ (List items)) -> return items
601 -- | Returns the references for the position in the document.
602 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
603 -> Position -- ^ The position to lookup.
604 -> Bool -- ^ Whether to include declarations as references.
605 -> Session (List Location) -- ^ The locations of the references.
606 getReferences doc pos inclDecl =
607 let ctx = ReferenceContext inclDecl
608 params = ReferenceParams doc pos Nothing Nothing ctx
609 in getResponseResult <$> request STextDocumentReferences params
611 -- | Returns the declarations(s) for the term at the specified position.
612 getDeclarations :: TextDocumentIdentifier -- ^ The document the term is in.
613 -> Position -- ^ The position the term is at.
614 -> Session ([Location] |? [LocationLink])
615 getDeclarations = getDeclarationyRequest STextDocumentDeclaration DeclarationParams
617 -- | Returns the definition(s) for the term at the specified position.
618 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
619 -> Position -- ^ The position the term is at.
620 -> Session ([Location] |? [LocationLink])
621 getDefinitions = getDeclarationyRequest STextDocumentDefinition DefinitionParams
623 -- | Returns the type definition(s) for the term at the specified position.
624 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
625 -> Position -- ^ The position the term is at.
626 -> Session ([Location] |? [LocationLink])
627 getTypeDefinitions = getDeclarationyRequest STextDocumentTypeDefinition TypeDefinitionParams
629 -- | Returns the type definition(s) for the term at the specified position.
630 getImplementations :: TextDocumentIdentifier -- ^ The document the term is in.
631 -> Position -- ^ The position the term is at.
632 -> Session ([Location] |? [LocationLink])
633 getImplementations = getDeclarationyRequest STextDocumentImplementation ImplementationParams
636 getDeclarationyRequest :: (ResponseParams m ~ (Location |? (List Location |? List LocationLink)))
638 -> (TextDocumentIdentifier
640 -> Maybe ProgressToken
641 -> Maybe ProgressToken
643 -> TextDocumentIdentifier
645 -> Session ([Location] |? [LocationLink])
646 getDeclarationyRequest method paramCons doc pos = do
647 let params = paramCons doc pos Nothing Nothing
648 rsp <- request method params
649 case getResponseResult rsp of
650 L loc -> pure (L [loc])
651 R (L (List locs)) -> pure (L locs)
652 R (R (List locLinks)) -> pure (R locLinks)
654 -- | Renames the term at the specified position.
655 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
656 rename doc pos newName = do
657 let params = RenameParams doc pos Nothing (T.pack newName)
658 rsp <- request STextDocumentRename params :: Session RenameResponse
659 let wEdit = getResponseResult rsp
660 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
661 updateState (FromServerMess SWorkspaceApplyEdit req)
663 -- | Returns the hover information at the specified position.
664 getHover :: TextDocumentIdentifier -> Position -> Session Hover
666 let params = HoverParams doc pos Nothing
667 in getResponseResult <$> request STextDocumentHover params
669 -- | Returns the highlighted occurences of the term at the specified position
670 getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
671 getHighlights doc pos =
672 let params = DocumentHighlightParams doc pos Nothing Nothing
673 in getResponseResult <$> request STextDocumentDocumentHighlight params
675 -- | Checks the response for errors and throws an exception if needed.
676 -- Returns the result if successful.
677 getResponseResult :: ResponseMessage m -> ResponseParams m
678 getResponseResult rsp =
679 case rsp ^. result of
681 Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
683 -- | Applies formatting to the specified document.
684 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
685 formatDoc doc opts = do
686 let params = DocumentFormattingParams Nothing doc opts
687 edits <- getResponseResult <$> request STextDocumentFormatting params
688 applyTextEdits doc edits
690 -- | Applies formatting to the specified range in a document.
691 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
692 formatRange doc opts range = do
693 let params = DocumentRangeFormattingParams Nothing doc range opts
694 edits <- getResponseResult <$> request STextDocumentRangeFormatting params
695 applyTextEdits doc edits
697 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
698 applyTextEdits doc edits =
699 let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
700 -- Send a dummy message to updateState so it can do bookkeeping
701 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
702 in updateState (FromServerMess SWorkspaceApplyEdit req)
704 -- | Returns the code lenses for the specified document.
705 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
706 getCodeLenses tId = do
707 rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId) :: Session CodeLensResponse
708 case getResponseResult rsp of
711 -- | Returns a list of capabilities that the server has requested to /dynamically/
712 -- register during the 'Session'.
715 getRegisteredCapabilities :: Session [SomeRegistration]
716 getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get