{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
module Language.LSP.Test
(
Session
, runSession
, runSessionWithConfig
, runSessionWithConfigCustomProcess
, runSessionWithHandles
, runSessionWithHandles'
, SessionConfig(..)
, defaultConfig
, C.fullCaps
, module Language.LSP.Test.Exceptions
, withTimeout
, request
, request_
, sendRequest
, sendNotification
, sendResponse
, module Language.LSP.Test.Parsing
, initializeResponse
, createDoc
, openDoc
, closeDoc
, changeDoc
, documentContents
, getDocumentEdit
, getDocUri
, getVersionedDoc
, getDocumentSymbols
, waitForDiagnostics
, waitForDiagnosticsSource
, noDiagnostics
, getCurrentDiagnostics
, getIncompleteProgressSessions
, executeCommand
, getCodeActions
, getAndResolveCodeActions
, getAllCodeActions
, executeCodeAction
, resolveCodeAction
, resolveAndExecuteCodeAction
, getCompletions
, getAndResolveCompletions
, getReferences
, getDeclarations
, getDefinitions
, getTypeDefinitions
, getImplementations
, rename
, getHover
, getHighlights
, formatDoc
, formatRange
, applyEdit
, getCodeLenses
, getAndResolveCodeLenses
, resolveCodeLens
, prepareCallHierarchy
, incomingCalls
, outgoingCalls
, getSemanticTokens
, 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 hiding (Null)
import Data.Default
import Data.List
import Data.Maybe
import Language.LSP.Protocol.Types
import Language.LSP.Protocol.Message
import qualified Language.LSP.Protocol.Lens as L
import qualified Language.LSP.Protocol.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)
import Data.Traversable (for)
runSession :: String
-> ClientCapabilities
-> FilePath
-> Session a
-> 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
runSessionWithConfig :: SessionConfig
-> String
-> ClientCapabilities
-> FilePath
-> Session a
-> 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
runSessionWithConfigCustomProcess :: (CreateProcess -> CreateProcess)
-> SessionConfig
-> String
-> ClientCapabilities
-> FilePath
-> Session a
-> 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
runSessionWithHandles :: Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> FilePath
-> Session a
-> 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
-> Handle
-> SessionConfig
-> ClientCapabilities
-> FilePath
-> Session a
-> 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
-> (Int32 |? Null)
-> Maybe
(Rec (("name" .== Text) .+ (("version" .== Maybe Text) .+ Empty)))
-> Maybe Text
-> Maybe (Text |? Null)
-> (Uri |? Null)
-> ClientCapabilities
-> Maybe Value
-> Maybe TraceValues
-> Maybe ([WorkspaceFolder] |? Null)
-> InitializeParams
InitializeParams forall a. Maybe a
Nothing
(forall a b. a -> a |? b
InL 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 Rec (("name" .== Text) .+ ("version" .== Maybe Text))
lspTestClientInfo)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
absRootDir)
forall a. Maybe a
Nothing
(forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ String -> Uri
filePathToUri String
absRootDir)
ClientCapabilities
caps
(SessionConfig -> Maybe Value
lspConfig SessionConfig
config')
(forall a. a -> Maybe a
Just TraceValues
TraceValues_Off)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> 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
LspId 'Method_Initialize
initReqId <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SMethod 'Method_Initialize
SMethod_Initialize InitializeParams
initializeParams
([FromServerMessage]
inBetween, TResponseMessage 'Method_Initialize
initRspMsg) <- forall (m :: * -> *) a end.
Alternative m =>
m a -> m end -> m ([a], end)
manyTill_ Session FromServerMessage
anyMessage (forall (m :: Method 'ClientToServer 'Request).
SMethod m -> LspId m -> Session (TResponseMessage m)
responseForId SMethod 'Method_Initialize
SMethod_Initialize LspId 'Method_Initialize
initReqId)
case TResponseMessage 'Method_Initialize
initRspMsg forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.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 (TResponseMessage 'Method_Initialize)
initRspVar <- SessionContext -> MVar (TResponseMessage 'Method_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 (TResponseMessage 'Method_Initialize)
initRspVar TResponseMessage 'Method_Initialize
initRspMsg
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_Initialized
SMethod_Initialized InitializedParams
InitializedParams
case SessionConfig -> Maybe Value
lspConfig SessionConfig
config of
Just Value
cfg -> forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_WorkspaceDidChangeConfiguration
SMethod_WorkspaceDidChangeConfiguration (Value -> DidChangeConfigurationParams
DidChangeConfigurationParams Value
cfg)
Maybe Value
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
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)
Session a
session
where
exitServer :: Session ()
exitServer :: Session ()
exitServer = forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session ()
request_ SMethod 'Method_Shutdown
SMethod_Shutdown forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_Exit
SMethod_Exit forall a. Maybe a
Nothing
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
SMethod_Shutdown TResponseMessage m
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
FromServerMessage
_ -> Handle -> SessionContext -> IO ()
listenServer Handle
serverOut SessionContext
context
checkLegalBetweenMessage :: FromServerMessage -> Session ()
checkLegalBetweenMessage :: FromServerMessage -> Session ()
checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_WindowShowMessage TMessage m
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_WindowLogMessage TMessage m
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_TelemetryEvent TMessage m
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_WindowShowMessageRequest TMessage 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)
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
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
L.uri))
forall (m :: * -> *) a. Monad m => a -> m a
return (VirtualFile -> Text
virtualFileText VirtualFile
file)
getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
getDocumentEdit :: TextDocumentIdentifier -> Session Text
getDocumentEdit TextDocumentIdentifier
doc = do
TRequestMessage 'Method_WorkspaceApplyEdit
req <- forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TRequestMessage 'Method_WorkspaceApplyEdit -> Bool
checkDocumentChanges TRequestMessage 'Method_WorkspaceApplyEdit
req Bool -> Bool -> Bool
|| TRequestMessage 'Method_WorkspaceApplyEdit -> Bool
checkChanges TRequestMessage 'Method_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 TRequestMessage 'Method_WorkspaceApplyEdit
req))
TextDocumentIdentifier -> Session Text
documentContents TextDocumentIdentifier
doc
where
checkDocumentChanges :: TRequestMessage 'Method_WorkspaceApplyEdit -> Bool
checkDocumentChanges TRequestMessage 'Method_WorkspaceApplyEdit
req =
let changes :: Maybe [DocumentChange]
changes = TRequestMessage 'Method_WorkspaceApplyEdit
req forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
L.params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEdit s a => Lens' s a
L.edit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDocumentChanges s a => Lens' s a
L.documentChanges
maybeDocs :: Maybe [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 [DocumentChange]
changes
in case Maybe [Uri]
maybeDocs of
Just [Uri]
docs -> (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Uri]
docs
Maybe [Uri]
Nothing -> Bool
False
checkChanges :: TRequestMessage 'Method_WorkspaceApplyEdit -> Bool
checkChanges TRequestMessage 'Method_WorkspaceApplyEdit
req =
let mMap :: Maybe (Map Uri [TextEdit])
mMap = TRequestMessage 'Method_WorkspaceApplyEdit
req forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
L.params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEdit s a => Lens' s a
L.edit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasChanges s a => Lens' s a
L.changes
in forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall k a. Ord k => k -> Map k a -> Bool
Map.member (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri)) Maybe (Map Uri [TextEdit])
mMap
request :: SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request :: forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod m
m = forall (m :: Method 'ClientToServer '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 'ClientToServer 'Request).
SMethod m -> LspId m -> Session (TResponseMessage m)
responseForId SClientMethod m
m
request_ :: SClientMethod (m :: Method ClientToServer Request) -> MessageParams m -> Session ()
request_ :: forall (m :: Method 'ClientToServer '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 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod m
p
sendRequest
:: SClientMethod m
-> MessageParams m
-> Session (LspId m)
sendRequest :: forall (m :: Method 'ClientToServer '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 :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
idn
let mess :: TRequestMessage m
mess = forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"2.0" LspId m
id SClientMethod m
method MessageParams m
params
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 'ClientToServer 'Request).
RequestMap -> LspId m -> SClientMethod m -> Maybe RequestMap
updateRequestMap RequestMap
r LspId m
id SClientMethod m
method
~() <- case forall {t :: MessageKind} (m :: Method 'ClientToServer 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 TRequestMessage 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 (s :: Symbol) (f :: MessageDirection).
TRequestMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Request
ReqMess TRequestMessage m
mess
forall (m :: * -> *) a. Monad m => a -> m a
return LspId m
id
sendNotification :: SClientMethod (m :: Method ClientToServer Notification)
-> MessageParams m
-> Session ()
sendNotification :: forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod m
SMethod_TextDocumentDidOpen MessageParams m
params = do
let n :: TNotificationMessage 'Method_TextDocumentDidOpen
n = forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen 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)
-> TMessage 'Method_TextDocumentDidOpen -> m ()
openVFS forall a. Monoid a => a
mempty TNotificationMessage 'Method_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 TNotificationMessage 'Method_TextDocumentDidOpen
n
sendNotification SMethod m
SMethod_TextDocumentDidClose MessageParams m
params = do
let n :: TNotificationMessage 'Method_TextDocumentDidClose
n = forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod 'Method_TextDocumentDidClose
SMethod_TextDocumentDidClose 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)
-> TMessage 'Method_TextDocumentDidClose -> m ()
closeVFS forall a. Monoid a => a
mempty TNotificationMessage 'Method_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 TNotificationMessage 'Method_TextDocumentDidClose
n
sendNotification SMethod m
SMethod_TextDocumentDidChange MessageParams m
params = do
let n :: TNotificationMessage 'Method_TextDocumentDidChange
n = forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod 'Method_TextDocumentDidChange
SMethod_TextDocumentDidChange 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)
-> TMessage 'Method_TextDocumentDidChange -> m ()
changeFromClientVFS forall a. Monoid a => a
mempty TNotificationMessage 'Method_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 TNotificationMessage 'Method_TextDocumentDidChange
n
sendNotification SMethod m
method MessageParams m
params =
case forall {t :: MessageKind} (m :: Method 'ClientToServer 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 :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage 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 (s :: Symbol) (f :: MessageDirection).
TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Notification
NotMess forall a b. (a -> b) -> a -> b
$ forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod m
method MessageParams m
params)
sendResponse :: (ToJSON (MessageResult m), ToJSON (ErrorData m)) => TResponseMessage m -> Session ()
sendResponse :: forall {f :: MessageDirection} (m :: Method f 'Request).
(ToJSON (MessageResult m), ToJSON (ErrorData m)) =>
TResponseMessage m -> Session ()
sendResponse = forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage
initializeResponse :: Session (TResponseMessage Method_Initialize)
initializeResponse :: Session (TResponseMessage 'Method_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 (TResponseMessage 'Method_Initialize)
initRsp
createDoc :: FilePath
-> T.Text
-> T.Text
-> Session TextDocumentIdentifier
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 -> [TRegistration Method_WorkspaceDidChangeWatchedFiles]
pred :: SomeRegistration
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
pred (SomeRegistration r :: TRegistration m
r@(TRegistration Text
_ SMethod m
SMethod_WorkspaceDidChangeWatchedFiles Maybe (RegistrationOptions m)
_)) = [TRegistration m
r]
pred SomeRegistration
_ = forall a. Monoid a => a
mempty
regs :: [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
regs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SomeRegistration
-> [TRegistration 'Method_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 (GlobPattern (InL (Pattern Text
pattern))) Maybe WatchKind
kind) =
String -> Bool
fileMatches (Text -> String
T.unpack Text
pattern) Bool -> Bool -> Bool
&& WatchKind -> Bool
containsCreate (forall a. a -> Maybe a -> a
fromMaybe WatchKind
WatchKind_Create Maybe WatchKind
kind)
watchHits FileSystemWatcher
_ = Bool
False
fileMatches :: String -> Bool
fileMatches String
pattern = Pattern -> String -> Bool
Glob.match (String -> Pattern
Glob.compile String
pattern) String
relOrAbs
where relOrAbs :: String
relOrAbs
| String -> Bool
isAbsolute String
pattern = String
absFile
| Bool
otherwise = String
file
regHits :: TRegistration Method_WorkspaceDidChangeWatchedFiles -> Bool
regHits :: TRegistration 'Method_WorkspaceDidChangeWatchedFiles -> Bool
regHits TRegistration 'Method_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 (TRegistration 'Method_WorkspaceDidChangeWatchedFiles
reg forall s a. s -> Getting a s a -> a
^. forall s a. HasRegisterOptions s a => Lens' s a
L.registerOptions 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. HasWatchers s a => Lens' s a
L.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
L.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
L.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
L.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 TRegistration 'Method_WorkspaceDidChangeWatchedFiles
r -> Bool
acc Bool -> Bool -> Bool
|| TRegistration 'Method_WorkspaceDidChangeWatchedFiles -> Bool
regHits TRegistration 'Method_WorkspaceDidChangeWatchedFiles
r) Bool
False [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
regs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldSend forall a b. (a -> b) -> a -> b
$
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_WorkspaceDidChangeWatchedFiles
SMethod_WorkspaceDidChangeWatchedFiles forall a b. (a -> b) -> a -> b
$ [FileEvent] -> DidChangeWatchedFilesParams
DidChangeWatchedFilesParams forall a b. (a -> b) -> a -> b
$
[ Uri -> FileChangeType -> FileEvent
FileEvent (String -> Uri
filePathToUri (String
rootDir String -> String -> String
</> String
file)) FileChangeType
FileChangeType_Created ]
String -> Text -> Text -> Session TextDocumentIdentifier
openDoc' String
file Text
languageId Text
contents
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
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 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen (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
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
L.uri))
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidClose
SMethod_TextDocumentDidClose DidCloseTextDocumentParams
params
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
-> [TextDocumentContentChangeEvent] -> DidChangeTextDocumentParams
DidChangeTextDocumentParams (VersionedTextDocumentIdentifier
verDoc forall a b. a -> (a -> b) -> b
& forall s a. HasVersion s a => Lens' s a
L.version forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int32
1) [TextDocumentContentChangeEvent]
changes
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidChange
SMethod_TextDocumentDidChange DidChangeTextDocumentParams
params
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
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics = do
TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot <- forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics)
let diags :: [Diagnostic]
diags = TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
L.params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDiagnostics s a => Lens' s a
L.diagnostics
forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
diags
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
L.source forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (String -> Text
T.pack String
src)
noDiagnostics :: Session ()
noDiagnostics :: Session ()
noDiagnostics = do
TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot <- forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
L.params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDiagnostics s a => Lens' s a
L.diagnostics forall a. Eq a => a -> a -> Bool
/= []) 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
getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [SymbolInformation] [DocumentSymbol])
getDocumentSymbols :: TextDocumentIdentifier
-> Session (Either [SymbolInformation] [DocumentSymbol])
getDocumentSymbols TextDocumentIdentifier
doc = do
TResponseMessage Text
_ Maybe (LspId 'Method_TextDocumentDocumentSymbol)
rspLid Either
ResponseError (MessageResult 'Method_TextDocumentDocumentSymbol)
res <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentDocumentSymbol
SMethod_TextDocumentDocumentSymbol (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> DocumentSymbolParams
DocumentSymbolParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
doc)
case Either
ResponseError (MessageResult 'Method_TextDocumentDocumentSymbol)
res of
Right (InL [SymbolInformation]
xs) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [SymbolInformation]
xs)
Right (InR (InL [DocumentSymbol]
xs)) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [DocumentSymbol]
xs)
Right (InR (InR Null
_)) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [])
Left ResponseError
err -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId 'Method_TextDocumentDocumentSymbol)
rspLid) ResponseError
err)
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
TResponseMessage 'Method_TextDocumentCodeAction
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction (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 TResponseMessage 'Method_TextDocumentCodeAction
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.result of
Right (InL [Command |? CodeAction]
xs) -> forall (m :: * -> *) a. Monad m => a -> m a
return [Command |? CodeAction]
xs
Right (InR Null
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Left ResponseError
error -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (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
$ TResponseMessage 'Method_TextDocumentCodeAction
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
L.id) ResponseError
error)
getAndResolveCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getAndResolveCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getAndResolveCodeActions TextDocumentIdentifier
doc Range
range = do
[Command |? CodeAction]
items <- TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getCodeActions TextDocumentIdentifier
doc Range
range
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Command |? CodeAction]
items forall a b. (a -> b) -> a -> b
$ \case
l :: Command |? CodeAction
l@(InL Command
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Command |? CodeAction
l
(InR CodeAction
r) | forall a. Maybe a -> Bool
isJust (CodeAction
r forall s a. s -> Getting a s a -> a
^. forall s a. HasData_ s a => Lens' s a
L.data_) -> forall a b. b -> a |? b
InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeAction -> Session CodeAction
resolveCodeAction CodeAction
r
r :: Command |? CodeAction
r@(InR CodeAction
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Command |? CodeAction
r
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
TResponseMessage Text
_ Maybe (LspId 'Method_TextDocumentCodeAction)
rspLid Either ResponseError (MessageResult 'Method_TextDocumentCodeAction)
res <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction (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
L.range) CodeActionContext
ctx)
case Either ResponseError (MessageResult 'Method_TextDocumentCodeAction)
res of
Left ResponseError
e -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId 'Method_TextDocumentCodeAction)
rspLid) ResponseError
e)
Right (InL [Command |? CodeAction]
cmdOrCAs) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Command |? CodeAction]
acc forall a. [a] -> [a] -> [a]
++ [Command |? CodeAction]
cmdOrCAs)
Right (InR Null
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Command |? CodeAction]
acc
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
$ [Diagnostic]
-> Maybe [CodeActionKind]
-> Maybe CodeActionTriggerKind
-> CodeActionContext
CodeActionContext [Diagnostic]
diags forall a. Maybe a
Nothing 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
$ [Diagnostic]
-> Maybe [CodeActionKind]
-> Maybe CodeActionTriggerKind
-> CodeActionContext
CodeActionContext [Diagnostic]
curDiags forall a. Maybe a
Nothing forall a. Maybe a
Nothing
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
L.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
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
executeCommand :: Command -> Session ()
executeCommand :: Command -> Session ()
executeCommand Command
cmd = do
let args :: Maybe [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
L.arguments
execParams :: ExecuteCommandParams
execParams = Maybe ProgressToken
-> Text -> Maybe [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
L.command) Maybe [Value]
args
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SMethod 'Method_WorkspaceExecuteCommand
SMethod_WorkspaceExecuteCommand ExecuteCommandParams
execParams
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
L.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
L.command
where handleEdit :: WorkspaceEdit -> Session ()
handleEdit :: WorkspaceEdit -> Session ()
handleEdit WorkspaceEdit
e =
let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (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 :: MessageKind) (m :: Method 'ServerToClient t)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TRequestMessage 'Method_WorkspaceApplyEdit
req)
resolveCodeAction :: CodeAction -> Session CodeAction
resolveCodeAction :: CodeAction -> Session CodeAction
resolveCodeAction CodeAction
ca = do
TResponseMessage 'Method_CodeActionResolve
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_CodeActionResolve
SMethod_CodeActionResolve CodeAction
ca
case TResponseMessage 'Method_CodeActionResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.result of
Right CodeAction
ca -> forall (m :: * -> *) a. Monad m => a -> m a
return CodeAction
ca
Left ResponseError
er -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (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
$ TResponseMessage 'Method_CodeActionResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
L.id) ResponseError
er)
resolveAndExecuteCodeAction :: CodeAction -> Session ()
resolveAndExecuteCodeAction :: CodeAction -> Session ()
resolveAndExecuteCodeAction ca :: CodeAction
ca@CodeAction{$sel:_data_:CodeAction :: CodeAction -> Maybe Value
_data_=Just Value
_} = do
CodeAction
caRsp <- CodeAction -> Session CodeAction
resolveCodeAction CodeAction
ca
CodeAction -> Session ()
executeCodeAction CodeAction
caRsp
resolveAndExecuteCodeAction CodeAction
ca = CodeAction -> Session ()
executeCodeAction CodeAction
ca
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 -> Int32 -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri (forall a. a -> Maybe a -> a
fromMaybe Int32
0 Maybe Int32
ver))
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
$ ClientCapabilities
caps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasWorkspace s a => Lens' s a
L.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. HasWorkspaceEdit s a => Lens' s a
L.workspaceEdit 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. HasDocumentChanges s a => Lens' s a
L.documentChanges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
let wEdit :: WorkspaceEdit
wEdit = if Bool
supportsDocChanges
then
let docEdit :: TextDocumentEdit
docEdit = OptionalVersionedTextDocumentIdentifier
-> [TextEdit |? AnnotatedTextEdit] -> TextDocumentEdit
TextDocumentEdit (forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Prism'
OptionalVersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier
_versionedTextDocumentIdentifier VersionedTextDocumentIdentifier
verDoc) [forall a b. a -> a |? b
InL TextEdit
edit]
in Maybe (Map Uri [TextEdit])
-> Maybe [DocumentChange]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just [forall a b. a -> a |? b
InL TextDocumentEdit
docEdit]) forall a. Maybe a
Nothing
else
let changes :: Map Uri [TextEdit]
changes = forall k a. k -> a -> Map k a
Map.singleton (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri) [TextEdit
edit]
in Maybe (Map Uri [TextEdit])
-> Maybe [DocumentChange]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just Map Uri [TextEdit]
changes) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (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 :: MessageKind) (m :: Method 'ServerToClient t)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TRequestMessage 'Method_WorkspaceApplyEdit
req)
TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
doc
getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions TextDocumentIdentifier
doc Position
pos = do
TResponseMessage 'Method_TextDocumentCompletion
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentCompletion
SMethod_TextDocumentCompletion (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 :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentCompletion
rsp of
InL [CompletionItem]
items -> forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items
InR (InL CompletionList
c) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CompletionList
c forall s a. s -> Getting a s a -> a
^. forall s a. HasItems s a => Lens' s a
L.items
InR (InR Null
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return []
getAndResolveCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getAndResolveCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getAndResolveCompletions TextDocumentIdentifier
doc Position
pos = do
[CompletionItem]
items <- TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions TextDocumentIdentifier
doc Position
pos
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CompletionItem]
items forall a b. (a -> b) -> a -> b
$ \CompletionItem
item -> if forall a. Maybe a -> Bool
isJust (CompletionItem
item forall s a. s -> Getting a s a -> a
^. forall s a. HasData_ s a => Lens' s a
L.data_) then CompletionItem -> Session CompletionItem
resolveCompletion CompletionItem
item else forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItem
item
resolveCompletion :: CompletionItem -> Session CompletionItem
resolveCompletion :: CompletionItem -> Session CompletionItem
resolveCompletion CompletionItem
ci = do
TResponseMessage 'Method_CompletionItemResolve
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_CompletionItemResolve
SMethod_CompletionItemResolve CompletionItem
ci
case TResponseMessage 'Method_CompletionItemResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.result of
Right CompletionItem
ci -> forall (m :: * -> *) a. Monad m => a -> m a
return CompletionItem
ci
Left ResponseError
error -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (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
$ TResponseMessage 'Method_CompletionItemResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
L.id) ResponseError
error)
getReferences :: TextDocumentIdentifier
-> Position
-> Bool
-> Session [Location]
getReferences :: TextDocumentIdentifier -> Position -> Bool -> Session [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 a. Monoid a => (a |? Null) -> a
absorbNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentReferences
SMethod_TextDocumentReferences ReferenceParams
params
getDeclarations :: TextDocumentIdentifier
-> Position
-> Session (Declaration |? [DeclarationLink] |? Null)
getDeclarations :: TextDocumentIdentifier
-> Position -> Session (Declaration |? ([DeclarationLink] |? Null))
getDeclarations TextDocumentIdentifier
doc Position
pos = do
TResponseMessage 'Method_TextDocumentDeclaration
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentDeclaration
SMethod_TextDocumentDeclaration (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DeclarationParams
DeclarationParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentDeclaration
rsp
getDefinitions :: TextDocumentIdentifier
-> Position
-> Session (Definition |? [DefinitionLink] |? Null)
getDefinitions :: TextDocumentIdentifier
-> Position -> Session (Definition |? ([DefinitionLink] |? Null))
getDefinitions TextDocumentIdentifier
doc Position
pos = do
TResponseMessage 'Method_TextDocumentDefinition
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentDefinition
SMethod_TextDocumentDefinition (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DefinitionParams
DefinitionParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentDefinition
rsp
getTypeDefinitions :: TextDocumentIdentifier
-> Position
-> Session (Definition |? [DefinitionLink] |? Null)
getTypeDefinitions :: TextDocumentIdentifier
-> Position -> Session (Definition |? ([DefinitionLink] |? Null))
getTypeDefinitions TextDocumentIdentifier
doc Position
pos = do
TResponseMessage 'Method_TextDocumentTypeDefinition
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentTypeDefinition
SMethod_TextDocumentTypeDefinition (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> TypeDefinitionParams
TypeDefinitionParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentTypeDefinition
rsp
getImplementations :: TextDocumentIdentifier
-> Position
-> Session (Definition |? [DefinitionLink] |? Null)
getImplementations :: TextDocumentIdentifier
-> Position -> Session (Definition |? ([DefinitionLink] |? Null))
getImplementations TextDocumentIdentifier
doc Position
pos = do
TResponseMessage 'Method_TextDocumentImplementation
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentImplementation
SMethod_TextDocumentImplementation (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> ImplementationParams
ImplementationParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentImplementation
rsp
rename :: TextDocumentIdentifier -> Position -> String -> Session ()
rename :: TextDocumentIdentifier -> Position -> String -> Session ()
rename TextDocumentIdentifier
doc Position
pos String
newName = do
let params :: RenameParams
params = Maybe ProgressToken
-> TextDocumentIdentifier -> Position -> Text -> RenameParams
RenameParams forall a. Maybe a
Nothing TextDocumentIdentifier
doc Position
pos (String -> Text
T.pack String
newName)
TResponseMessage 'Method_TextDocumentRename
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentRename
SMethod_TextDocumentRename RenameParams
params
let wEdit :: MessageResult 'Method_TextDocumentRename
wEdit = forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentRename
rsp
case forall a. (a |? Null) -> Maybe a
nullToMaybe MessageResult 'Method_TextDocumentRename
wEdit of
Just WorkspaceEdit
e -> do
let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
e)
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (forall (t :: MessageKind) (m :: Method 'ServerToClient t)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TRequestMessage 'Method_WorkspaceApplyEdit
req)
Maybe WorkspaceEdit
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
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 a. (a |? Null) -> Maybe a
nullToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentHover
SMethod_TextDocumentHover HoverParams
params
getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
getHighlights :: TextDocumentIdentifier -> Position -> Session [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 a. Monoid a => (a |? Null) -> a
absorbNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentDocumentHighlight
SMethod_TextDocumentDocumentHighlight DocumentHighlightParams
params
getResponseResult :: (ToJSON (ErrorData m)) => TResponseMessage m -> MessageResult m
getResponseResult :: forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage m
rsp =
case TResponseMessage m
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.result of
Right MessageResult m
x -> MessageResult 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 :: MessageDirection} (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
$ TResponseMessage m
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
L.id) ResponseError
err
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
[TextEdit]
edits <- forall a. Monoid a => (a |? Null) -> a
absorbNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentFormatting
SMethod_TextDocumentFormatting DocumentFormattingParams
params
TextDocumentIdentifier -> [TextEdit] -> Session ()
applyTextEdits TextDocumentIdentifier
doc [TextEdit]
edits
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
[TextEdit]
edits <- forall a. Monoid a => (a |? Null) -> a
absorbNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentRangeFormatting
SMethod_TextDocumentRangeFormatting DocumentRangeFormattingParams
params
TextDocumentIdentifier -> [TextEdit] -> Session ()
applyTextEdits TextDocumentIdentifier
doc [TextEdit]
edits
applyTextEdits :: TextDocumentIdentifier -> [TextEdit] -> Session ()
applyTextEdits :: TextDocumentIdentifier -> [TextEdit] -> Session ()
applyTextEdits TextDocumentIdentifier
doc [TextEdit]
edits =
let wEdit :: WorkspaceEdit
wEdit = Maybe (Map Uri [TextEdit])
-> Maybe [DocumentChange]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just (forall k a. k -> a -> Map k a
Map.singleton (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri) [TextEdit]
edits)) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (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 :: MessageKind) (m :: Method 'ServerToClient t)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TRequestMessage 'Method_WorkspaceApplyEdit
req)
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses TextDocumentIdentifier
tId = do
TResponseMessage 'Method_TextDocumentCodeLens
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentCodeLens
SMethod_TextDocumentCodeLens (Maybe ProgressToken
-> Maybe ProgressToken -> TextDocumentIdentifier -> CodeLensParams
CodeLensParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
tId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => (a |? Null) -> a
absorbNull forall a b. (a -> b) -> a -> b
$ forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentCodeLens
rsp
getAndResolveCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getAndResolveCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getAndResolveCodeLenses TextDocumentIdentifier
tId = do
[CodeLens]
codeLenses <- TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses TextDocumentIdentifier
tId
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CodeLens]
codeLenses forall a b. (a -> b) -> a -> b
$ \CodeLens
codeLens -> if forall a. Maybe a -> Bool
isJust (CodeLens
codeLens forall s a. s -> Getting a s a -> a
^. forall s a. HasData_ s a => Lens' s a
L.data_) then CodeLens -> Session CodeLens
resolveCodeLens CodeLens
codeLens else forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeLens
codeLens
resolveCodeLens :: CodeLens -> Session CodeLens
resolveCodeLens :: CodeLens -> Session CodeLens
resolveCodeLens CodeLens
cl = do
TResponseMessage 'Method_CodeLensResolve
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_CodeLensResolve
SMethod_CodeLensResolve CodeLens
cl
case TResponseMessage 'Method_CodeLensResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.result of
Right CodeLens
cl -> forall (m :: * -> *) a. Monad m => a -> m a
return CodeLens
cl
Left ResponseError
error -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (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
$ TResponseMessage 'Method_CodeLensResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
L.id) ResponseError
error)
prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem]
prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem]
prepareCallHierarchy = forall (m :: Method 'ClientToServer 'Request) a.
(ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
SMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod 'Method_TextDocumentPrepareCallHierarchy
SMethod_TextDocumentPrepareCallHierarchy
incomingCalls :: CallHierarchyIncomingCallsParams -> Session [CallHierarchyIncomingCall]
incomingCalls :: CallHierarchyIncomingCallsParams
-> Session [CallHierarchyIncomingCall]
incomingCalls = forall (m :: Method 'ClientToServer 'Request) a.
(ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
SMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod 'Method_CallHierarchyIncomingCalls
SMethod_CallHierarchyIncomingCalls
outgoingCalls :: CallHierarchyOutgoingCallsParams -> Session [CallHierarchyOutgoingCall]
outgoingCalls :: CallHierarchyOutgoingCallsParams
-> Session [CallHierarchyOutgoingCall]
outgoingCalls = forall (m :: Method 'ClientToServer 'Request) a.
(ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
SMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod 'Method_CallHierarchyOutgoingCalls
SMethod_CallHierarchyOutgoingCalls
resolveRequestWithListResp :: forall (m :: Method ClientToServer Request) a
. (ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null))
=> SMethod m
-> MessageParams m
-> Session [a]
resolveRequestWithListResp :: forall (m :: Method 'ClientToServer 'Request) a.
(ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
SMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod m
method MessageParams m
params = do
TResponseMessage m
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod m
method MessageParams m
params
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => (a |? Null) -> a
absorbNull forall a b. (a -> b) -> a -> b
$ forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage m
rsp
getSemanticTokens :: TextDocumentIdentifier -> Session (SemanticTokens |? Null)
getSemanticTokens :: TextDocumentIdentifier -> Session (SemanticTokens |? Null)
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
TResponseMessage 'Method_TextDocumentSemanticTokensFull
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentSemanticTokensFull
SMethod_TextDocumentSemanticTokensFull SemanticTokensParams
params
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentSemanticTokensFull
rsp
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