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