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