src/Language/Haskell/LSP/Test.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE TypeOperators #-}
   3 {-# LANGUAGE FlexibleContexts #-}
   4 {-# LANGUAGE KindSignatures #-}
   5 {-# LANGUAGE DataKinds #-}
   6 {-# LANGUAGE GADTs #-}
   7 {-# LANGUAGE RankNTypes #-}
   8 {-# LANGUAGE PolyKinds #-}
   9 {-# LANGUAGE ScopedTypeVariables #-}
  10 {-# LANGUAGE ExistentialQuantification #-}
  11
  12 {-|
  13 Module      : Language.Haskell.LSP.Test
  14 Description : A functional testing framework for LSP servers.
  15 Maintainer  : luke_lau@icloud.com
  16 Stability   : experimental
  17 Portability : non-portable
  18
  19 Provides the framework to start functionally testing
  20 <https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>.
  21 You should import "Language.Haskell.LSP.Types" alongside this.
  22 -}
  23 module Language.Haskell.LSP.Test
  24   (
  25   -- * Sessions
  26     Session
  27   , runSession
  28   -- ** Config
  29   , runSessionWithConfig
  30   , SessionConfig(..)
  31   , defaultConfig
  32   , C.fullCaps
  33   -- ** Exceptions
  34   , module Language.Haskell.LSP.Test.Exceptions
  35   , withTimeout
  36   -- * Sending
  37   , request
  38   , request_
  39   , sendRequest
  40   , sendNotification
  41   , sendResponse
  42   -- * Receving
  43   , module Language.Haskell.LSP.Test.Parsing
  44   -- * Utilities
  45   -- | Quick helper functions for common tasks.
  46
  47   -- ** Initialization
  48   , initializeResponse
  49   -- ** Documents
  50   , createDoc
  51   , openDoc
  52   , closeDoc
  53   , changeDoc
  54   , documentContents
  55   , getDocumentEdit
  56   , getDocUri
  57   , getVersionedDoc
  58   -- ** Symbols
  59   , getDocumentSymbols
  60   -- ** Diagnostics
  61   , waitForDiagnostics
  62   , waitForDiagnosticsSource
  63   , noDiagnostics
  64   , getCurrentDiagnostics
  65   -- ** Commands
  66   , executeCommand
  67   -- ** Code Actions
  68   , getCodeActions
  69   , getAllCodeActions
  70   , executeCodeAction
  71   -- ** Completions
  72   , getCompletions
  73   -- ** References
  74   , getReferences
  75   -- ** Definitions
  76   , getDefinitions
  77   , getTypeDefinitions
  78   -- ** Renaming
  79   , rename
  80   -- ** Hover
  81   , getHover
  82   -- ** Highlights
  83   , getHighlights
  84   -- ** Formatting
  85   , formatDoc
  86   , formatRange
  87   -- ** Edits
  88   , applyEdit
  89   -- ** Code lenses
  90   , getCodeLenses
  91   -- ** Capabilities
  92   , getRegisteredCapabilities
  93   ) where
  94
  95 import Control.Applicative.Combinators
  96 import Control.Concurrent
  97 import Control.Monad
  98 import Control.Monad.IO.Class
  99 import Control.Exception
 100 import Control.Lens hiding ((.=), List, Empty)
 101 import qualified Data.Map.Strict as Map
 102 import qualified Data.Text as T
 103 import qualified Data.Text.IO as T
 104 import Data.Aeson
 105 import Data.Default
 106 import qualified Data.HashMap.Strict as HashMap
 107 import Data.List
 108 import Data.Maybe
 109 import Language.Haskell.LSP.Types
 110 import Language.Haskell.LSP.Types.Lens hiding
 111   (id, capabilities, message, executeCommand, applyEdit, rename)
 112 import qualified Language.Haskell.LSP.Types.Lens as LSP
 113 import qualified Language.Haskell.LSP.Types.Capabilities as C
 114 import Language.Haskell.LSP.VFS
 115 import Language.Haskell.LSP.Test.Compat
 116 import Language.Haskell.LSP.Test.Decoding
 117 import Language.Haskell.LSP.Test.Exceptions
 118 import Language.Haskell.LSP.Test.Parsing
 119 import Language.Haskell.LSP.Test.Session
 120 import Language.Haskell.LSP.Test.Server
 121 import System.Environment
 122 import System.IO
 123 import System.Directory
 124 import System.FilePath
 125 import qualified System.FilePath.Glob as Glob
 126
 127 -- | Starts a new session.
 128 --
 129 -- > runSession "hie" fullCaps "path/to/root/dir" $ do
 130 -- >   doc <- openDoc "Desktop/simple.hs" "haskell"
 131 -- >   diags <- waitForDiagnostics
 132 -- >   let pos = Position 12 5
 133 -- >       params = TextDocumentPositionParams doc
 134 -- >   hover <- request TextDocumentHover params
 135 runSession :: 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 runSession = runSessionWithConfig def
 141
 142 -- | Starts a new sesion with a custom configuration.
 143 runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
 144                      -> String -- ^ The command to run the server.
 145                      -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
 146                      -> FilePath -- ^ The filepath to the root directory for the session.
 147                      -> Session a -- ^ The session to run.
 148                      -> IO a
 149 runSessionWithConfig config' serverExe caps rootDir session = do
 150   pid <- getCurrentProcessID
 151   absRootDir <- canonicalizePath rootDir
 152
 153   config <- envOverrideConfig config'
 154
 155   let initializeParams = InitializeParams (Just pid)
 156                                           (Just $ T.pack absRootDir)
 157                                           (Just $ filePathToUri absRootDir)
 158                                           Nothing
 159                                           caps
 160                                           (Just TraceOff)
 161                                           Nothing
 162   withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
 163     runSessionWithHandles serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
 164       -- Wrap the session around initialize and shutdown calls
 165       -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
 166       initReqId <- sendRequest SInitialize initializeParams
 167
 168       -- Because messages can be sent in between the request and response,
 169       -- collect them and then...
 170       (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId initReqId)
 171
 172       case initRspMsg ^. LSP.result of
 173         Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error)
 174         Right _ -> pure ()
 175
 176       initRspVar <- initRsp <$> ask
 177       liftIO $ putMVar initRspVar initRspMsg
 178       sendNotification SInitialized (Just InitializedParams)
 179
 180       case lspConfig config of
 181         Just cfg -> sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
 182         Nothing -> return ()
 183
 184       -- ... relay them back to the user Session so they can match on them!
 185       -- As long as they are allowed.
 186       forM_ inBetween checkLegalBetweenMessage
 187       msgChan <- asks messageChan
 188       liftIO $ writeList2Chan msgChan (ServerMessage <$> inBetween)
 189
 190       -- Run the actual test
 191       session
 192   where
 193   -- | Asks the server to shutdown and exit politely
 194   exitServer :: Session ()
 195   exitServer = request_ SShutdown (Nothing :: Maybe Value) >> sendNotification SExit (Just Empty)
 196
 197   -- | Listens to the server output until the shutdown ack,
 198   -- makes sure it matches the record and signals any semaphores
 199   listenServer :: Handle -> SessionContext -> IO ()
 200   listenServer serverOut context = do
 201     msgBytes <- getNextMessage serverOut
 202
 203     reqMap <- readMVar $ requestMap context
 204
 205     let msg = decodeFromServerMsg reqMap msgBytes
 206     writeChan (messageChan context) (ServerMessage msg)
 207
 208     case msg of
 209       (FromServerRsp SShutdown _) -> return ()
 210       _               -> listenServer serverOut context
 211
 212   -- | Is this message allowed to be sent by the server between the intialize
 213   -- request and response?
 214   -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
 215   checkLegalBetweenMessage :: FromServerMessage -> Session ()
 216   checkLegalBetweenMessage (FromServerMess SWindowShowMessage _) = pure ()
 217   checkLegalBetweenMessage (FromServerMess SWindowLogMessage _) = pure ()
 218   checkLegalBetweenMessage (FromServerMess STelemetryEvent _) = pure ()
 219   checkLegalBetweenMessage (FromServerMess SWindowShowMessageRequest _) = pure ()
 220   checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
 221
 222   -- | Check environment variables to override the config
 223   envOverrideConfig :: SessionConfig -> IO SessionConfig
 224   envOverrideConfig cfg = do
 225     logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
 226     logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
 227     return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
 228     where checkEnv :: String -> IO (Maybe Bool)
 229           checkEnv s = fmap convertVal <$> lookupEnv s
 230           convertVal "0" = False
 231           convertVal _ = True
 232
 233 -- | The current text contents of a document.
 234 documentContents :: TextDocumentIdentifier -> Session T.Text
 235 documentContents doc = do
 236   vfs <- vfs <$> get
 237   let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
 238   return (virtualFileText file)
 239
 240 -- | Parses an ApplyEditRequest, checks that it is for the passed document
 241 -- and returns the new content
 242 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
 243 getDocumentEdit doc = do
 244   req <- message SWorkspaceApplyEdit
 245
 246   unless (checkDocumentChanges req || checkChanges req) $
 247     liftIO $ throw (IncorrectApplyEditRequest (show req))
 248
 249   documentContents doc
 250   where
 251     checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
 252     checkDocumentChanges req =
 253       let changes = req ^. params . edit . documentChanges
 254           maybeDocs = fmap (fmap (^. textDocument . uri)) changes
 255       in case maybeDocs of
 256         Just docs -> (doc ^. uri) `elem` docs
 257         Nothing -> False
 258     checkChanges :: ApplyWorkspaceEditRequest -> Bool
 259     checkChanges req =
 260       let mMap = req ^. params . edit . changes
 261         in maybe False (HashMap.member (doc ^. uri)) mMap
 262
 263 -- | Sends a request to the server and waits for its response.
 264 -- Will skip any messages in between the request and the response
 265 -- @
 266 -- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
 267 -- @
 268 -- Note: will skip any messages in between the request and the response.
 269 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
 270 request m = sendRequest m >=> skipManyTill anyMessage . responseForId
 271
 272 -- | The same as 'sendRequest', but discard the response.
 273 request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
 274 request_ p = void . request p
 275
 276 -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
 277 sendRequest
 278   :: SClientMethod m -- ^ The request method.
 279   -> MessageParams m -- ^ The request parameters.
 280   -> Session (LspId m) -- ^ The id of the request that was sent.
 281 sendRequest method params = do
 282   idn <- curReqId <$> get
 283   modify $ \c -> c { curReqId = idn+1 }
 284   let id = IdInt idn
 285
 286   let mess = RequestMessage "2.0" id method params
 287
 288   -- Update the request map
 289   reqMap <- requestMap <$> ask
 290   liftIO $ modifyMVar_ reqMap $
 291     \r -> return $ fromJust $ updateRequestMap r id method
 292
 293   ~() <- case splitClientMethod method of
 294     IsClientReq -> sendMessage mess
 295     IsClientEither -> sendMessage $ ReqMess mess
 296
 297   return id
 298
 299 -- | Sends a notification to the server.
 300 sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
 301                  -> MessageParams m -- ^ The notification parameters.
 302                  -> Session ()
 303 -- Open a virtual file if we send a did open text document notification
 304 sendNotification STextDocumentDidOpen params = do
 305   let n = NotificationMessage "2.0" STextDocumentDidOpen params
 306   oldVFS <- vfs <$> get
 307   let (newVFS,_) = openVFS oldVFS n
 308   modify (\s -> s { vfs = newVFS })
 309   sendMessage n
 310
 311 -- Close a virtual file if we send a close text document notification
 312 sendNotification STextDocumentDidClose params = do
 313   let n = NotificationMessage "2.0" STextDocumentDidClose params
 314   oldVFS <- vfs <$> get
 315   let (newVFS,_) = closeVFS oldVFS n
 316   modify (\s -> s { vfs = newVFS })
 317   sendMessage n
 318
 319 sendNotification STextDocumentDidChange params = do
 320     let n = NotificationMessage "2.0" STextDocumentDidChange params
 321     oldVFS <- vfs <$> get
 322     let (newVFS,_) = changeFromClientVFS oldVFS n
 323     modify (\s -> s { vfs = newVFS })
 324     sendMessage n
 325
 326 sendNotification method params =
 327   case splitClientMethod method of
 328     IsClientNot -> sendMessage (NotificationMessage "2.0" method params)
 329     IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
 330
 331 -- | Sends a response to the server.
 332 sendResponse :: ToJSON (ResponseParams m) => ResponseMessage m -> Session ()
 333 sendResponse = sendMessage
 334
 335 -- | Returns the initialize response that was received from the server.
 336 -- The initialize requests and responses are not included the session,
 337 -- so if you need to test it use this.
 338 initializeResponse :: Session InitializeResponse
 339 initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
 340
 341 -- | /Creates/ a new text document. This is different from 'openDoc'
 342 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
 343 -- know that a file was created within the workspace, __provided that the server
 344 -- has registered for it__, and the file matches any patterns the server
 345 -- registered for.
 346 -- It /does not/ actually create a file on disk, but is useful for convincing
 347 -- the server that one does exist.
 348 --
 349 -- @since 11.0.0.0
 350 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
 351           -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
 352           -> T.Text -- ^ The content of the text document to create.
 353           -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
 354 createDoc file languageId contents = do
 355   dynCaps <- curDynCaps <$> get
 356   rootDir <- asks rootDir
 357   caps <- asks sessionCapabilities
 358   absFile <- liftIO $ canonicalizePath (rootDir </> file)
 359   let regs = filter (\r -> r ^. method == SomeClientMethod SWorkspaceDidChangeWatchedFiles) $
 360               Map.elems dynCaps
 361       watchHits :: FileSystemWatcher -> Bool
 362       watchHits (FileSystemWatcher pattern kind) =
 363         -- If WatchKind is exlcuded, defaults to all true as per spec
 364         fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
 365
 366       fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
 367         -- If the pattern is absolute then match against the absolute fp
 368         where relOrAbs
 369                 | isAbsolute pattern = absFile
 370                 | otherwise = file
 371
 372       createHits (WatchKind create _ _) = create
 373
 374       regHits :: SomeRegistration -> Bool
 375       regHits reg = isJust $ do
 376         opts <- reg ^. registerOptions
 377         fileWatchOpts <- case fromJSON opts :: Result DidChangeWatchedFilesRegistrationOptions of
 378           Success x -> Just x
 379           Error _ -> Nothing
 380         if foldl' (\acc w -> acc || watchHits w) False (fileWatchOpts ^. watchers)
 381           then Just ()
 382           else Nothing
 383
 384       clientCapsSupports =
 385           caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
 386             == Just True
 387       shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
 388
 389   when shouldSend $
 390     sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
 391       List [ FileEvent (filePathToUri (rootDir </> file)) FcCreated ]
 392   openDoc' file languageId contents
 393
 394 -- | Opens a text document that /exists on disk/, and sends a
 395 -- textDocument/didOpen notification to the server.
 396 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
 397 openDoc file languageId = do
 398   context <- ask
 399   let fp = rootDir context </> file
 400   contents <- liftIO $ T.readFile fp
 401   openDoc' file languageId contents
 402
 403 -- | This is a variant of `openDoc` that takes the file content as an argument.
 404 -- Use this is the file exists /outside/ of the current workspace.
 405 openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
 406 openDoc' file languageId contents = do
 407   context <- ask
 408   let fp = rootDir context </> file
 409       uri = filePathToUri fp
 410       item = TextDocumentItem uri (T.pack languageId) 0 contents
 411   sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
 412   pure $ TextDocumentIdentifier uri
 413
 414 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
 415 closeDoc :: TextDocumentIdentifier -> Session ()
 416 closeDoc docId = do
 417   let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
 418   sendNotification STextDocumentDidClose params
 419
 420 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
 421 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
 422 changeDoc docId changes = do
 423   verDoc <- getVersionedDoc docId
 424   let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes)
 425   sendNotification STextDocumentDidChange params
 426
 427 -- | Gets the Uri for the file corrected to the session directory.
 428 getDocUri :: FilePath -> Session Uri
 429 getDocUri file = do
 430   context <- ask
 431   let fp = rootDir context </> file
 432   return $ filePathToUri fp
 433
 434 -- | Waits for diagnostics to be published and returns them.
 435 waitForDiagnostics :: Session [Diagnostic]
 436 waitForDiagnostics = do
 437   diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics)
 438   let (List diags) = diagsNot ^. params . LSP.diagnostics
 439   return diags
 440
 441 -- | The same as 'waitForDiagnostics', but will only match a specific
 442 -- 'Language.Haskell.LSP.Types._source'.
 443 waitForDiagnosticsSource :: String -> Session [Diagnostic]
 444 waitForDiagnosticsSource src = do
 445   diags <- waitForDiagnostics
 446   let res = filter matches diags
 447   if null res
 448     then waitForDiagnosticsSource src
 449     else return res
 450   where
 451     matches :: Diagnostic -> Bool
 452     matches d = d ^. source == Just (T.pack src)
 453
 454 -- | Expects a 'PublishDiagnosticsNotification' and throws an
 455 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
 456 -- returned.
 457 noDiagnostics :: Session ()
 458 noDiagnostics = do
 459   diagsNot <- message STextDocumentPublishDiagnostics
 460   when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
 461
 462 -- | Returns the symbols in a document.
 463 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
 464 getDocumentSymbols doc = do
 465   ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse
 466   case res of
 467     Right (L (List xs)) -> return (Left xs)
 468     Right (R (List xs)) -> return (Right xs)
 469     Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
 470
 471 -- | Returns the code actions in the specified range.
 472 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
 473 getCodeActions doc range = do
 474   ctx <- getCodeActionContext doc
 475   rsp <- request STextDocumentCodeAction (CodeActionParams doc range ctx Nothing)
 476
 477   case rsp ^. result of
 478     Right (List xs) -> return xs
 479     Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
 480
 481 -- | Returns all the code actions in a document by
 482 -- querying the code actions at each of the current
 483 -- diagnostics' positions.
 484 getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
 485 getAllCodeActions doc = do
 486   ctx <- getCodeActionContext doc
 487
 488   foldM (go ctx) [] =<< getCurrentDiagnostics doc
 489
 490   where
 491     go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
 492     go ctx acc diag = do
 493       ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing)
 494
 495       case res of
 496         Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
 497         Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
 498
 499 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
 500 getCodeActionContext doc = do
 501   curDiags <- getCurrentDiagnostics doc
 502   return $ CodeActionContext (List curDiags) Nothing
 503
 504 -- | Returns the current diagnostics that have been sent to the client.
 505 -- Note that this does not wait for more to come in.
 506 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
 507 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
 508
 509 -- | Executes a command.
 510 executeCommand :: Command -> Session ()
 511 executeCommand cmd = do
 512   let args = decode $ encode $ fromJust $ cmd ^. arguments
 513       execParams = ExecuteCommandParams (cmd ^. command) args Nothing
 514   request_ SWorkspaceExecuteCommand execParams
 515
 516 -- | Executes a code action.
 517 -- Matching with the specification, if a code action
 518 -- contains both an edit and a command, the edit will
 519 -- be applied first.
 520 executeCodeAction :: CodeAction -> Session ()
 521 executeCodeAction action = do
 522   maybe (return ()) handleEdit $ action ^. edit
 523   maybe (return ()) executeCommand $ action ^. command
 524
 525   where handleEdit :: WorkspaceEdit -> Session ()
 526         handleEdit e =
 527           -- Its ok to pass in dummy parameters here as they aren't used
 528           let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams e)
 529             in updateState (FromServerMess SWorkspaceApplyEdit req)
 530
 531 -- | Adds the current version to the document, as tracked by the session.
 532 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
 533 getVersionedDoc (TextDocumentIdentifier uri) = do
 534   fs <- vfsMap . vfs <$> get
 535   let ver =
 536         case fs Map.!? toNormalizedUri uri of
 537           Just vf -> Just (virtualFileVersion vf)
 538           _ -> Nothing
 539   return (VersionedTextDocumentIdentifier uri ver)
 540
 541 -- | Applys an edit to the document and returns the updated document version.
 542 applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
 543 applyEdit doc edit = do
 544
 545   verDoc <- getVersionedDoc doc
 546
 547   caps <- asks sessionCapabilities
 548
 549   let supportsDocChanges = fromMaybe False $ do
 550         let mWorkspace = caps ^. LSP.workspace
 551         C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
 552         C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
 553         mDocChanges
 554
 555   let wEdit = if supportsDocChanges
 556       then
 557         let docEdit = TextDocumentEdit verDoc (List [edit])
 558         in WorkspaceEdit Nothing (Just (List [docEdit]))
 559       else
 560         let changes = HashMap.singleton (doc ^. uri) (List [edit])
 561         in WorkspaceEdit (Just changes) Nothing
 562
 563   let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
 564   updateState (FromServerMess SWorkspaceApplyEdit req)
 565
 566   -- version may have changed
 567   getVersionedDoc doc
 568
 569 -- | Returns the completions for the position in the document.
 570 getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
 571 getCompletions doc pos = do
 572   rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing)
 573
 574   case getResponseResult rsp of
 575     L (List items) -> return items
 576     R (CompletionList _ (List items)) -> return items
 577
 578 -- | Returns the references for the position in the document.
 579 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
 580               -> Position -- ^ The position to lookup.
 581               -> Bool -- ^ Whether to include declarations as references.
 582               -> Session (List Location) -- ^ The locations of the references.
 583 getReferences doc pos inclDecl =
 584   let ctx = ReferenceContext inclDecl
 585       params = ReferenceParams doc pos ctx Nothing
 586   in getResponseResult <$> request STextDocumentReferences params
 587
 588 -- | Returns the definition(s) for the term at the specified position.
 589 getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
 590                -> Position -- ^ The position the term is at.
 591                -> Session [Location] -- ^ The location(s) of the definitions
 592 getDefinitions doc pos = do
 593   let params = TextDocumentPositionParams doc pos Nothing
 594   rsp <- request STextDocumentDefinition params :: Session DefinitionResponse
 595   case getResponseResult rsp of
 596       L loc -> pure [loc]
 597       R locs -> pure locs
 598
 599 -- | Returns the type definition(s) for the term at the specified position.
 600 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
 601                -> Position -- ^ The position the term is at.
 602                -> Session (Location |? List Location |? List LocationLink) -- ^ The location(s) of the definitions
 603 getTypeDefinitions doc pos =
 604   let params = TextDocumentPositionParams doc pos Nothing
 605   rsp <- request STextDocumentTypeDefinition params :: Session TypeDefinitionResponse
 606   case getResponseResult rsp of
 607       L loc -> pure [loc]
 608       R locs -> pure locs
 609
 610 -- | Renames the term at the specified position.
 611 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
 612 rename doc pos newName = do
 613   let params = RenameParams doc pos (T.pack newName) Nothing
 614   rsp <- request STextDocumentRename params :: Session RenameResponse
 615   let wEdit = getResponseResult rsp
 616       req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
 617   updateState (FromServerMess SWorkspaceApplyEdit req)
 618
 619 -- | Returns the hover information at the specified position.
 620 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
 621 getHover doc pos =
 622   let params = TextDocumentPositionParams doc pos Nothing
 623   in getResponseResult <$> request STextDocumentHover params
 624
 625 -- | Returns the highlighted occurences of the term at the specified position
 626 getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
 627 getHighlights doc pos =
 628   let params = TextDocumentPositionParams doc pos Nothing
 629   in getResponseResult <$> request STextDocumentDocumentHighlight params
 630
 631 -- | Checks the response for errors and throws an exception if needed.
 632 -- Returns the result if successful.
 633 getResponseResult :: ResponseMessage m -> ResponseParams m
 634 getResponseResult rsp =
 635   case rsp ^. result of
 636     Right x -> x
 637     Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
 638
 639 -- | Applies formatting to the specified document.
 640 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
 641 formatDoc doc opts = do
 642   let params = DocumentFormattingParams doc opts Nothing
 643   edits <- getResponseResult <$> request STextDocumentFormatting params
 644   applyTextEdits doc edits
 645
 646 -- | Applies formatting to the specified range in a document.
 647 formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
 648 formatRange doc opts range = do
 649   let params = DocumentRangeFormattingParams doc range opts Nothing
 650   edits <- getResponseResult <$> request STextDocumentRangeFormatting params
 651   applyTextEdits doc edits
 652
 653 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
 654 applyTextEdits doc edits =
 655   let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
 656       -- Send a dummy message to updateState so it can do bookkeeping
 657       req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
 658   in updateState (FromServerMess SWorkspaceApplyEdit req)
 659
 660 -- | Returns the code lenses for the specified document.
 661 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
 662 getCodeLenses tId = do
 663     rsp <- request STextDocumentCodeLens (CodeLensParams tId Nothing) :: Session CodeLensResponse
 664     case getResponseResult rsp of
 665         List res -> pure res
 666
 667 -- | Returns a list of capabilities that the server has requested to /dynamically/
 668 -- register during the 'Session'.
 669 --
 670 -- @since 0.11.0.0
 671 getRegisteredCapabilities :: Session [SomeRegistration]
 672 getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get