1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE RankNTypes #-}
3 {-# LANGUAGE ScopedTypeVariables #-}
4 {-# LANGUAGE ExistentialQuantification #-}
7 Module : Language.Haskell.LSP.Test
8 Description : A functional testing framework for LSP servers.
9 Maintainer : luke_lau@icloud.com
10 Stability : experimental
11 Portability : non-portable
13 Provides the framework to start functionally testing
14 <https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>.
15 You should import "Language.Haskell.LSP.Types" alongside this.
17 module Language.Haskell.LSP.Test
23 , runSessionWithConfig
28 , module Language.Haskell.LSP.Test.Exceptions
37 , module Language.Haskell.LSP.Test.Parsing
39 -- | Quick helper functions for common tasks.
56 , waitForDiagnosticsSource
58 , getCurrentDiagnostics
59 , getIncompleteProgressSessions
87 , getRegisteredCapabilities
90 import Control.Applicative.Combinators
91 import Control.Concurrent
93 import Control.Monad.IO.Class
94 import Control.Exception
95 import Control.Lens hiding ((.=), List)
96 import qualified Data.Map.Strict as Map
97 import qualified Data.Set as Set
98 import qualified Data.Text as T
99 import qualified Data.Text.IO as T
102 import qualified Data.HashMap.Strict as HashMap
105 import Language.Haskell.LSP.Types
106 import Language.Haskell.LSP.Types.Lens hiding
107 (id, capabilities, message, executeCommand, applyEdit, rename)
108 import qualified Language.Haskell.LSP.Types.Lens as LSP
109 import qualified Language.Haskell.LSP.Types.Capabilities as C
110 import Language.Haskell.LSP.Messages
111 import Language.Haskell.LSP.VFS
112 import Language.Haskell.LSP.Test.Compat
113 import Language.Haskell.LSP.Test.Decoding
114 import Language.Haskell.LSP.Test.Exceptions
115 import Language.Haskell.LSP.Test.Parsing
116 import Language.Haskell.LSP.Test.Session
117 import Language.Haskell.LSP.Test.Server
118 import System.Environment
120 import System.Directory
121 import System.FilePath
122 import qualified System.FilePath.Glob as Glob
124 -- | Starts a new session.
126 -- > runSession "hie" fullCaps "path/to/root/dir" $ do
127 -- > doc <- openDoc "Desktop/simple.hs" "haskell"
128 -- > diags <- waitForDiagnostics
129 -- > let pos = Position 12 5
130 -- > params = TextDocumentPositionParams doc
131 -- > hover <- request TextDocumentHover params
132 runSession :: String -- ^ The command to run the server.
133 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
134 -> FilePath -- ^ The filepath to the root directory for the session.
135 -> Session a -- ^ The session to run.
137 runSession = runSessionWithConfig def
139 -- | Starts a new sesion with a custom configuration.
140 runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
141 -> String -- ^ The command to run the server.
142 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
143 -> FilePath -- ^ The filepath to the root directory for the session.
144 -> Session a -- ^ The session to run.
146 runSessionWithConfig config' serverExe caps rootDir session = do
147 pid <- getCurrentProcessID
148 absRootDir <- canonicalizePath rootDir
150 config <- envOverrideConfig config'
152 let initializeParams = InitializeParams (Just pid)
153 (Just $ T.pack absRootDir)
154 (Just $ filePathToUri absRootDir)
159 withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
160 runSessionWithHandles serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
161 -- Wrap the session around initialize and shutdown calls
162 -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
163 initReqId <- sendRequest Initialize initializeParams
165 -- Because messages can be sent in between the request and response,
166 -- collect them and then...
167 (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId initReqId)
169 case initRspMsg ^. LSP.result of
170 Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error)
173 initRspVar <- initRsp <$> ask
174 liftIO $ putMVar initRspVar initRspMsg
175 sendNotification Initialized InitializedParams
177 case lspConfig config of
178 Just cfg -> sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
181 -- ... relay them back to the user Session so they can match on them!
182 -- As long as they are allowed.
183 forM_ inBetween checkLegalBetweenMessage
184 msgChan <- asks messageChan
185 liftIO $ writeList2Chan msgChan (ServerMessage <$> inBetween)
187 -- Run the actual test
190 -- | Asks the server to shutdown and exit politely
191 exitServer :: Session ()
192 exitServer = request_ Shutdown (Nothing :: Maybe Value) >> sendNotification Exit ExitParams
194 -- | Listens to the server output until the shutdown ack,
195 -- makes sure it matches the record and signals any semaphores
196 listenServer :: Handle -> SessionContext -> IO ()
197 listenServer serverOut context = do
198 msgBytes <- getNextMessage serverOut
200 reqMap <- readMVar $ requestMap context
202 let msg = decodeFromServerMsg reqMap msgBytes
203 writeChan (messageChan context) (ServerMessage msg)
206 (RspShutdown _) -> return ()
207 _ -> listenServer serverOut context
209 -- | Is this message allowed to be sent by the server between the intialize
210 -- request and response?
211 -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
212 checkLegalBetweenMessage :: FromServerMessage -> Session ()
213 checkLegalBetweenMessage (NotShowMessage _) = pure ()
214 checkLegalBetweenMessage (NotLogMessage _) = pure ()
215 checkLegalBetweenMessage (NotTelemetry _) = pure ()
216 checkLegalBetweenMessage (ReqShowMessage _) = pure ()
217 checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
219 -- | Check environment variables to override the config
220 envOverrideConfig :: SessionConfig -> IO SessionConfig
221 envOverrideConfig cfg = do
222 logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
223 logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
224 return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
225 where checkEnv :: String -> IO (Maybe Bool)
226 checkEnv s = fmap convertVal <$> lookupEnv s
227 convertVal "0" = False
230 -- | The current text contents of a document.
231 documentContents :: TextDocumentIdentifier -> Session T.Text
232 documentContents doc = do
234 let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
235 return (virtualFileText file)
237 -- | Parses an ApplyEditRequest, checks that it is for the passed document
238 -- and returns the new content
239 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
240 getDocumentEdit doc = do
241 req <- message :: Session ApplyWorkspaceEditRequest
243 unless (checkDocumentChanges req || checkChanges req) $
244 liftIO $ throw (IncorrectApplyEditRequest (show req))
248 checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
249 checkDocumentChanges req =
250 let changes = req ^. params . edit . documentChanges
251 maybeDocs = fmap (fmap (^. textDocument . uri)) changes
253 Just docs -> (doc ^. uri) `elem` docs
255 checkChanges :: ApplyWorkspaceEditRequest -> Bool
257 let mMap = req ^. params . edit . changes
258 in maybe False (HashMap.member (doc ^. uri)) mMap
260 -- | Sends a request to the server and waits for its response.
261 -- Will skip any messages in between the request and the response
263 -- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
265 -- Note: will skip any messages in between the request and the response.
266 request :: (ToJSON params, FromJSON a) => ClientMethod -> params -> Session (ResponseMessage a)
267 request m = sendRequest m >=> skipManyTill anyMessage . responseForId
269 -- | The same as 'sendRequest', but discard the response.
270 request_ :: ToJSON params => ClientMethod -> params -> Session ()
271 request_ p = void . (request p :: ToJSON params => params -> Session (ResponseMessage Value))
273 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
276 => ClientMethod -- ^ The request method.
277 -> params -- ^ The request parameters.
278 -> Session LspId -- ^ The id of the request that was sent.
279 sendRequest method params = do
280 id <- curReqId <$> get
281 modify $ \c -> c { curReqId = nextId id }
283 let req = RequestMessage' "2.0" id method params
285 -- Update the request map
286 reqMap <- requestMap <$> ask
287 liftIO $ modifyMVar_ reqMap $
288 \r -> return $ updateRequestMap r id method
294 where nextId (IdInt i) = IdInt (i + 1)
295 nextId (IdString s) = IdString $ T.pack $ show $ read (T.unpack s) + 1
297 -- | A custom type for request message that doesn't
298 -- need a response type, allows us to infer the request
299 -- message type without using proxies.
300 data RequestMessage' a = RequestMessage' T.Text LspId ClientMethod a
302 instance ToJSON a => ToJSON (RequestMessage' a) where
303 toJSON (RequestMessage' rpc id method params) =
304 object ["jsonrpc" .= rpc, "id" .= id, "method" .= method, "params" .= params]
307 -- | Sends a notification to the server.
308 sendNotification :: ToJSON a
309 => ClientMethod -- ^ The notification method.
310 -> a -- ^ The notification parameters.
313 -- Open a virtual file if we send a did open text document notification
314 sendNotification TextDocumentDidOpen params = do
315 let params' = fromJust $ decode $ encode params
316 n :: DidOpenTextDocumentNotification
317 n = NotificationMessage "2.0" TextDocumentDidOpen params'
318 oldVFS <- vfs <$> get
319 let (newVFS,_) = openVFS oldVFS n
320 modify (\s -> s { vfs = newVFS })
323 -- Close a virtual file if we send a close text document notification
324 sendNotification TextDocumentDidClose params = do
325 let params' = fromJust $ decode $ encode params
326 n :: DidCloseTextDocumentNotification
327 n = NotificationMessage "2.0" TextDocumentDidClose params'
328 oldVFS <- vfs <$> get
329 let (newVFS,_) = closeVFS oldVFS n
330 modify (\s -> s { vfs = newVFS })
333 sendNotification TextDocumentDidChange params = do
334 let params' = fromJust $ decode $ encode params
335 n :: DidChangeTextDocumentNotification
336 n = NotificationMessage "2.0" TextDocumentDidChange params'
337 oldVFS <- vfs <$> get
338 let (newVFS,_) = changeFromClientVFS oldVFS n
339 modify (\s -> s { vfs = newVFS })
342 sendNotification method params = sendMessage (NotificationMessage "2.0" method params)
344 -- | Sends a response to the server.
345 sendResponse :: ToJSON a => ResponseMessage a -> Session ()
346 sendResponse = sendMessage
348 -- | Returns the initialize response that was received from the server.
349 -- The initialize requests and responses are not included the session,
350 -- so if you need to test it use this.
351 initializeResponse :: Session InitializeResponse
352 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
354 -- | /Creates/ a new text document. This is different from 'openDoc'
355 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
356 -- know that a file was created within the workspace, __provided that the server
357 -- has registered for it__, and the file matches any patterns the server
359 -- It /does not/ actually create a file on disk, but is useful for convincing
360 -- the server that one does exist.
363 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
364 -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
365 -> T.Text -- ^ The content of the text document to create.
366 -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
367 createDoc file languageId contents = do
368 dynCaps <- curDynCaps <$> get
369 rootDir <- asks rootDir
370 caps <- asks sessionCapabilities
371 absFile <- liftIO $ canonicalizePath (rootDir </> file)
372 let regs = filter (\r -> r ^. method == WorkspaceDidChangeWatchedFiles) $
374 watchHits :: FileSystemWatcher -> Bool
375 watchHits (FileSystemWatcher pattern kind) =
376 -- If WatchKind is exlcuded, defaults to all true as per spec
377 fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
379 fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
380 -- If the pattern is absolute then match against the absolute fp
382 | isAbsolute pattern = absFile
385 createHits (WatchKind create _ _) = create
387 regHits :: Registration -> Bool
388 regHits reg = isJust $ do
389 opts <- reg ^. registerOptions
390 fileWatchOpts <- case fromJSON opts :: Result DidChangeWatchedFilesRegistrationOptions of
393 if foldl' (\acc w -> acc || watchHits w) False (fileWatchOpts ^. watchers)
398 caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
400 shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
403 sendNotification WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
404 List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
405 openDoc' file languageId contents
407 -- | Opens a text document that /exists on disk/, and sends a
408 -- textDocument/didOpen notification to the server.
409 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
410 openDoc file languageId = do
412 let fp = rootDir context </> file
413 contents <- liftIO $ T.readFile fp
414 openDoc' file languageId contents
416 -- | This is a variant of `openDoc` that takes the file content as an argument.
417 -- Use this is the file exists /outside/ of the current workspace.
418 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
419 openDoc' file languageId contents = do
421 let fp = rootDir context </> file
422 uri = filePathToUri fp
423 item = TextDocumentItem uri (T.pack languageId) 0 contents
424 sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams item)
425 pure $ TextDocumentIdentifier uri
427 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
428 closeDoc :: TextDocumentIdentifier -> Session ()
430 let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
431 sendNotification TextDocumentDidClose params
433 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
434 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
435 changeDoc docId changes = do
436 verDoc <- getVersionedDoc docId
437 let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
438 sendNotification TextDocumentDidChange params
440 -- | Gets the Uri for the file corrected to the session directory.
441 getDocUri :: FilePath -> Session Uri
444 let fp = rootDir context </> file
445 return $ filePathToUri fp
447 -- | Waits for diagnostics to be published and returns them.
448 waitForDiagnostics :: Session [Diagnostic]
449 waitForDiagnostics = do
450 diagsNot <- skipManyTill anyMessage message :: Session PublishDiagnosticsNotification
451 let (List diags) = diagsNot ^. params . LSP.diagnostics
454 -- | The same as 'waitForDiagnostics', but will only match a specific
455 -- 'Language.Haskell.LSP.Types._source'.
456 waitForDiagnosticsSource :: String -> Session [Diagnostic]
457 waitForDiagnosticsSource src = do
458 diags <- waitForDiagnostics
459 let res = filter matches diags
461 then waitForDiagnosticsSource src
464 matches :: Diagnostic -> Bool
465 matches d = d ^. source == Just (T.pack src)
467 -- | Expects a 'PublishDiagnosticsNotification' and throws an
468 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
470 noDiagnostics :: Session ()
472 diagsNot <- message :: Session PublishDiagnosticsNotification
473 when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
475 -- | Returns the symbols in a document.
476 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
477 getDocumentSymbols doc = do
478 ResponseMessage _ rspLid res <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse
480 Right (DSDocumentSymbols (List xs)) -> return (Left xs)
481 Right (DSSymbolInformation (List xs)) -> return (Right xs)
482 Left err -> throw (UnexpectedResponseError rspLid err)
484 -- | Returns the code actions in the specified range.
485 getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
486 getCodeActions doc range = do
487 ctx <- getCodeActionContext doc
488 rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx Nothing)
490 case rsp ^. result of
491 Right (List xs) -> return xs
492 Left error -> throw (UnexpectedResponseError (rsp ^. LSP.id) error)
494 -- | Returns all the code actions in a document by
495 -- querying the code actions at each of the current
496 -- diagnostics' positions.
497 getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult]
498 getAllCodeActions doc = do
499 ctx <- getCodeActionContext doc
501 foldM (go ctx) [] =<< getCurrentDiagnostics doc
504 go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
506 ResponseMessage _ rspLid res <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing)
509 Left e -> throw (UnexpectedResponseError rspLid e)
510 Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
512 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
513 getCodeActionContext doc = do
514 curDiags <- getCurrentDiagnostics doc
515 return $ CodeActionContext (List curDiags) Nothing
517 -- | Returns the current diagnostics that have been sent to the client.
518 -- Note that this does not wait for more to come in.
519 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
520 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
522 -- | Returns the tokens of all progress sessions that have started but not yet ended.
523 getIncompleteProgressSessions :: Session (Set.Set ProgressToken)
524 getIncompleteProgressSessions = curProgressSessions <$> get
526 -- | Executes a command.
527 executeCommand :: Command -> Session ()
528 executeCommand cmd = do
529 let args = decode $ encode $ fromJust $ cmd ^. arguments
530 execParams = ExecuteCommandParams (cmd ^. command) args Nothing
531 request_ WorkspaceExecuteCommand execParams
533 -- | Executes a code action.
534 -- Matching with the specification, if a code action
535 -- contains both an edit and a command, the edit will
537 executeCodeAction :: CodeAction -> Session ()
538 executeCodeAction action = do
539 maybe (return ()) handleEdit $ action ^. edit
540 maybe (return ()) executeCommand $ action ^. command
542 where handleEdit :: WorkspaceEdit -> Session ()
544 -- Its ok to pass in dummy parameters here as they aren't used
545 let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams e)
546 in updateState (ReqApplyWorkspaceEdit req)
548 -- | Adds the current version to the document, as tracked by the session.
549 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
550 getVersionedDoc (TextDocumentIdentifier uri) = do
551 fs <- vfsMap . vfs <$> get
553 case fs Map.!? toNormalizedUri uri of
554 Just vf -> Just (virtualFileVersion vf)
556 return (VersionedTextDocumentIdentifier uri ver)
558 -- | Applys an edit to the document and returns the updated document version.
559 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
560 applyEdit doc edit = do
562 verDoc <- getVersionedDoc doc
564 caps <- asks sessionCapabilities
566 let supportsDocChanges = fromMaybe False $ do
567 let mWorkspace = C._workspace caps
568 C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
569 C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
572 let wEdit = if supportsDocChanges
574 let docEdit = TextDocumentEdit verDoc (List [edit])
575 in WorkspaceEdit Nothing (Just (List [docEdit]))
577 let changes = HashMap.singleton (doc ^. uri) (List [edit])
578 in WorkspaceEdit (Just changes) Nothing
580 let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
581 updateState (ReqApplyWorkspaceEdit req)
583 -- version may have changed
586 -- | Returns the completions for the position in the document.
587 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
588 getCompletions doc pos = do
589 rsp <- request TextDocumentCompletion (TextDocumentPositionParams doc pos Nothing)
591 case getResponseResult rsp of
592 Completions (List items) -> return items
593 CompletionList (CompletionListType _ (List items)) -> return items
595 -- | Returns the references for the position in the document.
596 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
597 -> Position -- ^ The position to lookup.
598 -> Bool -- ^ Whether to include declarations as references.
599 -> Session [Location] -- ^ The locations of the references.
600 getReferences doc pos inclDecl =
601 let ctx = ReferenceContext inclDecl
602 params = ReferenceParams doc pos ctx Nothing
603 in getResponseResult <$> request TextDocumentReferences params
605 -- | Returns the definition(s) for the term at the specified position.
606 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
607 -> Position -- ^ The position the term is at.
608 -> Session [Location] -- ^ The location(s) of the definitions
609 getDefinitions doc pos = do
610 let params = TextDocumentPositionParams doc pos Nothing
611 rsp <- request TextDocumentDefinition params :: Session DefinitionResponse
612 case getResponseResult rsp of
613 SingleLoc loc -> pure [loc]
614 MultiLoc locs -> pure locs
616 -- | Returns the type definition(s) for the term at the specified position.
617 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
618 -> Position -- ^ The position the term is at.
619 -> Session [Location] -- ^ The location(s) of the definitions
620 getTypeDefinitions doc pos = do
621 let params = TextDocumentPositionParams doc pos Nothing
622 rsp <- request TextDocumentTypeDefinition params :: Session TypeDefinitionResponse
623 case getResponseResult rsp of
624 SingleLoc loc -> pure [loc]
625 MultiLoc locs -> pure locs
627 -- | Renames the term at the specified position.
628 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
629 rename doc pos newName = do
630 let params = RenameParams doc pos (T.pack newName) Nothing
631 rsp <- request TextDocumentRename params :: Session RenameResponse
632 let wEdit = getResponseResult rsp
633 req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
634 updateState (ReqApplyWorkspaceEdit req)
636 -- | Returns the hover information at the specified position.
637 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
639 let params = TextDocumentPositionParams doc pos Nothing
640 in getResponseResult <$> request TextDocumentHover params
642 -- | Returns the highlighted occurences of the term at the specified position
643 getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
644 getHighlights doc pos =
645 let params = TextDocumentPositionParams doc pos Nothing
646 in getResponseResult <$> request TextDocumentDocumentHighlight params
648 -- | Checks the response for errors and throws an exception if needed.
649 -- Returns the result if successful.
650 getResponseResult :: ResponseMessage a -> a
651 getResponseResult rsp =
652 case rsp ^. result of
654 Left err -> throw $ UnexpectedResponseError (rsp ^. LSP.id) err
656 -- | Applies formatting to the specified document.
657 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
658 formatDoc doc opts = do
659 let params = DocumentFormattingParams doc opts Nothing
660 edits <- getResponseResult <$> request TextDocumentFormatting params
661 applyTextEdits doc edits
663 -- | Applies formatting to the specified range in a document.
664 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
665 formatRange doc opts range = do
666 let params = DocumentRangeFormattingParams doc range opts Nothing
667 edits <- getResponseResult <$> request TextDocumentRangeFormatting params
668 applyTextEdits doc edits
670 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
671 applyTextEdits doc edits =
672 let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
673 -- Send a dummy message to updateState so it can do bookkeeping
674 req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
675 in updateState (ReqApplyWorkspaceEdit req)
677 -- | Returns the code lenses for the specified document.
678 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
679 getCodeLenses tId = do
680 rsp <- request TextDocumentCodeLens (CodeLensParams tId Nothing) :: Session CodeLensResponse
681 case getResponseResult rsp of
684 -- | Returns a list of capabilities that the server has requested to /dynamically/
685 -- register during the 'Session'.
688 getRegisteredCapabilities :: Session [Registration]
689 getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get