{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
module Language.Haskell.LSP.Test
(
Session
, runSession
, runSessionWithConfig
, SessionConfig(..)
, defaultConfig
, C.fullCaps
, module Language.Haskell.LSP.Test.Exceptions
, withTimeout
, request
, request_
, sendRequest
, sendNotification
, sendResponse
, module Language.Haskell.LSP.Test.Parsing
, initializeResponse
, createDoc
, openDoc
, closeDoc
, changeDoc
, documentContents
, getDocumentEdit
, getDocUri
, getVersionedDoc
, getDocumentSymbols
, waitForDiagnostics
, waitForDiagnosticsSource
, noDiagnostics
, getCurrentDiagnostics
, getIncompleteProgressSessions
, executeCommand
, getCodeActions
, getAllCodeActions
, executeCodeAction
, getCompletions
, getReferences
, getDefinitions
, getTypeDefinitions
, rename
, getHover
, getHighlights
, formatDoc
, formatRange
, applyEdit
, getCodeLenses
, getRegisteredCapabilities
) where
import Control.Applicative.Combinators
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Control.Exception
import Control.Lens hiding ((.=), List)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Aeson
import Data.Default
import qualified Data.HashMap.Strict as HashMap
import Data.List
import Data.Maybe
import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Lens hiding
(id, capabilities, message, executeCommand, applyEdit, rename)
import qualified Language.Haskell.LSP.Types.Lens as LSP
import qualified Language.Haskell.LSP.Types.Capabilities as C
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Test.Compat
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Exceptions
import Language.Haskell.LSP.Test.Parsing
import Language.Haskell.LSP.Test.Session
import Language.Haskell.LSP.Test.Server
import System.Environment
import System.IO
import System.Directory
import System.FilePath
import qualified System.FilePath.Glob as Glob
runSession :: String
-> C.ClientCapabilities
-> FilePath
-> Session a
-> IO a
runSession :: 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
-> C.ClientCapabilities
-> FilePath
-> Session a
-> IO a
runSessionWithConfig :: SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
runSessionWithConfig SessionConfig
config' String
serverExe ClientCapabilities
caps String
rootDir Session a
session = do
Int
pid <- IO Int
getCurrentProcessID
String
absRootDir <- String -> IO String
canonicalizePath String
rootDir
SessionConfig
config <- SessionConfig -> IO SessionConfig
envOverrideConfig SessionConfig
config'
let initializeParams :: InitializeParams
initializeParams = Maybe Int
-> Maybe Text
-> Maybe Uri
-> Maybe Value
-> ClientCapabilities
-> Maybe Trace
-> Maybe (List WorkspaceFolder)
-> InitializeParams
InitializeParams (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
pid)
(Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
absRootDir)
(Uri -> Maybe Uri
forall a. a -> Maybe a
Just (Uri -> Maybe Uri) -> Uri -> Maybe Uri
forall a b. (a -> b) -> a -> b
$ String -> Uri
filePathToUri String
absRootDir)
Maybe Value
forall a. Maybe a
Nothing
ClientCapabilities
caps
(Trace -> Maybe Trace
forall a. a -> Maybe a
Just Trace
TraceOff)
Maybe (List WorkspaceFolder)
forall a. Maybe a
Nothing
String
-> Bool -> (Handle -> Handle -> ProcessHandle -> IO a) -> IO a
forall a.
String
-> Bool -> (Handle -> Handle -> ProcessHandle -> IO a) -> IO a
withServer String
serverExe (SessionConfig -> Bool
logStdErr SessionConfig
config) ((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 ->
Handle
-> Handle
-> ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
forall a.
Handle
-> Handle
-> ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
runSessionWithHandles Handle
serverIn Handle
serverOut 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
initReqId <- ClientMethod -> InitializeParams -> Session LspId
forall params.
ToJSON params =>
ClientMethod -> params -> Session LspId
sendRequest ClientMethod
Initialize InitializeParams
initializeParams
([FromServerMessage]
inBetween, ResponseMessage InitializeResponseCapabilities
initRspMsg) <- Session FromServerMessage
-> Session (ResponseMessage InitializeResponseCapabilities)
-> Session
([FromServerMessage],
ResponseMessage InitializeResponseCapabilities)
forall (m :: * -> *) a end.
Alternative m =>
m a -> m end -> m ([a], end)
manyTill_ Session FromServerMessage
anyMessage (LspId -> Session (ResponseMessage InitializeResponseCapabilities)
forall a. FromJSON a => LspId -> Session (ResponseMessage a)
responseForId LspId
initReqId)
case ResponseMessage InitializeResponseCapabilities
initRspMsg ResponseMessage InitializeResponseCapabilities
-> Getting
(Either ResponseError InitializeResponseCapabilities)
(ResponseMessage InitializeResponseCapabilities)
(Either ResponseError InitializeResponseCapabilities)
-> Either ResponseError InitializeResponseCapabilities
forall s a. s -> Getting a s a -> a
^. Getting
(Either ResponseError InitializeResponseCapabilities)
(ResponseMessage InitializeResponseCapabilities)
(Either ResponseError InitializeResponseCapabilities)
forall s a. HasResult s a => Lens' s a
LSP.result of
Left ResponseError
error -> IO () -> Session ()
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]
++ ResponseError -> String
forall a. Show a => a -> String
show ResponseError
error)
Right InitializeResponseCapabilities
_ -> () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
MVar (ResponseMessage InitializeResponseCapabilities)
initRspVar <- SessionContext
-> MVar (ResponseMessage InitializeResponseCapabilities)
initRsp (SessionContext
-> MVar (ResponseMessage InitializeResponseCapabilities))
-> Session SessionContext
-> Session (MVar (ResponseMessage InitializeResponseCapabilities))
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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ MVar (ResponseMessage InitializeResponseCapabilities)
-> ResponseMessage InitializeResponseCapabilities -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (ResponseMessage InitializeResponseCapabilities)
initRspVar ResponseMessage InitializeResponseCapabilities
initRspMsg
ClientMethod -> InitializedParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
Initialized InitializedParams
InitializedParams
case SessionConfig -> Maybe Value
lspConfig SessionConfig
config of
Just Value
cfg -> ClientMethod -> DidChangeConfigurationParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
WorkspaceDidChangeConfiguration (Value -> DidChangeConfigurationParams
DidChangeConfigurationParams Value
cfg)
Maybe Value
Nothing -> () -> Session ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[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 r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> Chan SessionMessage
messageChan
IO () -> Session ()
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 = ClientMethod -> Maybe Value -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
request_ ClientMethod
Shutdown (Maybe Value
forall a. Maybe a
Nothing :: Maybe Value) Session () -> Session () -> Session ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ClientMethod -> ExitParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
Exit ExitParams
ExitParams
listenServer :: Handle -> SessionContext -> IO ()
listenServer :: Handle -> SessionContext -> IO ()
listenServer Handle
serverOut SessionContext
context = do
ByteString
msgBytes <- Handle -> IO ByteString
getNextMessage Handle
serverOut
RequestMap
reqMap <- MVar RequestMap -> IO RequestMap
forall a. MVar a -> IO a
readMVar (MVar RequestMap -> IO RequestMap)
-> MVar RequestMap -> IO RequestMap
forall a b. (a -> b) -> a -> b
$ SessionContext -> MVar RequestMap
requestMap SessionContext
context
let msg :: FromServerMessage
msg = RequestMap -> ByteString -> 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
(RspShutdown ShutdownResponse
_) -> () -> IO ()
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 (NotShowMessage ShowMessageNotification
_) = () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkLegalBetweenMessage (NotLogMessage LogMessageNotification
_) = () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkLegalBetweenMessage (NotTelemetry TelemetryNotification
_) = () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkLegalBetweenMessage (ReqShowMessage ShowMessageRequest
_) = () -> Session ()
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 (m :: * -> *) a. Monad m => a -> m a
return (SessionConfig -> IO SessionConfig)
-> SessionConfig -> IO SessionConfig
forall a b. (a -> b) -> a -> b
$ SessionConfig
cfg { logMessages :: Bool
logMessages = Bool
logMessages', logStdErr :: Bool
logStdErr = Bool
logStdErr' }
where checkEnv :: String -> IO (Maybe Bool)
checkEnv :: String -> IO (Maybe Bool)
checkEnv String
s = (String -> Bool) -> Maybe String -> Maybe Bool
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 file :: VirtualFile
file = VFS -> Map NormalizedUri VirtualFile
vfsMap VFS
vfs Map NormalizedUri VirtualFile -> NormalizedUri -> VirtualFile
forall k a. Ord k => Map k a -> k -> a
Map.! 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
uri)
Text -> Session Text
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
ApplyWorkspaceEditRequest
req <- Session ApplyWorkspaceEditRequest
forall a. (Typeable a, FromJSON a) => Session a
message :: Session ApplyWorkspaceEditRequest
Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ApplyWorkspaceEditRequest -> Bool
checkDocumentChanges ApplyWorkspaceEditRequest
req Bool -> Bool -> Bool
|| ApplyWorkspaceEditRequest -> Bool
checkChanges ApplyWorkspaceEditRequest
req) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$
IO () -> Session ()
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 (ApplyWorkspaceEditRequest -> String
forall a. Show a => a -> String
show ApplyWorkspaceEditRequest
req))
TextDocumentIdentifier -> Session Text
documentContents TextDocumentIdentifier
doc
where
checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
checkDocumentChanges ApplyWorkspaceEditRequest
req =
let changes :: Maybe (List TextDocumentEdit)
changes = ApplyWorkspaceEditRequest
req ApplyWorkspaceEditRequest
-> Getting
(Maybe (List TextDocumentEdit))
ApplyWorkspaceEditRequest
(Maybe (List TextDocumentEdit))
-> Maybe (List TextDocumentEdit)
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditRequest
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditRequest)
-> ((Maybe (List TextDocumentEdit)
-> Const
(Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
-> ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> Getting
(Maybe (List TextDocumentEdit))
ApplyWorkspaceEditRequest
(Maybe (List TextDocumentEdit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit
-> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
edit ((WorkspaceEdit
-> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> ((Maybe (List TextDocumentEdit)
-> Const
(Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
-> WorkspaceEdit
-> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit)
-> (Maybe (List TextDocumentEdit)
-> Const
(Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
-> ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (List TextDocumentEdit)
-> Const
(Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
-> WorkspaceEdit
-> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit
forall s a. HasDocumentChanges s a => Lens' s a
documentChanges
maybeDocs :: Maybe (List Uri)
maybeDocs = (List TextDocumentEdit -> List Uri)
-> Maybe (List TextDocumentEdit) -> Maybe (List Uri)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextDocumentEdit -> Uri) -> List TextDocumentEdit -> List Uri
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TextDocumentEdit -> Getting Uri TextDocumentEdit Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (VersionedTextDocumentIdentifier
-> Const Uri VersionedTextDocumentIdentifier)
-> TextDocumentEdit -> Const Uri TextDocumentEdit
forall s a. HasTextDocument s a => Lens' s a
textDocument ((VersionedTextDocumentIdentifier
-> Const Uri VersionedTextDocumentIdentifier)
-> TextDocumentEdit -> Const Uri TextDocumentEdit)
-> ((Uri -> Const Uri Uri)
-> VersionedTextDocumentIdentifier
-> Const Uri VersionedTextDocumentIdentifier)
-> Getting Uri TextDocumentEdit Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> VersionedTextDocumentIdentifier
-> Const Uri VersionedTextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri)) Maybe (List TextDocumentEdit)
changes
in case Maybe (List Uri)
maybeDocs of
Just List 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
uri) Uri -> List Uri -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` List Uri
docs
Maybe (List Uri)
Nothing -> Bool
False
checkChanges :: ApplyWorkspaceEditRequest -> Bool
checkChanges :: ApplyWorkspaceEditRequest -> Bool
checkChanges ApplyWorkspaceEditRequest
req =
let mMap :: Maybe WorkspaceEditMap
mMap = ApplyWorkspaceEditRequest
req ApplyWorkspaceEditRequest
-> Getting
(Maybe WorkspaceEditMap)
ApplyWorkspaceEditRequest
(Maybe WorkspaceEditMap)
-> Maybe WorkspaceEditMap
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditRequest
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditRequest)
-> ((Maybe WorkspaceEditMap
-> Const (Maybe WorkspaceEditMap) (Maybe WorkspaceEditMap))
-> ApplyWorkspaceEditParams
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams)
-> Getting
(Maybe WorkspaceEditMap)
ApplyWorkspaceEditRequest
(Maybe WorkspaceEditMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit -> Const (Maybe WorkspaceEditMap) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
edit ((WorkspaceEdit -> Const (Maybe WorkspaceEditMap) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams)
-> ((Maybe WorkspaceEditMap
-> Const (Maybe WorkspaceEditMap) (Maybe WorkspaceEditMap))
-> WorkspaceEdit -> Const (Maybe WorkspaceEditMap) WorkspaceEdit)
-> (Maybe WorkspaceEditMap
-> Const (Maybe WorkspaceEditMap) (Maybe WorkspaceEditMap))
-> ApplyWorkspaceEditParams
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe WorkspaceEditMap
-> Const (Maybe WorkspaceEditMap) (Maybe WorkspaceEditMap))
-> WorkspaceEdit -> Const (Maybe WorkspaceEditMap) WorkspaceEdit
forall s a. HasChanges s a => Lens' s a
changes
in Bool
-> (WorkspaceEditMap -> Bool) -> Maybe WorkspaceEditMap -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Uri -> WorkspaceEditMap -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.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
uri)) Maybe WorkspaceEditMap
mMap
request :: (ToJSON params, FromJSON a) => ClientMethod -> params -> Session (ResponseMessage a)
request :: ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
m = ClientMethod -> params -> Session LspId
forall params.
ToJSON params =>
ClientMethod -> params -> Session LspId
sendRequest ClientMethod
m (params -> Session LspId)
-> (LspId -> Session (ResponseMessage a))
-> params
-> Session (ResponseMessage a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Session FromServerMessage
-> Session (ResponseMessage a) -> Session (ResponseMessage a)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (Session (ResponseMessage a) -> Session (ResponseMessage a))
-> (LspId -> Session (ResponseMessage a))
-> LspId
-> Session (ResponseMessage a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LspId -> Session (ResponseMessage a)
forall a. FromJSON a => LspId -> Session (ResponseMessage a)
responseForId
request_ :: ToJSON params => ClientMethod -> params -> Session ()
request_ :: ClientMethod -> params -> Session ()
request_ ClientMethod
p = Session (ResponseMessage Value) -> Session ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Session (ResponseMessage Value) -> Session ())
-> (params -> Session (ResponseMessage Value))
-> params
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientMethod -> params -> Session (ResponseMessage Value)
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
p :: ToJSON params => params -> Session (ResponseMessage Value))
sendRequest
:: ToJSON params
=> ClientMethod
-> params
-> Session LspId
sendRequest :: ClientMethod -> params -> Session LspId
sendRequest ClientMethod
method params
params = do
LspId
id <- SessionState -> LspId
curReqId (SessionState -> LspId) -> Session SessionState -> Session LspId
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 :: LspId
curReqId = LspId -> LspId
nextId LspId
id }
let req :: RequestMessage' params
req = Text -> LspId -> ClientMethod -> params -> RequestMessage' params
forall a. Text -> LspId -> ClientMethod -> a -> RequestMessage' a
RequestMessage' Text
"2.0" LspId
id ClientMethod
method params
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 (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 (m :: * -> *) a. Monad m => a -> m a
return (RequestMap -> IO RequestMap) -> RequestMap -> IO RequestMap
forall a b. (a -> b) -> a -> b
$ RequestMap -> LspId -> ClientMethod -> RequestMap
updateRequestMap RequestMap
r LspId
id ClientMethod
method
RequestMessage' params -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage RequestMessage' params
req
LspId -> Session LspId
forall (m :: * -> *) a. Monad m => a -> m a
return LspId
id
where nextId :: LspId -> LspId
nextId (IdInt Int
i) = Int -> LspId
IdInt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
nextId (IdString Text
s) = Text -> LspId
IdString (Text -> LspId) -> Text -> LspId
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ String -> Integer
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
s) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
data RequestMessage' a = RequestMessage' T.Text LspId ClientMethod a
instance ToJSON a => ToJSON (RequestMessage' a) where
toJSON :: RequestMessage' a -> Value
toJSON (RequestMessage' Text
rpc LspId
id ClientMethod
method a
params) =
[Pair] -> Value
object [Text
"jsonrpc" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
rpc, Text
"id" Text -> LspId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= LspId
id, Text
"method" Text -> ClientMethod -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ClientMethod
method, Text
"params" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
params]
sendNotification :: ToJSON a
=> ClientMethod
-> a
-> Session ()
sendNotification :: ClientMethod -> a -> Session ()
sendNotification ClientMethod
TextDocumentDidOpen a
params = do
let params' :: DidOpenTextDocumentParams
params' = Maybe DidOpenTextDocumentParams -> DidOpenTextDocumentParams
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DidOpenTextDocumentParams -> DidOpenTextDocumentParams)
-> Maybe DidOpenTextDocumentParams -> DidOpenTextDocumentParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe DidOpenTextDocumentParams
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe DidOpenTextDocumentParams)
-> ByteString -> Maybe DidOpenTextDocumentParams
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
params
n :: DidOpenTextDocumentNotification
n :: DidOpenTextDocumentNotification
n = Text
-> ClientMethod
-> DidOpenTextDocumentParams
-> DidOpenTextDocumentNotification
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ClientMethod
TextDocumentDidOpen DidOpenTextDocumentParams
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 (VFS
newVFS,[String]
_) = VFS -> DidOpenTextDocumentNotification -> (VFS, [String])
openVFS VFS
oldVFS DidOpenTextDocumentNotification
n
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
DidOpenTextDocumentNotification -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage DidOpenTextDocumentNotification
n
sendNotification ClientMethod
TextDocumentDidClose a
params = do
let params' :: DidCloseTextDocumentParams
params' = Maybe DidCloseTextDocumentParams -> DidCloseTextDocumentParams
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DidCloseTextDocumentParams -> DidCloseTextDocumentParams)
-> Maybe DidCloseTextDocumentParams -> DidCloseTextDocumentParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe DidCloseTextDocumentParams
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe DidCloseTextDocumentParams)
-> ByteString -> Maybe DidCloseTextDocumentParams
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
params
n :: DidCloseTextDocumentNotification
n :: DidCloseTextDocumentNotification
n = Text
-> ClientMethod
-> DidCloseTextDocumentParams
-> DidCloseTextDocumentNotification
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ClientMethod
TextDocumentDidClose DidCloseTextDocumentParams
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 (VFS
newVFS,[String]
_) = VFS -> DidCloseTextDocumentNotification -> (VFS, [String])
closeVFS VFS
oldVFS DidCloseTextDocumentNotification
n
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
DidCloseTextDocumentNotification -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage DidCloseTextDocumentNotification
n
sendNotification ClientMethod
TextDocumentDidChange a
params = do
let params' :: DidChangeTextDocumentParams
params' = Maybe DidChangeTextDocumentParams -> DidChangeTextDocumentParams
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DidChangeTextDocumentParams -> DidChangeTextDocumentParams)
-> Maybe DidChangeTextDocumentParams -> DidChangeTextDocumentParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe DidChangeTextDocumentParams
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe DidChangeTextDocumentParams)
-> ByteString -> Maybe DidChangeTextDocumentParams
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
params
n :: DidChangeTextDocumentNotification
n :: DidChangeTextDocumentNotification
n = Text
-> ClientMethod
-> DidChangeTextDocumentParams
-> DidChangeTextDocumentNotification
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ClientMethod
TextDocumentDidChange DidChangeTextDocumentParams
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 (VFS
newVFS,[String]
_) = VFS -> DidChangeTextDocumentNotification -> (VFS, [String])
changeFromClientVFS VFS
oldVFS DidChangeTextDocumentNotification
n
(SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
DidChangeTextDocumentNotification -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage DidChangeTextDocumentNotification
n
sendNotification ClientMethod
method a
params = NotificationMessage ClientMethod a -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (Text -> ClientMethod -> a -> NotificationMessage ClientMethod a
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ClientMethod
method a
params)
sendResponse :: ToJSON a => ResponseMessage a -> Session ()
sendResponse :: ResponseMessage a -> Session ()
sendResponse = ResponseMessage a -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage
initializeResponse :: Session InitializeResponse
initializeResponse :: Session (ResponseMessage InitializeResponseCapabilities)
initializeResponse = SessionContext
-> MVar (ResponseMessage InitializeResponseCapabilities)
initRsp (SessionContext
-> MVar (ResponseMessage InitializeResponseCapabilities))
-> Session SessionContext
-> Session (MVar (ResponseMessage InitializeResponseCapabilities))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask Session (MVar (ResponseMessage InitializeResponseCapabilities))
-> (MVar (ResponseMessage InitializeResponseCapabilities)
-> Session (ResponseMessage InitializeResponseCapabilities))
-> Session (ResponseMessage InitializeResponseCapabilities)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (ResponseMessage InitializeResponseCapabilities)
-> Session (ResponseMessage InitializeResponseCapabilities)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ResponseMessage InitializeResponseCapabilities)
-> Session (ResponseMessage InitializeResponseCapabilities))
-> (MVar (ResponseMessage InitializeResponseCapabilities)
-> IO (ResponseMessage InitializeResponseCapabilities))
-> MVar (ResponseMessage InitializeResponseCapabilities)
-> Session (ResponseMessage InitializeResponseCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (ResponseMessage InitializeResponseCapabilities)
-> IO (ResponseMessage InitializeResponseCapabilities)
forall a. MVar a -> IO a
readMVar)
createDoc :: FilePath
-> String
-> T.Text
-> Session TextDocumentIdentifier
createDoc :: String -> String -> Text -> Session TextDocumentIdentifier
createDoc String
file String
languageId Text
contents = do
Map Text Registration
dynCaps <- SessionState -> Map Text Registration
curDynCaps (SessionState -> Map Text Registration)
-> Session SessionState -> Session (Map Text Registration)
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 r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> String
rootDir
ClientCapabilities
caps <- (SessionContext -> ClientCapabilities)
-> Session ClientCapabilities
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> ClientCapabilities
sessionCapabilities
String
absFile <- IO String -> Session String
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 regs :: [Registration]
regs = (Registration -> Bool) -> [Registration] -> [Registration]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Registration
r -> Registration
r Registration
-> Getting ClientMethod Registration ClientMethod -> ClientMethod
forall s a. s -> Getting a s a -> a
^. Getting ClientMethod Registration ClientMethod
forall s a. HasMethod s a => Lens' s a
method ClientMethod -> ClientMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientMethod
WorkspaceDidChangeWatchedFiles) ([Registration] -> [Registration])
-> [Registration] -> [Registration]
forall a b. (a -> b) -> a -> b
$
Map Text Registration -> [Registration]
forall k a. Map k a -> [a]
Map.elems Map Text Registration
dynCaps
watchHits :: FileSystemWatcher -> Bool
watchHits :: FileSystemWatcher -> Bool
watchHits (FileSystemWatcher String
pattern Maybe WatchKind
kind) =
String -> Bool
fileMatches String
pattern Bool -> Bool -> Bool
&& WatchKind -> Bool
createHits (WatchKind -> Maybe WatchKind -> WatchKind
forall a. a -> Maybe a -> a
fromMaybe (Bool -> Bool -> Bool -> WatchKind
WatchKind Bool
True Bool
True Bool
True) Maybe WatchKind
kind)
fileMatches :: String -> Bool
fileMatches String
pattern = Pattern -> String -> Bool
Glob.match (String -> Pattern
Glob.compile String
pattern) String
relOrAbs
where relOrAbs :: String
relOrAbs
| String -> Bool
isAbsolute String
pattern = String
absFile
| Bool
otherwise = String
file
createHits :: WatchKind -> Bool
createHits (WatchKind Bool
create Bool
_ Bool
_) = Bool
create
regHits :: Registration -> Bool
regHits :: Registration -> Bool
regHits Registration
reg = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
Value
opts <- Registration
reg Registration
-> Getting (Maybe Value) Registration (Maybe Value) -> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) Registration (Maybe Value)
forall s a. HasRegisterOptions s a => Lens' s a
registerOptions
DidChangeWatchedFilesRegistrationOptions
fileWatchOpts <- case Value -> Result DidChangeWatchedFilesRegistrationOptions
forall a. FromJSON a => Value -> Result a
fromJSON Value
opts :: Result DidChangeWatchedFilesRegistrationOptions of
Success DidChangeWatchedFilesRegistrationOptions
x -> DidChangeWatchedFilesRegistrationOptions
-> Maybe DidChangeWatchedFilesRegistrationOptions
forall a. a -> Maybe a
Just DidChangeWatchedFilesRegistrationOptions
x
Error String
_ -> Maybe DidChangeWatchedFilesRegistrationOptions
forall a. Maybe a
Nothing
if (Bool -> FileSystemWatcher -> Bool)
-> Bool -> List FileSystemWatcher -> Bool
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 (DidChangeWatchedFilesRegistrationOptions
fileWatchOpts DidChangeWatchedFilesRegistrationOptions
-> Getting
(List FileSystemWatcher)
DidChangeWatchedFilesRegistrationOptions
(List FileSystemWatcher)
-> List FileSystemWatcher
forall s a. s -> Getting a s a -> a
^. Getting
(List FileSystemWatcher)
DidChangeWatchedFilesRegistrationOptions
(List FileSystemWatcher)
forall s a. HasWatchers s a => Lens' s a
watchers)
then () -> Maybe ()
forall a. a -> Maybe a
Just ()
else Maybe ()
forall a. Maybe a
Nothing
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
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. Prism (Maybe a) (Maybe b) a 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
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. Prism (Maybe a) (Maybe b) a 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
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. Prism (Maybe a) (Maybe b) a 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 -> Registration -> Bool) -> Bool -> [Registration] -> Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Bool
acc Registration
r -> Bool
acc Bool -> Bool -> Bool
|| Registration -> Bool
regHits Registration
r) Bool
False [Registration]
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
$
ClientMethod -> DidChangeWatchedFilesParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
WorkspaceDidChangeWatchedFiles (DidChangeWatchedFilesParams -> Session ())
-> DidChangeWatchedFilesParams -> Session ()
forall a b. (a -> b) -> a -> b
$ List FileEvent -> DidChangeWatchedFilesParams
DidChangeWatchedFilesParams (List FileEvent -> DidChangeWatchedFilesParams)
-> List FileEvent -> DidChangeWatchedFilesParams
forall a b. (a -> b) -> a -> b
$
[FileEvent] -> List FileEvent
forall a. [a] -> List a
List [ Uri -> FileChangeType -> FileEvent
FileEvent (String -> Uri
filePathToUri (String
rootDir String -> String -> String
</> String
file)) FileChangeType
FcCreated ]
String -> String -> Text -> Session TextDocumentIdentifier
openDoc' String
file String
languageId Text
contents
openDoc :: FilePath -> String -> Session TextDocumentIdentifier
openDoc :: String -> String -> Session TextDocumentIdentifier
openDoc String
file String
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 (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 -> String -> Text -> Session TextDocumentIdentifier
openDoc' String
file String
languageId Text
contents
openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
openDoc' :: String -> String -> Text -> Session TextDocumentIdentifier
openDoc' String
file String
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 -> Text -> Int -> Text -> TextDocumentItem
TextDocumentItem Uri
uri (String -> Text
T.pack String
languageId) Int
0 Text
contents
ClientMethod -> DidOpenTextDocumentParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
TextDocumentDidOpen (TextDocumentItem -> DidOpenTextDocumentParams
DidOpenTextDocumentParams TextDocumentItem
item)
TextDocumentIdentifier -> Session TextDocumentIdentifier
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
uri))
ClientMethod -> DidCloseTextDocumentParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
TextDocumentDidClose DidCloseTextDocumentParams
params
changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
changeDoc :: TextDocumentIdentifier
-> [TextDocumentContentChangeEvent] -> Session ()
changeDoc TextDocumentIdentifier
docId [TextDocumentContentChangeEvent]
changes = do
VersionedTextDocumentIdentifier
verDoc <- TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
docId
let params :: DidChangeTextDocumentParams
params = VersionedTextDocumentIdentifier
-> List TextDocumentContentChangeEvent
-> DidChangeTextDocumentParams
DidChangeTextDocumentParams (VersionedTextDocumentIdentifier
verDoc VersionedTextDocumentIdentifier
-> (VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier)
-> VersionedTextDocumentIdentifier
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier
forall s a. HasVersion s a => Lens' s a
version ((Maybe Int -> Identity (Maybe Int))
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier)
-> ((Int -> Identity Int) -> Maybe Int -> Identity (Maybe Int))
-> (Int -> Identity Int)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Iso' (Maybe Int) Int
forall a. Eq a => a -> Iso' (Maybe a) a
non Int
0 ((Int -> Identity Int)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier)
-> Int
-> VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1) ([TextDocumentContentChangeEvent]
-> List TextDocumentContentChangeEvent
forall a. [a] -> List a
List [TextDocumentContentChangeEvent]
changes)
ClientMethod -> DidChangeTextDocumentParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
TextDocumentDidChange DidChangeTextDocumentParams
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 (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
PublishDiagnosticsNotification
diagsNot <- Session FromServerMessage
-> Session PublishDiagnosticsNotification
-> Session PublishDiagnosticsNotification
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage Session PublishDiagnosticsNotification
forall a. (Typeable a, FromJSON a) => Session a
message :: Session PublishDiagnosticsNotification
let (List [Diagnostic]
diags) = PublishDiagnosticsNotification
diagsNot PublishDiagnosticsNotification
-> Getting
(List Diagnostic) PublishDiagnosticsNotification (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams)
-> PublishDiagnosticsNotification
-> Const (List Diagnostic) PublishDiagnosticsNotification
forall s a. HasParams s a => Lens' s a
params ((PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams)
-> PublishDiagnosticsNotification
-> Const (List Diagnostic) PublishDiagnosticsNotification)
-> ((List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams)
-> Getting
(List Diagnostic) PublishDiagnosticsNotification (List Diagnostic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
LSP.diagnostics
[Diagnostic] -> Session [Diagnostic]
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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnostic]
res
then String -> Session [Diagnostic]
waitForDiagnosticsSource String
src
else [Diagnostic] -> Session [Diagnostic]
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
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
PublishDiagnosticsNotification
diagsNot <- Session PublishDiagnosticsNotification
forall a. (Typeable a, FromJSON a) => Session a
message :: Session PublishDiagnosticsNotification
Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PublishDiagnosticsNotification
diagsNot PublishDiagnosticsNotification
-> Getting
(List Diagnostic) PublishDiagnosticsNotification (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams)
-> PublishDiagnosticsNotification
-> Const (List Diagnostic) PublishDiagnosticsNotification
forall s a. HasParams s a => Lens' s a
params ((PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams)
-> PublishDiagnosticsNotification
-> Const (List Diagnostic) PublishDiagnosticsNotification)
-> ((List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams)
-> Getting
(List Diagnostic) PublishDiagnosticsNotification (List Diagnostic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
LSP.diagnostics List Diagnostic -> List Diagnostic -> Bool
forall a. Eq a => a -> a -> Bool
/= [Diagnostic] -> List Diagnostic
forall a. [a] -> List a
List []) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ IO () -> Session ()
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 [DocumentSymbol] [SymbolInformation])
getDocumentSymbols :: TextDocumentIdentifier
-> Session (Either [DocumentSymbol] [SymbolInformation])
getDocumentSymbols TextDocumentIdentifier
doc = do
ResponseMessage Text
_ LspIdRsp
rspLid Either ResponseError DSResult
res <- ClientMethod
-> DocumentSymbolParams -> Session (ResponseMessage DSResult)
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentDocumentSymbol (TextDocumentIdentifier
-> Maybe ProgressToken -> DocumentSymbolParams
DocumentSymbolParams TextDocumentIdentifier
doc Maybe ProgressToken
forall a. Maybe a
Nothing) :: Session DocumentSymbolsResponse
case Either ResponseError DSResult
res of
Right (DSDocumentSymbols (List [DocumentSymbol]
xs)) -> Either [DocumentSymbol] [SymbolInformation]
-> Session (Either [DocumentSymbol] [SymbolInformation])
forall (m :: * -> *) a. Monad m => a -> m a
return ([DocumentSymbol] -> Either [DocumentSymbol] [SymbolInformation]
forall a b. a -> Either a b
Left [DocumentSymbol]
xs)
Right (DSSymbolInformation (List [SymbolInformation]
xs)) -> Either [DocumentSymbol] [SymbolInformation]
-> Session (Either [DocumentSymbol] [SymbolInformation])
forall (m :: * -> *) a. Monad m => a -> m a
return ([SymbolInformation] -> Either [DocumentSymbol] [SymbolInformation]
forall a b. b -> Either a b
Right [SymbolInformation]
xs)
Left ResponseError
err -> SessionException
-> Session (Either [DocumentSymbol] [SymbolInformation])
forall a e. Exception e => e -> a
throw (LspIdRsp -> ResponseError -> SessionException
UnexpectedResponseError LspIdRsp
rspLid ResponseError
err)
getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
getCodeActions TextDocumentIdentifier
doc Range
range = do
CodeActionContext
ctx <- TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext TextDocumentIdentifier
doc
ResponseMessage (List CAResult)
rsp <- ClientMethod
-> CodeActionParams -> Session (ResponseMessage (List CAResult))
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentCodeAction (TextDocumentIdentifier
-> Range
-> CodeActionContext
-> Maybe ProgressToken
-> CodeActionParams
CodeActionParams TextDocumentIdentifier
doc Range
range CodeActionContext
ctx Maybe ProgressToken
forall a. Maybe a
Nothing)
case ResponseMessage (List CAResult)
rsp ResponseMessage (List CAResult)
-> Getting
(Either ResponseError (List CAResult))
(ResponseMessage (List CAResult))
(Either ResponseError (List CAResult))
-> Either ResponseError (List CAResult)
forall s a. s -> Getting a s a -> a
^. Getting
(Either ResponseError (List CAResult))
(ResponseMessage (List CAResult))
(Either ResponseError (List CAResult))
forall s a. HasResult s a => Lens' s a
result of
Right (List [CAResult]
xs) -> [CAResult] -> Session [CAResult]
forall (m :: * -> *) a. Monad m => a -> m a
return [CAResult]
xs
Left ResponseError
error -> SessionException -> Session [CAResult]
forall a e. Exception e => e -> a
throw (LspIdRsp -> ResponseError -> SessionException
UnexpectedResponseError (ResponseMessage (List CAResult)
rsp ResponseMessage (List CAResult)
-> Getting LspIdRsp (ResponseMessage (List CAResult)) LspIdRsp
-> LspIdRsp
forall s a. s -> Getting a s a -> a
^. Getting LspIdRsp (ResponseMessage (List CAResult)) LspIdRsp
forall s a. HasId s a => Lens' s a
LSP.id) ResponseError
error)
getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult]
getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult]
getAllCodeActions TextDocumentIdentifier
doc = do
CodeActionContext
ctx <- TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext TextDocumentIdentifier
doc
([CAResult] -> Diagnostic -> Session [CAResult])
-> [CAResult] -> [Diagnostic] -> Session [CAResult]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
go CodeActionContext
ctx) [] ([Diagnostic] -> Session [CAResult])
-> Session [Diagnostic] -> Session [CAResult]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc
where
go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
go CodeActionContext
ctx [CAResult]
acc Diagnostic
diag = do
ResponseMessage Text
_ LspIdRsp
rspLid Either ResponseError (List CAResult)
res <- ClientMethod
-> CodeActionParams -> Session (ResponseMessage (List CAResult))
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentCodeAction (TextDocumentIdentifier
-> Range
-> CodeActionContext
-> Maybe ProgressToken
-> CodeActionParams
CodeActionParams 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
range) CodeActionContext
ctx Maybe ProgressToken
forall a. Maybe a
Nothing)
case Either ResponseError (List CAResult)
res of
Left ResponseError
e -> SessionException -> Session [CAResult]
forall a e. Exception e => e -> a
throw (LspIdRsp -> ResponseError -> SessionException
UnexpectedResponseError LspIdRsp
rspLid ResponseError
e)
Right (List [CAResult]
cmdOrCAs) -> [CAResult] -> Session [CAResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CAResult]
acc [CAResult] -> [CAResult] -> [CAResult]
forall a. [a] -> [a] -> [a]
++ [CAResult]
cmdOrCAs)
getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext TextDocumentIdentifier
doc = do
[Diagnostic]
curDiags <- TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc
CodeActionContext -> Session CodeActionContext
forall (m :: * -> *) a. Monad m => a -> m a
return (CodeActionContext -> Session CodeActionContext)
-> CodeActionContext -> Session CodeActionContext
forall a b. (a -> b) -> a -> b
$ List Diagnostic -> Maybe (List CodeActionKind) -> CodeActionContext
CodeActionContext ([Diagnostic] -> List Diagnostic
forall a. [a] -> List a
List [Diagnostic]
curDiags) Maybe (List CodeActionKind)
forall a. Maybe a
Nothing
getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc = [Diagnostic] -> Maybe [Diagnostic] -> [Diagnostic]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Diagnostic] -> [Diagnostic])
-> (SessionState -> Maybe [Diagnostic])
-> SessionState
-> [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedUri
-> Map NormalizedUri [Diagnostic] -> Maybe [Diagnostic]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (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
uri) (Map NormalizedUri [Diagnostic] -> Maybe [Diagnostic])
-> (SessionState -> Map NormalizedUri [Diagnostic])
-> SessionState
-> Maybe [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 (List Value)
args = ByteString -> Maybe (List Value)
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe (List Value))
-> ByteString -> Maybe (List Value)
forall a b. (a -> b) -> a -> b
$ List Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (List Value -> ByteString) -> List Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe (List Value) -> List Value
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (List Value) -> List Value)
-> Maybe (List Value) -> List Value
forall a b. (a -> b) -> a -> b
$ Command
cmd Command
-> Getting (Maybe (List Value)) Command (Maybe (List Value))
-> Maybe (List Value)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (List Value)) Command (Maybe (List Value))
forall s a. HasArguments s a => Lens' s a
arguments
execParams :: ExecuteCommandParams
execParams = Text
-> Maybe (List Value)
-> Maybe ProgressToken
-> ExecuteCommandParams
ExecuteCommandParams (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
command) Maybe (List Value)
args Maybe ProgressToken
forall a. Maybe a
Nothing
ClientMethod -> ExecuteCommandParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
request_ ClientMethod
WorkspaceExecuteCommand ExecuteCommandParams
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 (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
edit
Session ()
-> (Command -> Session ()) -> Maybe Command -> Session ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Session ()
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
command
where handleEdit :: WorkspaceEdit -> Session ()
handleEdit :: WorkspaceEdit -> Session ()
handleEdit WorkspaceEdit
e =
let req :: RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req = Text
-> LspId
-> ServerMethod
-> ApplyWorkspaceEditParams
-> RequestMessage ServerMethod ApplyWorkspaceEditParams resp
forall m req resp.
Text -> LspId -> m -> req -> RequestMessage m req resp
RequestMessage Text
"" (Int -> LspId
IdInt Int
0) ServerMethod
WorkspaceApplyEdit (WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
e)
in FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (ApplyWorkspaceEditRequest -> FromServerMessage
ReqApplyWorkspaceEdit ApplyWorkspaceEditRequest
forall resp.
RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req)
getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc (TextDocumentIdentifier Uri
uri) = do
Map NormalizedUri VirtualFile
fs <- VFS -> Map NormalizedUri VirtualFile
vfsMap (VFS -> Map NormalizedUri VirtualFile)
-> (SessionState -> VFS)
-> SessionState
-> Map NormalizedUri VirtualFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> VFS
vfs (SessionState -> Map NormalizedUri VirtualFile)
-> Session SessionState -> Session (Map NormalizedUri VirtualFile)
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 Int
ver =
case Map NormalizedUri VirtualFile
fs Map NormalizedUri VirtualFile -> NormalizedUri -> Maybe VirtualFile
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Uri -> NormalizedUri
toNormalizedUri Uri
uri of
Just VirtualFile
vf -> Int -> Maybe Int
forall a. a -> Maybe a
Just (VirtualFile -> Int
virtualFileVersion VirtualFile
vf)
Maybe VirtualFile
_ -> Maybe Int
forall a. Maybe a
Nothing
VersionedTextDocumentIdentifier
-> Session VersionedTextDocumentIdentifier
forall (m :: * -> *) a. Monad m => a -> m a
return (Uri -> Maybe Int -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri Maybe Int
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 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
$ do
let mWorkspace :: Maybe WorkspaceClientCapabilities
mWorkspace = ClientCapabilities -> Maybe WorkspaceClientCapabilities
C._workspace ClientCapabilities
caps
C.WorkspaceClientCapabilities Maybe Bool
_ Maybe WorkspaceEditClientCapabilities
mEdit Maybe DidChangeConfigurationClientCapabilities
_ Maybe DidChangeWatchedFilesClientCapabilities
_ Maybe SymbolClientCapabilities
_ Maybe ExecuteClientCapabilities
_ Maybe Bool
_ Maybe Bool
_ <- Maybe WorkspaceClientCapabilities
mWorkspace
C.WorkspaceEditClientCapabilities Maybe Bool
mDocChanges <- Maybe WorkspaceEditClientCapabilities
mEdit
Maybe Bool
mDocChanges
let wEdit :: WorkspaceEdit
wEdit = if Bool
supportsDocChanges
then
let docEdit :: TextDocumentEdit
docEdit = VersionedTextDocumentIdentifier
-> List TextEdit -> TextDocumentEdit
TextDocumentEdit VersionedTextDocumentIdentifier
verDoc ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
edit])
in Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit Maybe WorkspaceEditMap
forall a. Maybe a
Nothing (List TextDocumentEdit -> Maybe (List TextDocumentEdit)
forall a. a -> Maybe a
Just ([TextDocumentEdit] -> List TextDocumentEdit
forall a. [a] -> List a
List [TextDocumentEdit
docEdit]))
else
let changes :: WorkspaceEditMap
changes = Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.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
uri) ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
edit])
in Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just WorkspaceEditMap
changes) Maybe (List TextDocumentEdit)
forall a. Maybe a
Nothing
let req :: RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req = Text
-> LspId
-> ServerMethod
-> ApplyWorkspaceEditParams
-> RequestMessage ServerMethod ApplyWorkspaceEditParams resp
forall m req resp.
Text -> LspId -> m -> req -> RequestMessage m req resp
RequestMessage Text
"" (Int -> LspId
IdInt Int
0) ServerMethod
WorkspaceApplyEdit (WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
wEdit)
FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (ApplyWorkspaceEditRequest -> FromServerMessage
ReqApplyWorkspaceEdit ApplyWorkspaceEditRequest
forall resp.
RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req)
TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
doc
getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions TextDocumentIdentifier
doc Position
pos = do
ResponseMessage CompletionResponseResult
rsp <- ClientMethod
-> TextDocumentPositionParams
-> Session (ResponseMessage CompletionResponseResult)
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentCompletion (TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> TextDocumentPositionParams
TextDocumentPositionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing)
case ResponseMessage CompletionResponseResult
-> CompletionResponseResult
forall a. ResponseMessage a -> a
getResponseResult ResponseMessage CompletionResponseResult
rsp of
Completions (List [CompletionItem]
items) -> [CompletionItem] -> Session [CompletionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items
CompletionList (CompletionListType Bool
_ (List [CompletionItem]
items)) -> [CompletionItem] -> Session [CompletionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items
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
-> ReferenceContext
-> Maybe ProgressToken
-> ReferenceParams
ReferenceParams TextDocumentIdentifier
doc Position
pos ReferenceContext
ctx Maybe ProgressToken
forall a. Maybe a
Nothing
in ResponseMessage [Location] -> [Location]
forall a. ResponseMessage a -> a
getResponseResult (ResponseMessage [Location] -> [Location])
-> Session (ResponseMessage [Location]) -> Session [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMethod
-> ReferenceParams -> Session (ResponseMessage [Location])
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentReferences ReferenceParams
params
getDefinitions :: TextDocumentIdentifier
-> Position
-> Session [Location]
getDefinitions :: TextDocumentIdentifier -> Position -> Session [Location]
getDefinitions TextDocumentIdentifier
doc Position
pos = do
let params :: TextDocumentPositionParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> TextDocumentPositionParams
TextDocumentPositionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing
DefinitionResponse
rsp <- ClientMethod
-> TextDocumentPositionParams -> Session DefinitionResponse
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentDefinition TextDocumentPositionParams
params :: Session DefinitionResponse
case DefinitionResponse -> LocationResponseParams
forall a. ResponseMessage a -> a
getResponseResult DefinitionResponse
rsp of
SingleLoc Location
loc -> [Location] -> Session [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Location
loc]
MultiLoc [Location]
locs -> [Location] -> Session [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Location]
locs
getTypeDefinitions :: TextDocumentIdentifier
-> Position
-> Session [Location]
getTypeDefinitions :: TextDocumentIdentifier -> Position -> Session [Location]
getTypeDefinitions TextDocumentIdentifier
doc Position
pos = do
let params :: TextDocumentPositionParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> TextDocumentPositionParams
TextDocumentPositionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing
DefinitionResponse
rsp <- ClientMethod
-> TextDocumentPositionParams -> Session DefinitionResponse
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentTypeDefinition TextDocumentPositionParams
params :: Session TypeDefinitionResponse
case DefinitionResponse -> LocationResponseParams
forall a. ResponseMessage a -> a
getResponseResult DefinitionResponse
rsp of
SingleLoc Location
loc -> [Location] -> Session [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Location
loc]
MultiLoc [Location]
locs -> [Location] -> Session [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Location]
locs
rename :: TextDocumentIdentifier -> Position -> String -> Session ()
rename :: TextDocumentIdentifier -> Position -> String -> Session ()
rename TextDocumentIdentifier
doc Position
pos String
newName = do
let params :: RenameParams
params = TextDocumentIdentifier
-> Position -> Text -> Maybe ProgressToken -> RenameParams
RenameParams TextDocumentIdentifier
doc Position
pos (String -> Text
T.pack String
newName) Maybe ProgressToken
forall a. Maybe a
Nothing
RenameResponse
rsp <- ClientMethod -> RenameParams -> Session RenameResponse
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentRename RenameParams
params :: Session RenameResponse
let wEdit :: WorkspaceEdit
wEdit = RenameResponse -> WorkspaceEdit
forall a. ResponseMessage a -> a
getResponseResult RenameResponse
rsp
req :: RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req = Text
-> LspId
-> ServerMethod
-> ApplyWorkspaceEditParams
-> RequestMessage ServerMethod ApplyWorkspaceEditParams resp
forall m req resp.
Text -> LspId -> m -> req -> RequestMessage m req resp
RequestMessage Text
"" (Int -> LspId
IdInt Int
0) ServerMethod
WorkspaceApplyEdit (WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
wEdit)
FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (ApplyWorkspaceEditRequest -> FromServerMessage
ReqApplyWorkspaceEdit ApplyWorkspaceEditRequest
forall resp.
RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req)
getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
getHover TextDocumentIdentifier
doc Position
pos =
let params :: TextDocumentPositionParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> TextDocumentPositionParams
TextDocumentPositionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing
in ResponseMessage (Maybe Hover) -> Maybe Hover
forall a. ResponseMessage a -> a
getResponseResult (ResponseMessage (Maybe Hover) -> Maybe Hover)
-> Session (ResponseMessage (Maybe Hover)) -> Session (Maybe Hover)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMethod
-> TextDocumentPositionParams
-> Session (ResponseMessage (Maybe Hover))
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentHover TextDocumentPositionParams
params
getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
getHighlights TextDocumentIdentifier
doc Position
pos =
let params :: TextDocumentPositionParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> TextDocumentPositionParams
TextDocumentPositionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing
in ResponseMessage [DocumentHighlight] -> [DocumentHighlight]
forall a. ResponseMessage a -> a
getResponseResult (ResponseMessage [DocumentHighlight] -> [DocumentHighlight])
-> Session (ResponseMessage [DocumentHighlight])
-> Session [DocumentHighlight]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMethod
-> TextDocumentPositionParams
-> Session (ResponseMessage [DocumentHighlight])
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentDocumentHighlight TextDocumentPositionParams
params
getResponseResult :: ResponseMessage a -> a
getResponseResult :: ResponseMessage a -> a
getResponseResult ResponseMessage a
rsp =
case ResponseMessage a
rsp ResponseMessage a
-> Getting
(Either ResponseError a)
(ResponseMessage a)
(Either ResponseError a)
-> Either ResponseError a
forall s a. s -> Getting a s a -> a
^. Getting
(Either ResponseError a)
(ResponseMessage a)
(Either ResponseError a)
forall s a. HasResult s a => Lens' s a
result of
Right a
x -> a
x
Left ResponseError
err -> SessionException -> a
forall a e. Exception e => e -> a
throw (SessionException -> a) -> SessionException -> a
forall a b. (a -> b) -> a -> b
$ LspIdRsp -> ResponseError -> SessionException
UnexpectedResponseError (ResponseMessage a
rsp ResponseMessage a
-> Getting LspIdRsp (ResponseMessage a) LspIdRsp -> LspIdRsp
forall s a. s -> Getting a s a -> a
^. Getting LspIdRsp (ResponseMessage a) LspIdRsp
forall s a. HasId s a => Lens' s a
LSP.id) ResponseError
err
formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
formatDoc TextDocumentIdentifier
doc FormattingOptions
opts = do
let params :: DocumentFormattingParams
params = TextDocumentIdentifier
-> FormattingOptions
-> Maybe ProgressToken
-> DocumentFormattingParams
DocumentFormattingParams TextDocumentIdentifier
doc FormattingOptions
opts Maybe ProgressToken
forall a. Maybe a
Nothing
List TextEdit
edits <- ResponseMessage (List TextEdit) -> List TextEdit
forall a. ResponseMessage a -> a
getResponseResult (ResponseMessage (List TextEdit) -> List TextEdit)
-> Session (ResponseMessage (List TextEdit))
-> Session (List TextEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMethod
-> DocumentFormattingParams
-> Session (ResponseMessage (List TextEdit))
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentFormatting DocumentFormattingParams
params
TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits TextDocumentIdentifier
doc List TextEdit
edits
formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
formatRange TextDocumentIdentifier
doc FormattingOptions
opts Range
range = do
let params :: DocumentRangeFormattingParams
params = TextDocumentIdentifier
-> Range
-> FormattingOptions
-> Maybe ProgressToken
-> DocumentRangeFormattingParams
DocumentRangeFormattingParams TextDocumentIdentifier
doc Range
range FormattingOptions
opts Maybe ProgressToken
forall a. Maybe a
Nothing
List TextEdit
edits <- ResponseMessage (List TextEdit) -> List TextEdit
forall a. ResponseMessage a -> a
getResponseResult (ResponseMessage (List TextEdit) -> List TextEdit)
-> Session (ResponseMessage (List TextEdit))
-> Session (List TextEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMethod
-> DocumentRangeFormattingParams
-> Session (ResponseMessage (List TextEdit))
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentRangeFormatting DocumentRangeFormattingParams
params
TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits TextDocumentIdentifier
doc List TextEdit
edits
applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits TextDocumentIdentifier
doc List TextEdit
edits =
let wEdit :: WorkspaceEdit
wEdit = Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.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
uri) List TextEdit
edits)) Maybe (List TextDocumentEdit)
forall a. Maybe a
Nothing
req :: RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req = Text
-> LspId
-> ServerMethod
-> ApplyWorkspaceEditParams
-> RequestMessage ServerMethod ApplyWorkspaceEditParams resp
forall m req resp.
Text -> LspId -> m -> req -> RequestMessage m req resp
RequestMessage Text
"" (Int -> LspId
IdInt Int
0) ServerMethod
WorkspaceApplyEdit (WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
wEdit)
in FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (ApplyWorkspaceEditRequest -> FromServerMessage
ReqApplyWorkspaceEdit ApplyWorkspaceEditRequest
forall resp.
RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req)
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses TextDocumentIdentifier
tId = do
CodeLensResponse
rsp <- ClientMethod -> CodeLensParams -> Session CodeLensResponse
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentCodeLens (TextDocumentIdentifier -> Maybe ProgressToken -> CodeLensParams
CodeLensParams TextDocumentIdentifier
tId Maybe ProgressToken
forall a. Maybe a
Nothing) :: Session CodeLensResponse
case CodeLensResponse -> List CodeLens
forall a. ResponseMessage a -> a
getResponseResult CodeLensResponse
rsp of
List [CodeLens]
res -> [CodeLens] -> Session [CodeLens]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [CodeLens]
res
getRegisteredCapabilities :: Session [Registration]
getRegisteredCapabilities :: Session [Registration]
getRegisteredCapabilities = (Map Text Registration -> [Registration]
forall k a. Map k a -> [a]
Map.elems (Map Text Registration -> [Registration])
-> (SessionState -> Map Text Registration)
-> SessionState
-> [Registration]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map Text Registration
curDynCaps) (SessionState -> [Registration])
-> Session SessionState -> Session [Registration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get