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