{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DuplicateRecordFields #-}

{-|
Module      : Language.LSP.Test
Description : A functional testing framework for LSP servers.
Maintainer  : luke_lau@icloud.com
Stability   : experimental
Portability : non-portable

Provides the framework to start functionally testing
<https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>.
You should import "Language.LSP.Types" alongside this.
-}
module Language.LSP.Test
  (
  -- * Sessions
    Session
  , runSession
  , runSessionWithConfig
  , runSessionWithConfigCustomProcess
  , runSessionWithHandles
  , runSessionWithHandles'
  -- ** Config
  , SessionConfig(..)
  , defaultConfig
  , C.fullCaps
  -- ** Exceptions
  , module Language.LSP.Test.Exceptions
  , withTimeout
  -- * Sending
  , request
  , request_
  , sendRequest
  , sendNotification
  , sendResponse
  -- * Receiving
  , module Language.LSP.Test.Parsing
  -- * Utilities
  -- | Quick helper functions for common tasks.

  -- ** Initialization
  , initializeResponse
  -- ** Documents
  , createDoc
  , openDoc
  , closeDoc
  , changeDoc
  , documentContents
  , getDocumentEdit
  , getDocUri
  , getVersionedDoc
  -- ** Symbols
  , getDocumentSymbols
  -- ** Diagnostics
  , waitForDiagnostics
  , waitForDiagnosticsSource
  , noDiagnostics
  , getCurrentDiagnostics
  , getIncompleteProgressSessions
  -- ** Commands
  , executeCommand
  -- ** Code Actions
  , getCodeActions
  , getAllCodeActions
  , executeCodeAction
  -- ** Completions
  , getCompletions
  -- ** References
  , getReferences
  -- ** Definitions
  , getDeclarations
  , getDefinitions
  , getTypeDefinitions
  , getImplementations
  -- ** Renaming
  , rename
  -- ** Hover
  , getHover
  -- ** Highlights
  , getHighlights
  -- ** Formatting
  , formatDoc
  , formatRange
  -- ** Edits
  , applyEdit
  -- ** Code lenses
  , getCodeLenses
  -- ** Call hierarchy
  , prepareCallHierarchy
  , incomingCalls
  , outgoingCalls
  -- ** SemanticTokens
  , getSemanticTokens
  -- ** Capabilities
  , getRegisteredCapabilities
  ) where

import Control.Applicative.Combinators
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Control.Exception
import Control.Lens hiding ((.=), List, Empty)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Aeson
import Data.Default
import qualified Data.HashMap.Strict as HashMap
import Data.List
import Data.Maybe
import Language.LSP.Types
import Language.LSP.Types.Lens hiding
  (id, capabilities, message, executeCommand, applyEdit, rename, to)
import qualified Language.LSP.Types.Lens as LSP
import qualified Language.LSP.Types.Capabilities as C
import Language.LSP.VFS
import Language.LSP.Test.Compat
import Language.LSP.Test.Decoding
import Language.LSP.Test.Exceptions
import Language.LSP.Test.Parsing
import Language.LSP.Test.Session
import Language.LSP.Test.Server
import System.Environment
import System.IO
import System.Directory
import System.FilePath
import System.Process (ProcessHandle, CreateProcess)
import qualified System.FilePath.Glob as Glob
import Control.Monad.State (execState)

-- | Starts a new session.
--
-- > runSession "hie" fullCaps "path/to/root/dir" $ do
-- >   doc <- openDoc "Desktop/simple.hs" "haskell"
-- >   diags <- waitForDiagnostics
-- >   let pos = Position 12 5
-- >       params = TextDocumentPositionParams doc
-- >   hover <- request STextdocumentHover params
runSession :: String -- ^ The command to run the server.
           -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
           -> FilePath -- ^ The filepath to the root directory for the session.
           -> Session a -- ^ The session to run.
           -> IO a
runSession :: forall a.
String -> ClientCapabilities -> String -> Session a -> IO a
runSession = forall a.
SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
runSessionWithConfig forall a. Default a => a
def

-- | Starts a new session with a custom configuration.
runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
                     -> String -- ^ The command to run the server.
                     -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
                     -> FilePath -- ^ The filepath to the root directory for the session.
                     -> Session a -- ^ The session to run.
                     -> IO a
runSessionWithConfig :: forall a.
SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
runSessionWithConfig = forall a.
(CreateProcess -> CreateProcess)
-> SessionConfig
-> String
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithConfigCustomProcess forall a. a -> a
id

-- | Starts a new session with a custom configuration and server 'CreateProcess'.
runSessionWithConfigCustomProcess :: (CreateProcess -> CreateProcess) -- ^ Tweak the 'CreateProcess' used to start the server.
                                  -> SessionConfig -- ^ Configuration options for the session.
                                  -> String -- ^ The command to run the server.
                                  -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
                                  -> FilePath -- ^ The filepath to the root directory for the session.
                                  -> Session a -- ^ The session to run.
                                  -> IO a
runSessionWithConfigCustomProcess :: forall a.
(CreateProcess -> CreateProcess)
-> SessionConfig
-> String
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithConfigCustomProcess CreateProcess -> CreateProcess
modifyCreateProcess SessionConfig
config' String
serverExe ClientCapabilities
caps String
rootDir Session a
session = do
  SessionConfig
config <- SessionConfig -> IO SessionConfig
envOverrideConfig SessionConfig
config'
  forall a.
String
-> Bool
-> (CreateProcess -> CreateProcess)
-> (Handle -> Handle -> ProcessHandle -> IO a)
-> IO a
withServer String
serverExe (SessionConfig -> Bool
logStdErr SessionConfig
config) CreateProcess -> CreateProcess
modifyCreateProcess forall a b. (a -> b) -> a -> b
$ \Handle
serverIn Handle
serverOut ProcessHandle
serverProc ->
    forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' (forall a. a -> Maybe a
Just ProcessHandle
serverProc) Handle
serverIn Handle
serverOut SessionConfig
config ClientCapabilities
caps String
rootDir Session a
session

-- | Starts a new session, using the specified handles to communicate with the
-- server. You can use this to host the server within the same process.
-- An example with lsp might look like:
--
-- > (hinRead, hinWrite) <- createPipe
-- > (houtRead, houtWrite) <- createPipe
-- >
-- > forkIO $ void $ runServerWithHandles hinRead houtWrite serverDefinition
-- > runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
-- >   -- ...
runSessionWithHandles :: Handle -- ^ The input handle
                      -> Handle -- ^ The output handle
                      -> SessionConfig
                      -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
                      -> FilePath -- ^ The filepath to the root directory for the session.
                      -> Session a -- ^ The session to run.
                      -> IO a
runSessionWithHandles :: forall a.
Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles = forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' forall a. Maybe a
Nothing


runSessionWithHandles' :: Maybe ProcessHandle
                       -> Handle -- ^ The input handle
                       -> Handle -- ^ The output handle
                       -> SessionConfig
                       -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
                       -> FilePath -- ^ The filepath to the root directory for the session.
                       -> Session a -- ^ The session to run.
                       -> IO a
runSessionWithHandles' :: forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' Maybe ProcessHandle
serverProc Handle
serverIn Handle
serverOut SessionConfig
config' ClientCapabilities
caps String
rootDir Session a
session = do
  Int
pid <- IO Int
getCurrentProcessID
  String
absRootDir <- String -> IO String
canonicalizePath String
rootDir

  SessionConfig
config <- SessionConfig -> IO SessionConfig
envOverrideConfig SessionConfig
config'

  let initializeParams :: InitializeParams
initializeParams = Maybe ProgressToken
-> Maybe Int32
-> Maybe ClientInfo
-> Maybe Text
-> Maybe Uri
-> Maybe Value
-> ClientCapabilities
-> Maybe Trace
-> Maybe (List WorkspaceFolder)
-> InitializeParams
InitializeParams forall a. Maybe a
Nothing
                                          -- Narrowing to Int32 here, but it's unlikely that a PID will
                                          -- be outside the range
                                          (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pid)
                                          (forall a. a -> Maybe a
Just ClientInfo
lspTestClientInfo)
                                          (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
absRootDir)
                                          (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Uri
filePathToUri String
absRootDir)
                                          (SessionConfig -> Maybe Value
lspConfig SessionConfig
config')
                                          ClientCapabilities
caps
                                          (forall a. a -> Maybe a
Just Trace
TraceOff)
                                          (forall a. [a] -> List a
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionConfig -> Maybe [WorkspaceFolder]
initialWorkspaceFolders SessionConfig
config)
  forall a.
Handle
-> Handle
-> Maybe ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
runSession' Handle
serverIn Handle
serverOut Maybe ProcessHandle
serverProc Handle -> SessionContext -> IO ()
listenServer SessionConfig
config ClientCapabilities
caps String
rootDir Session ()
exitServer forall a b. (a -> b) -> a -> b
$ do
    -- Wrap the session around initialize and shutdown calls
    LspId 'Initialize
initReqId <- forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SMethod 'Initialize
SInitialize InitializeParams
initializeParams

    -- Because messages can be sent in between the request and response,
    -- collect them and then...
    ([FromServerMessage]
inBetween, ResponseMessage 'Initialize
initRspMsg) <- forall (m :: * -> *) a end.
Alternative m =>
m a -> m end -> m ([a], end)
manyTill_ Session FromServerMessage
anyMessage (forall (m :: Method 'FromClient 'Request).
SMethod m -> LspId m -> Session (ResponseMessage m)
responseForId SMethod 'Initialize
SInitialize LspId 'Initialize
initReqId)

    case ResponseMessage 'Initialize
initRspMsg forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
LSP.result of
      Left ResponseError
error -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String
"Error while initializing: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ResponseError
error)
      Right InitializeResult
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    MVar (ResponseMessage 'Initialize)
initRspVar <- SessionContext -> MVar (ResponseMessage 'Initialize)
initRsp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). HasReader r m => m r
ask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar (ResponseMessage 'Initialize)
initRspVar ResponseMessage 'Initialize
initRspMsg
    forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Initialized
SInitialized (forall a. a -> Maybe a
Just InitializedParams
InitializedParams)

    case SessionConfig -> Maybe Value
lspConfig SessionConfig
config of
      Just Value
cfg -> forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'WorkspaceDidChangeConfiguration
SWorkspaceDidChangeConfiguration (Value -> DidChangeConfigurationParams
DidChangeConfigurationParams Value
cfg)
      Maybe Value
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- ... relay them back to the user Session so they can match on them!
    -- As long as they are allowed.
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FromServerMessage]
inBetween FromServerMessage -> Session ()
checkLegalBetweenMessage
    Chan SessionMessage
msgChan <- forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> Chan SessionMessage
messageChan
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Chan a -> [a] -> IO ()
writeList2Chan Chan SessionMessage
msgChan (FromServerMessage -> SessionMessage
ServerMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FromServerMessage]
inBetween)

    -- Run the actual test
    Session a
session
  where
  -- | Asks the server to shutdown and exit politely
  exitServer :: Session ()
  exitServer :: Session ()
exitServer = forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session ()
request_ SMethod 'Shutdown
SShutdown Empty
Empty forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Exit
SExit Empty
Empty

  -- | Listens to the server output until the shutdown ACK,
  -- makes sure it matches the record and signals any semaphores
  listenServer :: Handle -> SessionContext -> IO ()
  listenServer :: Handle -> SessionContext -> IO ()
listenServer Handle
serverOut SessionContext
context = do
    ByteString
msgBytes <- Handle -> IO ByteString
getNextMessage Handle
serverOut

    FromServerMessage
msg <- forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (SessionContext -> MVar RequestMap
requestMap SessionContext
context) forall a b. (a -> b) -> a -> b
$ \RequestMap
reqMap ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RequestMap -> ByteString -> (RequestMap, FromServerMessage)
decodeFromServerMsg RequestMap
reqMap ByteString
msgBytes
    forall a. Chan a -> a -> IO ()
writeChan (SessionContext -> Chan SessionMessage
messageChan SessionContext
context) (FromServerMessage -> SessionMessage
ServerMessage FromServerMessage
msg)

    case FromServerMessage
msg of
      (FromServerRsp SMethod m
SShutdown ResponseMessage m
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      FromServerMessage
_                           -> Handle -> SessionContext -> IO ()
listenServer Handle
serverOut SessionContext
context

  -- | Is this message allowed to be sent by the server between the intialize
  -- request and response?
  -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
  checkLegalBetweenMessage :: FromServerMessage -> Session ()
  checkLegalBetweenMessage :: FromServerMessage -> Session ()
checkLegalBetweenMessage (FromServerMess SMethod m
SWindowShowMessage Message m
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
SWindowLogMessage Message m
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
STelemetryEvent Message m
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
SWindowShowMessageRequest Message m
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage FromServerMessage
msg = forall a e. Exception e => e -> a
throw (FromServerMessage -> SessionException
IllegalInitSequenceMessage FromServerMessage
msg)

-- | Check environment variables to override the config
envOverrideConfig :: SessionConfig -> IO SessionConfig
envOverrideConfig :: SessionConfig -> IO SessionConfig
envOverrideConfig SessionConfig
cfg = do
  Bool
logMessages' <- forall a. a -> Maybe a -> a
fromMaybe (SessionConfig -> Bool
logMessages SessionConfig
cfg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe Bool)
checkEnv String
"LSP_TEST_LOG_MESSAGES"
  Bool
logStdErr' <- forall a. a -> Maybe a -> a
fromMaybe (SessionConfig -> Bool
logStdErr SessionConfig
cfg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe Bool)
checkEnv String
"LSP_TEST_LOG_STDERR"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SessionConfig
cfg { logMessages :: Bool
logMessages = Bool
logMessages', logStdErr :: Bool
logStdErr = Bool
logStdErr' }
  where checkEnv :: String -> IO (Maybe Bool)
        checkEnv :: String -> IO (Maybe Bool)
checkEnv String
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. (Eq a, IsString a) => a -> Bool
convertVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
s
        convertVal :: a -> Bool
convertVal a
"0" = Bool
False
        convertVal a
_ = Bool
True

-- | The current text contents of a document.
documentContents :: TextDocumentIdentifier -> Session T.Text
documentContents :: TextDocumentIdentifier -> Session Text
documentContents TextDocumentIdentifier
doc = do
  VFS
vfs <- SessionState -> VFS
vfs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let Just VirtualFile
file = VFS
vfs forall s a. s -> Getting a s a -> a
^. forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Uri -> NormalizedUri
toNormalizedUri (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri))
  forall (m :: * -> *) a. Monad m => a -> m a
return (VirtualFile -> Text
virtualFileText VirtualFile
file)

-- | Parses an ApplyEditRequest, checks that it is for the passed document
-- and returns the new content
getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
getDocumentEdit :: TextDocumentIdentifier -> Session Text
getDocumentEdit TextDocumentIdentifier
doc = do
  RequestMessage 'WorkspaceApplyEdit
req <- forall {t :: MethodType} (m :: Method 'FromServer t).
SServerMethod m -> Session (ServerMessage m)
message SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RequestMessage 'WorkspaceApplyEdit -> Bool
checkDocumentChanges RequestMessage 'WorkspaceApplyEdit
req Bool -> Bool -> Bool
|| RequestMessage 'WorkspaceApplyEdit -> Bool
checkChanges RequestMessage 'WorkspaceApplyEdit
req) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a e. Exception e => e -> a
throw (String -> SessionException
IncorrectApplyEditRequest (forall a. Show a => a -> String
show RequestMessage 'WorkspaceApplyEdit
req))

  TextDocumentIdentifier -> Session Text
documentContents TextDocumentIdentifier
doc
  where
    checkDocumentChanges :: RequestMessage 'WorkspaceApplyEdit -> Bool
checkDocumentChanges RequestMessage 'WorkspaceApplyEdit
req =
      let changes :: Maybe (List DocumentChange)
changes = RequestMessage 'WorkspaceApplyEdit
req forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEdit s a => Lens' s a
edit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDocumentChanges s a => Lens' s a
documentChanges
          maybeDocs :: Maybe (List Uri)
maybeDocs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocumentChange -> Uri
documentChangeUri) Maybe (List DocumentChange)
changes
      in case Maybe (List Uri)
maybeDocs of
        Just List Uri
docs -> (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` List Uri
docs
        Maybe (List Uri)
Nothing -> Bool
False
    checkChanges :: RequestMessage 'WorkspaceApplyEdit -> Bool
checkChanges RequestMessage 'WorkspaceApplyEdit
req =
      let mMap :: Maybe (HashMap Uri (List TextEdit))
mMap = RequestMessage 'WorkspaceApplyEdit
req forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEdit s a => Lens' s a
edit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasChanges s a => Lens' s a
changes
        in forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri)) Maybe (HashMap Uri (List TextEdit))
mMap

-- | Sends a request to the server and waits for its response.
-- Will skip any messages in between the request and the response
-- @
-- rsp <- request STextDocumentDocumentSymbol params
-- @
-- Note: will skip any messages in between the request and the response.
request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request :: forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod m
m = forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod m
m forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Method 'FromClient 'Request).
SMethod m -> LspId m -> Session (ResponseMessage m)
responseForId SClientMethod m
m

-- | The same as 'sendRequest', but discard the response.
request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()
request_ :: forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session ()
request_ SClientMethod m
p = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod m
p

-- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
sendRequest
  :: SClientMethod m -- ^ The request method.
  -> MessageParams m -- ^ The request parameters.
  -> Session (LspId m) -- ^ The id of the request that was sent.
sendRequest :: forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod m
method MessageParams m
params = do
  Int32
idn <- SessionState -> Int32
curReqId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \SessionState
c -> SessionState
c { curReqId :: Int32
curReqId = Int32
idnforall a. Num a => a -> a -> a
+Int32
1 }
  let id :: LspId m
id = forall (f :: From) (m :: Method f 'Request). Int32 -> LspId m
IdInt Int32
idn

  let mess :: RequestMessage m
mess = forall (f :: From) (m :: Method f 'Request).
Text -> LspId m -> SMethod m -> MessageParams m -> RequestMessage m
RequestMessage Text
"2.0" LspId m
id SClientMethod m
method MessageParams m
params

  -- Update the request map
  MVar RequestMap
reqMap <- SessionContext -> MVar RequestMap
requestMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). HasReader r m => m r
ask
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar RequestMap
reqMap forall a b. (a -> b) -> a -> b
$
    \RequestMap
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromClient 'Request).
RequestMap -> LspId m -> SClientMethod m -> Maybe RequestMap
updateRequestMap RequestMap
r LspId m
id SClientMethod m
method

  ~() <- case forall {t :: MethodType} (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m
method of
    ClientNotOrReq m
IsClientReq -> forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage RequestMessage m
mess
    ClientNotOrReq m
IsClientEither -> forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage forall a b. (a -> b) -> a -> b
$ forall (f :: From).
RequestMessage 'CustomMethod -> CustomMessage f 'Request
ReqMess RequestMessage m
mess

  forall (m :: * -> *) a. Monad m => a -> m a
return LspId m
id

-- | Sends a notification to the server.
sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
                 -> MessageParams m -- ^ The notification parameters.
                 -> Session ()
-- Open a virtual file if we send a did open text document notification
sendNotification :: forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod m
STextDocumentDidOpen MessageParams m
params = do
  let n :: NotificationMessage 'TextDocumentDidOpen
n = forall (f :: From) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> NotificationMessage m
NotificationMessage Text
"2.0" SMethod 'TextDocumentDidOpen
STextDocumentDidOpen MessageParams m
params
  VFS
oldVFS <- SessionState -> VFS
vfs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let newVFS :: VFS
newVFS = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState VFS
oldVFS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> Message 'TextDocumentDidOpen -> m ()
openVFS forall a. Monoid a => a
mempty NotificationMessage 'TextDocumentDidOpen
n
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
  forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage NotificationMessage 'TextDocumentDidOpen
n

-- Close a virtual file if we send a close text document notification
sendNotification SMethod m
STextDocumentDidClose MessageParams m
params = do
  let n :: NotificationMessage 'TextDocumentDidClose
n = forall (f :: From) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> NotificationMessage m
NotificationMessage Text
"2.0" SMethod 'TextDocumentDidClose
STextDocumentDidClose MessageParams m
params
  VFS
oldVFS <- SessionState -> VFS
vfs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let newVFS :: VFS
newVFS = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState VFS
oldVFS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> Message 'TextDocumentDidClose -> m ()
closeVFS forall a. Monoid a => a
mempty NotificationMessage 'TextDocumentDidClose
n
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
  forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage NotificationMessage 'TextDocumentDidClose
n

sendNotification SMethod m
STextDocumentDidChange MessageParams m
params = do
  let n :: NotificationMessage 'TextDocumentDidChange
n = forall (f :: From) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> NotificationMessage m
NotificationMessage Text
"2.0" SMethod 'TextDocumentDidChange
STextDocumentDidChange MessageParams m
params
  VFS
oldVFS <- SessionState -> VFS
vfs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let newVFS :: VFS
newVFS = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState VFS
oldVFS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> Message 'TextDocumentDidChange -> m ()
changeFromClientVFS forall a. Monoid a => a
mempty NotificationMessage 'TextDocumentDidChange
n
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
  forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage NotificationMessage 'TextDocumentDidChange
n

sendNotification SMethod m
method MessageParams m
params =
  case forall {t :: MethodType} (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SMethod m
method of
    ClientNotOrReq m
IsClientNot -> forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (forall (f :: From) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> NotificationMessage m
NotificationMessage Text
"2.0" SMethod m
method MessageParams m
params)
    ClientNotOrReq m
IsClientEither -> forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (forall (f :: From).
NotificationMessage 'CustomMethod -> CustomMessage f 'Notification
NotMess forall a b. (a -> b) -> a -> b
$ forall (f :: From) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> NotificationMessage m
NotificationMessage Text
"2.0" SMethod m
method MessageParams m
params)

-- | Sends a response to the server.
sendResponse :: ToJSON (ResponseResult m) => ResponseMessage m -> Session ()
sendResponse :: forall {f :: From} (m :: Method f 'Request).
ToJSON (ResponseResult m) =>
ResponseMessage m -> Session ()
sendResponse = forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage

-- | Returns the initialize response that was received from the server.
-- The initialize requests and responses are not included the session,
-- so if you need to test it use this.
initializeResponse :: Session (ResponseMessage Initialize)
initializeResponse :: Session (ResponseMessage 'Initialize)
initializeResponse = forall r (m :: * -> *). HasReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO a
readMVar) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionContext -> MVar (ResponseMessage 'Initialize)
initRsp

-- | /Creates/ a new text document. This is different from 'openDoc'
-- as it sends a workspace/didChangeWatchedFiles notification letting the server
-- know that a file was created within the workspace, __provided that the server
-- has registered for it__, and the file matches any patterns the server
-- registered for.
-- It /does not/ actually create a file on disk, but is useful for convincing
-- the server that one does exist.
--
-- @since 11.0.0.0
createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
          -> T.Text -- ^ The text document's language identifier, e.g. @"haskell"@.
          -> T.Text -- ^ The content of the text document to create.
          -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
createDoc :: String -> Text -> Text -> Session TextDocumentIdentifier
createDoc String
file Text
languageId Text
contents = do
  Map Text SomeRegistration
dynCaps <- SessionState -> Map Text SomeRegistration
curDynCaps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  String
rootDir <- forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> String
rootDir
  ClientCapabilities
caps <- forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> ClientCapabilities
sessionCapabilities
  String
absFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath (String
rootDir String -> String -> String
</> String
file)
  let pred :: SomeRegistration -> [Registration WorkspaceDidChangeWatchedFiles]
      pred :: SomeRegistration -> [Registration 'WorkspaceDidChangeWatchedFiles]
pred (SomeRegistration r :: Registration m
r@(Registration Text
_ SMethod m
SWorkspaceDidChangeWatchedFiles RegistrationOptions m
_)) = [Registration m
r]
      pred SomeRegistration
_ = forall a. Monoid a => a
mempty
      regs :: [Registration 'WorkspaceDidChangeWatchedFiles]
regs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SomeRegistration -> [Registration 'WorkspaceDidChangeWatchedFiles]
pred forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map Text SomeRegistration
dynCaps
      watchHits :: FileSystemWatcher -> Bool
      watchHits :: FileSystemWatcher -> Bool
watchHits (FileSystemWatcher Text
pattern Maybe WatchKind
kind) =
        -- If WatchKind is excluded, defaults to all true as per spec
        String -> Bool
fileMatches (Text -> String
T.unpack Text
pattern) Bool -> Bool -> Bool
&& WatchKind -> Bool
createHits (forall a. a -> Maybe a -> a
fromMaybe (Bool -> Bool -> Bool -> WatchKind
WatchKind Bool
True Bool
True Bool
True) Maybe WatchKind
kind)

      fileMatches :: String -> Bool
fileMatches String
pattern = Pattern -> String -> Bool
Glob.match (String -> Pattern
Glob.compile String
pattern) String
relOrAbs
        -- If the pattern is absolute then match against the absolute fp
        where relOrAbs :: String
relOrAbs
                | String -> Bool
isAbsolute String
pattern = String
absFile
                | Bool
otherwise = String
file

      createHits :: WatchKind -> Bool
createHits (WatchKind Bool
create Bool
_ Bool
_) = Bool
create

      regHits :: Registration WorkspaceDidChangeWatchedFiles -> Bool
      regHits :: Registration 'WorkspaceDidChangeWatchedFiles -> Bool
regHits Registration 'WorkspaceDidChangeWatchedFiles
reg = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Bool
acc FileSystemWatcher
w -> Bool
acc Bool -> Bool -> Bool
|| FileSystemWatcher -> Bool
watchHits FileSystemWatcher
w) Bool
False (Registration 'WorkspaceDidChangeWatchedFiles
reg forall s a. s -> Getting a s a -> a
^. forall s a. HasRegisterOptions s a => Lens' s a
registerOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWatchers s a => Lens' s a
watchers)

      clientCapsSupports :: Bool
clientCapsSupports =
          ClientCapabilities
caps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasWorkspace s a => Lens' s a
workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDidChangeWatchedFiles s a => Lens' s a
didChangeWatchedFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDynamicRegistration s a => Lens' s a
dynamicRegistration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
            forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
      shouldSend :: Bool
shouldSend = Bool
clientCapsSupports Bool -> Bool -> Bool
&& forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Bool
acc Registration 'WorkspaceDidChangeWatchedFiles
r -> Bool
acc Bool -> Bool -> Bool
|| Registration 'WorkspaceDidChangeWatchedFiles -> Bool
regHits Registration 'WorkspaceDidChangeWatchedFiles
r) Bool
False [Registration 'WorkspaceDidChangeWatchedFiles]
regs

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldSend forall a b. (a -> b) -> a -> b
$
    forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'WorkspaceDidChangeWatchedFiles
SWorkspaceDidChangeWatchedFiles forall a b. (a -> b) -> a -> b
$ List FileEvent -> DidChangeWatchedFilesParams
DidChangeWatchedFilesParams forall a b. (a -> b) -> a -> b
$
      forall a. [a] -> List a
List [ Uri -> FileChangeType -> FileEvent
FileEvent (String -> Uri
filePathToUri (String
rootDir String -> String -> String
</> String
file)) FileChangeType
FcCreated ]
  String -> Text -> Text -> Session TextDocumentIdentifier
openDoc' String
file Text
languageId Text
contents

-- | Opens a text document that /exists on disk/, and sends a
-- textDocument/didOpen notification to the server.
openDoc :: FilePath -> T.Text -> Session TextDocumentIdentifier
openDoc :: String -> Text -> Session TextDocumentIdentifier
openDoc String
file Text
languageId = do
  SessionContext
context <- forall r (m :: * -> *). HasReader r m => m r
ask
  let fp :: String
fp = SessionContext -> String
rootDir SessionContext
context String -> String -> String
</> String
file
  Text
contents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
fp
  String -> Text -> Text -> Session TextDocumentIdentifier
openDoc' String
file Text
languageId Text
contents

-- | This is a variant of `openDoc` that takes the file content as an argument.
-- Use this is the file exists /outside/ of the current workspace.
openDoc' :: FilePath -> T.Text -> T.Text -> Session TextDocumentIdentifier
openDoc' :: String -> Text -> Text -> Session TextDocumentIdentifier
openDoc' String
file Text
languageId Text
contents = do
  SessionContext
context <- forall r (m :: * -> *). HasReader r m => m r
ask
  let fp :: String
fp = SessionContext -> String
rootDir SessionContext
context String -> String -> String
</> String
file
      uri :: Uri
uri = String -> Uri
filePathToUri String
fp
      item :: TextDocumentItem
item = Uri -> Text -> Int32 -> Text -> TextDocumentItem
TextDocumentItem Uri
uri Text
languageId Int32
0 Text
contents
  forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'TextDocumentDidOpen
STextDocumentDidOpen (TextDocumentItem -> DidOpenTextDocumentParams
DidOpenTextDocumentParams TextDocumentItem
item)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Uri -> TextDocumentIdentifier
TextDocumentIdentifier Uri
uri

-- | Closes a text document and sends a textDocument/didOpen notification to the server.
closeDoc :: TextDocumentIdentifier -> Session ()
closeDoc :: TextDocumentIdentifier -> Session ()
closeDoc TextDocumentIdentifier
docId = do
  let params :: DidCloseTextDocumentParams
params = TextDocumentIdentifier -> DidCloseTextDocumentParams
DidCloseTextDocumentParams (Uri -> TextDocumentIdentifier
TextDocumentIdentifier (TextDocumentIdentifier
docId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri))
  forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'TextDocumentDidClose
STextDocumentDidClose DidCloseTextDocumentParams
params

-- | Changes a text document and sends a textDocument/didOpen notification to the server.
changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
changeDoc :: TextDocumentIdentifier
-> [TextDocumentContentChangeEvent] -> Session ()
changeDoc TextDocumentIdentifier
docId [TextDocumentContentChangeEvent]
changes = do
  VersionedTextDocumentIdentifier
verDoc <- TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
docId
  let params :: DidChangeTextDocumentParams
params = VersionedTextDocumentIdentifier
-> List TextDocumentContentChangeEvent
-> DidChangeTextDocumentParams
DidChangeTextDocumentParams (VersionedTextDocumentIdentifier
verDoc forall a b. a -> (a -> b) -> b
& forall s a. HasVersion s a => Lens' s a
version forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non Int32
0 forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int32
1) (forall a. [a] -> List a
List [TextDocumentContentChangeEvent]
changes)
  forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'TextDocumentDidChange
STextDocumentDidChange DidChangeTextDocumentParams
params

-- | Gets the Uri for the file corrected to the session directory.
getDocUri :: FilePath -> Session Uri
getDocUri :: String -> Session Uri
getDocUri String
file = do
  SessionContext
context <- forall r (m :: * -> *). HasReader r m => m r
ask
  let fp :: String
fp = SessionContext -> String
rootDir SessionContext
context String -> String -> String
</> String
file
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Uri
filePathToUri String
fp

-- | Waits for diagnostics to be published and returns them.
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics = do
  NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot <- forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (forall {t :: MethodType} (m :: Method 'FromServer t).
SServerMethod m -> Session (ServerMessage m)
message SMethod 'TextDocumentPublishDiagnostics
STextDocumentPublishDiagnostics)
  let (List [Diagnostic]
diags) = NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDiagnostics s a => Lens' s a
LSP.diagnostics
  forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
diags

-- | The same as 'waitForDiagnostics', but will only match a specific
-- 'Language.LSP.Types._source'.
waitForDiagnosticsSource :: String -> Session [Diagnostic]
waitForDiagnosticsSource :: String -> Session [Diagnostic]
waitForDiagnosticsSource String
src = do
  [Diagnostic]
diags <- Session [Diagnostic]
waitForDiagnostics
  let res :: [Diagnostic]
res = forall a. (a -> Bool) -> [a] -> [a]
filter Diagnostic -> Bool
matches [Diagnostic]
diags
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnostic]
res
    then String -> Session [Diagnostic]
waitForDiagnosticsSource String
src
    else forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
res
  where
    matches :: Diagnostic -> Bool
    matches :: Diagnostic -> Bool
matches Diagnostic
d = Diagnostic
d forall s a. s -> Getting a s a -> a
^. forall s a. HasSource s a => Lens' s a
source forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (String -> Text
T.pack String
src)

-- | Expects a 'PublishDiagnosticsNotification' and throws an
-- 'UnexpectedDiagnostics' exception if there are any diagnostics
-- returned.
noDiagnostics :: Session ()
noDiagnostics :: Session ()
noDiagnostics = do
  NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot <- forall {t :: MethodType} (m :: Method 'FromServer t).
SServerMethod m -> Session (ServerMessage m)
message SMethod 'TextDocumentPublishDiagnostics
STextDocumentPublishDiagnostics
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDiagnostics s a => Lens' s a
LSP.diagnostics forall a. Eq a => a -> a -> Bool
/= forall a. [a] -> List a
List []) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a e. Exception e => e -> a
throw SessionException
UnexpectedDiagnostics

-- | Returns the symbols in a document.
getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
getDocumentSymbols :: TextDocumentIdentifier
-> Session (Either [DocumentSymbol] [SymbolInformation])
getDocumentSymbols TextDocumentIdentifier
doc = do
  ResponseMessage Text
_ Maybe (LspId 'TextDocumentDocumentSymbol)
rspLid Either ResponseError (ResponseResult 'TextDocumentDocumentSymbol)
res <- forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentDocumentSymbol
STextDocumentDocumentSymbol (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> DocumentSymbolParams
DocumentSymbolParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
doc)
  case Either ResponseError (ResponseResult 'TextDocumentDocumentSymbol)
res of
    Right (InL (List [DocumentSymbol]
xs)) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [DocumentSymbol]
xs)
    Right (InR (List [SymbolInformation]
xs)) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [SymbolInformation]
xs)
    Left ResponseError
err -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: From} (m :: Method f 'Request). LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId 'TextDocumentDocumentSymbol)
rspLid) ResponseError
err)

-- | Returns the code actions in the specified range.
getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getCodeActions TextDocumentIdentifier
doc Range
range = do
  CodeActionContext
ctx <- TextDocumentIdentifier -> Range -> Session CodeActionContext
getCodeActionContextInRange TextDocumentIdentifier
doc Range
range
  ResponseMessage 'TextDocumentCodeAction
rsp <- forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentCodeAction
STextDocumentCodeAction (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> CodeActionParams
CodeActionParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
doc Range
range CodeActionContext
ctx)

  case ResponseMessage 'TextDocumentCodeAction
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
result of
    Right (List [Command |? CodeAction]
xs) -> forall (m :: * -> *) a. Monad m => a -> m a
return [Command |? CodeAction]
xs
    Left ResponseError
error -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: From} (m :: Method f 'Request). LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ ResponseMessage 'TextDocumentCodeAction
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
LSP.id) ResponseError
error)

-- | Returns all the code actions in a document by
-- querying the code actions at each of the current
-- diagnostics' positions.
getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
getAllCodeActions TextDocumentIdentifier
doc = do
  CodeActionContext
ctx <- TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext TextDocumentIdentifier
doc

  forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (CodeActionContext
-> [Command |? CodeAction]
-> Diagnostic
-> Session [Command |? CodeAction]
go CodeActionContext
ctx) [] forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc

  where
    go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
    go :: CodeActionContext
-> [Command |? CodeAction]
-> Diagnostic
-> Session [Command |? CodeAction]
go CodeActionContext
ctx [Command |? CodeAction]
acc Diagnostic
diag = do
      ResponseMessage Text
_ Maybe (LspId 'TextDocumentCodeAction)
rspLid Either ResponseError (ResponseResult 'TextDocumentCodeAction)
res <- forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentCodeAction
STextDocumentCodeAction (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> CodeActionParams
CodeActionParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
doc (Diagnostic
diag forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
range) CodeActionContext
ctx)

      case Either ResponseError (ResponseResult 'TextDocumentCodeAction)
res of
        Left ResponseError
e -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: From} (m :: Method f 'Request). LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId 'TextDocumentCodeAction)
rspLid) ResponseError
e)
        Right (List [Command |? CodeAction]
cmdOrCAs) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Command |? CodeAction]
acc forall a. [a] -> [a] -> [a]
++ [Command |? CodeAction]
cmdOrCAs)

getCodeActionContextInRange :: TextDocumentIdentifier -> Range -> Session CodeActionContext
getCodeActionContextInRange :: TextDocumentIdentifier -> Range -> Session CodeActionContext
getCodeActionContextInRange TextDocumentIdentifier
doc Range
caRange = do
  [Diagnostic]
curDiags <- TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc
  let diags :: [Diagnostic]
diags = [ Diagnostic
d | d :: Diagnostic
d@Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
range} <- [Diagnostic]
curDiags
                  , Range -> Range -> Bool
overlappingRange Range
caRange Range
range
              ]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ List Diagnostic -> Maybe (List CodeActionKind) -> CodeActionContext
CodeActionContext (forall a. [a] -> List a
List [Diagnostic]
diags) forall a. Maybe a
Nothing
  where
    overlappingRange :: Range -> Range -> Bool
    overlappingRange :: Range -> Range -> Bool
overlappingRange (Range Position
s Position
e) Range
range =
         Position -> Range -> Bool
positionInRange Position
s Range
range
      Bool -> Bool -> Bool
|| Position -> Range -> Bool
positionInRange Position
e Range
range

    positionInRange :: Position -> Range -> Bool
    positionInRange :: Position -> Range -> Bool
positionInRange (Position UInt
pl UInt
po) (Range (Position UInt
sl UInt
so) (Position UInt
el UInt
eo)) =
         UInt
pl forall a. Ord a => a -> a -> Bool
>  UInt
sl Bool -> Bool -> Bool
&& UInt
pl forall a. Ord a => a -> a -> Bool
<  UInt
el
      Bool -> Bool -> Bool
|| UInt
pl forall a. Eq a => a -> a -> Bool
== UInt
sl Bool -> Bool -> Bool
&& UInt
pl forall a. Eq a => a -> a -> Bool
== UInt
el Bool -> Bool -> Bool
&& UInt
po forall a. Ord a => a -> a -> Bool
>= UInt
so Bool -> Bool -> Bool
&& UInt
po forall a. Ord a => a -> a -> Bool
<= UInt
eo
      Bool -> Bool -> Bool
|| UInt
pl forall a. Eq a => a -> a -> Bool
== UInt
sl Bool -> Bool -> Bool
&& UInt
po forall a. Ord a => a -> a -> Bool
>= UInt
so
      Bool -> Bool -> Bool
|| UInt
pl forall a. Eq a => a -> a -> Bool
== UInt
el Bool -> Bool -> Bool
&& UInt
po forall a. Ord a => a -> a -> Bool
<= UInt
eo

getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext TextDocumentIdentifier
doc = do
  [Diagnostic]
curDiags <- TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ List Diagnostic -> Maybe (List CodeActionKind) -> CodeActionContext
CodeActionContext (forall a. [a] -> List a
List [Diagnostic]
curDiags) forall a. Maybe a
Nothing

-- | Returns the current diagnostics that have been sent to the client.
-- Note that this does not wait for more to come in.
getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Uri -> NormalizedUri
toNormalizedUri forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map NormalizedUri [Diagnostic]
curDiagnostics forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get

-- | Returns the tokens of all progress sessions that have started but not yet ended.
getIncompleteProgressSessions :: Session (Set.Set ProgressToken)
getIncompleteProgressSessions :: Session (Set ProgressToken)
getIncompleteProgressSessions = SessionState -> Set ProgressToken
curProgressSessions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get

-- | Executes a command.
executeCommand :: Command -> Session ()
executeCommand :: Command -> Session ()
executeCommand Command
cmd = do
  let args :: Maybe (List Value)
args = forall a. FromJSON a => ByteString -> Maybe a
decode forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Command
cmd forall s a. s -> Getting a s a -> a
^. forall s a. HasArguments s a => Lens' s a
arguments
      execParams :: ExecuteCommandParams
execParams = Maybe ProgressToken
-> Text -> Maybe (List Value) -> ExecuteCommandParams
ExecuteCommandParams forall a. Maybe a
Nothing (Command
cmd forall s a. s -> Getting a s a -> a
^. forall s a. HasCommand s a => Lens' s a
command) Maybe (List Value)
args
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SMethod 'WorkspaceExecuteCommand
SWorkspaceExecuteCommand ExecuteCommandParams
execParams

-- | Executes a code action.
-- Matching with the specification, if a code action
-- contains both an edit and a command, the edit will
-- be applied first.
executeCodeAction :: CodeAction -> Session ()
executeCodeAction :: CodeAction -> Session ()
executeCodeAction CodeAction
action = do
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) WorkspaceEdit -> Session ()
handleEdit forall a b. (a -> b) -> a -> b
$ CodeAction
action forall s a. s -> Getting a s a -> a
^. forall s a. HasEdit s a => Lens' s a
edit
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Command -> Session ()
executeCommand forall a b. (a -> b) -> a -> b
$ CodeAction
action forall s a. s -> Getting a s a -> a
^. forall s a. HasCommand s a => Lens' s a
command

  where handleEdit :: WorkspaceEdit -> Session ()
        handleEdit :: WorkspaceEdit -> Session ()
handleEdit WorkspaceEdit
e =
          -- Its ok to pass in dummy parameters here as they aren't used
          let req :: RequestMessage 'WorkspaceApplyEdit
req = forall (f :: From) (m :: Method f 'Request).
Text -> LspId m -> SMethod m -> MessageParams m -> RequestMessage m
RequestMessage Text
"" (forall (f :: From) (m :: Method f 'Request). Int32 -> LspId m
IdInt Int32
0) SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
e)
            in forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit RequestMessage 'WorkspaceApplyEdit
req)

-- | Adds the current version to the document, as tracked by the session.
getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc (TextDocumentIdentifier Uri
uri) = do
  VFS
vfs <- SessionState -> VFS
vfs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let ver :: Maybe Int32
ver = VFS
vfs forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Uri -> NormalizedUri
toNormalizedUri Uri
uri) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to VirtualFile -> Int32
virtualFileVersion
  forall (m :: * -> *) a. Monad m => a -> m a
return (Uri -> Maybe Int32 -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri Maybe Int32
ver)

-- | Applys an edit to the document and returns the updated document version.
applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
applyEdit :: TextDocumentIdentifier
-> TextEdit -> Session VersionedTextDocumentIdentifier
applyEdit TextDocumentIdentifier
doc TextEdit
edit = do

  VersionedTextDocumentIdentifier
verDoc <- TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
doc

  ClientCapabilities
caps <- forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> ClientCapabilities
sessionCapabilities

  let supportsDocChanges :: Bool
supportsDocChanges = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
        let mWorkspace :: Maybe WorkspaceClientCapabilities
mWorkspace = ClientCapabilities
caps forall s a. s -> Getting a s a -> a
^. forall s a. HasWorkspace s a => Lens' s a
LSP.workspace
        C.WorkspaceClientCapabilities Maybe Bool
_ Maybe WorkspaceEditClientCapabilities
mEdit Maybe DidChangeConfigurationClientCapabilities
_ Maybe DidChangeWatchedFilesClientCapabilities
_ Maybe WorkspaceSymbolClientCapabilities
_ Maybe ExecuteCommandClientCapabilities
_ Maybe Bool
_ Maybe Bool
_ Maybe SemanticTokensWorkspaceClientCapabilities
_ <- Maybe WorkspaceClientCapabilities
mWorkspace
        C.WorkspaceEditClientCapabilities Maybe Bool
mDocChanges Maybe (List ResourceOperationKind)
_ Maybe FailureHandlingKind
_ Maybe Bool
_ Maybe WorkspaceEditChangeAnnotationClientCapabilities
_ <- Maybe WorkspaceEditClientCapabilities
mEdit
        Maybe Bool
mDocChanges

  let wEdit :: WorkspaceEdit
wEdit = if Bool
supportsDocChanges
      then
        let docEdit :: TextDocumentEdit
docEdit = VersionedTextDocumentIdentifier
-> List (TextEdit |? AnnotatedTextEdit) -> TextDocumentEdit
TextDocumentEdit VersionedTextDocumentIdentifier
verDoc (forall a. [a] -> List a
List [forall a b. a -> a |? b
InL TextEdit
edit])
        in Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (forall a. [a] -> List a
List [forall a b. a -> a |? b
InL TextDocumentEdit
docEdit])) forall a. Maybe a
Nothing
      else
        let changes :: HashMap Uri (List TextEdit)
changes = forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri) (forall a. [a] -> List a
List [TextEdit
edit])
        in Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just HashMap Uri (List TextEdit)
changes) forall a. Maybe a
Nothing forall a. Maybe a
Nothing

  let req :: RequestMessage 'WorkspaceApplyEdit
req = forall (f :: From) (m :: Method f 'Request).
Text -> LspId m -> SMethod m -> MessageParams m -> RequestMessage m
RequestMessage Text
"" (forall (f :: From) (m :: Method f 'Request). Int32 -> LspId m
IdInt Int32
0) SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
wEdit)
  forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit RequestMessage 'WorkspaceApplyEdit
req)

  -- version may have changed
  TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
doc

-- | Returns the completions for the position in the document.
getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions TextDocumentIdentifier
doc Position
pos = do
  ResponseMessage 'TextDocumentCompletion
rsp <- forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentCompletion
STextDocumentCompletion (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> Maybe CompletionContext
-> CompletionParams
CompletionParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing)

  case forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage 'TextDocumentCompletion
rsp of
    InL (List [CompletionItem]
items) -> forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items
    InR (CompletionList Bool
_ (List [CompletionItem]
items)) -> forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items

-- | Returns the references for the position in the document.
getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
              -> Position -- ^ The position to lookup.
              -> Bool -- ^ Whether to include declarations as references.
              -> Session (List Location) -- ^ The locations of the references.
getReferences :: TextDocumentIdentifier
-> Position -> Bool -> Session (List Location)
getReferences TextDocumentIdentifier
doc Position
pos Bool
inclDecl =
  let ctx :: ReferenceContext
ctx = Bool -> ReferenceContext
ReferenceContext Bool
inclDecl
      params :: ReferenceParams
params = TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> ReferenceContext
-> ReferenceParams
ReferenceParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing ReferenceContext
ctx
  in forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentReferences
STextDocumentReferences ReferenceParams
params

-- | Returns the declarations(s) for the term at the specified position.
getDeclarations :: TextDocumentIdentifier -- ^ The document the term is in.
                -> Position -- ^ The position the term is at.
                -> Session ([Location] |? [LocationLink])
getDeclarations :: TextDocumentIdentifier
-> Position -> Session ([Location] |? [LocationLink])
getDeclarations = forall (m :: Method 'FromClient 'Request).
(ResponseResult m
 ~ (Location |? (List Location |? List LocationLink))) =>
SClientMethod m
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams m)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
getDeclarationyRequest SMethod 'TextDocumentDeclaration
STextDocumentDeclaration TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DeclarationParams
DeclarationParams

-- | Returns the definition(s) for the term at the specified position.
getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
               -> Position -- ^ The position the term is at.
               -> Session ([Location] |? [LocationLink])
getDefinitions :: TextDocumentIdentifier
-> Position -> Session ([Location] |? [LocationLink])
getDefinitions = forall (m :: Method 'FromClient 'Request).
(ResponseResult m
 ~ (Location |? (List Location |? List LocationLink))) =>
SClientMethod m
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams m)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
getDeclarationyRequest SMethod 'TextDocumentDefinition
STextDocumentDefinition TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DefinitionParams
DefinitionParams

-- | Returns the type definition(s) for the term at the specified position.
getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
                   -> Position -- ^ The position the term is at.
                   -> Session ([Location] |? [LocationLink])
getTypeDefinitions :: TextDocumentIdentifier
-> Position -> Session ([Location] |? [LocationLink])
getTypeDefinitions = forall (m :: Method 'FromClient 'Request).
(ResponseResult m
 ~ (Location |? (List Location |? List LocationLink))) =>
SClientMethod m
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams m)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
getDeclarationyRequest SMethod 'TextDocumentTypeDefinition
STextDocumentTypeDefinition TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> TypeDefinitionParams
TypeDefinitionParams

-- | Returns the type definition(s) for the term at the specified position.
getImplementations :: TextDocumentIdentifier -- ^ The document the term is in.
                   -> Position -- ^ The position the term is at.
                   -> Session ([Location] |? [LocationLink])
getImplementations :: TextDocumentIdentifier
-> Position -> Session ([Location] |? [LocationLink])
getImplementations = forall (m :: Method 'FromClient 'Request).
(ResponseResult m
 ~ (Location |? (List Location |? List LocationLink))) =>
SClientMethod m
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams m)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
getDeclarationyRequest SMethod 'TextDocumentImplementation
STextDocumentImplementation TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> ImplementationParams
ImplementationParams


getDeclarationyRequest :: (ResponseResult m ~ (Location |? (List Location |? List LocationLink)))
                       => SClientMethod m
                       -> (TextDocumentIdentifier
                            -> Position
                            -> Maybe ProgressToken
                            -> Maybe ProgressToken
                            -> MessageParams m)
                       -> TextDocumentIdentifier
                       -> Position
                       -> Session ([Location] |? [LocationLink])
getDeclarationyRequest :: forall (m :: Method 'FromClient 'Request).
(ResponseResult m
 ~ (Location |? (List Location |? List LocationLink))) =>
SClientMethod m
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams m)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
getDeclarationyRequest SClientMethod m
method TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> MessageParams m
paramCons TextDocumentIdentifier
doc Position
pos = do
  let params :: MessageParams m
params = TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> MessageParams m
paramCons TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  ResponseMessage m
rsp <- forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod m
method MessageParams m
params
  case forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage m
rsp of
      InL Location
loc -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> a |? b
InL [Location
loc])
      InR (InL (List [Location]
locs)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> a |? b
InL [Location]
locs)
      InR (InR (List [LocationLink]
locLinks)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> a |? b
InR [LocationLink]
locLinks)

-- | Renames the term at the specified position.
rename :: TextDocumentIdentifier -> Position -> String -> Session ()
rename :: TextDocumentIdentifier -> Position -> String -> Session ()
rename TextDocumentIdentifier
doc Position
pos String
newName = do
  let params :: RenameParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> Text -> RenameParams
RenameParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing (String -> Text
T.pack String
newName)
  ResponseMessage 'TextDocumentRename
rsp <- forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentRename
STextDocumentRename RenameParams
params
  let wEdit :: ResponseResult 'TextDocumentRename
wEdit = forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage 'TextDocumentRename
rsp
      req :: RequestMessage 'WorkspaceApplyEdit
req = forall (f :: From) (m :: Method f 'Request).
Text -> LspId m -> SMethod m -> MessageParams m -> RequestMessage m
RequestMessage Text
"" (forall (f :: From) (m :: Method f 'Request). Int32 -> LspId m
IdInt Int32
0) SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing ResponseResult 'TextDocumentRename
wEdit)
  forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit RequestMessage 'WorkspaceApplyEdit
req)

-- | Returns the hover information at the specified position.
getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
getHover TextDocumentIdentifier
doc Position
pos =
  let params :: HoverParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> HoverParams
HoverParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing
  in forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentHover
STextDocumentHover HoverParams
params

-- | Returns the highlighted occurrences of the term at the specified position
getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
getHighlights :: TextDocumentIdentifier
-> Position -> Session (List DocumentHighlight)
getHighlights TextDocumentIdentifier
doc Position
pos =
  let params :: DocumentHighlightParams
params = TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DocumentHighlightParams
DocumentHighlightParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  in forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentDocumentHighlight
STextDocumentDocumentHighlight DocumentHighlightParams
params

-- | Checks the response for errors and throws an exception if needed.
-- Returns the result if successful.
getResponseResult :: ResponseMessage m -> ResponseResult m
getResponseResult :: forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage m
rsp =
  case ResponseMessage m
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
result of
    Right ResponseResult m
x -> ResponseResult m
x
    Left ResponseError
err -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: From} (m :: Method f 'Request). LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ ResponseMessage m
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
LSP.id) ResponseError
err

-- | Applies formatting to the specified document.
formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
formatDoc TextDocumentIdentifier
doc FormattingOptions
opts = do
  let params :: DocumentFormattingParams
params = Maybe ProgressToken
-> TextDocumentIdentifier
-> FormattingOptions
-> DocumentFormattingParams
DocumentFormattingParams forall a. Maybe a
Nothing TextDocumentIdentifier
doc FormattingOptions
opts
  List TextEdit
edits <- forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentFormatting
STextDocumentFormatting DocumentFormattingParams
params
  TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits TextDocumentIdentifier
doc List TextEdit
edits

-- | Applies formatting to the specified range in a document.
formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
formatRange TextDocumentIdentifier
doc FormattingOptions
opts Range
range = do
  let params :: DocumentRangeFormattingParams
params = Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> FormattingOptions
-> DocumentRangeFormattingParams
DocumentRangeFormattingParams forall a. Maybe a
Nothing TextDocumentIdentifier
doc Range
range FormattingOptions
opts
  List TextEdit
edits <- forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentRangeFormatting
STextDocumentRangeFormatting DocumentRangeFormattingParams
params
  TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits TextDocumentIdentifier
doc List TextEdit
edits

applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits TextDocumentIdentifier
doc List TextEdit
edits =
  let wEdit :: WorkspaceEdit
wEdit = Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just (forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri) List TextEdit
edits)) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
      -- Send a dummy message to updateState so it can do bookkeeping
      req :: RequestMessage 'WorkspaceApplyEdit
req = forall (f :: From) (m :: Method f 'Request).
Text -> LspId m -> SMethod m -> MessageParams m -> RequestMessage m
RequestMessage Text
"" (forall (f :: From) (m :: Method f 'Request). Int32 -> LspId m
IdInt Int32
0) SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
wEdit)
  in forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit RequestMessage 'WorkspaceApplyEdit
req)

-- | Returns the code lenses for the specified document.
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses TextDocumentIdentifier
tId = do
    ResponseMessage 'TextDocumentCodeLens
rsp <- forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentCodeLens
STextDocumentCodeLens (Maybe ProgressToken
-> Maybe ProgressToken -> TextDocumentIdentifier -> CodeLensParams
CodeLensParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
tId)
    case forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage 'TextDocumentCodeLens
rsp of
        List [CodeLens]
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [CodeLens]
res

-- | Pass a param and return the response from `prepareCallHierarchy`
prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem]
prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem]
prepareCallHierarchy = forall (m :: Method 'FromClient 'Request) a.
(ResponseResult m ~ Maybe (List a)) =>
SClientMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod 'TextDocumentPrepareCallHierarchy
STextDocumentPrepareCallHierarchy

incomingCalls :: CallHierarchyIncomingCallsParams -> Session [CallHierarchyIncomingCall]
incomingCalls :: CallHierarchyIncomingCallsParams
-> Session [CallHierarchyIncomingCall]
incomingCalls = forall (m :: Method 'FromClient 'Request) a.
(ResponseResult m ~ Maybe (List a)) =>
SClientMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod 'CallHierarchyIncomingCalls
SCallHierarchyIncomingCalls

outgoingCalls :: CallHierarchyOutgoingCallsParams -> Session [CallHierarchyOutgoingCall]
outgoingCalls :: CallHierarchyOutgoingCallsParams
-> Session [CallHierarchyOutgoingCall]
outgoingCalls = forall (m :: Method 'FromClient 'Request) a.
(ResponseResult m ~ Maybe (List a)) =>
SClientMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod 'CallHierarchyOutgoingCalls
SCallHierarchyOutgoingCalls

-- | Send a request and receive a response with list.
resolveRequestWithListResp :: (ResponseResult m ~ Maybe (List a))
               => SClientMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp :: forall (m :: Method 'FromClient 'Request) a.
(ResponseResult m ~ Maybe (List a)) =>
SClientMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SClientMethod m
method MessageParams m
params = do
  ResponseMessage m
rsp <- forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod m
method MessageParams m
params
  case forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage m
rsp of
    Maybe (List a)
ResponseResult m
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just (List [a]
x) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
x

-- | Pass a param and return the response from `prepareCallHierarchy`
getSemanticTokens :: TextDocumentIdentifier -> Session (Maybe SemanticTokens)
getSemanticTokens :: TextDocumentIdentifier -> Session (Maybe SemanticTokens)
getSemanticTokens TextDocumentIdentifier
doc = do
  let params :: SemanticTokensParams
params = Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> SemanticTokensParams
SemanticTokensParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
doc
  ResponseMessage 'TextDocumentSemanticTokensFull
rsp <- forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SMethod 'TextDocumentSemanticTokensFull
STextDocumentSemanticTokensFull SemanticTokensParams
params
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {f :: From} (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage 'TextDocumentSemanticTokensFull
rsp

-- | Returns a list of capabilities that the server has requested to /dynamically/
-- register during the 'Session'.
--
-- @since 0.11.0.0
getRegisteredCapabilities :: Session [SomeRegistration]
getRegisteredCapabilities :: Session [SomeRegistration]
getRegisteredCapabilities = forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map Text SomeRegistration
curDynCaps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get