src/Language/Haskell/LSP/Test.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE RankNTypes #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4 {-# LANGUAGE ExistentialQuantification #-}
   5
   6 {-|
   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
  12
  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.
  16 -}
  17 module Language.Haskell.LSP.Test
  18   (
  19   -- * Sessions
  20     Session
  21   , runSession
  22   -- ** Config
  23   , runSessionWithConfig
  24   , SessionConfig(..)
  25   , defaultConfig
  26   , C.fullCaps
  27   -- ** Exceptions
  28   , module Language.Haskell.LSP.Test.Exceptions
  29   , withTimeout
  30   -- * Sending
  31   , request
  32   , request_
  33   , sendRequest
  34   , sendNotification
  35   , sendResponse
  36   -- * Receving
  37   , module Language.Haskell.LSP.Test.Parsing
  38   -- * Utilities
  39   -- | Quick helper functions for common tasks.
  40
  41   -- ** Initialization
  42   , initializeResponse
  43   -- ** Documents
  44   , openDoc
  45   , openDoc'
  46   , closeDoc
  47   , changeDoc
  48   , documentContents
  49   , getDocumentEdit
  50   , getDocUri
  51   , getVersionedDoc
  52   -- ** Symbols
  53   , getDocumentSymbols
  54   -- ** Diagnostics
  55   , waitForDiagnostics
  56   , waitForDiagnosticsSource
  57   , noDiagnostics
  58   , getCurrentDiagnostics
  59   -- ** Commands
  60   , executeCommand
  61   -- ** Code Actions
  62   , getCodeActions
  63   , getAllCodeActions
  64   , executeCodeAction
  65   -- ** Completions
  66   , getCompletions
  67   -- ** References
  68   , getReferences
  69   -- ** Definitions
  70   , getDefinitions
  71   , getTypeDefinitions
  72   -- ** Renaming
  73   , rename
  74   -- ** Hover
  75   , getHover
  76   -- ** Highlights
  77   , getHighlights
  78   -- ** Formatting
  79   , formatDoc
  80   , formatRange
  81   -- ** Edits
  82   , applyEdit
  83   -- ** Code lenses
  84   , getCodeLenses
  85   ) where
  86
  87 import Control.Applicative.Combinators
  88 import Control.Concurrent
  89 import Control.Monad
  90 import Control.Monad.IO.Class
  91 import Control.Exception
  92 import Control.Lens hiding ((.=), List)
  93 import qualified Data.Text as T
  94 import qualified Data.Text.IO as T
  95 import Data.Aeson
  96 import Data.Default
  97 import qualified Data.HashMap.Strict as HashMap
  98 import qualified Data.Map as Map
  99 import Data.Maybe
 100 import Language.Haskell.LSP.Types
 101 import Language.Haskell.LSP.Types.Lens hiding
 102   (id, capabilities, message, executeCommand, applyEdit, rename)
 103 import qualified Language.Haskell.LSP.Types.Lens as LSP
 104 import qualified Language.Haskell.LSP.Types.Capabilities as C
 105 import Language.Haskell.LSP.Messages
 106 import Language.Haskell.LSP.VFS
 107 import Language.Haskell.LSP.Test.Compat
 108 import Language.Haskell.LSP.Test.Decoding
 109 import Language.Haskell.LSP.Test.Exceptions
 110 import Language.Haskell.LSP.Test.Parsing
 111 import Language.Haskell.LSP.Test.Session
 112 import Language.Haskell.LSP.Test.Server
 113 import System.IO
 114 import System.Directory
 115 import System.FilePath
 116 import qualified Data.Rope.UTF16 as Rope
 117
 118 -- | Starts a new session.
 119 --
 120 -- > runSession "hie" fullCaps "path/to/root/dir" $ do
 121 -- >   doc <- openDoc "Desktop/simple.hs" "haskell"
 122 -- >   diags <- waitForDiagnostics
 123 -- >   let pos = Position 12 5
 124 -- >       params = TextDocumentPositionParams doc
 125 -- >   hover <- request TextDocumentHover params
 126 runSession :: String -- ^ The command to run the server.
 127            -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
 128            -> FilePath -- ^ The filepath to the root directory for the session.
 129            -> Session a -- ^ The session to run.
 130            -> IO a
 131 runSession = runSessionWithConfig def
 132
 133 -- | Starts a new sesion with a custom configuration.
 134 runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
 135                      -> 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.
 139                      -> IO a
 140 runSessionWithConfig config serverExe caps rootDir session = do
 141   pid <- getCurrentProcessID
 142   absRootDir <- canonicalizePath rootDir
 143
 144   let initializeParams = InitializeParams (Just pid)
 145                                           (Just $ T.pack absRootDir)
 146                                           (Just $ filePathToUri absRootDir)
 147                                           Nothing
 148                                           caps
 149                                           (Just TraceOff)
 150                                           Nothing
 151   withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
 152     runSessionWithHandles serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
 153       -- Wrap the session around initialize and shutdown calls
 154       initRspMsg <- request Initialize initializeParams :: Session InitializeResponse
 155
 156       liftIO $ maybe (return ()) (putStrLn . ("Error while initializing: " ++) . show ) (initRspMsg ^. LSP.error)
 157
 158       initRspVar <- initRsp <$> ask
 159       liftIO $ putMVar initRspVar initRspMsg
 160       sendNotification Initialized InitializedParams
 161
 162       case lspConfig config of
 163         Just cfg -> sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
 164         Nothing -> return ()
 165
 166       -- Run the actual test
 167       session
 168   where
 169   -- | Asks the server to shutdown and exit politely
 170   exitServer :: Session ()
 171   exitServer = request_ Shutdown (Nothing :: Maybe Value) >> sendNotification Exit ExitParams
 172
 173   -- | Listens to the server output until the shutdown ack,
 174   -- makes sure it matches the record and signals any semaphores
 175   listenServer :: Handle -> SessionContext -> IO ()
 176   listenServer serverOut context = do
 177     msgBytes <- getNextMessage serverOut
 178
 179     reqMap <- readMVar $ requestMap context
 180
 181     let msg = decodeFromServerMsg reqMap msgBytes
 182     writeChan (messageChan context) (ServerMessage msg)
 183
 184     case msg of
 185       (RspShutdown _) -> return ()
 186       _               -> listenServer serverOut context
 187
 188 -- | The current text contents of a document.
 189 documentContents :: TextDocumentIdentifier -> Session T.Text
 190 documentContents doc = do
 191   vfs <- vfs <$> get
 192   let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
 193   return $ Rope.toText $ Language.Haskell.LSP.VFS._text file
 194
 195 -- | Parses an ApplyEditRequest, checks that it is for the passed document
 196 -- and returns the new content
 197 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
 198 getDocumentEdit doc = do
 199   req <- message :: Session ApplyWorkspaceEditRequest
 200
 201   unless (checkDocumentChanges req || checkChanges req) $
 202     liftIO $ throw (IncorrectApplyEditRequest (show req))
 203
 204   documentContents doc
 205   where
 206     checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
 207     checkDocumentChanges req =
 208       let changes = req ^. params . edit . documentChanges
 209           maybeDocs = fmap (fmap (^. textDocument . uri)) changes
 210       in case maybeDocs of
 211         Just docs -> (doc ^. uri) `elem` docs
 212         Nothing -> False
 213     checkChanges :: ApplyWorkspaceEditRequest -> Bool
 214     checkChanges req =
 215       let mMap = req ^. params . edit . changes
 216         in maybe False (HashMap.member (doc ^. uri)) mMap
 217
 218 -- | Sends a request to the server and waits for its response.
 219 -- Will skip any messages in between the request and the response
 220 -- @
 221 -- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
 222 -- @
 223 -- Note: will skip any messages in between the request and the response.
 224 request :: (ToJSON params, FromJSON a) => ClientMethod -> params -> Session (ResponseMessage a)
 225 request m = sendRequest m >=> skipManyTill anyMessage . responseForId
 226
 227 -- | The same as 'sendRequest', but discard the response.
 228 request_ :: ToJSON params => ClientMethod -> params -> Session ()
 229 request_ p = void . (request p :: ToJSON params => params -> Session (ResponseMessage Value))
 230
 231 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
 232 sendRequest
 233   :: ToJSON params
 234   => ClientMethod -- ^ The request method.
 235   -> params -- ^ The request parameters.
 236   -> Session LspId -- ^ The id of the request that was sent.
 237 sendRequest method params = do
 238   id <- curReqId <$> get
 239   modify $ \c -> c { curReqId = nextId id }
 240
 241   let req = RequestMessage' "2.0" id method params
 242
 243   -- Update the request map
 244   reqMap <- requestMap <$> ask
 245   liftIO $ modifyMVar_ reqMap $
 246     \r -> return $ updateRequestMap r id method
 247
 248   sendMessage req
 249
 250   return id
 251
 252   where nextId (IdInt i) = IdInt (i + 1)
 253         nextId (IdString s) = IdString $ T.pack $ show $ read (T.unpack s) + 1
 254
 255 -- | A custom type for request message that doesn't
 256 -- need a response type, allows us to infer the request
 257 -- message type without using proxies.
 258 data RequestMessage' a = RequestMessage' T.Text LspId ClientMethod a
 259
 260 instance ToJSON a => ToJSON (RequestMessage' a) where
 261   toJSON (RequestMessage' rpc id method params) =
 262     object ["jsonrpc" .= rpc, "id" .= id, "method" .= method, "params" .= params]
 263
 264
 265 -- | Sends a notification to the server.
 266 sendNotification :: ToJSON a
 267                  => ClientMethod -- ^ The notification method.
 268                  -> a -- ^ The notification parameters.
 269                  -> Session ()
 270
 271 -- Open a virtual file if we send a did open text document notification
 272 sendNotification TextDocumentDidOpen params = do
 273   let params' = fromJust $ decode $ encode params
 274       n :: DidOpenTextDocumentNotification
 275       n = NotificationMessage "2.0" TextDocumentDidOpen params'
 276   oldVFS <- vfs <$> get
 277   let (newVFS,_) = openVFS oldVFS n
 278   modify (\s -> s { vfs = newVFS })
 279   sendMessage n
 280
 281 -- Close a virtual file if we send a close text document notification
 282 sendNotification TextDocumentDidClose params = do
 283   let params' = fromJust $ decode $ encode params
 284       n :: DidCloseTextDocumentNotification
 285       n = NotificationMessage "2.0" TextDocumentDidClose params'
 286   oldVFS <- vfs <$> get
 287   let (newVFS,_) = closeVFS oldVFS n
 288   modify (\s -> s { vfs = newVFS })
 289   sendMessage n
 290
 291 sendNotification TextDocumentDidChange params = do
 292     let params' = fromJust $ decode $ encode params
 293         n :: DidChangeTextDocumentNotification
 294         n = NotificationMessage "2.0" TextDocumentDidChange params'
 295     oldVFS <- vfs <$> get
 296     let (newVFS,_) = changeFromClientVFS oldVFS n
 297     modify (\s -> s { vfs = newVFS })
 298     sendMessage n
 299
 300 sendNotification method params = sendMessage (NotificationMessage "2.0" method params)
 301
 302 -- | Sends a response to the server.
 303 sendResponse :: ToJSON a => ResponseMessage a -> Session ()
 304 sendResponse = sendMessage
 305
 306 -- | Returns the initialize response that was received from the server.
 307 -- The initialize requests and responses are not included the session,
 308 -- so if you need to test it use this.
 309 initializeResponse :: Session InitializeResponse
 310 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
 311
 312 -- | Opens a text document and sends a notification to the client.
 313 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
 314 openDoc file languageId = do
 315   context <- ask
 316   let fp = rootDir context </> file
 317   contents <- liftIO $ T.readFile fp
 318   openDoc' file languageId contents
 319
 320 -- | This is a variant of `openDoc` that takes the file content as an argument.
 321 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
 322 openDoc' file languageId contents = do
 323   context <- ask
 324   let fp = rootDir context </> file
 325       uri = filePathToUri fp
 326       item = TextDocumentItem uri (T.pack languageId) 0 contents
 327   sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams item)
 328   pure $ TextDocumentIdentifier uri
 329
 330 -- | Closes a text document and sends a notification to the client.
 331 closeDoc :: TextDocumentIdentifier -> Session ()
 332 closeDoc docId = do
 333   let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
 334   sendNotification TextDocumentDidClose params
 335
 336 -- | Changes a text document and sends a notification to the client
 337 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
 338 changeDoc docId changes = do
 339   verDoc <- getVersionedDoc docId
 340   let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
 341   sendNotification TextDocumentDidChange params
 342
 343 -- | Gets the Uri for the file corrected to the session directory.
 344 getDocUri :: FilePath -> Session Uri
 345 getDocUri file = do
 346   context <- ask
 347   let fp = rootDir context </> file
 348   return $ filePathToUri fp
 349
 350 -- | Waits for diagnostics to be published and returns them.
 351 waitForDiagnostics :: Session [Diagnostic]
 352 waitForDiagnostics = do
 353   diagsNot <- skipManyTill anyMessage message :: Session PublishDiagnosticsNotification
 354   let (List diags) = diagsNot ^. params . LSP.diagnostics
 355   return diags
 356
 357 -- | The same as 'waitForDiagnostics', but will only match a specific
 358 -- 'Language.Haskell.LSP.Types._source'.
 359 waitForDiagnosticsSource :: String -> Session [Diagnostic]
 360 waitForDiagnosticsSource src = do
 361   diags <- waitForDiagnostics
 362   let res = filter matches diags
 363   if null res
 364     then waitForDiagnosticsSource src
 365     else return res
 366   where
 367     matches :: Diagnostic -> Bool
 368     matches d = d ^. source == Just (T.pack src)
 369
 370 -- | Expects a 'PublishDiagnosticsNotification' and throws an
 371 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
 372 -- returned.
 373 noDiagnostics :: Session ()
 374 noDiagnostics = do
 375   diagsNot <- message :: Session PublishDiagnosticsNotification
 376   when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
 377
 378 -- | Returns the symbols in a document.
 379 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
 380 getDocumentSymbols doc = do
 381   ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse
 382   maybe (return ()) (throw . UnexpectedResponseError rspLid) mErr
 383   case mRes of
 384     Just (DSDocumentSymbols (List xs)) -> return (Left xs)
 385     Just (DSSymbolInformation (List xs)) -> return (Right xs)
 386     Nothing -> Prelude.error "No result and no error in DocumentSymbolsResponse"
 387
 388 -- | Returns the code actions in the specified range.
 389 getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
 390 getCodeActions doc range = do
 391   ctx <- getCodeActionContext doc
 392   rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx Nothing)
 393
 394   case rsp ^. result of
 395     Just (List xs) -> return xs
 396     _ -> throw (UnexpectedResponseError (rsp ^. LSP.id) (fromJust $ rsp ^. LSP.error))
 397
 398 -- | Returns all the code actions in a document by
 399 -- querying the code actions at each of the current
 400 -- diagnostics' positions.
 401 getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult]
 402 getAllCodeActions doc = do
 403   ctx <- getCodeActionContext doc
 404
 405   foldM (go ctx) [] =<< getCurrentDiagnostics doc
 406
 407   where
 408     go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
 409     go ctx acc diag = do
 410       ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing)
 411
 412       case mErr of
 413         Just e -> throw (UnexpectedResponseError rspLid e)
 414         Nothing ->
 415           let Just (List cmdOrCAs) = mRes
 416             in return (acc ++ cmdOrCAs)
 417
 418 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
 419 getCodeActionContext doc = do
 420   curDiags <- getCurrentDiagnostics doc
 421   return $ CodeActionContext (List curDiags) Nothing
 422
 423 -- | Returns the current diagnostics that have been sent to the client.
 424 -- Note that this does not wait for more to come in.
 425 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
 426 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
 427
 428 -- | Executes a command.
 429 executeCommand :: Command -> Session ()
 430 executeCommand cmd = do
 431   let args = decode $ encode $ fromJust $ cmd ^. arguments
 432       execParams = ExecuteCommandParams (cmd ^. command) args Nothing
 433   request_ WorkspaceExecuteCommand execParams
 434
 435 -- | Executes a code action.
 436 -- Matching with the specification, if a code action
 437 -- contains both an edit and a command, the edit will
 438 -- be applied first.
 439 executeCodeAction :: CodeAction -> Session ()
 440 executeCodeAction action = do
 441   maybe (return ()) handleEdit $ action ^. edit
 442   maybe (return ()) executeCommand $ action ^. command
 443
 444   where handleEdit :: WorkspaceEdit -> Session ()
 445         handleEdit e =
 446           -- Its ok to pass in dummy parameters here as they aren't used
 447           let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams e)
 448             in updateState (ReqApplyWorkspaceEdit req)
 449
 450 -- | Adds the current version to the document, as tracked by the session.
 451 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
 452 getVersionedDoc (TextDocumentIdentifier uri) = do
 453   fs <- vfsMap . vfs <$> get
 454   let ver =
 455         case fs Map.!? toNormalizedUri uri of
 456           Just vf -> Just (virtualFileVersion vf)
 457           _ -> Nothing
 458   return (VersionedTextDocumentIdentifier uri ver)
 459
 460 -- | Applys an edit to the document and returns the updated document version.
 461 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
 462 applyEdit doc edit = do
 463
 464   verDoc <- getVersionedDoc doc
 465
 466   caps <- asks sessionCapabilities
 467
 468   let supportsDocChanges = fromMaybe False $ do
 469         let mWorkspace = C._workspace caps
 470         C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
 471         C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
 472         mDocChanges
 473
 474   let wEdit = if supportsDocChanges
 475       then
 476         let docEdit = TextDocumentEdit verDoc (List [edit])
 477         in WorkspaceEdit Nothing (Just (List [docEdit]))
 478       else
 479         let changes = HashMap.singleton (doc ^. uri) (List [edit])
 480         in WorkspaceEdit (Just changes) Nothing
 481
 482   let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
 483   updateState (ReqApplyWorkspaceEdit req)
 484
 485   -- version may have changed
 486   getVersionedDoc doc
 487
 488 -- | Returns the completions for the position in the document.
 489 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
 490 getCompletions doc pos = do
 491   rsp <- request TextDocumentCompletion (TextDocumentPositionParams doc pos Nothing)
 492
 493   case getResponseResult rsp of
 494     Completions (List items) -> return items
 495     CompletionList (CompletionListType _ (List items)) -> return items
 496
 497 -- | Returns the references for the position in the document.
 498 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
 499               -> Position -- ^ The position to lookup.
 500               -> Bool -- ^ Whether to include declarations as references.
 501               -> Session [Location] -- ^ The locations of the references.
 502 getReferences doc pos inclDecl =
 503   let ctx = ReferenceContext inclDecl
 504       params = ReferenceParams doc pos ctx Nothing
 505   in getResponseResult <$> request TextDocumentReferences params
 506
 507 -- | Returns the definition(s) for the term at the specified position.
 508 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
 509                -> Position -- ^ The position the term is at.
 510                -> Session [Location] -- ^ The location(s) of the definitions
 511 getDefinitions doc pos = do
 512   let params = TextDocumentPositionParams doc pos Nothing
 513   rsp <- request TextDocumentDefinition params :: Session DefinitionResponse
 514   case getResponseResult rsp of
 515       SingleLoc loc -> pure [loc]
 516       MultiLoc locs -> pure locs
 517
 518 -- | Returns the type definition(s) for the term at the specified position.
 519 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
 520                -> Position -- ^ The position the term is at.
 521                -> Session [Location] -- ^ The location(s) of the definitions
 522 getTypeDefinitions doc pos =
 523   let params = TextDocumentPositionParams doc pos Nothing
 524   in getResponseResult <$> request TextDocumentTypeDefinition params
 525
 526 -- | Renames the term at the specified position.
 527 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
 528 rename doc pos newName = do
 529   let params = RenameParams doc pos (T.pack newName) Nothing
 530   rsp <- request TextDocumentRename params :: Session RenameResponse
 531   let wEdit = getResponseResult rsp
 532       req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
 533   updateState (ReqApplyWorkspaceEdit req)
 534
 535 -- | Returns the hover information at the specified position.
 536 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
 537 getHover doc pos =
 538   let params = TextDocumentPositionParams doc pos Nothing
 539   in getResponseResult <$> request TextDocumentHover params
 540
 541 -- | Returns the highlighted occurences of the term at the specified position
 542 getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
 543 getHighlights doc pos =
 544   let params = TextDocumentPositionParams doc pos Nothing
 545   in getResponseResult <$> request TextDocumentDocumentHighlight params
 546
 547 -- | Checks the response for errors and throws an exception if needed.
 548 -- Returns the result if successful.
 549 getResponseResult :: ResponseMessage a -> a
 550 getResponseResult rsp = fromMaybe exc (rsp ^. result)
 551   where exc = throw $ UnexpectedResponseError (rsp ^. LSP.id)
 552                                               (fromJust $ rsp ^. LSP.error)
 553
 554 -- | Applies formatting to the specified document.
 555 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
 556 formatDoc doc opts = do
 557   let params = DocumentFormattingParams doc opts Nothing
 558   edits <- getResponseResult <$> request TextDocumentFormatting params
 559   applyTextEdits doc edits
 560
 561 -- | Applies formatting to the specified range in a document.
 562 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
 563 formatRange doc opts range = do
 564   let params = DocumentRangeFormattingParams doc range opts Nothing
 565   edits <- getResponseResult <$> request TextDocumentRangeFormatting params
 566   applyTextEdits doc edits
 567
 568 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
 569 applyTextEdits doc edits =
 570   let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
 571       req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
 572   in updateState (ReqApplyWorkspaceEdit req)
 573
 574 -- | Returns the code lenses for the specified document.
 575 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
 576 getCodeLenses tId = do
 577     rsp <- request TextDocumentCodeLens (CodeLensParams tId Nothing) :: Session CodeLensResponse
 578     case getResponseResult rsp of
 579         List res -> pure res