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