{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.LSP.Test (
Session,
runSession,
runSessionWithConfig,
runSessionWithConfigCustomProcess,
runSessionWithHandles,
runSessionWithHandles',
setIgnoringLogNotifications,
setIgnoringConfigurationRequests,
setIgnoringRegistrationRequests,
SessionConfig (..),
defaultConfig,
C.fullLatestClientCaps,
module Language.LSP.Test.Exceptions,
withTimeout,
request,
request_,
sendRequest,
sendNotification,
sendResponse,
module Language.LSP.Test.Parsing,
initializeResponse,
modifyConfig,
setConfig,
modifyConfigSection,
setConfigSection,
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,
getInlayHints,
getAndResolveInlayHints,
resolveInlayHint,
prepareCallHierarchy,
incomingCalls,
outgoingCalls,
getSemanticTokens,
getRegisteredCapabilities,
) where
import Control.Applicative.Combinators
import Control.Concurrent
import Control.Exception
import Control.Lens hiding (Empty, List, (.=))
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.State (execState)
import Data.Aeson hiding (Null)
import Data.Aeson qualified as J
import Data.Aeson.KeyMap qualified as J
import Data.Default
import Data.List
import Data.List.Extra (firstJust)
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import Data.String (fromString)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Traversable (for)
import Language.LSP.Protocol.Capabilities qualified as C
import Language.LSP.Protocol.Lens qualified as L
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import Language.LSP.Test.Compat
import Language.LSP.Test.Decoding
import Language.LSP.Test.Exceptions
import Language.LSP.Test.Parsing
import Language.LSP.Test.Server
import Language.LSP.Test.Session
import Language.LSP.VFS
import System.Directory
import System.Environment
import System.FilePath
import System.FilePath.Glob qualified as Glob
import System.IO
import System.Process (CreateProcess, ProcessHandle)
runSession ::
String ->
ClientCapabilities ->
FilePath ->
Session a ->
IO a
runSession :: forall a.
String -> ClientCapabilities -> String -> Session a -> IO a
runSession = SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
forall a.
SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
runSessionWithConfig SessionConfig
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 = (CreateProcess -> CreateProcess)
-> SessionConfig
-> String
-> ClientCapabilities
-> String
-> Session a
-> IO a
forall a.
(CreateProcess -> CreateProcess)
-> SessionConfig
-> String
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithConfigCustomProcess CreateProcess -> CreateProcess
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'
String
-> Bool
-> (CreateProcess -> CreateProcess)
-> (Handle -> Handle -> ProcessHandle -> IO a)
-> IO a
forall a.
String
-> Bool
-> (CreateProcess -> CreateProcess)
-> (Handle -> Handle -> ProcessHandle -> IO a)
-> IO a
withServer String
serverExe (SessionConfig -> Bool
logStdErr SessionConfig
config) CreateProcess -> CreateProcess
modifyCreateProcess ((Handle -> Handle -> ProcessHandle -> IO a) -> IO a)
-> (Handle -> Handle -> ProcessHandle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
serverIn Handle
serverOut ProcessHandle
serverProc ->
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' (ProcessHandle -> Maybe ProcessHandle
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 = Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' Maybe ProcessHandle
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 =
InitializeParams
{ $sel:_workDoneToken:InitializeParams :: Maybe ProgressToken
_workDoneToken = Maybe ProgressToken
forall a. Maybe a
Nothing
,
$sel:_processId:InitializeParams :: Int32 |? Null
_processId = Int32 -> Int32 |? Null
forall a b. a -> a |? b
InL (Int32 -> Int32 |? Null) -> Int32 -> Int32 |? Null
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pid
, $sel:_clientInfo:InitializeParams :: Maybe ClientInfo
_clientInfo = ClientInfo -> Maybe ClientInfo
forall a. a -> Maybe a
Just ClientInfo
lspTestClientInfo
, $sel:_locale:InitializeParams :: Maybe Text
_locale = Maybe Text
forall a. Maybe a
Nothing
, $sel:_rootPath:InitializeParams :: Maybe (Text |? Null)
_rootPath = (Text |? Null) -> Maybe (Text |? Null)
forall a. a -> Maybe a
Just (Text -> Text |? Null
forall a b. a -> a |? b
InL (Text -> Text |? Null) -> Text -> Text |? Null
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
absRootDir)
, $sel:_rootUri:InitializeParams :: Uri |? Null
_rootUri = Uri -> Uri |? Null
forall a b. a -> a |? b
InL (Uri -> Uri |? Null) -> Uri -> Uri |? Null
forall a b. (a -> b) -> a -> b
$ String -> Uri
filePathToUri String
absRootDir
, $sel:_capabilities:InitializeParams :: ClientCapabilities
_capabilities = ClientCapabilities
caps
,
$sel:_initializationOptions:InitializeParams :: Maybe Value
_initializationOptions = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ SessionConfig -> Object
lspConfig SessionConfig
config'
, $sel:_trace:InitializeParams :: Maybe TraceValue
_trace = TraceValue -> Maybe TraceValue
forall a. a -> Maybe a
Just TraceValue
TraceValue_Off
, $sel:_workspaceFolders:InitializeParams :: Maybe ([WorkspaceFolder] |? Null)
_workspaceFolders = [WorkspaceFolder] -> [WorkspaceFolder] |? Null
forall a b. a -> a |? b
InL ([WorkspaceFolder] -> [WorkspaceFolder] |? Null)
-> Maybe [WorkspaceFolder] -> Maybe ([WorkspaceFolder] |? Null)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionConfig -> Maybe [WorkspaceFolder]
initialWorkspaceFolders SessionConfig
config
}
Handle
-> Handle
-> Maybe ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
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 (Session a -> IO a) -> Session a -> IO a
forall a b. (a -> b) -> a -> b
$ do
LspId 'Method_Initialize
initReqId <- SClientMethod 'Method_Initialize
-> MessageParams 'Method_Initialize
-> Session (LspId 'Method_Initialize)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod 'Method_Initialize
SMethod_Initialize InitializeParams
MessageParams 'Method_Initialize
initializeParams
([FromServerMessage]
inBetween, TResponseMessage 'Method_Initialize
initRspMsg) <- Session FromServerMessage
-> Session (TResponseMessage 'Method_Initialize)
-> Session
([FromServerMessage], TResponseMessage 'Method_Initialize)
forall (m :: * -> *) a end.
Alternative m =>
m a -> m end -> m ([a], end)
manyTill_ Session FromServerMessage
anyMessage (SClientMethod 'Method_Initialize
-> LspId 'Method_Initialize
-> Session (TResponseMessage 'Method_Initialize)
forall (m :: Method 'ClientToServer 'Request).
SMethod m -> LspId m -> Session (TResponseMessage m)
responseForId SClientMethod 'Method_Initialize
SMethod_Initialize LspId 'Method_Initialize
initReqId)
case TResponseMessage 'Method_Initialize
initRspMsg TResponseMessage 'Method_Initialize
-> Getting
(Either (TResponseError 'Method_Initialize) InitializeResult)
(TResponseMessage 'Method_Initialize)
(Either (TResponseError 'Method_Initialize) InitializeResult)
-> Either (TResponseError 'Method_Initialize) InitializeResult
forall s a. s -> Getting a s a -> a
^. Getting
(Either (TResponseError 'Method_Initialize) InitializeResult)
(TResponseMessage 'Method_Initialize)
(Either (TResponseError 'Method_Initialize) InitializeResult)
forall s a. HasResult s a => Lens' s a
Lens'
(TResponseMessage 'Method_Initialize)
(Either (TResponseError 'Method_Initialize) InitializeResult)
L.result of
Left TResponseError 'Method_Initialize
error -> IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String
"Error while initializing: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TResponseError 'Method_Initialize -> String
forall a. Show a => a -> String
show TResponseError 'Method_Initialize
error)
Right InitializeResult
_ -> () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
MVar (TResponseMessage 'Method_Initialize)
initRspVar <- SessionContext -> MVar (TResponseMessage 'Method_Initialize)
initRsp (SessionContext -> MVar (TResponseMessage 'Method_Initialize))
-> Session SessionContext
-> Session (MVar (TResponseMessage 'Method_Initialize))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ MVar (TResponseMessage 'Method_Initialize)
-> TResponseMessage 'Method_Initialize -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (TResponseMessage 'Method_Initialize)
initRspVar TResponseMessage 'Method_Initialize
initRspMsg
SClientMethod 'Method_Initialized
-> MessageParams 'Method_Initialized -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'Method_Initialized
SMethod_Initialized InitializedParams
MessageParams 'Method_Initialized
InitializedParams
[FromServerMessage]
-> (FromServerMessage -> Session ()) -> Session ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FromServerMessage]
inBetween FromServerMessage -> Session ()
checkLegalBetweenMessage
Chan SessionMessage
msgChan <- (SessionContext -> Chan SessionMessage)
-> Session (Chan SessionMessage)
forall b. (SessionContext -> b) -> Session b
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> Chan SessionMessage
messageChan
IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ Chan SessionMessage -> [SessionMessage] -> IO ()
forall a. Chan a -> [a] -> IO ()
writeList2Chan Chan SessionMessage
msgChan (FromServerMessage -> SessionMessage
ServerMessage (FromServerMessage -> SessionMessage)
-> [FromServerMessage] -> [SessionMessage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FromServerMessage]
inBetween)
Session a
session
where
exitServer :: Session ()
exitServer :: Session ()
exitServer = SClientMethod 'Method_Shutdown
-> MessageParams 'Method_Shutdown -> Session ()
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session ()
request_ SClientMethod 'Method_Shutdown
SMethod_Shutdown Maybe Void
MessageParams 'Method_Shutdown
forall a. Maybe a
Nothing Session () -> Session () -> Session ()
forall a b. Session a -> Session b -> Session b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SClientMethod 'Method_Exit
-> MessageParams 'Method_Exit -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'Method_Exit
SMethod_Exit Maybe Void
MessageParams 'Method_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 <- MVar RequestMap
-> (RequestMap -> IO (RequestMap, FromServerMessage))
-> IO FromServerMessage
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (SessionContext -> MVar RequestMap
requestMap SessionContext
context) ((RequestMap -> IO (RequestMap, FromServerMessage))
-> IO FromServerMessage)
-> (RequestMap -> IO (RequestMap, FromServerMessage))
-> IO FromServerMessage
forall a b. (a -> b) -> a -> b
$ \RequestMap
reqMap ->
(RequestMap, FromServerMessage)
-> IO (RequestMap, FromServerMessage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((RequestMap, FromServerMessage)
-> IO (RequestMap, FromServerMessage))
-> (RequestMap, FromServerMessage)
-> IO (RequestMap, FromServerMessage)
forall a b. (a -> b) -> a -> b
$ RequestMap -> ByteString -> (RequestMap, FromServerMessage)
decodeFromServerMsg RequestMap
reqMap ByteString
msgBytes
Chan SessionMessage -> SessionMessage -> IO ()
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
_) -> () -> IO ()
forall a. a -> IO a
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
_) = () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_WindowLogMessage TMessage m
_) = () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_TelemetryEvent TMessage m
_) = () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_WindowShowMessageRequest TMessage m
_) = () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkLegalBetweenMessage FromServerMessage
msg = SessionException -> Session ()
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' <- Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (SessionConfig -> Bool
logMessages SessionConfig
cfg) (Maybe Bool -> Bool) -> IO (Maybe Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe Bool)
checkEnv String
"LSP_TEST_LOG_MESSAGES"
Bool
logStdErr' <- Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (SessionConfig -> Bool
logStdErr SessionConfig
cfg) (Maybe Bool -> Bool) -> IO (Maybe Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe Bool)
checkEnv String
"LSP_TEST_LOG_STDERR"
SessionConfig -> IO SessionConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionConfig -> IO SessionConfig)
-> SessionConfig -> IO SessionConfig
forall a b. (a -> b) -> a -> b
$ SessionConfig
cfg{logMessages = logMessages', logStdErr = logStdErr'}
where
checkEnv :: String -> IO (Maybe Bool)
checkEnv :: String -> IO (Maybe Bool)
checkEnv String
s = (String -> Bool) -> Maybe String -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
convertVal (Maybe String -> Maybe Bool)
-> IO (Maybe String) -> IO (Maybe Bool)
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 (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
let Just VirtualFile
file = VFS
vfs VFS
-> Getting (Maybe VirtualFile) VFS (Maybe VirtualFile)
-> Maybe VirtualFile
forall s a. s -> Getting a s a -> a
^. (Map NormalizedUri VirtualFile
-> Const (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> VFS -> Const (Maybe VirtualFile) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Const (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> VFS -> Const (Maybe VirtualFile) VFS)
-> ((Maybe VirtualFile
-> Const (Maybe VirtualFile) (Maybe VirtualFile))
-> Map NormalizedUri VirtualFile
-> Const (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> Getting (Maybe VirtualFile) VFS (Maybe VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Uri -> NormalizedUri
toNormalizedUri (TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri))
Text -> Session Text
forall a. a -> Session a
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 <- SServerMethod 'Method_WorkspaceApplyEdit
-> Session (TMessage 'Method_WorkspaceApplyEdit)
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit
Bool -> Session () -> Session ()
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) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$
IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$
SessionException -> IO ()
forall a e. Exception e => e -> a
throw (String -> SessionException
IncorrectApplyEditRequest (TRequestMessage 'Method_WorkspaceApplyEdit -> String
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 TRequestMessage 'Method_WorkspaceApplyEdit
-> Getting
(Maybe [DocumentChange])
(TRequestMessage 'Method_WorkspaceApplyEdit)
(Maybe [DocumentChange])
-> Maybe [DocumentChange]
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
-> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
-> TRequestMessage 'Method_WorkspaceApplyEdit
-> Const
(Maybe [DocumentChange])
(TRequestMessage 'Method_WorkspaceApplyEdit)
forall s a. HasParams s a => Lens' s a
Lens'
(TRequestMessage 'Method_WorkspaceApplyEdit)
ApplyWorkspaceEditParams
L.params ((ApplyWorkspaceEditParams
-> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
-> TRequestMessage 'Method_WorkspaceApplyEdit
-> Const
(Maybe [DocumentChange])
(TRequestMessage 'Method_WorkspaceApplyEdit))
-> ((Maybe [DocumentChange]
-> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
-> ApplyWorkspaceEditParams
-> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
-> Getting
(Maybe [DocumentChange])
(TRequestMessage 'Method_WorkspaceApplyEdit)
(Maybe [DocumentChange])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
Lens' ApplyWorkspaceEditParams WorkspaceEdit
L.edit ((WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
-> ((Maybe [DocumentChange]
-> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
-> WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit)
-> (Maybe [DocumentChange]
-> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
-> ApplyWorkspaceEditParams
-> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [DocumentChange]
-> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
-> WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit
forall s a. HasDocumentChanges s a => Lens' s a
Lens' WorkspaceEdit (Maybe [DocumentChange])
L.documentChanges
maybeDocs :: Maybe [Uri]
maybeDocs = ([DocumentChange] -> [Uri])
-> Maybe [DocumentChange] -> Maybe [Uri]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DocumentChange -> Uri) -> [DocumentChange] -> [Uri]
forall a b. (a -> b) -> [a] -> [b]
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 TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri) Uri -> [Uri] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 TRequestMessage 'Method_WorkspaceApplyEdit
-> Getting
(Maybe (Map Uri [TextEdit]))
(TRequestMessage 'Method_WorkspaceApplyEdit)
(Maybe (Map Uri [TextEdit]))
-> Maybe (Map Uri [TextEdit])
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
-> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
-> TRequestMessage 'Method_WorkspaceApplyEdit
-> Const
(Maybe (Map Uri [TextEdit]))
(TRequestMessage 'Method_WorkspaceApplyEdit)
forall s a. HasParams s a => Lens' s a
Lens'
(TRequestMessage 'Method_WorkspaceApplyEdit)
ApplyWorkspaceEditParams
L.params ((ApplyWorkspaceEditParams
-> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
-> TRequestMessage 'Method_WorkspaceApplyEdit
-> Const
(Maybe (Map Uri [TextEdit]))
(TRequestMessage 'Method_WorkspaceApplyEdit))
-> ((Maybe (Map Uri [TextEdit])
-> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
-> ApplyWorkspaceEditParams
-> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
-> Getting
(Maybe (Map Uri [TextEdit]))
(TRequestMessage 'Method_WorkspaceApplyEdit)
(Maybe (Map Uri [TextEdit]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit -> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
Lens' ApplyWorkspaceEditParams WorkspaceEdit
L.edit ((WorkspaceEdit
-> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
-> ((Maybe (Map Uri [TextEdit])
-> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
-> WorkspaceEdit
-> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit)
-> (Maybe (Map Uri [TextEdit])
-> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
-> ApplyWorkspaceEditParams
-> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Map Uri [TextEdit])
-> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
-> WorkspaceEdit
-> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit
forall s a. HasChanges s a => Lens' s a
Lens' WorkspaceEdit (Maybe (Map Uri [TextEdit]))
L.changes
in Bool
-> (Map Uri [TextEdit] -> Bool)
-> Maybe (Map Uri [TextEdit])
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Uri -> Map Uri [TextEdit] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
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 = SClientMethod m -> MessageParams m -> Session (LspId m)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod m
m (MessageParams m -> Session (LspId m))
-> (LspId m -> Session (TResponseMessage m))
-> MessageParams m
-> Session (TResponseMessage m)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Session FromServerMessage
-> Session (TResponseMessage m) -> Session (TResponseMessage m)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (Session (TResponseMessage m) -> Session (TResponseMessage m))
-> (LspId m -> Session (TResponseMessage m))
-> LspId m
-> Session (TResponseMessage m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SClientMethod m -> LspId m -> Session (TResponseMessage m)
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 = Session (TResponseMessage m) -> Session ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Session (TResponseMessage m) -> Session ())
-> (MessageParams m -> Session (TResponseMessage m))
-> MessageParams m
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
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 (SessionState -> Int32) -> Session SessionState -> Session Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> Session ())
-> (SessionState -> SessionState) -> Session ()
forall a b. (a -> b) -> a -> b
$ \SessionState
c -> SessionState
c{curReqId = idn + 1}
let id :: LspId m
id = Int32 -> LspId m
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
idn
let mess :: TRequestMessage m
mess = Text
-> LspId m
-> SClientMethod m
-> MessageParams m
-> TRequestMessage m
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 (SessionContext -> MVar RequestMap)
-> Session SessionContext -> Session (MVar RequestMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$
MVar RequestMap -> (RequestMap -> IO RequestMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar RequestMap
reqMap ((RequestMap -> IO RequestMap) -> IO ())
-> (RequestMap -> IO RequestMap) -> IO ()
forall a b. (a -> b) -> a -> b
$
\RequestMap
r -> RequestMap -> IO RequestMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestMap -> IO RequestMap) -> RequestMap -> IO RequestMap
forall a b. (a -> b) -> a -> b
$ Maybe RequestMap -> RequestMap
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe RequestMap -> RequestMap) -> Maybe RequestMap -> RequestMap
forall a b. (a -> b) -> a -> b
$ RequestMap -> LspId m -> SClientMethod m -> Maybe RequestMap
forall (m :: Method 'ClientToServer 'Request).
RequestMap -> LspId m -> SClientMethod m -> Maybe RequestMap
updateRequestMap RequestMap
r LspId m
id SClientMethod m
method
~() <- case SClientMethod m -> ClientNotOrReq m
forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m
method of
ClientNotOrReq m
IsClientReq -> TRequestMessage m -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage TRequestMessage m
mess
ClientNotOrReq m
IsClientEither -> TCustomMessage s 'ClientToServer 'Request -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (TCustomMessage s 'ClientToServer 'Request -> Session ())
-> TCustomMessage s 'ClientToServer 'Request -> Session ()
forall a b. (a -> b) -> a -> b
$ TRequestMessage ('Method_CustomMethod s)
-> TCustomMessage s 'ClientToServer 'Request
forall (s :: Symbol) (f :: MessageDirection).
TRequestMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Request
ReqMess TRequestMessage m
TRequestMessage ('Method_CustomMethod s)
mess
LspId m -> Session (LspId m)
forall a. a -> Session a
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 = Text
-> SMethod 'Method_TextDocumentDidOpen
-> MessageParams 'Method_TextDocumentDidOpen
-> TNotificationMessage 'Method_TextDocumentDidOpen
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
MessageParams 'Method_TextDocumentDidOpen
params
VFS
oldVFS <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
let newVFS :: VFS
newVFS = (State VFS () -> VFS -> VFS) -> VFS -> State VFS () -> VFS
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState VFS
oldVFS (State VFS () -> VFS) -> State VFS () -> VFS
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidOpen -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidOpen -> m ()
openVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidOpen
TNotificationMessage 'Method_TextDocumentDidOpen
n
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s{vfs = newVFS})
TNotificationMessage 'Method_TextDocumentDidOpen -> Session ()
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 = Text
-> SMethod 'Method_TextDocumentDidClose
-> MessageParams 'Method_TextDocumentDidClose
-> TNotificationMessage 'Method_TextDocumentDidClose
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
MessageParams 'Method_TextDocumentDidClose
params
VFS
oldVFS <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
let newVFS :: VFS
newVFS = (State VFS () -> VFS -> VFS) -> VFS -> State VFS () -> VFS
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState VFS
oldVFS (State VFS () -> VFS) -> State VFS () -> VFS
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidClose -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidClose -> m ()
closeVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidClose
TNotificationMessage 'Method_TextDocumentDidClose
n
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s{vfs = newVFS})
TNotificationMessage 'Method_TextDocumentDidClose -> Session ()
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 = Text
-> SMethod 'Method_TextDocumentDidChange
-> MessageParams 'Method_TextDocumentDidChange
-> TNotificationMessage 'Method_TextDocumentDidChange
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
MessageParams 'Method_TextDocumentDidChange
params
VFS
oldVFS <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
let newVFS :: VFS
newVFS = (State VFS () -> VFS -> VFS) -> VFS -> State VFS () -> VFS
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState VFS
oldVFS (State VFS () -> VFS) -> State VFS () -> VFS
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidChange -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidChange -> m ()
changeFromClientVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidChange
TNotificationMessage 'Method_TextDocumentDidChange
n
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s{vfs = newVFS})
TNotificationMessage 'Method_TextDocumentDidChange -> Session ()
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 SMethod m -> ClientNotOrReq m
forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SMethod m
method of
ClientNotOrReq m
IsClientNot -> TNotificationMessage m -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (Text -> SMethod m -> MessageParams m -> TNotificationMessage m
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 -> TCustomMessage s 'ClientToServer 'Notification -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s 'ClientToServer 'Notification
forall (s :: Symbol) (f :: MessageDirection).
TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Notification
NotMess (TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s 'ClientToServer 'Notification)
-> TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s 'ClientToServer 'Notification
forall a b. (a -> b) -> a -> b
$ Text
-> SMethod ('Method_CustomMethod s)
-> MessageParams ('Method_CustomMethod s)
-> TNotificationMessage ('Method_CustomMethod s)
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod m
SMethod ('Method_CustomMethod s)
method MessageParams m
MessageParams ('Method_CustomMethod s)
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 = TResponseMessage m -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage
initializeResponse :: Session (TResponseMessage Method_Initialize)
initializeResponse :: Session (TResponseMessage 'Method_Initialize)
initializeResponse = Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask Session SessionContext
-> (SessionContext
-> Session (TResponseMessage 'Method_Initialize))
-> Session (TResponseMessage 'Method_Initialize)
forall a b. Session a -> (a -> Session b) -> Session b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (TResponseMessage 'Method_Initialize)
-> Session (TResponseMessage 'Method_Initialize)
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TResponseMessage 'Method_Initialize)
-> Session (TResponseMessage 'Method_Initialize))
-> (MVar (TResponseMessage 'Method_Initialize)
-> IO (TResponseMessage 'Method_Initialize))
-> MVar (TResponseMessage 'Method_Initialize)
-> Session (TResponseMessage 'Method_Initialize)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (TResponseMessage 'Method_Initialize)
-> IO (TResponseMessage 'Method_Initialize)
forall a. MVar a -> IO a
readMVar) (MVar (TResponseMessage 'Method_Initialize)
-> Session (TResponseMessage 'Method_Initialize))
-> (SessionContext -> MVar (TResponseMessage 'Method_Initialize))
-> SessionContext
-> Session (TResponseMessage 'Method_Initialize)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionContext -> MVar (TResponseMessage 'Method_Initialize)
initRsp
setIgnoringLogNotifications :: Bool -> Session ()
setIgnoringLogNotifications :: Bool -> Session ()
setIgnoringLogNotifications Bool
value = do
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{ignoringLogNotifications = value})
setIgnoringConfigurationRequests :: Bool -> Session ()
setIgnoringConfigurationRequests :: Bool -> Session ()
setIgnoringConfigurationRequests Bool
value = do
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{ignoringConfigurationRequests = value})
setIgnoringRegistrationRequests :: Bool -> Session ()
setIgnoringRegistrationRequests :: Bool -> Session ()
setIgnoringRegistrationRequests Bool
value = do
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{ignoringRegistrationRequests = value})
modifyConfig :: (Object -> Object) -> Session ()
modifyConfig :: (Object -> Object) -> Session ()
modifyConfig Object -> Object
f = do
Object
oldConfig <- SessionState -> Object
curLspConfig (SessionState -> Object) -> Session SessionState -> Session Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
let newConfig :: Object
newConfig = Object -> Object
f Object
oldConfig
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{curLspConfig = newConfig})
[SomeRegistration]
registeredCaps <- Session [SomeRegistration]
getRegisteredCapabilities
let
requestedSections :: Maybe [T.Text]
requestedSections :: Maybe [Text]
requestedSections = ((SomeRegistration -> Maybe [Text])
-> [SomeRegistration] -> Maybe [Text])
-> [SomeRegistration]
-> (SomeRegistration -> Maybe [Text])
-> Maybe [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SomeRegistration -> Maybe [Text])
-> [SomeRegistration] -> Maybe [Text]
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust [SomeRegistration]
registeredCaps ((SomeRegistration -> Maybe [Text]) -> Maybe [Text])
-> (SomeRegistration -> Maybe [Text]) -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ \(SomeRegistration (TRegistration Text
_ SClientMethod m
regMethod Maybe (RegistrationOptions m)
regOpts)) ->
case SClientMethod m
regMethod of
SClientMethod m
SMethod_WorkspaceDidChangeConfiguration -> case Maybe (RegistrationOptions m)
regOpts of
Just (DidChangeConfigurationRegistrationOptions{$sel:_section:DidChangeConfigurationRegistrationOptions :: DidChangeConfigurationRegistrationOptions -> Maybe (Text |? [Text])
_section = Maybe (Text |? [Text])
section}) -> case Maybe (Text |? [Text])
section of
Just (InL Text
s) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
s]
Just (InR [Text]
ss) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
ss
Maybe (Text |? [Text])
Nothing -> Maybe [Text]
forall a. Maybe a
Nothing
Maybe (RegistrationOptions m)
_ -> Maybe [Text]
forall a. Maybe a
Nothing
SClientMethod m
_ -> Maybe [Text]
forall a. Maybe a
Nothing
requestedSectionKeys :: Maybe [J.Key]
requestedSectionKeys :: Maybe [Key]
requestedSectionKeys = (([Text] -> [Key]) -> Maybe [Text] -> Maybe [Key]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Text] -> [Key]) -> Maybe [Text] -> Maybe [Key])
-> ((Text -> Key) -> [Text] -> [Key])
-> (Text -> Key)
-> Maybe [Text]
-> Maybe [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Key) -> [Text] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> (Text -> String) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Maybe [Text]
requestedSections
let configToSend :: Value
configToSend = case Maybe [Key]
requestedSectionKeys of
Just [Key]
ss -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (Key -> Value -> Bool) -> Object -> Object
forall v. (Key -> v -> Bool) -> KeyMap v -> KeyMap v
J.filterWithKey (\Key
k Value
_ -> Key
k Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
ss) Object
newConfig
Maybe [Key]
Nothing -> Object -> Value
Object Object
newConfig
SClientMethod 'Method_WorkspaceDidChangeConfiguration
-> MessageParams 'Method_WorkspaceDidChangeConfiguration
-> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'Method_WorkspaceDidChangeConfiguration
SMethod_WorkspaceDidChangeConfiguration (MessageParams 'Method_WorkspaceDidChangeConfiguration
-> Session ())
-> MessageParams 'Method_WorkspaceDidChangeConfiguration
-> Session ()
forall a b. (a -> b) -> a -> b
$ Value -> DidChangeConfigurationParams
DidChangeConfigurationParams Value
configToSend
setConfig :: Object -> Session ()
setConfig :: Object -> Session ()
setConfig Object
newConfig = (Object -> Object) -> Session ()
modifyConfig (Object -> Object -> Object
forall a b. a -> b -> a
const Object
newConfig)
modifyConfigSection :: String -> (Value -> Value) -> Session ()
modifyConfigSection :: String -> (Value -> Value) -> Session ()
modifyConfigSection String
section Value -> Value
f = (Object -> Object) -> Session ()
modifyConfig (\Object
o -> Object
o Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Traversal' Object (IxValue Object)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (String -> Key
forall a. IsString a => String -> a
fromString String
section) ((Value -> Identity Value) -> Object -> Identity Object)
-> (Value -> Value) -> Object -> Object
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Value -> Value
f)
setConfigSection :: String -> Value -> Session ()
setConfigSection :: String -> Value -> Session ()
setConfigSection String
section Value
settings = (Object -> Object) -> Session ()
modifyConfig (\Object
o -> Object
o Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (String -> Key
forall a. IsString a => String -> a
fromString String
section) ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
settings)
createDoc ::
FilePath ->
LanguageKind ->
T.Text ->
Session TextDocumentIdentifier
createDoc :: String -> LanguageKind -> Text -> Session TextDocumentIdentifier
createDoc String
file LanguageKind
languageId Text
contents = do
Map Text SomeRegistration
dynCaps <- SessionState -> Map Text SomeRegistration
curDynCaps (SessionState -> Map Text SomeRegistration)
-> Session SessionState -> Session (Map Text SomeRegistration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
String
rootDir <- (SessionContext -> String) -> Session String
forall b. (SessionContext -> b) -> Session b
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> String
rootDir
ClientCapabilities
caps <- (SessionContext -> ClientCapabilities)
-> Session ClientCapabilities
forall b. (SessionContext -> b) -> Session b
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> ClientCapabilities
sessionCapabilities
String
absFile <- IO String -> Session String
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Session String) -> IO String -> Session String
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
TRegistration 'Method_WorkspaceDidChangeWatchedFiles
r]
pred SomeRegistration
_ = [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
forall a. Monoid a => a
mempty
regs :: [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
regs = (SomeRegistration
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles])
-> Map Text SomeRegistration
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SomeRegistration
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
pred 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 (WatchKind -> Maybe WatchKind -> WatchKind
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 = (Bool -> FileSystemWatcher -> Bool)
-> Bool -> [FileSystemWatcher] -> Bool
forall b a. (b -> a -> b) -> b -> [a] -> b
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 TRegistration 'Method_WorkspaceDidChangeWatchedFiles
-> Getting
[FileSystemWatcher]
(TRegistration 'Method_WorkspaceDidChangeWatchedFiles)
[FileSystemWatcher]
-> [FileSystemWatcher]
forall s a. s -> Getting a s a -> a
^. (Maybe DidChangeWatchedFilesRegistrationOptions
-> Const
[FileSystemWatcher]
(Maybe DidChangeWatchedFilesRegistrationOptions))
-> TRegistration 'Method_WorkspaceDidChangeWatchedFiles
-> Const
[FileSystemWatcher]
(TRegistration 'Method_WorkspaceDidChangeWatchedFiles)
forall s a. HasRegisterOptions s a => Lens' s a
Lens'
(TRegistration 'Method_WorkspaceDidChangeWatchedFiles)
(Maybe DidChangeWatchedFilesRegistrationOptions)
L.registerOptions ((Maybe DidChangeWatchedFilesRegistrationOptions
-> Const
[FileSystemWatcher]
(Maybe DidChangeWatchedFilesRegistrationOptions))
-> TRegistration 'Method_WorkspaceDidChangeWatchedFiles
-> Const
[FileSystemWatcher]
(TRegistration 'Method_WorkspaceDidChangeWatchedFiles))
-> (([FileSystemWatcher]
-> Const [FileSystemWatcher] [FileSystemWatcher])
-> Maybe DidChangeWatchedFilesRegistrationOptions
-> Const
[FileSystemWatcher]
(Maybe DidChangeWatchedFilesRegistrationOptions))
-> Getting
[FileSystemWatcher]
(TRegistration 'Method_WorkspaceDidChangeWatchedFiles)
[FileSystemWatcher]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DidChangeWatchedFilesRegistrationOptions
-> Const
[FileSystemWatcher] DidChangeWatchedFilesRegistrationOptions)
-> Maybe DidChangeWatchedFilesRegistrationOptions
-> Const
[FileSystemWatcher]
(Maybe DidChangeWatchedFilesRegistrationOptions)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((DidChangeWatchedFilesRegistrationOptions
-> Const
[FileSystemWatcher] DidChangeWatchedFilesRegistrationOptions)
-> Maybe DidChangeWatchedFilesRegistrationOptions
-> Const
[FileSystemWatcher]
(Maybe DidChangeWatchedFilesRegistrationOptions))
-> (([FileSystemWatcher]
-> Const [FileSystemWatcher] [FileSystemWatcher])
-> DidChangeWatchedFilesRegistrationOptions
-> Const
[FileSystemWatcher] DidChangeWatchedFilesRegistrationOptions)
-> ([FileSystemWatcher]
-> Const [FileSystemWatcher] [FileSystemWatcher])
-> Maybe DidChangeWatchedFilesRegistrationOptions
-> Const
[FileSystemWatcher]
(Maybe DidChangeWatchedFilesRegistrationOptions)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FileSystemWatcher]
-> Const [FileSystemWatcher] [FileSystemWatcher])
-> DidChangeWatchedFilesRegistrationOptions
-> Const
[FileSystemWatcher] DidChangeWatchedFilesRegistrationOptions
forall s a. HasWatchers s a => Lens' s a
Lens' DidChangeWatchedFilesRegistrationOptions [FileSystemWatcher]
L.watchers)
clientCapsSupports :: Bool
clientCapsSupports =
ClientCapabilities
caps ClientCapabilities
-> Getting (First Bool) ClientCapabilities Bool -> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> ClientCapabilities -> Const (First Bool) ClientCapabilities
forall s a. HasWorkspace s a => Lens' s a
Lens' ClientCapabilities (Maybe WorkspaceClientCapabilities)
L.workspace ((Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> ClientCapabilities -> Const (First Bool) ClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> Getting (First Bool) ClientCapabilities Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> ((Bool -> Const (First Bool) Bool)
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities)
-> (Bool -> Const (First Bool) Bool)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe DidChangeWatchedFilesClientCapabilities
-> Const
(First Bool) (Maybe DidChangeWatchedFilesClientCapabilities))
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities
forall s a. HasDidChangeWatchedFiles s a => Lens' s a
Lens'
WorkspaceClientCapabilities
(Maybe DidChangeWatchedFilesClientCapabilities)
L.didChangeWatchedFiles ((Maybe DidChangeWatchedFilesClientCapabilities
-> Const
(First Bool) (Maybe DidChangeWatchedFilesClientCapabilities))
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
-> Maybe DidChangeWatchedFilesClientCapabilities
-> Const
(First Bool) (Maybe DidChangeWatchedFilesClientCapabilities))
-> (Bool -> Const (First Bool) Bool)
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DidChangeWatchedFilesClientCapabilities
-> Const (First Bool) DidChangeWatchedFilesClientCapabilities)
-> Maybe DidChangeWatchedFilesClientCapabilities
-> Const
(First Bool) (Maybe DidChangeWatchedFilesClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((DidChangeWatchedFilesClientCapabilities
-> Const (First Bool) DidChangeWatchedFilesClientCapabilities)
-> Maybe DidChangeWatchedFilesClientCapabilities
-> Const
(First Bool) (Maybe DidChangeWatchedFilesClientCapabilities))
-> ((Bool -> Const (First Bool) Bool)
-> DidChangeWatchedFilesClientCapabilities
-> Const (First Bool) DidChangeWatchedFilesClientCapabilities)
-> (Bool -> Const (First Bool) Bool)
-> Maybe DidChangeWatchedFilesClientCapabilities
-> Const
(First Bool) (Maybe DidChangeWatchedFilesClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Const (First Bool) (Maybe Bool))
-> DidChangeWatchedFilesClientCapabilities
-> Const (First Bool) DidChangeWatchedFilesClientCapabilities
forall s a. HasDynamicRegistration s a => Lens' s a
Lens' DidChangeWatchedFilesClientCapabilities (Maybe Bool)
L.dynamicRegistration ((Maybe Bool -> Const (First Bool) (Maybe Bool))
-> DidChangeWatchedFilesClientCapabilities
-> Const (First Bool) DidChangeWatchedFilesClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
-> Maybe Bool -> Const (First Bool) (Maybe Bool))
-> (Bool -> Const (First Bool) Bool)
-> DidChangeWatchedFilesClientCapabilities
-> Const (First Bool) DidChangeWatchedFilesClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const (First Bool) Bool)
-> Maybe Bool -> Const (First Bool) (Maybe Bool)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just
Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
shouldSend :: Bool
shouldSend = Bool
clientCapsSupports Bool -> Bool -> Bool
&& (Bool
-> TRegistration 'Method_WorkspaceDidChangeWatchedFiles -> Bool)
-> Bool
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
-> Bool
forall b a. (b -> a -> b) -> b -> [a] -> b
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
Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldSend (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$
SClientMethod 'Method_WorkspaceDidChangeWatchedFiles
-> MessageParams 'Method_WorkspaceDidChangeWatchedFiles
-> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'Method_WorkspaceDidChangeWatchedFiles
SMethod_WorkspaceDidChangeWatchedFiles (MessageParams 'Method_WorkspaceDidChangeWatchedFiles
-> Session ())
-> MessageParams 'Method_WorkspaceDidChangeWatchedFiles
-> Session ()
forall a b. (a -> b) -> a -> b
$
[FileEvent] -> DidChangeWatchedFilesParams
DidChangeWatchedFilesParams ([FileEvent] -> DidChangeWatchedFilesParams)
-> [FileEvent] -> 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 -> LanguageKind -> Text -> Session TextDocumentIdentifier
openDoc' String
file LanguageKind
languageId Text
contents
openDoc :: FilePath -> LanguageKind -> Session TextDocumentIdentifier
openDoc :: String -> LanguageKind -> Session TextDocumentIdentifier
openDoc String
file LanguageKind
languageId = do
SessionContext
context <- Session SessionContext
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 <- IO Text -> Session Text
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> Session Text) -> IO Text -> Session Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
fp
String -> LanguageKind -> Text -> Session TextDocumentIdentifier
openDoc' String
file LanguageKind
languageId Text
contents
openDoc' :: FilePath -> LanguageKind -> T.Text -> Session TextDocumentIdentifier
openDoc' :: String -> LanguageKind -> Text -> Session TextDocumentIdentifier
openDoc' String
file LanguageKind
languageId Text
contents = do
SessionContext
context <- Session SessionContext
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 -> LanguageKind -> Int32 -> Text -> TextDocumentItem
TextDocumentItem Uri
uri LanguageKind
languageId Int32
0 Text
contents
SMethod 'Method_TextDocumentDidOpen
-> MessageParams 'Method_TextDocumentDidOpen -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen (TextDocumentItem -> DidOpenTextDocumentParams
DidOpenTextDocumentParams TextDocumentItem
item)
TextDocumentIdentifier -> Session TextDocumentIdentifier
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextDocumentIdentifier -> Session TextDocumentIdentifier)
-> TextDocumentIdentifier -> Session TextDocumentIdentifier
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 TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri))
SMethod 'Method_TextDocumentDidClose
-> MessageParams 'Method_TextDocumentDidClose -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidClose
SMethod_TextDocumentDidClose DidCloseTextDocumentParams
MessageParams 'Method_TextDocumentDidClose
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 VersionedTextDocumentIdentifier
-> (VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier)
-> VersionedTextDocumentIdentifier
forall a b. a -> (a -> b) -> b
& (Int32 -> Identity Int32)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier
forall s a. HasVersion s a => Lens' s a
Lens' VersionedTextDocumentIdentifier Int32
L.version ((Int32 -> Identity Int32)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier)
-> Int32
-> VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int32
1) [TextDocumentContentChangeEvent]
changes
SMethod 'Method_TextDocumentDidChange
-> MessageParams 'Method_TextDocumentDidChange -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidChange
SMethod_TextDocumentDidChange DidChangeTextDocumentParams
MessageParams 'Method_TextDocumentDidChange
params
getDocUri :: FilePath -> Session Uri
getDocUri :: String -> Session Uri
getDocUri String
file = do
SessionContext
context <- Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
let fp :: String
fp = SessionContext -> String
rootDir SessionContext
context String -> String -> String
</> String
file
Uri -> Session Uri
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return (Uri -> Session Uri) -> Uri -> Session Uri
forall a b. (a -> b) -> a -> b
$ String -> Uri
filePathToUri String
fp
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics = do
TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot <- Session FromServerMessage
-> Session
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
-> Session
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (SServerMethod 'Method_TextDocumentPublishDiagnostics
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SServerMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics)
let diags :: [Diagnostic]
diags = TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Getting
[Diagnostic]
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
[Diagnostic]
-> [Diagnostic]
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams)
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Const
[Diagnostic]
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
Lens'
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
PublishDiagnosticsParams
L.params ((PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams)
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Const
[Diagnostic]
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics))
-> (([Diagnostic] -> Const [Diagnostic] [Diagnostic])
-> PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams)
-> Getting
[Diagnostic]
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
[Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Diagnostic] -> Const [Diagnostic] [Diagnostic])
-> PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
Lens' PublishDiagnosticsParams [Diagnostic]
L.diagnostics
[Diagnostic] -> Session [Diagnostic]
forall a. a -> Session a
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 = (Diagnostic -> Bool) -> [Diagnostic] -> [Diagnostic]
forall a. (a -> Bool) -> [a] -> [a]
filter Diagnostic -> Bool
matches [Diagnostic]
diags
if [Diagnostic] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnostic]
res
then String -> Session [Diagnostic]
waitForDiagnosticsSource String
src
else [Diagnostic] -> Session [Diagnostic]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
res
where
matches :: Diagnostic -> Bool
matches :: Diagnostic -> Bool
matches Diagnostic
d = Diagnostic
d Diagnostic
-> Getting (Maybe Text) Diagnostic (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Diagnostic (Maybe Text)
forall s a. HasSource s a => Lens' s a
Lens' Diagnostic (Maybe Text)
L.source Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack String
src)
noDiagnostics :: Session ()
noDiagnostics :: Session ()
noDiagnostics = do
TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot <- SServerMethod 'Method_TextDocumentPublishDiagnostics
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SServerMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics
Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Getting
[Diagnostic]
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
[Diagnostic]
-> [Diagnostic]
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams)
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Const
[Diagnostic]
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
Lens'
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
PublishDiagnosticsParams
L.params ((PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams)
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Const
[Diagnostic]
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics))
-> (([Diagnostic] -> Const [Diagnostic] [Diagnostic])
-> PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams)
-> Getting
[Diagnostic]
(TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
[Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Diagnostic] -> Const [Diagnostic] [Diagnostic])
-> PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
Lens' PublishDiagnosticsParams [Diagnostic]
L.diagnostics [Diagnostic] -> [Diagnostic] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ SessionException -> IO ()
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
(TResponseError 'Method_TextDocumentDocumentSymbol)
(MessageResult 'Method_TextDocumentDocumentSymbol)
res <- SClientMethod 'Method_TextDocumentDocumentSymbol
-> MessageParams 'Method_TextDocumentDocumentSymbol
-> Session (TResponseMessage 'Method_TextDocumentDocumentSymbol)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentDocumentSymbol
SMethod_TextDocumentDocumentSymbol (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> DocumentSymbolParams
DocumentSymbolParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc)
case Either
(TResponseError 'Method_TextDocumentDocumentSymbol)
(MessageResult 'Method_TextDocumentDocumentSymbol)
res of
Right (InL [SymbolInformation]
xs) -> Either [SymbolInformation] [DocumentSymbol]
-> Session (Either [SymbolInformation] [DocumentSymbol])
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SymbolInformation] -> Either [SymbolInformation] [DocumentSymbol]
forall a b. a -> Either a b
Left [SymbolInformation]
xs)
Right (InR (InL [DocumentSymbol]
xs)) -> Either [SymbolInformation] [DocumentSymbol]
-> Session (Either [SymbolInformation] [DocumentSymbol])
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ([DocumentSymbol] -> Either [SymbolInformation] [DocumentSymbol]
forall a b. b -> Either a b
Right [DocumentSymbol]
xs)
Right (InR (InR Null
_)) -> Either [SymbolInformation] [DocumentSymbol]
-> Session (Either [SymbolInformation] [DocumentSymbol])
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ([DocumentSymbol] -> Either [SymbolInformation] [DocumentSymbol]
forall a b. b -> Either a b
Right [])
Left TResponseError 'Method_TextDocumentDocumentSymbol
err -> SessionException
-> Session (Either [SymbolInformation] [DocumentSymbol])
forall a e. Exception e => e -> a
throw (LspId 'Method_TextDocumentDocumentSymbol
-> TResponseError 'Method_TextDocumentDocumentSymbol
-> SessionException
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
LspId m -> TResponseError m -> SessionException
UnexpectedResponseError (Maybe (LspId 'Method_TextDocumentDocumentSymbol)
-> LspId 'Method_TextDocumentDocumentSymbol
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId 'Method_TextDocumentDocumentSymbol)
rspLid) TResponseError 'Method_TextDocumentDocumentSymbol
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 <- SClientMethod 'Method_TextDocumentCodeAction
-> MessageParams 'Method_TextDocumentCodeAction
-> Session (TResponseMessage 'Method_TextDocumentCodeAction)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> CodeActionParams
CodeActionParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc Range
range CodeActionContext
ctx)
case TResponseMessage 'Method_TextDocumentCodeAction
rsp TResponseMessage 'Method_TextDocumentCodeAction
-> Getting
(Either
(TResponseError 'Method_TextDocumentCodeAction)
([Command |? CodeAction] |? Null))
(TResponseMessage 'Method_TextDocumentCodeAction)
(Either
(TResponseError 'Method_TextDocumentCodeAction)
([Command |? CodeAction] |? Null))
-> Either
(TResponseError 'Method_TextDocumentCodeAction)
([Command |? CodeAction] |? Null)
forall s a. s -> Getting a s a -> a
^. Getting
(Either
(TResponseError 'Method_TextDocumentCodeAction)
([Command |? CodeAction] |? Null))
(TResponseMessage 'Method_TextDocumentCodeAction)
(Either
(TResponseError 'Method_TextDocumentCodeAction)
([Command |? CodeAction] |? Null))
forall s a. HasResult s a => Lens' s a
Lens'
(TResponseMessage 'Method_TextDocumentCodeAction)
(Either
(TResponseError 'Method_TextDocumentCodeAction)
([Command |? CodeAction] |? Null))
L.result of
Right (InL [Command |? CodeAction]
xs) -> [Command |? CodeAction] -> Session [Command |? CodeAction]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return [Command |? CodeAction]
xs
Right (InR Null
_) -> [Command |? CodeAction] -> Session [Command |? CodeAction]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Left TResponseError 'Method_TextDocumentCodeAction
error -> SessionException -> Session [Command |? CodeAction]
forall a e. Exception e => e -> a
throw (LspId 'Method_TextDocumentCodeAction
-> TResponseError 'Method_TextDocumentCodeAction
-> SessionException
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
LspId m -> TResponseError m -> SessionException
UnexpectedResponseError (Maybe (LspId 'Method_TextDocumentCodeAction)
-> LspId 'Method_TextDocumentCodeAction
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId 'Method_TextDocumentCodeAction)
-> LspId 'Method_TextDocumentCodeAction)
-> Maybe (LspId 'Method_TextDocumentCodeAction)
-> LspId 'Method_TextDocumentCodeAction
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentCodeAction
rsp TResponseMessage 'Method_TextDocumentCodeAction
-> Getting
(Maybe (LspId 'Method_TextDocumentCodeAction))
(TResponseMessage 'Method_TextDocumentCodeAction)
(Maybe (LspId 'Method_TextDocumentCodeAction))
-> Maybe (LspId 'Method_TextDocumentCodeAction)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (LspId 'Method_TextDocumentCodeAction))
(TResponseMessage 'Method_TextDocumentCodeAction)
(Maybe (LspId 'Method_TextDocumentCodeAction))
forall s a. HasId s a => Lens' s a
Lens'
(TResponseMessage 'Method_TextDocumentCodeAction)
(Maybe (LspId 'Method_TextDocumentCodeAction))
L.id) TResponseError 'Method_TextDocumentCodeAction
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
[Command |? CodeAction]
-> ((Command |? CodeAction) -> Session (Command |? CodeAction))
-> Session [Command |? CodeAction]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Command |? CodeAction]
items (((Command |? CodeAction) -> Session (Command |? CodeAction))
-> Session [Command |? CodeAction])
-> ((Command |? CodeAction) -> Session (Command |? CodeAction))
-> Session [Command |? CodeAction]
forall a b. (a -> b) -> a -> b
$ \case
l :: Command |? CodeAction
l@(InL Command
_) -> (Command |? CodeAction) -> Session (Command |? CodeAction)
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command |? CodeAction
l
(InR CodeAction
r) | Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (CodeAction
r CodeAction
-> Getting (Maybe Value) CodeAction (Maybe Value) -> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) CodeAction (Maybe Value)
forall s a. HasData_ s a => Lens' s a
Lens' CodeAction (Maybe Value)
L.data_) -> CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> Session CodeAction -> Session (Command |? CodeAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeAction -> Session CodeAction
resolveCodeAction CodeAction
r
r :: Command |? CodeAction
r@(InR CodeAction
_) -> (Command |? CodeAction) -> Session (Command |? CodeAction)
forall a. a -> Session a
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
([Command |? CodeAction]
-> Diagnostic -> Session [Command |? CodeAction])
-> [Command |? CodeAction]
-> [Diagnostic]
-> Session [Command |? CodeAction]
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) [] ([Diagnostic] -> Session [Command |? CodeAction])
-> Session [Diagnostic] -> Session [Command |? CodeAction]
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
(TResponseError 'Method_TextDocumentCodeAction)
(MessageResult 'Method_TextDocumentCodeAction)
res <- SClientMethod 'Method_TextDocumentCodeAction
-> MessageParams 'Method_TextDocumentCodeAction
-> Session (TResponseMessage 'Method_TextDocumentCodeAction)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> CodeActionParams
CodeActionParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc (Diagnostic
diag Diagnostic -> Getting Range Diagnostic Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range Diagnostic Range
forall s a. HasRange s a => Lens' s a
Lens' Diagnostic Range
L.range) CodeActionContext
ctx)
case Either
(TResponseError 'Method_TextDocumentCodeAction)
(MessageResult 'Method_TextDocumentCodeAction)
res of
Left TResponseError 'Method_TextDocumentCodeAction
e -> SessionException -> Session [Command |? CodeAction]
forall a e. Exception e => e -> a
throw (LspId 'Method_TextDocumentCodeAction
-> TResponseError 'Method_TextDocumentCodeAction
-> SessionException
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
LspId m -> TResponseError m -> SessionException
UnexpectedResponseError (Maybe (LspId 'Method_TextDocumentCodeAction)
-> LspId 'Method_TextDocumentCodeAction
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId 'Method_TextDocumentCodeAction)
rspLid) TResponseError 'Method_TextDocumentCodeAction
e)
Right (InL [Command |? CodeAction]
cmdOrCAs) -> [Command |? CodeAction] -> Session [Command |? CodeAction]
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Command |? CodeAction]
acc [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall a. [a] -> [a] -> [a]
++ [Command |? CodeAction]
cmdOrCAs)
Right (InR Null
_) -> [Command |? CodeAction] -> Session [Command |? CodeAction]
forall a. a -> Session a
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
]
CodeActionContext -> Session CodeActionContext
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return (CodeActionContext -> Session CodeActionContext)
-> CodeActionContext -> Session CodeActionContext
forall a b. (a -> b) -> a -> b
$ [Diagnostic]
-> Maybe [CodeActionKind]
-> Maybe CodeActionTriggerKind
-> CodeActionContext
CodeActionContext [Diagnostic]
diags Maybe [CodeActionKind]
forall a. Maybe a
Nothing Maybe CodeActionTriggerKind
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 UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
> UInt
sl Bool -> Bool -> Bool
&& UInt
pl UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
< UInt
el
Bool -> Bool -> Bool
|| UInt
pl UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
sl Bool -> Bool -> Bool
&& UInt
pl UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
el Bool -> Bool -> Bool
&& UInt
po UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
>= UInt
so Bool -> Bool -> Bool
&& UInt
po UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
<= UInt
eo
Bool -> Bool -> Bool
|| UInt
pl UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
sl Bool -> Bool -> Bool
&& UInt
po UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
>= UInt
so
Bool -> Bool -> Bool
|| UInt
pl UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
el Bool -> Bool -> Bool
&& UInt
po UInt -> UInt -> Bool
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
CodeActionContext -> Session CodeActionContext
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return (CodeActionContext -> Session CodeActionContext)
-> CodeActionContext -> Session CodeActionContext
forall a b. (a -> b) -> a -> b
$ [Diagnostic]
-> Maybe [CodeActionKind]
-> Maybe CodeActionTriggerKind
-> CodeActionContext
CodeActionContext [Diagnostic]
curDiags Maybe [CodeActionKind]
forall a. Maybe a
Nothing Maybe CodeActionTriggerKind
forall a. Maybe a
Nothing
getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc = [Diagnostic]
-> NormalizedUri -> Map NormalizedUri [Diagnostic] -> [Diagnostic]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (Uri -> NormalizedUri
toNormalizedUri (Uri -> NormalizedUri) -> Uri -> NormalizedUri
forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri) (Map NormalizedUri [Diagnostic] -> [Diagnostic])
-> (SessionState -> Map NormalizedUri [Diagnostic])
-> SessionState
-> [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map NormalizedUri [Diagnostic]
curDiagnostics (SessionState -> [Diagnostic])
-> Session SessionState -> Session [Diagnostic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
getIncompleteProgressSessions :: Session (Set.Set ProgressToken)
getIncompleteProgressSessions :: Session (Set ProgressToken)
getIncompleteProgressSessions = SessionState -> Set ProgressToken
curProgressSessions (SessionState -> Set ProgressToken)
-> Session SessionState -> Session (Set ProgressToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
executeCommand :: Command -> Session ()
executeCommand :: Command -> Session ()
executeCommand Command
cmd = do
let args :: Maybe [Value]
args = ByteString -> Maybe [Value]
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe [Value]) -> ByteString -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([Value] -> ByteString) -> [Value] -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe [Value] -> [Value]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Value] -> [Value]) -> Maybe [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ Command
cmd Command
-> Getting (Maybe [Value]) Command (Maybe [Value]) -> Maybe [Value]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Value]) Command (Maybe [Value])
forall s a. HasArguments s a => Lens' s a
Lens' Command (Maybe [Value])
L.arguments
execParams :: ExecuteCommandParams
execParams = Maybe ProgressToken
-> Text -> Maybe [Value] -> ExecuteCommandParams
ExecuteCommandParams Maybe ProgressToken
forall a. Maybe a
Nothing (Command
cmd Command -> Getting Text Command Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Command Text
forall s a. HasCommand s a => Lens' s a
Lens' Command Text
L.command) Maybe [Value]
args
Session (LspId 'Method_WorkspaceExecuteCommand) -> Session ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Session (LspId 'Method_WorkspaceExecuteCommand) -> Session ())
-> Session (LspId 'Method_WorkspaceExecuteCommand) -> Session ()
forall a b. (a -> b) -> a -> b
$ SClientMethod 'Method_WorkspaceExecuteCommand
-> MessageParams 'Method_WorkspaceExecuteCommand
-> Session (LspId 'Method_WorkspaceExecuteCommand)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod 'Method_WorkspaceExecuteCommand
SMethod_WorkspaceExecuteCommand ExecuteCommandParams
MessageParams 'Method_WorkspaceExecuteCommand
execParams
executeCodeAction :: CodeAction -> Session ()
executeCodeAction :: CodeAction -> Session ()
executeCodeAction CodeAction
action = do
Session ()
-> (WorkspaceEdit -> Session ())
-> Maybe WorkspaceEdit
-> Session ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Session ()
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) WorkspaceEdit -> Session ()
handleEdit (Maybe WorkspaceEdit -> Session ())
-> Maybe WorkspaceEdit -> Session ()
forall a b. (a -> b) -> a -> b
$ CodeAction
action CodeAction
-> Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
-> Maybe WorkspaceEdit
forall s a. s -> Getting a s a -> a
^. Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
forall s a. HasEdit s a => Lens' s a
Lens' CodeAction (Maybe WorkspaceEdit)
L.edit
Session ()
-> (Command -> Session ()) -> Maybe Command -> Session ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Session ()
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Command -> Session ()
executeCommand (Maybe Command -> Session ()) -> Maybe Command -> Session ()
forall a b. (a -> b) -> a -> b
$ CodeAction
action CodeAction
-> Getting (Maybe Command) CodeAction (Maybe Command)
-> Maybe Command
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Command) CodeAction (Maybe Command)
forall s a. HasCommand s a => Lens' s a
Lens' CodeAction (Maybe Command)
L.command
where
handleEdit :: WorkspaceEdit -> Session ()
handleEdit :: WorkspaceEdit -> Session ()
handleEdit WorkspaceEdit
e =
let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = Text
-> LspId 'Method_WorkspaceApplyEdit
-> SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> TRequestMessage 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (Int32 -> LspId 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
e)
in FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'Method_WorkspaceApplyEdit
-> TMessage 'Method_WorkspaceApplyEdit -> FromServerMessage
forall (t :: MessageKind) (m :: Method 'ServerToClient t)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TMessage 'Method_WorkspaceApplyEdit
TRequestMessage 'Method_WorkspaceApplyEdit
req)
resolveCodeAction :: CodeAction -> Session CodeAction
resolveCodeAction :: CodeAction -> Session CodeAction
resolveCodeAction CodeAction
ca = do
TResponseMessage 'Method_CodeActionResolve
rsp <- SClientMethod 'Method_CodeActionResolve
-> MessageParams 'Method_CodeActionResolve
-> Session (TResponseMessage 'Method_CodeActionResolve)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_CodeActionResolve
SMethod_CodeActionResolve CodeAction
MessageParams 'Method_CodeActionResolve
ca
case TResponseMessage 'Method_CodeActionResolve
rsp TResponseMessage 'Method_CodeActionResolve
-> Getting
(Either (TResponseError 'Method_CodeActionResolve) CodeAction)
(TResponseMessage 'Method_CodeActionResolve)
(Either (TResponseError 'Method_CodeActionResolve) CodeAction)
-> Either (TResponseError 'Method_CodeActionResolve) CodeAction
forall s a. s -> Getting a s a -> a
^. Getting
(Either (TResponseError 'Method_CodeActionResolve) CodeAction)
(TResponseMessage 'Method_CodeActionResolve)
(Either (TResponseError 'Method_CodeActionResolve) CodeAction)
forall s a. HasResult s a => Lens' s a
Lens'
(TResponseMessage 'Method_CodeActionResolve)
(Either (TResponseError 'Method_CodeActionResolve) CodeAction)
L.result of
Right CodeAction
ca -> CodeAction -> Session CodeAction
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return CodeAction
ca
Left TResponseError 'Method_CodeActionResolve
er -> SessionException -> Session CodeAction
forall a e. Exception e => e -> a
throw (LspId 'Method_CodeActionResolve
-> TResponseError 'Method_CodeActionResolve -> SessionException
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
LspId m -> TResponseError m -> SessionException
UnexpectedResponseError (Maybe (LspId 'Method_CodeActionResolve)
-> LspId 'Method_CodeActionResolve
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId 'Method_CodeActionResolve)
-> LspId 'Method_CodeActionResolve)
-> Maybe (LspId 'Method_CodeActionResolve)
-> LspId 'Method_CodeActionResolve
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_CodeActionResolve
rsp TResponseMessage 'Method_CodeActionResolve
-> Getting
(Maybe (LspId 'Method_CodeActionResolve))
(TResponseMessage 'Method_CodeActionResolve)
(Maybe (LspId 'Method_CodeActionResolve))
-> Maybe (LspId 'Method_CodeActionResolve)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (LspId 'Method_CodeActionResolve))
(TResponseMessage 'Method_CodeActionResolve)
(Maybe (LspId 'Method_CodeActionResolve))
forall s a. HasId s a => Lens' s a
Lens'
(TResponseMessage 'Method_CodeActionResolve)
(Maybe (LspId 'Method_CodeActionResolve))
L.id) TResponseError 'Method_CodeActionResolve
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 (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
let ver :: Maybe Int32
ver = VFS
vfs VFS -> Getting (First Int32) VFS Int32 -> Maybe Int32
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Map NormalizedUri VirtualFile
-> Const (First Int32) (Map NormalizedUri VirtualFile))
-> VFS -> Const (First Int32) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Const (First Int32) (Map NormalizedUri VirtualFile))
-> VFS -> Const (First Int32) VFS)
-> ((Int32 -> Const (First Int32) Int32)
-> Map NormalizedUri VirtualFile
-> Const (First Int32) (Map NormalizedUri VirtualFile))
-> Getting (First Int32) VFS Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Traversal'
(Map NormalizedUri VirtualFile)
(IxValue (Map NormalizedUri VirtualFile))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Uri -> NormalizedUri
toNormalizedUri Uri
uri) ((VirtualFile -> Const (First Int32) VirtualFile)
-> Map NormalizedUri VirtualFile
-> Const (First Int32) (Map NormalizedUri VirtualFile))
-> ((Int32 -> Const (First Int32) Int32)
-> VirtualFile -> Const (First Int32) VirtualFile)
-> (Int32 -> Const (First Int32) Int32)
-> Map NormalizedUri VirtualFile
-> Const (First Int32) (Map NormalizedUri VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VirtualFile -> Int32)
-> (Int32 -> Const (First Int32) Int32)
-> VirtualFile
-> Const (First Int32) VirtualFile
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to VirtualFile -> Int32
virtualFileVersion
VersionedTextDocumentIdentifier
-> Session VersionedTextDocumentIdentifier
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return (Uri -> Int32 -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri (Int32 -> Maybe Int32 -> Int32
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 <- (SessionContext -> ClientCapabilities)
-> Session ClientCapabilities
forall b. (SessionContext -> b) -> Session b
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> ClientCapabilities
sessionCapabilities
let supportsDocChanges :: Bool
supportsDocChanges = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ClientCapabilities
caps ClientCapabilities
-> Getting (First Bool) ClientCapabilities Bool -> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> ClientCapabilities -> Const (First Bool) ClientCapabilities
forall s a. HasWorkspace s a => Lens' s a
Lens' ClientCapabilities (Maybe WorkspaceClientCapabilities)
L.workspace ((Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> ClientCapabilities -> Const (First Bool) ClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> Getting (First Bool) ClientCapabilities Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> ((Bool -> Const (First Bool) Bool)
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities)
-> (Bool -> Const (First Bool) Bool)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe WorkspaceEditClientCapabilities
-> Const (First Bool) (Maybe WorkspaceEditClientCapabilities))
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities
forall s a. HasWorkspaceEdit s a => Lens' s a
Lens'
WorkspaceClientCapabilities (Maybe WorkspaceEditClientCapabilities)
L.workspaceEdit ((Maybe WorkspaceEditClientCapabilities
-> Const (First Bool) (Maybe WorkspaceEditClientCapabilities))
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
-> Maybe WorkspaceEditClientCapabilities
-> Const (First Bool) (Maybe WorkspaceEditClientCapabilities))
-> (Bool -> Const (First Bool) Bool)
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEditClientCapabilities
-> Const (First Bool) WorkspaceEditClientCapabilities)
-> Maybe WorkspaceEditClientCapabilities
-> Const (First Bool) (Maybe WorkspaceEditClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((WorkspaceEditClientCapabilities
-> Const (First Bool) WorkspaceEditClientCapabilities)
-> Maybe WorkspaceEditClientCapabilities
-> Const (First Bool) (Maybe WorkspaceEditClientCapabilities))
-> ((Bool -> Const (First Bool) Bool)
-> WorkspaceEditClientCapabilities
-> Const (First Bool) WorkspaceEditClientCapabilities)
-> (Bool -> Const (First Bool) Bool)
-> Maybe WorkspaceEditClientCapabilities
-> Const (First Bool) (Maybe WorkspaceEditClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Const (First Bool) (Maybe Bool))
-> WorkspaceEditClientCapabilities
-> Const (First Bool) WorkspaceEditClientCapabilities
forall s a. HasDocumentChanges s a => Lens' s a
Lens' WorkspaceEditClientCapabilities (Maybe Bool)
L.documentChanges ((Maybe Bool -> Const (First Bool) (Maybe Bool))
-> WorkspaceEditClientCapabilities
-> Const (First Bool) WorkspaceEditClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
-> Maybe Bool -> Const (First Bool) (Maybe Bool))
-> (Bool -> Const (First Bool) Bool)
-> WorkspaceEditClientCapabilities
-> Const (First Bool) WorkspaceEditClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const (First Bool) Bool)
-> Maybe Bool -> Const (First Bool) (Maybe Bool)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just
let wEdit :: WorkspaceEdit
wEdit =
if Bool
supportsDocChanges
then
let docEdit :: TextDocumentEdit
docEdit = OptionalVersionedTextDocumentIdentifier
-> [TextEdit |? AnnotatedTextEdit] -> TextDocumentEdit
TextDocumentEdit (AReview
OptionalVersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
-> OptionalVersionedTextDocumentIdentifier
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview
OptionalVersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier
Prism'
OptionalVersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier
_versionedTextDocumentIdentifier VersionedTextDocumentIdentifier
verDoc) [TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. a -> a |? b
InL TextEdit
edit]
in Maybe (Map Uri [TextEdit])
-> Maybe [DocumentChange]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit Maybe (Map Uri [TextEdit])
forall a. Maybe a
Nothing ([DocumentChange] -> Maybe [DocumentChange]
forall a. a -> Maybe a
Just [TextDocumentEdit -> DocumentChange
forall a b. a -> a |? b
InL TextDocumentEdit
docEdit]) Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
else
let changes :: Map Uri [TextEdit]
changes = Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton (TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri) [TextEdit
edit]
in Maybe (Map Uri [TextEdit])
-> Maybe [DocumentChange]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just Map Uri [TextEdit]
changes) Maybe [DocumentChange]
forall a. Maybe a
Nothing Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = Text
-> LspId 'Method_WorkspaceApplyEdit
-> SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> TRequestMessage 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (Int32 -> LspId 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
wEdit)
FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'Method_WorkspaceApplyEdit
-> TMessage 'Method_WorkspaceApplyEdit -> FromServerMessage
forall (t :: MessageKind) (m :: Method 'ServerToClient t)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TMessage 'Method_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 <- SClientMethod 'Method_TextDocumentCompletion
-> MessageParams 'Method_TextDocumentCompletion
-> Session (TResponseMessage 'Method_TextDocumentCompletion)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentCompletion
SMethod_TextDocumentCompletion (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> Maybe CompletionContext
-> CompletionParams
CompletionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing Maybe CompletionContext
forall a. Maybe a
Nothing)
case TResponseMessage 'Method_TextDocumentCompletion
-> MessageResult 'Method_TextDocumentCompletion
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentCompletion
rsp of
InL [CompletionItem]
items -> [CompletionItem] -> Session [CompletionItem]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items
InR (InL CompletionList
c) -> [CompletionItem] -> Session [CompletionItem]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompletionItem] -> Session [CompletionItem])
-> [CompletionItem] -> Session [CompletionItem]
forall a b. (a -> b) -> a -> b
$ CompletionList
c CompletionList
-> Getting [CompletionItem] CompletionList [CompletionItem]
-> [CompletionItem]
forall s a. s -> Getting a s a -> a
^. Getting [CompletionItem] CompletionList [CompletionItem]
forall s a. HasItems s a => Lens' s a
Lens' CompletionList [CompletionItem]
L.items
InR (InR Null
_) -> [CompletionItem] -> Session [CompletionItem]
forall a. a -> Session a
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
[CompletionItem]
-> (CompletionItem -> Session CompletionItem)
-> Session [CompletionItem]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CompletionItem]
items ((CompletionItem -> Session CompletionItem)
-> Session [CompletionItem])
-> (CompletionItem -> Session CompletionItem)
-> Session [CompletionItem]
forall a b. (a -> b) -> a -> b
$ \CompletionItem
item -> if Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (CompletionItem
item CompletionItem
-> Getting (Maybe Value) CompletionItem (Maybe Value)
-> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) CompletionItem (Maybe Value)
forall s a. HasData_ s a => Lens' s a
Lens' CompletionItem (Maybe Value)
L.data_) then CompletionItem -> Session CompletionItem
resolveCompletion CompletionItem
item else CompletionItem -> Session CompletionItem
forall a. a -> Session a
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 <- SClientMethod 'Method_CompletionItemResolve
-> MessageParams 'Method_CompletionItemResolve
-> Session (TResponseMessage 'Method_CompletionItemResolve)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_CompletionItemResolve
SMethod_CompletionItemResolve CompletionItem
MessageParams 'Method_CompletionItemResolve
ci
case TResponseMessage 'Method_CompletionItemResolve
rsp TResponseMessage 'Method_CompletionItemResolve
-> Getting
(Either
(TResponseError 'Method_CompletionItemResolve) CompletionItem)
(TResponseMessage 'Method_CompletionItemResolve)
(Either
(TResponseError 'Method_CompletionItemResolve) CompletionItem)
-> Either
(TResponseError 'Method_CompletionItemResolve) CompletionItem
forall s a. s -> Getting a s a -> a
^. Getting
(Either
(TResponseError 'Method_CompletionItemResolve) CompletionItem)
(TResponseMessage 'Method_CompletionItemResolve)
(Either
(TResponseError 'Method_CompletionItemResolve) CompletionItem)
forall s a. HasResult s a => Lens' s a
Lens'
(TResponseMessage 'Method_CompletionItemResolve)
(Either
(TResponseError 'Method_CompletionItemResolve) CompletionItem)
L.result of
Right CompletionItem
ci -> CompletionItem -> Session CompletionItem
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return CompletionItem
ci
Left TResponseError 'Method_CompletionItemResolve
error -> SessionException -> Session CompletionItem
forall a e. Exception e => e -> a
throw (LspId 'Method_CompletionItemResolve
-> TResponseError 'Method_CompletionItemResolve -> SessionException
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
LspId m -> TResponseError m -> SessionException
UnexpectedResponseError (Maybe (LspId 'Method_CompletionItemResolve)
-> LspId 'Method_CompletionItemResolve
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId 'Method_CompletionItemResolve)
-> LspId 'Method_CompletionItemResolve)
-> Maybe (LspId 'Method_CompletionItemResolve)
-> LspId 'Method_CompletionItemResolve
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_CompletionItemResolve
rsp TResponseMessage 'Method_CompletionItemResolve
-> Getting
(Maybe (LspId 'Method_CompletionItemResolve))
(TResponseMessage 'Method_CompletionItemResolve)
(Maybe (LspId 'Method_CompletionItemResolve))
-> Maybe (LspId 'Method_CompletionItemResolve)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (LspId 'Method_CompletionItemResolve))
(TResponseMessage 'Method_CompletionItemResolve)
(Maybe (LspId 'Method_CompletionItemResolve))
forall s a. HasId s a => Lens' s a
Lens'
(TResponseMessage 'Method_CompletionItemResolve)
(Maybe (LspId 'Method_CompletionItemResolve))
L.id) TResponseError 'Method_CompletionItemResolve
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 Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing ReferenceContext
ctx
in ([Location] |? Null) -> [Location]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([Location] |? Null) -> [Location])
-> (TResponseMessage 'Method_TextDocumentReferences
-> [Location] |? Null)
-> TResponseMessage 'Method_TextDocumentReferences
-> [Location]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TResponseMessage 'Method_TextDocumentReferences
-> [Location] |? Null
TResponseMessage 'Method_TextDocumentReferences
-> MessageResult 'Method_TextDocumentReferences
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult (TResponseMessage 'Method_TextDocumentReferences -> [Location])
-> Session (TResponseMessage 'Method_TextDocumentReferences)
-> Session [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'Method_TextDocumentReferences
-> MessageParams 'Method_TextDocumentReferences
-> Session (TResponseMessage 'Method_TextDocumentReferences)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentReferences
SMethod_TextDocumentReferences ReferenceParams
MessageParams 'Method_TextDocumentReferences
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 <- SClientMethod 'Method_TextDocumentDeclaration
-> MessageParams 'Method_TextDocumentDeclaration
-> Session (TResponseMessage 'Method_TextDocumentDeclaration)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentDeclaration
SMethod_TextDocumentDeclaration (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DeclarationParams
DeclarationParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing)
(Declaration |? ([DeclarationLink] |? Null))
-> Session (Declaration |? ([DeclarationLink] |? Null))
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Declaration |? ([DeclarationLink] |? Null))
-> Session (Declaration |? ([DeclarationLink] |? Null)))
-> (Declaration |? ([DeclarationLink] |? Null))
-> Session (Declaration |? ([DeclarationLink] |? Null))
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentDeclaration
-> MessageResult 'Method_TextDocumentDeclaration
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (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 <- SClientMethod 'Method_TextDocumentDefinition
-> MessageParams 'Method_TextDocumentDefinition
-> Session (TResponseMessage 'Method_TextDocumentDefinition)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentDefinition
SMethod_TextDocumentDefinition (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DefinitionParams
DefinitionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing)
(Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null)))
-> (Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentDefinition
-> MessageResult 'Method_TextDocumentDefinition
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (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 <- SClientMethod 'Method_TextDocumentTypeDefinition
-> MessageParams 'Method_TextDocumentTypeDefinition
-> Session (TResponseMessage 'Method_TextDocumentTypeDefinition)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentTypeDefinition
SMethod_TextDocumentTypeDefinition (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> TypeDefinitionParams
TypeDefinitionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing)
(Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null)))
-> (Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentTypeDefinition
-> MessageResult 'Method_TextDocumentTypeDefinition
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (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 <- SClientMethod 'Method_TextDocumentImplementation
-> MessageParams 'Method_TextDocumentImplementation
-> Session (TResponseMessage 'Method_TextDocumentImplementation)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentImplementation
SMethod_TextDocumentImplementation (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> ImplementationParams
ImplementationParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing)
(Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null)))
-> (Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentImplementation
-> MessageResult 'Method_TextDocumentImplementation
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (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 Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc Position
pos (String -> Text
T.pack String
newName)
TResponseMessage 'Method_TextDocumentRename
rsp <- SClientMethod 'Method_TextDocumentRename
-> MessageParams 'Method_TextDocumentRename
-> Session (TResponseMessage 'Method_TextDocumentRename)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentRename
SMethod_TextDocumentRename RenameParams
MessageParams 'Method_TextDocumentRename
params
let wEdit :: MessageResult 'Method_TextDocumentRename
wEdit = TResponseMessage 'Method_TextDocumentRename
-> MessageResult 'Method_TextDocumentRename
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentRename
rsp
case (WorkspaceEdit |? Null) -> Maybe WorkspaceEdit
forall a. (a |? Null) -> Maybe a
nullToMaybe WorkspaceEdit |? Null
MessageResult 'Method_TextDocumentRename
wEdit of
Just WorkspaceEdit
e -> do
let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = Text
-> LspId 'Method_WorkspaceApplyEdit
-> SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> TRequestMessage 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (Int32 -> LspId 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
e)
FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'Method_WorkspaceApplyEdit
-> TMessage 'Method_WorkspaceApplyEdit -> FromServerMessage
forall (t :: MessageKind) (m :: Method 'ServerToClient t)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TMessage 'Method_WorkspaceApplyEdit
TRequestMessage 'Method_WorkspaceApplyEdit
req)
Maybe WorkspaceEdit
Nothing -> () -> Session ()
forall a. a -> Session a
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 Maybe ProgressToken
forall a. Maybe a
Nothing
in (Hover |? Null) -> Maybe Hover
forall a. (a |? Null) -> Maybe a
nullToMaybe ((Hover |? Null) -> Maybe Hover)
-> (TResponseMessage 'Method_TextDocumentHover -> Hover |? Null)
-> TResponseMessage 'Method_TextDocumentHover
-> Maybe Hover
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TResponseMessage 'Method_TextDocumentHover -> Hover |? Null
TResponseMessage 'Method_TextDocumentHover
-> MessageResult 'Method_TextDocumentHover
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult (TResponseMessage 'Method_TextDocumentHover -> Maybe Hover)
-> Session (TResponseMessage 'Method_TextDocumentHover)
-> Session (Maybe Hover)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'Method_TextDocumentHover
-> MessageParams 'Method_TextDocumentHover
-> Session (TResponseMessage 'Method_TextDocumentHover)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentHover
SMethod_TextDocumentHover HoverParams
MessageParams 'Method_TextDocumentHover
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 Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing
in ([DocumentHighlight] |? Null) -> [DocumentHighlight]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([DocumentHighlight] |? Null) -> [DocumentHighlight])
-> (TResponseMessage 'Method_TextDocumentDocumentHighlight
-> [DocumentHighlight] |? Null)
-> TResponseMessage 'Method_TextDocumentDocumentHighlight
-> [DocumentHighlight]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TResponseMessage 'Method_TextDocumentDocumentHighlight
-> [DocumentHighlight] |? Null
TResponseMessage 'Method_TextDocumentDocumentHighlight
-> MessageResult 'Method_TextDocumentDocumentHighlight
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult (TResponseMessage 'Method_TextDocumentDocumentHighlight
-> [DocumentHighlight])
-> Session (TResponseMessage 'Method_TextDocumentDocumentHighlight)
-> Session [DocumentHighlight]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'Method_TextDocumentDocumentHighlight
-> MessageParams 'Method_TextDocumentDocumentHighlight
-> Session (TResponseMessage 'Method_TextDocumentDocumentHighlight)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentDocumentHighlight
SMethod_TextDocumentDocumentHighlight DocumentHighlightParams
MessageParams 'Method_TextDocumentDocumentHighlight
params
getResponseResult :: (Show (ErrorData m)) => TResponseMessage m -> MessageResult m
getResponseResult :: forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage m
rsp =
case TResponseMessage m
rsp TResponseMessage m
-> Getting
(Either (TResponseError m) (MessageResult m))
(TResponseMessage m)
(Either (TResponseError m) (MessageResult m))
-> Either (TResponseError m) (MessageResult m)
forall s a. s -> Getting a s a -> a
^. Getting
(Either (TResponseError m) (MessageResult m))
(TResponseMessage m)
(Either (TResponseError m) (MessageResult m))
forall s a. HasResult s a => Lens' s a
Lens'
(TResponseMessage m) (Either (TResponseError m) (MessageResult m))
L.result of
Right MessageResult m
x -> MessageResult m
x
Left TResponseError m
err -> SessionException -> MessageResult m
forall a e. Exception e => e -> a
throw (SessionException -> MessageResult m)
-> SessionException -> MessageResult m
forall a b. (a -> b) -> a -> b
$ LspId m -> TResponseError m -> SessionException
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
LspId m -> TResponseError m -> SessionException
UnexpectedResponseError (Maybe (LspId m) -> LspId m
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId m) -> LspId m) -> Maybe (LspId m) -> LspId m
forall a b. (a -> b) -> a -> b
$ TResponseMessage m
rsp TResponseMessage m
-> Getting (Maybe (LspId m)) (TResponseMessage m) (Maybe (LspId m))
-> Maybe (LspId m)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (LspId m)) (TResponseMessage m) (Maybe (LspId m))
forall s a. HasId s a => Lens' s a
Lens' (TResponseMessage m) (Maybe (LspId m))
L.id) TResponseError m
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 Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc FormattingOptions
opts
[TextEdit]
edits <- ([TextEdit] |? Null) -> [TextEdit]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([TextEdit] |? Null) -> [TextEdit])
-> (TResponseMessage 'Method_TextDocumentFormatting
-> [TextEdit] |? Null)
-> TResponseMessage 'Method_TextDocumentFormatting
-> [TextEdit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TResponseMessage 'Method_TextDocumentFormatting
-> [TextEdit] |? Null
TResponseMessage 'Method_TextDocumentFormatting
-> MessageResult 'Method_TextDocumentFormatting
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult (TResponseMessage 'Method_TextDocumentFormatting -> [TextEdit])
-> Session (TResponseMessage 'Method_TextDocumentFormatting)
-> Session [TextEdit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'Method_TextDocumentFormatting
-> MessageParams 'Method_TextDocumentFormatting
-> Session (TResponseMessage 'Method_TextDocumentFormatting)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentFormatting
SMethod_TextDocumentFormatting DocumentFormattingParams
MessageParams 'Method_TextDocumentFormatting
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 Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc Range
range FormattingOptions
opts
[TextEdit]
edits <- ([TextEdit] |? Null) -> [TextEdit]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([TextEdit] |? Null) -> [TextEdit])
-> (TResponseMessage 'Method_TextDocumentRangeFormatting
-> [TextEdit] |? Null)
-> TResponseMessage 'Method_TextDocumentRangeFormatting
-> [TextEdit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TResponseMessage 'Method_TextDocumentRangeFormatting
-> [TextEdit] |? Null
TResponseMessage 'Method_TextDocumentRangeFormatting
-> MessageResult 'Method_TextDocumentRangeFormatting
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult (TResponseMessage 'Method_TextDocumentRangeFormatting
-> [TextEdit])
-> Session (TResponseMessage 'Method_TextDocumentRangeFormatting)
-> Session [TextEdit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'Method_TextDocumentRangeFormatting
-> MessageParams 'Method_TextDocumentRangeFormatting
-> Session (TResponseMessage 'Method_TextDocumentRangeFormatting)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentRangeFormatting
SMethod_TextDocumentRangeFormatting DocumentRangeFormattingParams
MessageParams 'Method_TextDocumentRangeFormatting
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 (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton (TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri) [TextEdit]
edits)) Maybe [DocumentChange]
forall a. Maybe a
Nothing Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = Text
-> LspId 'Method_WorkspaceApplyEdit
-> SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> TRequestMessage 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (Int32 -> LspId 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
wEdit)
in FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'Method_WorkspaceApplyEdit
-> TMessage 'Method_WorkspaceApplyEdit -> FromServerMessage
forall (t :: MessageKind) (m :: Method 'ServerToClient t)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TMessage 'Method_WorkspaceApplyEdit
TRequestMessage 'Method_WorkspaceApplyEdit
req)
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses TextDocumentIdentifier
tId = do
TResponseMessage 'Method_TextDocumentCodeLens
rsp <- SClientMethod 'Method_TextDocumentCodeLens
-> MessageParams 'Method_TextDocumentCodeLens
-> Session (TResponseMessage 'Method_TextDocumentCodeLens)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentCodeLens
SMethod_TextDocumentCodeLens (Maybe ProgressToken
-> Maybe ProgressToken -> TextDocumentIdentifier -> CodeLensParams
CodeLensParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
tId)
[CodeLens] -> Session [CodeLens]
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CodeLens] -> Session [CodeLens])
-> [CodeLens] -> Session [CodeLens]
forall a b. (a -> b) -> a -> b
$ ([CodeLens] |? Null) -> [CodeLens]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([CodeLens] |? Null) -> [CodeLens])
-> ([CodeLens] |? Null) -> [CodeLens]
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentCodeLens
-> MessageResult 'Method_TextDocumentCodeLens
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (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
[CodeLens] -> (CodeLens -> Session CodeLens) -> Session [CodeLens]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CodeLens]
codeLenses ((CodeLens -> Session CodeLens) -> Session [CodeLens])
-> (CodeLens -> Session CodeLens) -> Session [CodeLens]
forall a b. (a -> b) -> a -> b
$ \CodeLens
codeLens -> if Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (CodeLens
codeLens CodeLens
-> Getting (Maybe Value) CodeLens (Maybe Value) -> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) CodeLens (Maybe Value)
forall s a. HasData_ s a => Lens' s a
Lens' CodeLens (Maybe Value)
L.data_) then CodeLens -> Session CodeLens
resolveCodeLens CodeLens
codeLens else CodeLens -> Session CodeLens
forall a. a -> Session a
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 <- SClientMethod 'Method_CodeLensResolve
-> MessageParams 'Method_CodeLensResolve
-> Session (TResponseMessage 'Method_CodeLensResolve)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_CodeLensResolve
SMethod_CodeLensResolve CodeLens
MessageParams 'Method_CodeLensResolve
cl
case TResponseMessage 'Method_CodeLensResolve
rsp TResponseMessage 'Method_CodeLensResolve
-> Getting
(Either (TResponseError 'Method_CodeLensResolve) CodeLens)
(TResponseMessage 'Method_CodeLensResolve)
(Either (TResponseError 'Method_CodeLensResolve) CodeLens)
-> Either (TResponseError 'Method_CodeLensResolve) CodeLens
forall s a. s -> Getting a s a -> a
^. Getting
(Either (TResponseError 'Method_CodeLensResolve) CodeLens)
(TResponseMessage 'Method_CodeLensResolve)
(Either (TResponseError 'Method_CodeLensResolve) CodeLens)
forall s a. HasResult s a => Lens' s a
Lens'
(TResponseMessage 'Method_CodeLensResolve)
(Either (TResponseError 'Method_CodeLensResolve) CodeLens)
L.result of
Right CodeLens
cl -> CodeLens -> Session CodeLens
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return CodeLens
cl
Left TResponseError 'Method_CodeLensResolve
error -> SessionException -> Session CodeLens
forall a e. Exception e => e -> a
throw (LspId 'Method_CodeLensResolve
-> TResponseError 'Method_CodeLensResolve -> SessionException
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
LspId m -> TResponseError m -> SessionException
UnexpectedResponseError (Maybe (LspId 'Method_CodeLensResolve)
-> LspId 'Method_CodeLensResolve
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId 'Method_CodeLensResolve)
-> LspId 'Method_CodeLensResolve)
-> Maybe (LspId 'Method_CodeLensResolve)
-> LspId 'Method_CodeLensResolve
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_CodeLensResolve
rsp TResponseMessage 'Method_CodeLensResolve
-> Getting
(Maybe (LspId 'Method_CodeLensResolve))
(TResponseMessage 'Method_CodeLensResolve)
(Maybe (LspId 'Method_CodeLensResolve))
-> Maybe (LspId 'Method_CodeLensResolve)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (LspId 'Method_CodeLensResolve))
(TResponseMessage 'Method_CodeLensResolve)
(Maybe (LspId 'Method_CodeLensResolve))
forall s a. HasId s a => Lens' s a
Lens'
(TResponseMessage 'Method_CodeLensResolve)
(Maybe (LspId 'Method_CodeLensResolve))
L.id) TResponseError 'Method_CodeLensResolve
error)
getInlayHints :: TextDocumentIdentifier -> Range -> Session [InlayHint]
getInlayHints :: TextDocumentIdentifier -> Range -> Session [InlayHint]
getInlayHints TextDocumentIdentifier
tId Range
range = do
TResponseMessage 'Method_TextDocumentInlayHint
rsp <- SClientMethod 'Method_TextDocumentInlayHint
-> MessageParams 'Method_TextDocumentInlayHint
-> Session (TResponseMessage 'Method_TextDocumentInlayHint)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentInlayHint
SMethod_TextDocumentInlayHint (Maybe ProgressToken
-> TextDocumentIdentifier -> Range -> InlayHintParams
InlayHintParams Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
tId Range
range)
[InlayHint] -> Session [InlayHint]
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([InlayHint] -> Session [InlayHint])
-> [InlayHint] -> Session [InlayHint]
forall a b. (a -> b) -> a -> b
$ ([InlayHint] |? Null) -> [InlayHint]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([InlayHint] |? Null) -> [InlayHint])
-> ([InlayHint] |? Null) -> [InlayHint]
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentInlayHint
-> MessageResult 'Method_TextDocumentInlayHint
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentInlayHint
rsp
getAndResolveInlayHints :: TextDocumentIdentifier -> Range -> Session [InlayHint]
getAndResolveInlayHints :: TextDocumentIdentifier -> Range -> Session [InlayHint]
getAndResolveInlayHints TextDocumentIdentifier
tId Range
range = do
[InlayHint]
inlayHints <- TextDocumentIdentifier -> Range -> Session [InlayHint]
getInlayHints TextDocumentIdentifier
tId Range
range
[InlayHint]
-> (InlayHint -> Session InlayHint) -> Session [InlayHint]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [InlayHint]
inlayHints ((InlayHint -> Session InlayHint) -> Session [InlayHint])
-> (InlayHint -> Session InlayHint) -> Session [InlayHint]
forall a b. (a -> b) -> a -> b
$ \InlayHint
inlayHint -> if Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (InlayHint
inlayHint InlayHint
-> Getting (Maybe Value) InlayHint (Maybe Value) -> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) InlayHint (Maybe Value)
forall s a. HasData_ s a => Lens' s a
Lens' InlayHint (Maybe Value)
L.data_) then InlayHint -> Session InlayHint
resolveInlayHint InlayHint
inlayHint else InlayHint -> Session InlayHint
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InlayHint
inlayHint
resolveInlayHint :: InlayHint -> Session InlayHint
resolveInlayHint :: InlayHint -> Session InlayHint
resolveInlayHint InlayHint
ih = do
TResponseMessage 'Method_InlayHintResolve
rsp <- SClientMethod 'Method_InlayHintResolve
-> MessageParams 'Method_InlayHintResolve
-> Session (TResponseMessage 'Method_InlayHintResolve)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_InlayHintResolve
SMethod_InlayHintResolve InlayHint
MessageParams 'Method_InlayHintResolve
ih
case TResponseMessage 'Method_InlayHintResolve
rsp TResponseMessage 'Method_InlayHintResolve
-> Getting
(Either (TResponseError 'Method_InlayHintResolve) InlayHint)
(TResponseMessage 'Method_InlayHintResolve)
(Either (TResponseError 'Method_InlayHintResolve) InlayHint)
-> Either (TResponseError 'Method_InlayHintResolve) InlayHint
forall s a. s -> Getting a s a -> a
^. Getting
(Either (TResponseError 'Method_InlayHintResolve) InlayHint)
(TResponseMessage 'Method_InlayHintResolve)
(Either (TResponseError 'Method_InlayHintResolve) InlayHint)
forall s a. HasResult s a => Lens' s a
Lens'
(TResponseMessage 'Method_InlayHintResolve)
(Either (TResponseError 'Method_InlayHintResolve) InlayHint)
L.result of
Right InlayHint
ih -> InlayHint -> Session InlayHint
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return InlayHint
ih
Left TResponseError 'Method_InlayHintResolve
error -> SessionException -> Session InlayHint
forall a e. Exception e => e -> a
throw (LspId 'Method_InlayHintResolve
-> TResponseError 'Method_InlayHintResolve -> SessionException
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
LspId m -> TResponseError m -> SessionException
UnexpectedResponseError (Maybe (LspId 'Method_InlayHintResolve)
-> LspId 'Method_InlayHintResolve
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId 'Method_InlayHintResolve)
-> LspId 'Method_InlayHintResolve)
-> Maybe (LspId 'Method_InlayHintResolve)
-> LspId 'Method_InlayHintResolve
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_InlayHintResolve
rsp TResponseMessage 'Method_InlayHintResolve
-> Getting
(Maybe (LspId 'Method_InlayHintResolve))
(TResponseMessage 'Method_InlayHintResolve)
(Maybe (LspId 'Method_InlayHintResolve))
-> Maybe (LspId 'Method_InlayHintResolve)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (LspId 'Method_InlayHintResolve))
(TResponseMessage 'Method_InlayHintResolve)
(Maybe (LspId 'Method_InlayHintResolve))
forall s a. HasId s a => Lens' s a
Lens'
(TResponseMessage 'Method_InlayHintResolve)
(Maybe (LspId 'Method_InlayHintResolve))
L.id) TResponseError 'Method_InlayHintResolve
error)
prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem]
prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem]
prepareCallHierarchy = SMethod 'Method_TextDocumentPrepareCallHierarchy
-> MessageParams 'Method_TextDocumentPrepareCallHierarchy
-> Session [CallHierarchyItem]
forall (m :: Method 'ClientToServer 'Request) a.
(Show (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 = SMethod 'Method_CallHierarchyIncomingCalls
-> MessageParams 'Method_CallHierarchyIncomingCalls
-> Session [CallHierarchyIncomingCall]
forall (m :: Method 'ClientToServer 'Request) a.
(Show (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 = SMethod 'Method_CallHierarchyOutgoingCalls
-> MessageParams 'Method_CallHierarchyOutgoingCalls
-> Session [CallHierarchyOutgoingCall]
forall (m :: Method 'ClientToServer 'Request) a.
(Show (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.
(Show (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
SMethod m ->
MessageParams m ->
Session [a]
resolveRequestWithListResp :: forall (m :: Method 'ClientToServer 'Request) a.
(Show (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
SMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod m
method MessageParams m
params = do
TResponseMessage m
rsp <- SMethod m -> MessageParams m -> Session (TResponseMessage m)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod m
method MessageParams m
params
[a] -> Session [a]
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Session [a]) -> [a] -> Session [a]
forall a b. (a -> b) -> a -> b
$ ([a] |? Null) -> [a]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([a] |? Null) -> [a]) -> ([a] |? Null) -> [a]
forall a b. (a -> b) -> a -> b
$ TResponseMessage m -> MessageResult m
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (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 Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc
TResponseMessage 'Method_TextDocumentSemanticTokensFull
rsp <- SClientMethod 'Method_TextDocumentSemanticTokensFull
-> MessageParams 'Method_TextDocumentSemanticTokensFull
-> Session
(TResponseMessage 'Method_TextDocumentSemanticTokensFull)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentSemanticTokensFull
SMethod_TextDocumentSemanticTokensFull SemanticTokensParams
MessageParams 'Method_TextDocumentSemanticTokensFull
params
(SemanticTokens |? Null) -> Session (SemanticTokens |? Null)
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SemanticTokens |? Null) -> Session (SemanticTokens |? Null))
-> (SemanticTokens |? Null) -> Session (SemanticTokens |? Null)
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentSemanticTokensFull
-> MessageResult 'Method_TextDocumentSemanticTokensFull
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentSemanticTokensFull
rsp
getRegisteredCapabilities :: Session [SomeRegistration]
getRegisteredCapabilities :: Session [SomeRegistration]
getRegisteredCapabilities = Map Text SomeRegistration -> [SomeRegistration]
forall k a. Map k a -> [a]
Map.elems (Map Text SomeRegistration -> [SomeRegistration])
-> (SessionState -> Map Text SomeRegistration)
-> SessionState
-> [SomeRegistration]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map Text SomeRegistration
curDynCaps (SessionState -> [SomeRegistration])
-> Session SessionState -> Session [SomeRegistration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get