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
86 , getRegisteredCapabilities
89 import Control.Applicative.Combinators
90 import Control.Concurrent
92 import Control.Monad.IO.Class
93 import Control.Exception
94 import Control.Lens hiding ((.=), List)
95 import qualified Data.Map.Strict as Map
96 import qualified Data.Text as T
97 import qualified Data.Text.IO as T
100 import qualified Data.HashMap.Strict as HashMap
103 import Language.Haskell.LSP.Types
104 import Language.Haskell.LSP.Types.Lens hiding
105 (id, capabilities, message, executeCommand, applyEdit, rename)
106 import qualified Language.Haskell.LSP.Types.Lens as LSP
107 import qualified Language.Haskell.LSP.Types.Capabilities as C
108 import Language.Haskell.LSP.Messages
109 import Language.Haskell.LSP.VFS
110 import Language.Haskell.LSP.Test.Compat
111 import Language.Haskell.LSP.Test.Decoding
112 import Language.Haskell.LSP.Test.Exceptions
113 import Language.Haskell.LSP.Test.Parsing
114 import Language.Haskell.LSP.Test.Session
115 import Language.Haskell.LSP.Test.Server
116 import System.Environment
118 import System.Directory
119 import System.FilePath
120 import qualified System.FilePath.Glob as Glob
122 -- | Starts a new session.
124 -- > runSession "hie" fullCaps "path/to/root/dir" $ do
125 -- > doc <- openDoc "Desktop/simple.hs" "haskell"
126 -- > diags <- waitForDiagnostics
127 -- > let pos = Position 12 5
128 -- > params = TextDocumentPositionParams doc
129 -- > hover <- request TextDocumentHover params
130 runSession :: String -- ^ The command to run the server.
131 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
132 -> FilePath -- ^ The filepath to the root directory for the session.
133 -> Session a -- ^ The session to run.
135 runSession = runSessionWithConfig def
137 -- | Starts a new sesion with a custom configuration.
138 runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
139 -> 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 runSessionWithConfig config' serverExe caps rootDir session = do
145 pid <- getCurrentProcessID
146 absRootDir <- canonicalizePath rootDir
148 config <- envOverrideConfig config'
150 let initializeParams = InitializeParams (Just pid)
151 (Just $ T.pack absRootDir)
152 (Just $ filePathToUri absRootDir)
157 withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
158 runSessionWithHandles serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
159 -- Wrap the session around initialize and shutdown calls
160 -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
161 initReqId <- sendRequest Initialize initializeParams
163 -- Because messages can be sent in between the request and response,
164 -- collect them and then...
165 (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId initReqId)
167 case initRspMsg ^. LSP.result of
168 Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error)
171 initRspVar <- initRsp <$> ask
172 liftIO $ putMVar initRspVar initRspMsg
173 sendNotification Initialized InitializedParams
175 case lspConfig config of
176 Just cfg -> sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
179 -- ... relay them back to the user Session so they can match on them!
180 -- As long as they are allowed.
181 forM_ inBetween checkLegalBetweenMessage
182 msgChan <- asks messageChan
183 liftIO $ writeList2Chan msgChan (ServerMessage <$> inBetween)
185 -- Run the actual test
188 -- | Asks the server to shutdown and exit politely
189 exitServer :: Session ()
190 exitServer = request_ Shutdown (Nothing :: Maybe Value) >> sendNotification Exit ExitParams
192 -- | Listens to the server output until the shutdown ack,
193 -- makes sure it matches the record and signals any semaphores
194 listenServer :: Handle -> SessionContext -> IO ()
195 listenServer serverOut context = do
196 msgBytes <- getNextMessage serverOut
198 reqMap <- readMVar $ requestMap context
200 let msg = decodeFromServerMsg reqMap msgBytes
201 writeChan (messageChan context) (ServerMessage msg)
204 (RspShutdown _) -> return ()
205 _ -> listenServer serverOut context
207 -- | Is this message allowed to be sent by the server between the intialize
208 -- request and response?
209 -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
210 checkLegalBetweenMessage :: FromServerMessage -> Session ()
211 checkLegalBetweenMessage (NotShowMessage _) = pure ()
212 checkLegalBetweenMessage (NotLogMessage _) = pure ()
213 checkLegalBetweenMessage (NotTelemetry _) = pure ()
214 checkLegalBetweenMessage (ReqShowMessage _) = pure ()
215 checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
217 -- | Check environment variables to override the config
218 envOverrideConfig :: SessionConfig -> IO SessionConfig
219 envOverrideConfig cfg = do
220 logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
221 logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
222 return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
223 where checkEnv :: String -> IO (Maybe Bool)
224 checkEnv s = fmap convertVal <$> lookupEnv s
225 convertVal "0" = False
228 -- | The current text contents of a document.
229 documentContents :: TextDocumentIdentifier -> Session T.Text
230 documentContents doc = do
232 let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
233 return (virtualFileText file)
235 -- | Parses an ApplyEditRequest, checks that it is for the passed document
236 -- and returns the new content
237 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
238 getDocumentEdit doc = do
239 req <- message :: Session ApplyWorkspaceEditRequest
241 unless (checkDocumentChanges req || checkChanges req) $
242 liftIO $ throw (IncorrectApplyEditRequest (show req))
246 checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
247 checkDocumentChanges req =
248 let changes = req ^. params . edit . documentChanges
249 maybeDocs = fmap (fmap (^. textDocument . uri)) changes
251 Just docs -> (doc ^. uri) `elem` docs
253 checkChanges :: ApplyWorkspaceEditRequest -> Bool
255 let mMap = req ^. params . edit . changes
256 in maybe False (HashMap.member (doc ^. uri)) mMap
258 -- | Sends a request to the server and waits for its response.
259 -- Will skip any messages in between the request and the response
261 -- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
263 -- Note: will skip any messages in between the request and the response.
264 request :: (ToJSON params, FromJSON a) => ClientMethod -> params -> Session (ResponseMessage a)
265 request m = sendRequest m >=> skipManyTill anyMessage . responseForId
267 -- | The same as 'sendRequest', but discard the response.
268 request_ :: ToJSON params => ClientMethod -> params -> Session ()
269 request_ p = void . (request p :: ToJSON params => params -> Session (ResponseMessage Value))
271 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
274 => ClientMethod -- ^ The request method.
275 -> params -- ^ The request parameters.
276 -> Session LspId -- ^ The id of the request that was sent.
277 sendRequest method params = do
278 id <- curReqId <$> get
279 modify $ \c -> c { curReqId = nextId id }
281 let req = RequestMessage' "2.0" id method params
283 -- Update the request map
284 reqMap <- requestMap <$> ask
285 liftIO $ modifyMVar_ reqMap $
286 \r -> return $ updateRequestMap r id method
292 where nextId (IdInt i) = IdInt (i + 1)
293 nextId (IdString s) = IdString $ T.pack $ show $ read (T.unpack s) + 1
295 -- | A custom type for request message that doesn't
296 -- need a response type, allows us to infer the request
297 -- message type without using proxies.
298 data RequestMessage' a = RequestMessage' T.Text LspId ClientMethod a
300 instance ToJSON a => ToJSON (RequestMessage' a) where
301 toJSON (RequestMessage' rpc id method params) =
302 object ["jsonrpc" .= rpc, "id" .= id, "method" .= method, "params" .= params]
305 -- | Sends a notification to the server.
306 sendNotification :: ToJSON a
307 => ClientMethod -- ^ The notification method.
308 -> a -- ^ The notification parameters.
311 -- Open a virtual file if we send a did open text document notification
312 sendNotification TextDocumentDidOpen params = do
313 let params' = fromJust $ decode $ encode params
314 n :: DidOpenTextDocumentNotification
315 n = NotificationMessage "2.0" TextDocumentDidOpen params'
316 oldVFS <- vfs <$> get
317 let (newVFS,_) = openVFS oldVFS n
318 modify (\s -> s { vfs = newVFS })
321 -- Close a virtual file if we send a close text document notification
322 sendNotification TextDocumentDidClose params = do
323 let params' = fromJust $ decode $ encode params
324 n :: DidCloseTextDocumentNotification
325 n = NotificationMessage "2.0" TextDocumentDidClose params'
326 oldVFS <- vfs <$> get
327 let (newVFS,_) = closeVFS oldVFS n
328 modify (\s -> s { vfs = newVFS })
331 sendNotification TextDocumentDidChange params = do
332 let params' = fromJust $ decode $ encode params
333 n :: DidChangeTextDocumentNotification
334 n = NotificationMessage "2.0" TextDocumentDidChange params'
335 oldVFS <- vfs <$> get
336 let (newVFS,_) = changeFromClientVFS oldVFS n
337 modify (\s -> s { vfs = newVFS })
340 sendNotification method params = sendMessage (NotificationMessage "2.0" method params)
342 -- | Sends a response to the server.
343 sendResponse :: ToJSON a => ResponseMessage a -> Session ()
344 sendResponse = sendMessage
346 -- | Returns the initialize response that was received from the server.
347 -- The initialize requests and responses are not included the session,
348 -- so if you need to test it use this.
349 initializeResponse :: Session InitializeResponse
350 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
352 -- | /Creates/ a new text document. This is different from 'openDoc'
353 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
354 -- know that a file was created within the workspace, __provided that the server
355 -- has registered for it__, and the file matches any patterns the server
357 -- It /does not/ actually create a file on disk, but is useful for convincing
358 -- the server that one does exist.
361 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
362 -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
363 -> T.Text -- ^ The content of the text document to create.
364 -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
365 createDoc file languageId contents = do
366 dynCaps <- curDynCaps <$> get
367 rootDir <- asks rootDir
368 caps <- asks sessionCapabilities
369 absFile <- liftIO $ canonicalizePath (rootDir </> file)
370 let regs = filter (\r -> r ^. method == WorkspaceDidChangeWatchedFiles) $
372 watchHits :: FileSystemWatcher -> Bool
373 watchHits (FileSystemWatcher pattern kind) =
374 -- If WatchKind is exlcuded, defaults to all true as per spec
375 fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
377 fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
378 -- If the pattern is absolute then match against the absolute fp
380 | isAbsolute pattern = absFile
383 createHits (WatchKind create _ _) = create
385 regHits :: Registration -> Bool
386 regHits reg = isJust $ do
387 opts <- reg ^. registerOptions
388 fileWatchOpts <- case fromJSON opts :: Result DidChangeWatchedFilesRegistrationOptions of
391 if foldl' (\acc w -> acc || watchHits w) False (fileWatchOpts ^. watchers)
396 caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
398 shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
401 sendNotification WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
402 List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
403 openDoc' file languageId contents
405 -- | Opens a text document that /exists on disk/, and sends a
406 -- textDocument/didOpen notification to the server.
407 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
408 openDoc file languageId = do
410 let fp = rootDir context </> file
411 contents <- liftIO $ T.readFile fp
412 openDoc' file languageId contents
414 -- | This is a variant of `openDoc` that takes the file content as an argument.
415 -- Use this is the file exists /outside/ of the current workspace.
416 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
417 openDoc' file languageId contents = do
419 let fp = rootDir context </> file
420 uri = filePathToUri fp
421 item = TextDocumentItem uri (T.pack languageId) 0 contents
422 sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams item)
423 pure $ TextDocumentIdentifier uri
425 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
426 closeDoc :: TextDocumentIdentifier -> Session ()
428 let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
429 sendNotification TextDocumentDidClose params
431 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
432 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
433 changeDoc docId changes = do
434 verDoc <- getVersionedDoc docId
435 let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
436 sendNotification TextDocumentDidChange params
438 -- | Gets the Uri for the file corrected to the session directory.
439 getDocUri :: FilePath -> Session Uri
442 let fp = rootDir context </> file
443 return $ filePathToUri fp
445 -- | Waits for diagnostics to be published and returns them.
446 waitForDiagnostics :: Session [Diagnostic]
447 waitForDiagnostics = do
448 diagsNot <- skipManyTill anyMessage message :: Session PublishDiagnosticsNotification
449 let (List diags) = diagsNot ^. params . LSP.diagnostics
452 -- | The same as 'waitForDiagnostics', but will only match a specific
453 -- 'Language.Haskell.LSP.Types._source'.
454 waitForDiagnosticsSource :: String -> Session [Diagnostic]
455 waitForDiagnosticsSource src = do
456 diags <- waitForDiagnostics
457 let res = filter matches diags
459 then waitForDiagnosticsSource src
462 matches :: Diagnostic -> Bool
463 matches d = d ^. source == Just (T.pack src)
465 -- | Expects a 'PublishDiagnosticsNotification' and throws an
466 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
468 noDiagnostics :: Session ()
470 diagsNot <- message :: Session PublishDiagnosticsNotification
471 when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
473 -- | Returns the symbols in a document.
474 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
475 getDocumentSymbols doc = do
476 ResponseMessage _ rspLid res <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse
478 Right (DSDocumentSymbols (List xs)) -> return (Left xs)
479 Right (DSSymbolInformation (List xs)) -> return (Right xs)
480 Left err -> throw (UnexpectedResponseError rspLid err)
482 -- | Returns the code actions in the specified range.
483 getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
484 getCodeActions doc range = do
485 ctx <- getCodeActionContext doc
486 rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx Nothing)
488 case rsp ^. result of
489 Right (List xs) -> return xs
490 Left error -> throw (UnexpectedResponseError (rsp ^. LSP.id) error)
492 -- | Returns all the code actions in a document by
493 -- querying the code actions at each of the current
494 -- diagnostics' positions.
495 getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult]
496 getAllCodeActions doc = do
497 ctx <- getCodeActionContext doc
499 foldM (go ctx) [] =<< getCurrentDiagnostics doc
502 go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
504 ResponseMessage _ rspLid res <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing)
507 Left e -> throw (UnexpectedResponseError rspLid e)
508 Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
510 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
511 getCodeActionContext doc = do
512 curDiags <- getCurrentDiagnostics doc
513 return $ CodeActionContext (List curDiags) Nothing
515 -- | Returns the current diagnostics that have been sent to the client.
516 -- Note that this does not wait for more to come in.
517 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
518 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
520 -- | Executes a command.
521 executeCommand :: Command -> Session ()
522 executeCommand cmd = do
523 let args = decode $ encode $ fromJust $ cmd ^. arguments
524 execParams = ExecuteCommandParams (cmd ^. command) args Nothing
525 request_ WorkspaceExecuteCommand execParams
527 -- | Executes a code action.
528 -- Matching with the specification, if a code action
529 -- contains both an edit and a command, the edit will
531 executeCodeAction :: CodeAction -> Session ()
532 executeCodeAction action = do
533 maybe (return ()) handleEdit $ action ^. edit
534 maybe (return ()) executeCommand $ action ^. command
536 where handleEdit :: WorkspaceEdit -> Session ()
538 -- Its ok to pass in dummy parameters here as they aren't used
539 let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams e)
540 in updateState (ReqApplyWorkspaceEdit req)
542 -- | Adds the current version to the document, as tracked by the session.
543 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
544 getVersionedDoc (TextDocumentIdentifier uri) = do
545 fs <- vfsMap . vfs <$> get
547 case fs Map.!? toNormalizedUri uri of
548 Just vf -> Just (virtualFileVersion vf)
550 return (VersionedTextDocumentIdentifier uri ver)
552 -- | Applys an edit to the document and returns the updated document version.
553 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
554 applyEdit doc edit = do
556 verDoc <- getVersionedDoc doc
558 caps <- asks sessionCapabilities
560 let supportsDocChanges = fromMaybe False $ do
561 let mWorkspace = C._workspace caps
562 C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
563 C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
566 let wEdit = if supportsDocChanges
568 let docEdit = TextDocumentEdit verDoc (List [edit])
569 in WorkspaceEdit Nothing (Just (List [docEdit]))
571 let changes = HashMap.singleton (doc ^. uri) (List [edit])
572 in WorkspaceEdit (Just changes) Nothing
574 let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
575 updateState (ReqApplyWorkspaceEdit req)
577 -- version may have changed
580 -- | Returns the completions for the position in the document.
581 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
582 getCompletions doc pos = do
583 rsp <- request TextDocumentCompletion (TextDocumentPositionParams doc pos Nothing)
585 case getResponseResult rsp of
586 Completions (List items) -> return items
587 CompletionList (CompletionListType _ (List items)) -> return items
589 -- | Returns the references for the position in the document.
590 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
591 -> Position -- ^ The position to lookup.
592 -> Bool -- ^ Whether to include declarations as references.
593 -> Session [Location] -- ^ The locations of the references.
594 getReferences doc pos inclDecl =
595 let ctx = ReferenceContext inclDecl
596 params = ReferenceParams doc pos ctx Nothing
597 in getResponseResult <$> request TextDocumentReferences params
599 -- | Returns the definition(s) for the term at the specified position.
600 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
601 -> Position -- ^ The position the term is at.
602 -> Session [Location] -- ^ The location(s) of the definitions
603 getDefinitions doc pos = do
604 let params = TextDocumentPositionParams doc pos Nothing
605 rsp <- request TextDocumentDefinition params :: Session DefinitionResponse
606 case getResponseResult rsp of
607 SingleLoc loc -> pure [loc]
608 MultiLoc locs -> pure locs
610 -- | Returns the type definition(s) for the term at the specified position.
611 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
612 -> Position -- ^ The position the term is at.
613 -> Session [Location] -- ^ The location(s) of the definitions
614 getTypeDefinitions doc pos = do
615 let params = TextDocumentPositionParams doc pos Nothing
616 rsp <- request TextDocumentTypeDefinition params :: Session TypeDefinitionResponse
617 case getResponseResult rsp of
618 SingleLoc loc -> pure [loc]
619 MultiLoc locs -> pure locs
621 -- | Renames the term at the specified position.
622 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
623 rename doc pos newName = do
624 let params = RenameParams doc pos (T.pack newName) Nothing
625 rsp <- request TextDocumentRename params :: Session RenameResponse
626 let wEdit = getResponseResult rsp
627 req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
628 updateState (ReqApplyWorkspaceEdit req)
630 -- | Returns the hover information at the specified position.
631 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
633 let params = TextDocumentPositionParams doc pos Nothing
634 in getResponseResult <$> request TextDocumentHover params
636 -- | Returns the highlighted occurences of the term at the specified position
637 getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
638 getHighlights doc pos =
639 let params = TextDocumentPositionParams doc pos Nothing
640 in getResponseResult <$> request TextDocumentDocumentHighlight params
642 -- | Checks the response for errors and throws an exception if needed.
643 -- Returns the result if successful.
644 getResponseResult :: ResponseMessage a -> a
645 getResponseResult rsp =
646 case rsp ^. result of
648 Left err -> throw $ UnexpectedResponseError (rsp ^. LSP.id) err
650 -- | Applies formatting to the specified document.
651 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
652 formatDoc doc opts = do
653 let params = DocumentFormattingParams doc opts Nothing
654 edits <- getResponseResult <$> request TextDocumentFormatting params
655 applyTextEdits doc edits
657 -- | Applies formatting to the specified range in a document.
658 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
659 formatRange doc opts range = do
660 let params = DocumentRangeFormattingParams doc range opts Nothing
661 edits <- getResponseResult <$> request TextDocumentRangeFormatting params
662 applyTextEdits doc edits
664 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
665 applyTextEdits doc edits =
666 let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
667 req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
668 in updateState (ReqApplyWorkspaceEdit req)
670 -- | Returns the code lenses for the specified document.
671 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
672 getCodeLenses tId = do
673 rsp <- request TextDocumentCodeLens (CodeLensParams tId Nothing) :: Session CodeLensResponse
674 case getResponseResult rsp of
677 -- | Returns a list of capabilities that the server has requested to /dynamically/
678 -- register during the 'Session'.
681 getRegisteredCapabilities :: Session [Registration]
682 getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get