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