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
29 , runSessionWithConfig
34 , module Language.Haskell.LSP.Test.Exceptions
43 , module Language.Haskell.LSP.Test.Parsing
45 -- | Quick helper functions for common tasks.
62 , waitForDiagnosticsSource
64 , getCurrentDiagnostics
92 , getRegisteredCapabilities
95 import Control.Applicative.Combinators
96 import Control.Concurrent
98 import Control.Monad.IO.Class
99 import Control.Exception
100 import Control.Lens hiding ((.=), List, Empty)
101 import qualified Data.Map.Strict as Map
102 import qualified Data.Text as T
103 import qualified Data.Text.IO as T
106 import qualified Data.HashMap.Strict as HashMap
109 import Language.Haskell.LSP.Types
110 import Language.Haskell.LSP.Types.Lens hiding
111 (id, capabilities, message, executeCommand, applyEdit, rename)
112 import qualified Language.Haskell.LSP.Types.Lens as LSP
113 import qualified Language.Haskell.LSP.Types.Capabilities as C
114 import Language.Haskell.LSP.VFS
115 import Language.Haskell.LSP.Test.Compat
116 import Language.Haskell.LSP.Test.Decoding
117 import Language.Haskell.LSP.Test.Exceptions
118 import Language.Haskell.LSP.Test.Parsing
119 import Language.Haskell.LSP.Test.Session
120 import Language.Haskell.LSP.Test.Server
121 import System.Environment
123 import System.Directory
124 import System.FilePath
125 import qualified System.FilePath.Glob as Glob
127 -- | Starts a new session.
129 -- > runSession "hie" fullCaps "path/to/root/dir" $ do
130 -- > doc <- openDoc "Desktop/simple.hs" "haskell"
131 -- > diags <- waitForDiagnostics
132 -- > let pos = Position 12 5
133 -- > params = TextDocumentPositionParams doc
134 -- > hover <- request TextDocumentHover params
135 runSession :: String -- ^ The command to run the server.
136 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
137 -> FilePath -- ^ The filepath to the root directory for the session.
138 -> Session a -- ^ The session to run.
140 runSession = runSessionWithConfig def
142 -- | Starts a new sesion with a custom configuration.
143 runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
144 -> String -- ^ The command to run the server.
145 -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
146 -> FilePath -- ^ The filepath to the root directory for the session.
147 -> Session a -- ^ The session to run.
149 runSessionWithConfig config' serverExe caps rootDir session = do
150 pid <- getCurrentProcessID
151 absRootDir <- canonicalizePath rootDir
153 config <- envOverrideConfig config'
155 let initializeParams = InitializeParams (Just pid)
156 (Just $ T.pack absRootDir)
157 (Just $ filePathToUri absRootDir)
162 withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
163 runSessionWithHandles serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
164 -- Wrap the session around initialize and shutdown calls
165 -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
166 initReqId <- sendRequest SInitialize initializeParams
168 -- Because messages can be sent in between the request and response,
169 -- collect them and then...
170 (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId initReqId)
172 case initRspMsg ^. LSP.result of
173 Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error)
176 initRspVar <- initRsp <$> ask
177 liftIO $ putMVar initRspVar initRspMsg
178 sendNotification SInitialized (Just InitializedParams)
180 case lspConfig config of
181 Just cfg -> sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
184 -- ... relay them back to the user Session so they can match on them!
185 -- As long as they are allowed.
186 forM_ inBetween checkLegalBetweenMessage
187 msgChan <- asks messageChan
188 liftIO $ writeList2Chan msgChan (ServerMessage <$> inBetween)
190 -- Run the actual test
193 -- | Asks the server to shutdown and exit politely
194 exitServer :: Session ()
195 exitServer = request_ SShutdown (Nothing :: Maybe Value) >> sendNotification SExit (Just Empty)
197 -- | Listens to the server output until the shutdown ack,
198 -- makes sure it matches the record and signals any semaphores
199 listenServer :: Handle -> SessionContext -> IO ()
200 listenServer serverOut context = do
201 msgBytes <- getNextMessage serverOut
203 reqMap <- readMVar $ requestMap context
205 let msg = decodeFromServerMsg reqMap msgBytes
206 writeChan (messageChan context) (ServerMessage msg)
209 (FromServerRsp SShutdown _) -> return ()
210 _ -> listenServer serverOut context
212 -- | Is this message allowed to be sent by the server between the intialize
213 -- request and response?
214 -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
215 checkLegalBetweenMessage :: FromServerMessage -> Session ()
216 checkLegalBetweenMessage (FromServerMess SWindowShowMessage _) = pure ()
217 checkLegalBetweenMessage (FromServerMess SWindowLogMessage _) = pure ()
218 checkLegalBetweenMessage (FromServerMess STelemetryEvent _) = pure ()
219 checkLegalBetweenMessage (FromServerMess SWindowShowMessageRequest _) = pure ()
220 checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
222 -- | Check environment variables to override the config
223 envOverrideConfig :: SessionConfig -> IO SessionConfig
224 envOverrideConfig cfg = do
225 logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
226 logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
227 return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
228 where checkEnv :: String -> IO (Maybe Bool)
229 checkEnv s = fmap convertVal <$> lookupEnv s
230 convertVal "0" = False
233 -- | The current text contents of a document.
234 documentContents :: TextDocumentIdentifier -> Session T.Text
235 documentContents doc = do
237 let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
238 return (virtualFileText file)
240 -- | Parses an ApplyEditRequest, checks that it is for the passed document
241 -- and returns the new content
242 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
243 getDocumentEdit doc = do
244 req <- message SWorkspaceApplyEdit
246 unless (checkDocumentChanges req || checkChanges req) $
247 liftIO $ throw (IncorrectApplyEditRequest (show req))
251 checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
252 checkDocumentChanges req =
253 let changes = req ^. params . edit . documentChanges
254 maybeDocs = fmap (fmap (^. textDocument . uri)) changes
256 Just docs -> (doc ^. uri) `elem` docs
258 checkChanges :: ApplyWorkspaceEditRequest -> Bool
260 let mMap = req ^. params . edit . changes
261 in maybe False (HashMap.member (doc ^. uri)) mMap
263 -- | Sends a request to the server and waits for its response.
264 -- Will skip any messages in between the request and the response
266 -- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
268 -- Note: will skip any messages in between the request and the response.
269 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
270 request m = sendRequest m >=> skipManyTill anyMessage . responseForId
272 -- | The same as 'sendRequest', but discard the response.
273 request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
274 request_ p = void . request p
276 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
278 :: SClientMethod m -- ^ The request method.
279 -> MessageParams m -- ^ The request parameters.
280 -> Session (LspId m) -- ^ The id of the request that was sent.
281 sendRequest method params = do
282 idn <- curReqId <$> get
283 modify $ \c -> c { curReqId = idn+1 }
286 let mess = RequestMessage "2.0" id method params
288 -- Update the request map
289 reqMap <- requestMap <$> ask
290 liftIO $ modifyMVar_ reqMap $
291 \r -> return $ fromJust $ updateRequestMap r id method
293 ~() <- case splitClientMethod method of
294 IsClientReq -> sendMessage mess
295 IsClientEither -> sendMessage $ ReqMess mess
299 -- | Sends a notification to the server.
300 sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
301 -> MessageParams m -- ^ The notification parameters.
303 -- Open a virtual file if we send a did open text document notification
304 sendNotification STextDocumentDidOpen params = do
305 let n = NotificationMessage "2.0" STextDocumentDidOpen params
306 oldVFS <- vfs <$> get
307 let (newVFS,_) = openVFS oldVFS n
308 modify (\s -> s { vfs = newVFS })
311 -- Close a virtual file if we send a close text document notification
312 sendNotification STextDocumentDidClose params = do
313 let n = NotificationMessage "2.0" STextDocumentDidClose params
314 oldVFS <- vfs <$> get
315 let (newVFS,_) = closeVFS oldVFS n
316 modify (\s -> s { vfs = newVFS })
319 sendNotification STextDocumentDidChange params = do
320 let n = NotificationMessage "2.0" STextDocumentDidChange params
321 oldVFS <- vfs <$> get
322 let (newVFS,_) = changeFromClientVFS oldVFS n
323 modify (\s -> s { vfs = newVFS })
326 sendNotification method params =
327 case splitClientMethod method of
328 IsClientNot -> sendMessage (NotificationMessage "2.0" method params)
329 IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
331 -- | Sends a response to the server.
332 sendResponse :: ToJSON (ResponseParams m) => ResponseMessage m -> Session ()
333 sendResponse = sendMessage
335 -- | Returns the initialize response that was received from the server.
336 -- The initialize requests and responses are not included the session,
337 -- so if you need to test it use this.
338 initializeResponse :: Session InitializeResponse
339 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
341 -- | /Creates/ a new text document. This is different from 'openDoc'
342 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
343 -- know that a file was created within the workspace, __provided that the server
344 -- has registered for it__, and the file matches any patterns the server
346 -- It /does not/ actually create a file on disk, but is useful for convincing
347 -- the server that one does exist.
350 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
351 -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
352 -> T.Text -- ^ The content of the text document to create.
353 -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
354 createDoc file languageId contents = do
355 dynCaps <- curDynCaps <$> get
356 rootDir <- asks rootDir
357 caps <- asks sessionCapabilities
358 absFile <- liftIO $ canonicalizePath (rootDir </> file)
359 let regs = filter (\r -> r ^. method == SomeClientMethod SWorkspaceDidChangeWatchedFiles) $
361 watchHits :: FileSystemWatcher -> Bool
362 watchHits (FileSystemWatcher pattern kind) =
363 -- If WatchKind is exlcuded, defaults to all true as per spec
364 fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
366 fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
367 -- If the pattern is absolute then match against the absolute fp
369 | isAbsolute pattern = absFile
372 createHits (WatchKind create _ _) = create
374 regHits :: SomeRegistration -> Bool
375 regHits reg = isJust $ do
376 opts <- reg ^. registerOptions
377 fileWatchOpts <- case fromJSON opts :: Result DidChangeWatchedFilesRegistrationOptions of
380 if foldl' (\acc w -> acc || watchHits w) False (fileWatchOpts ^. watchers)
385 caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
387 shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
390 sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
391 List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
392 openDoc' file languageId contents
394 -- | Opens a text document that /exists on disk/, and sends a
395 -- textDocument/didOpen notification to the server.
396 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
397 openDoc file languageId = do
399 let fp = rootDir context </> file
400 contents <- liftIO $ T.readFile fp
401 openDoc' file languageId contents
403 -- | This is a variant of `openDoc` that takes the file content as an argument.
404 -- Use this is the file exists /outside/ of the current workspace.
405 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
406 openDoc' file languageId contents = do
408 let fp = rootDir context </> file
409 uri = filePathToUri fp
410 item = TextDocumentItem uri (T.pack languageId) 0 contents
411 sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
412 pure $ TextDocumentIdentifier uri
414 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
415 closeDoc :: TextDocumentIdentifier -> Session ()
417 let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
418 sendNotification STextDocumentDidClose params
420 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
421 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
422 changeDoc docId changes = do
423 verDoc <- getVersionedDoc docId
424 let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
425 sendNotification STextDocumentDidChange params
427 -- | Gets the Uri for the file corrected to the session directory.
428 getDocUri :: FilePath -> Session Uri
431 let fp = rootDir context </> file
432 return $ filePathToUri fp
434 -- | Waits for diagnostics to be published and returns them.
435 waitForDiagnostics :: Session [Diagnostic]
436 waitForDiagnostics = do
437 diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics)
438 let (List diags) = diagsNot ^. params . LSP.diagnostics
441 -- | The same as 'waitForDiagnostics', but will only match a specific
442 -- 'Language.Haskell.LSP.Types._source'.
443 waitForDiagnosticsSource :: String -> Session [Diagnostic]
444 waitForDiagnosticsSource src = do
445 diags <- waitForDiagnostics
446 let res = filter matches diags
448 then waitForDiagnosticsSource src
451 matches :: Diagnostic -> Bool
452 matches d = d ^. source == Just (T.pack src)
454 -- | Expects a 'PublishDiagnosticsNotification' and throws an
455 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
457 noDiagnostics :: Session ()
459 diagsNot <- message STextDocumentPublishDiagnostics
460 when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
462 -- | Returns the symbols in a document.
463 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
464 getDocumentSymbols doc = do
465 ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse
467 Right (L (List xs)) -> return (Left xs)
468 Right (R (List xs)) -> return (Right xs)
469 Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
471 -- | Returns the code actions in the specified range.
472 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
473 getCodeActions doc range = do
474 ctx <- getCodeActionContext doc
475 rsp <- request STextDocumentCodeAction (CodeActionParams doc range ctx Nothing)
477 case rsp ^. result of
478 Right (List xs) -> return xs
479 Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
481 -- | Returns all the code actions in a document by
482 -- querying the code actions at each of the current
483 -- diagnostics' positions.
484 getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
485 getAllCodeActions doc = do
486 ctx <- getCodeActionContext doc
488 foldM (go ctx) [] =<< getCurrentDiagnostics doc
491 go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
493 ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing)
496 Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
497 Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
499 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
500 getCodeActionContext doc = do
501 curDiags <- getCurrentDiagnostics doc
502 return $ CodeActionContext (List curDiags) Nothing
504 -- | Returns the current diagnostics that have been sent to the client.
505 -- Note that this does not wait for more to come in.
506 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
507 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
509 -- | Executes a command.
510 executeCommand :: Command -> Session ()
511 executeCommand cmd = do
512 let args = decode $ encode $ fromJust $ cmd ^. arguments
513 execParams = ExecuteCommandParams (cmd ^. command) args Nothing
514 request_ SWorkspaceExecuteCommand execParams
516 -- | Executes a code action.
517 -- Matching with the specification, if a code action
518 -- contains both an edit and a command, the edit will
520 executeCodeAction :: CodeAction -> Session ()
521 executeCodeAction action = do
522 maybe (return ()) handleEdit $ action ^. edit
523 maybe (return ()) executeCommand $ action ^. command
525 where handleEdit :: WorkspaceEdit -> Session ()
527 -- Its ok to pass in dummy parameters here as they aren't used
528 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams e)
529 in updateState (FromServerMess SWorkspaceApplyEdit req)
531 -- | Adds the current version to the document, as tracked by the session.
532 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
533 getVersionedDoc (TextDocumentIdentifier uri) = do
534 fs <- vfsMap . vfs <$> get
536 case fs Map.!? toNormalizedUri uri of
537 Just vf -> Just (virtualFileVersion vf)
539 return (VersionedTextDocumentIdentifier uri ver)
541 -- | Applys an edit to the document and returns the updated document version.
542 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
543 applyEdit doc edit = do
545 verDoc <- getVersionedDoc doc
547 caps <- asks sessionCapabilities
549 let supportsDocChanges = fromMaybe False $ do
550 let mWorkspace = caps ^. LSP.workspace
551 C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
552 C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
555 let wEdit = if supportsDocChanges
557 let docEdit = TextDocumentEdit verDoc (List [edit])
558 in WorkspaceEdit Nothing (Just (List [docEdit]))
560 let changes = HashMap.singleton (doc ^. uri) (List [edit])
561 in WorkspaceEdit (Just changes) Nothing
563 let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
564 updateState (FromServerMess SWorkspaceApplyEdit req)
566 -- version may have changed
569 -- | Returns the completions for the position in the document.
570 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
571 getCompletions doc pos = do
572 rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing)
574 case getResponseResult rsp of
575 L (List items) -> return items
576 R (CompletionList _ (List items)) -> return items
578 -- | Returns the references for the position in the document.
579 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
580 -> Position -- ^ The position to lookup.
581 -> Bool -- ^ Whether to include declarations as references.
582 -> Session (List Location) -- ^ The locations of the references.
583 getReferences doc pos inclDecl =
584 let ctx = ReferenceContext inclDecl
585 params = ReferenceParams doc pos ctx Nothing
586 in getResponseResult <$> request STextDocumentReferences params
588 -- | Returns the definition(s) for the term at the specified position.
589 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
590 -> Position -- ^ The position the term is at.
591 -> Session [Location] -- ^ The location(s) of the definitions
592 getDefinitions doc pos = do
593 let params = TextDocumentPositionParams doc pos Nothing
594 rsp <- request STextDocumentDefinition params :: Session DefinitionResponse
595 case getResponseResult rsp of
599 -- | Returns the type definition(s) for the term at the specified position.
600 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
601 -> Position -- ^ The position the term is at.
602 -> Session (Location |? List Location |? List LocationLink) -- ^ The location(s) of the definitions
603 getTypeDefinitions doc pos =
604 let params = TextDocumentPositionParams doc pos Nothing
605 rsp <- request STextDocumentTypeDefinition params :: Session TypeDefinitionResponse
606 case getResponseResult rsp of
610 -- | Renames the term at the specified position.
611 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
612 rename doc pos newName = do
613 let params = RenameParams doc pos (T.pack newName) Nothing
614 rsp <- request STextDocumentRename params :: Session RenameResponse
615 let wEdit = getResponseResult rsp
616 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
617 updateState (FromServerMess SWorkspaceApplyEdit req)
619 -- | Returns the hover information at the specified position.
620 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
622 let params = TextDocumentPositionParams doc pos Nothing
623 in getResponseResult <$> request STextDocumentHover params
625 -- | Returns the highlighted occurences of the term at the specified position
626 getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
627 getHighlights doc pos =
628 let params = TextDocumentPositionParams doc pos Nothing
629 in getResponseResult <$> request STextDocumentDocumentHighlight params
631 -- | Checks the response for errors and throws an exception if needed.
632 -- Returns the result if successful.
633 getResponseResult :: ResponseMessage m -> ResponseParams m
634 getResponseResult rsp =
635 case rsp ^. result of
637 Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
639 -- | Applies formatting to the specified document.
640 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
641 formatDoc doc opts = do
642 let params = DocumentFormattingParams doc opts Nothing
643 edits <- getResponseResult <$> request STextDocumentFormatting params
644 applyTextEdits doc edits
646 -- | Applies formatting to the specified range in a document.
647 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
648 formatRange doc opts range = do
649 let params = DocumentRangeFormattingParams doc range opts Nothing
650 edits <- getResponseResult <$> request STextDocumentRangeFormatting params
651 applyTextEdits doc edits
653 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
654 applyTextEdits doc edits =
655 let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
656 -- Send a dummy message to updateState so it can do bookkeeping
657 req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
658 in updateState (FromServerMess SWorkspaceApplyEdit req)
660 -- | Returns the code lenses for the specified document.
661 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
662 getCodeLenses tId = do
663 rsp <- request STextDocumentCodeLens (CodeLensParams tId Nothing) :: Session CodeLensResponse
664 case getResponseResult rsp of
667 -- | Returns a list of capabilities that the server has requested to /dynamically/
668 -- register during the 'Session'.
671 getRegisteredCapabilities :: Session [SomeRegistration]
672 getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get