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