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