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 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 reqMap <- readMVar $ requestMap context
234 let msg = fst $ decodeFromServerMsg reqMap msgBytes
235 writeChan (messageChan context) (ServerMessage msg)
238 (FromServerRsp SShutdown _) -> return ()
239 _ -> listenServer serverOut context
241 -- | Is this message allowed to be sent by the server between the intialize
242 -- request and response?
243 -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
244 checkLegalBetweenMessage :: FromServerMessage -> Session ()
245 checkLegalBetweenMessage (FromServerMess SWindowShowMessage _) = pure ()
246 checkLegalBetweenMessage (FromServerMess SWindowLogMessage _) = pure ()
247 checkLegalBetweenMessage (FromServerMess STelemetryEvent _) = pure ()
248 checkLegalBetweenMessage (FromServerMess SWindowShowMessageRequest _) = pure ()
249 checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
251 -- | Check environment variables to override the config
252 envOverrideConfig :: SessionConfig -> IO SessionConfig
253 envOverrideConfig cfg = do
254 logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
255 logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
256 return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
257 where checkEnv :: String -> IO (Maybe Bool)
258 checkEnv s = fmap convertVal <$> lookupEnv s
259 convertVal "0" = False
262 -- | The current text contents of a document.
263 documentContents :: TextDocumentIdentifier -> Session T.Text
264 documentContents doc = do
266 let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
267 return (virtualFileText file)
269 -- | Parses an ApplyEditRequest, checks that it is for the passed document
270 -- and returns the new content
271 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
272 getDocumentEdit doc = do
273 req <- message SWorkspaceApplyEdit
275 unless (checkDocumentChanges req || checkChanges req) $
276 liftIO $ throw (IncorrectApplyEditRequest (show req))
280 checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
281 checkDocumentChanges req =
282 let changes = req ^. params . edit . documentChanges
283 maybeDocs = fmap (fmap (^. textDocument . uri)) changes
285 Just docs -> (doc ^. uri) `elem` docs
287 checkChanges :: ApplyWorkspaceEditRequest -> Bool
289 let mMap = req ^. params . edit . changes
290 in maybe False (HashMap.member (doc ^. uri)) mMap
292 -- | Sends a request to the server and waits for its response.
293 -- Will skip any messages in between the request and the response
295 -- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
297 -- Note: will skip any messages in between the request and the response.
298 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
299 request m = sendRequest m >=> skipManyTill anyMessage . responseForId
301 -- | The same as 'sendRequest', but discard the response.
302 request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
303 request_ p = void . request p
305 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
307 :: SClientMethod m -- ^ The request method.
308 -> MessageParams m -- ^ The request parameters.
309 -> Session (LspId m) -- ^ The id of the request that was sent.
310 sendRequest method params = do
311 idn <- curReqId <$> get
312 modify $ \c -> c { curReqId = idn+1 }
315 let mess = RequestMessage "2.0" id method params
317 -- Update the request map
318 reqMap <- requestMap <$> ask
319 liftIO $ modifyMVar_ reqMap $
320 \r -> return $ fromJust $ updateRequestMap r id method
322 ~() <- case splitClientMethod method of
323 IsClientReq -> sendMessage mess
324 IsClientEither -> sendMessage $ ReqMess mess
328 -- | Sends a notification to the server.
329 sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
330 -> MessageParams m -- ^ The notification parameters.
332 -- Open a virtual file if we send a did open text document notification
333 sendNotification STextDocumentDidOpen params = do
334 let n = NotificationMessage "2.0" STextDocumentDidOpen params
335 oldVFS <- vfs <$> get
336 let (newVFS,_) = openVFS oldVFS n
337 modify (\s -> s { vfs = newVFS })
340 -- Close a virtual file if we send a close text document notification
341 sendNotification STextDocumentDidClose params = do
342 let n = NotificationMessage "2.0" STextDocumentDidClose params
343 oldVFS <- vfs <$> get
344 let (newVFS,_) = closeVFS oldVFS n
345 modify (\s -> s { vfs = newVFS })
348 sendNotification STextDocumentDidChange params = do
349 let n = NotificationMessage "2.0" STextDocumentDidChange params
350 oldVFS <- vfs <$> get
351 let (newVFS,_) = changeFromClientVFS oldVFS n
352 modify (\s -> s { vfs = newVFS })
355 sendNotification method params =
356 case splitClientMethod method of
357 IsClientNot -> sendMessage (NotificationMessage "2.0" method params)
358 IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
360 -- | Sends a response to the server.
361 sendResponse :: ToJSON (ResponseParams m) => ResponseMessage m -> Session ()
362 sendResponse = sendMessage
364 -- | Returns the initialize response that was received from the server.
365 -- The initialize requests and responses are not included the session,
366 -- so if you need to test it use this.
367 initializeResponse :: Session InitializeResponse
368 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
370 -- | /Creates/ a new text document. This is different from 'openDoc'
371 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
372 -- know that a file was created within the workspace, __provided that the server
373 -- has registered for it__, and the file matches any patterns the server
375 -- It /does not/ actually create a file on disk, but is useful for convincing
376 -- the server that one does exist.
379 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
380 -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
381 -> T.Text -- ^ The content of the text document to create.
382 -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
383 createDoc file languageId contents = do
384 dynCaps <- curDynCaps <$> get
385 rootDir <- asks rootDir
386 caps <- asks sessionCapabilities
387 absFile <- liftIO $ canonicalizePath (rootDir </> file)
388 let pred :: SomeRegistration -> [Registration WorkspaceDidChangeWatchedFiles]
389 pred (SomeRegistration r@(Registration _ SWorkspaceDidChangeWatchedFiles _)) = [r]
391 regs = concatMap pred $ Map.elems dynCaps
392 watchHits :: FileSystemWatcher -> Bool
393 watchHits (FileSystemWatcher pattern kind) =
394 -- If WatchKind is exlcuded, defaults to all true as per spec
395 fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
397 fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
398 -- If the pattern is absolute then match against the absolute fp
400 | isAbsolute pattern = absFile
403 createHits (WatchKind create _ _) = create
405 regHits :: Registration WorkspaceDidChangeWatchedFiles -> Bool
406 regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. registerOptions . watchers)
409 caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
411 shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
414 sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
415 List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
416 openDoc' file languageId contents
418 -- | Opens a text document that /exists on disk/, and sends a
419 -- textDocument/didOpen notification to the server.
420 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
421 openDoc file languageId = do
423 let fp = rootDir context </> file
424 contents <- liftIO $ T.readFile fp
425 openDoc' file languageId contents
427 -- | This is a variant of `openDoc` that takes the file content as an argument.
428 -- Use this is the file exists /outside/ of the current workspace.
429 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
430 openDoc' file languageId contents = do
432 let fp = rootDir context </> file
433 uri = filePathToUri fp
434 item = TextDocumentItem uri (T.pack languageId) 0 contents
435 sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
436 pure $ TextDocumentIdentifier uri
438 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
439 closeDoc :: TextDocumentIdentifier -> Session ()
441 let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
442 sendNotification STextDocumentDidClose params
444 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
445 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
446 changeDoc docId changes = do
447 verDoc <- getVersionedDoc docId
448 let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
449 sendNotification STextDocumentDidChange params
451 -- | Gets the Uri for the file corrected to the session directory.
452 getDocUri :: FilePath -> Session Uri
455 let fp = rootDir context </> file
456 return $ filePathToUri fp
458 -- | Waits for diagnostics to be published and returns them.
459 waitForDiagnostics :: Session [Diagnostic]
460 waitForDiagnostics = do
461 diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics)
462 let (List diags) = diagsNot ^. params . LSP.diagnostics
465 -- | The same as 'waitForDiagnostics', but will only match a specific
466 -- 'Language.Haskell.LSP.Types._source'.
467 waitForDiagnosticsSource :: String -> Session [Diagnostic]
468 waitForDiagnosticsSource src = do
469 diags <- waitForDiagnostics
470 let res = filter matches diags
472 then waitForDiagnosticsSource src
475 matches :: Diagnostic -> Bool
476 matches d = d ^. source == Just (T.pack src)
478 -- | Expects a 'PublishDiagnosticsNotification' and throws an
479 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
481 noDiagnostics :: Session ()
483 diagsNot <- message STextDocumentPublishDiagnostics
484 when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
486 -- | Returns the symbols in a document.
487 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
488 getDocumentSymbols doc = do
489 ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) :: Session DocumentSymbolsResponse
491 Right (L (List xs)) -> return (Left xs)
492 Right (R (List xs)) -> return (Right xs)
493 Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
495 -- | Returns the code actions in the specified range.
496 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
497 getCodeActions doc range = do
498 ctx <- getCodeActionContext doc
499 rsp <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx)
501 case rsp ^. result of
502 Right (List xs) -> return xs
503 Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
505 -- | Returns all the code actions in a document by
506 -- querying the code actions at each of the current
507 -- diagnostics' positions.
508 getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
509 getAllCodeActions doc = do
510 ctx <- getCodeActionContext doc
512 foldM (go ctx) [] =<< getCurrentDiagnostics doc
515 go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
517 ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. range) ctx)
520 Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
521 Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
523 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
524 getCodeActionContext doc = do
525 curDiags <- getCurrentDiagnostics doc
526 return $ CodeActionContext (List curDiags) Nothing
528 -- | Returns the current diagnostics that have been sent to the client.
529 -- Note that this does not wait for more to come in.
530 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
531 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
533 -- | Executes a command.
534 executeCommand :: Command -> Session ()
535 executeCommand cmd = do
536 let args = decode $ encode $ fromJust $ cmd ^. arguments
537 execParams = ExecuteCommandParams Nothing (cmd ^. command) args
538 request_ SWorkspaceExecuteCommand execParams
540 -- | Executes a code action.
541 -- Matching with the specification, if a code action
542 -- contains both an edit and a command, the edit will
544 executeCodeAction :: CodeAction -> Session ()
545 executeCodeAction action = do
546 maybe (return ()) handleEdit $ action ^. edit
547 maybe (return ()) executeCommand $ action ^. command
549 where handleEdit :: WorkspaceEdit -> Session ()
551 -- Its ok to pass in dummy parameters here as they aren't used
552 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e)
553 in updateState (FromServerMess SWorkspaceApplyEdit req)
555 -- | Adds the current version to the document, as tracked by the session.
556 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
557 getVersionedDoc (TextDocumentIdentifier uri) = do
558 fs <- vfsMap . vfs <$> get
560 case fs Map.!? toNormalizedUri uri of
561 Just vf -> Just (virtualFileVersion vf)
563 return (VersionedTextDocumentIdentifier uri ver)
565 -- | Applys an edit to the document and returns the updated document version.
566 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
567 applyEdit doc edit = do
569 verDoc <- getVersionedDoc doc
571 caps <- asks sessionCapabilities
573 let supportsDocChanges = fromMaybe False $ do
574 let mWorkspace = caps ^. LSP.workspace
575 C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
576 C.WorkspaceEditClientCapabilities mDocChanges _ _ <- mEdit
579 let wEdit = if supportsDocChanges
581 let docEdit = TextDocumentEdit verDoc (List [edit])
582 in WorkspaceEdit Nothing (Just (List [docEdit]))
584 let changes = HashMap.singleton (doc ^. uri) (List [edit])
585 in WorkspaceEdit (Just changes) Nothing
587 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
588 updateState (FromServerMess SWorkspaceApplyEdit req)
590 -- version may have changed
593 -- | Returns the completions for the position in the document.
594 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
595 getCompletions doc pos = do
596 rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing)
598 case getResponseResult rsp of
599 L (List items) -> return items
600 R (CompletionList _ (List items)) -> return items
602 -- | Returns the references for the position in the document.
603 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
604 -> Position -- ^ The position to lookup.
605 -> Bool -- ^ Whether to include declarations as references.
606 -> Session (List Location) -- ^ The locations of the references.
607 getReferences doc pos inclDecl =
608 let ctx = ReferenceContext inclDecl
609 params = ReferenceParams doc pos Nothing Nothing ctx
610 in getResponseResult <$> request STextDocumentReferences params
612 -- | Returns the declarations(s) for the term at the specified position.
613 getDeclarations :: TextDocumentIdentifier -- ^ The document the term is in.
614 -> Position -- ^ The position the term is at.
615 -> Session ([Location] |? [LocationLink])
616 getDeclarations = getDeclarationyRequest STextDocumentDeclaration DeclarationParams
618 -- | Returns the definition(s) for the term at the specified position.
619 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
620 -> Position -- ^ The position the term is at.
621 -> Session ([Location] |? [LocationLink])
622 getDefinitions = getDeclarationyRequest STextDocumentDefinition DefinitionParams
624 -- | Returns the type definition(s) for the term at the specified position.
625 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
626 -> Position -- ^ The position the term is at.
627 -> Session ([Location] |? [LocationLink])
628 getTypeDefinitions = getDeclarationyRequest STextDocumentTypeDefinition TypeDefinitionParams
630 -- | Returns the type definition(s) for the term at the specified position.
631 getImplementations :: TextDocumentIdentifier -- ^ The document the term is in.
632 -> Position -- ^ The position the term is at.
633 -> Session ([Location] |? [LocationLink])
634 getImplementations = getDeclarationyRequest STextDocumentImplementation ImplementationParams
637 getDeclarationyRequest :: (ResponseParams m ~ (Location |? (List Location |? List LocationLink)))
639 -> (TextDocumentIdentifier
641 -> Maybe ProgressToken
642 -> Maybe ProgressToken
644 -> TextDocumentIdentifier
646 -> Session ([Location] |? [LocationLink])
647 getDeclarationyRequest method paramCons doc pos = do
648 let params = paramCons doc pos Nothing Nothing
649 rsp <- request method params
650 case getResponseResult rsp of
651 L loc -> pure (L [loc])
652 R (L (List locs)) -> pure (L locs)
653 R (R (List locLinks)) -> pure (R locLinks)
655 -- | Renames the term at the specified position.
656 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
657 rename doc pos newName = do
658 let params = RenameParams doc pos Nothing (T.pack newName)
659 rsp <- request STextDocumentRename params :: Session RenameResponse
660 let wEdit = getResponseResult rsp
661 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
662 updateState (FromServerMess SWorkspaceApplyEdit req)
664 -- | Returns the hover information at the specified position.
665 getHover :: TextDocumentIdentifier -> Position -> Session Hover
667 let params = HoverParams doc pos Nothing
668 in getResponseResult <$> request STextDocumentHover params
670 -- | Returns the highlighted occurences of the term at the specified position
671 getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
672 getHighlights doc pos =
673 let params = DocumentHighlightParams doc pos Nothing Nothing
674 in getResponseResult <$> request STextDocumentDocumentHighlight params
676 -- | Checks the response for errors and throws an exception if needed.
677 -- Returns the result if successful.
678 getResponseResult :: ResponseMessage m -> ResponseParams m
679 getResponseResult rsp =
680 case rsp ^. result of
682 Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
684 -- | Applies formatting to the specified document.
685 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
686 formatDoc doc opts = do
687 let params = DocumentFormattingParams Nothing doc opts
688 edits <- getResponseResult <$> request STextDocumentFormatting params
689 applyTextEdits doc edits
691 -- | Applies formatting to the specified range in a document.
692 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
693 formatRange doc opts range = do
694 let params = DocumentRangeFormattingParams Nothing doc range opts
695 edits <- getResponseResult <$> request STextDocumentRangeFormatting params
696 applyTextEdits doc edits
698 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
699 applyTextEdits doc edits =
700 let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
701 -- Send a dummy message to updateState so it can do bookkeeping
702 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
703 in updateState (FromServerMess SWorkspaceApplyEdit req)
705 -- | Returns the code lenses for the specified document.
706 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
707 getCodeLenses tId = do
708 rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId) :: Session CodeLensResponse
709 case getResponseResult rsp of
712 -- | Returns a list of capabilities that the server has requested to /dynamically/
713 -- register during the 'Session'.
716 getRegisteredCapabilities :: Session [SomeRegistration]
717 getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get