Safe Haskell | None |
---|---|
Language | GHC2021 |
Synopsis
- data LspServerLog
- = LspProcessingLog LspProcessingLog
- | DecodeInitializeError String
- | HeaderParseFail [String] String
- | EOF
- | Starting
- | ParsedMsg Text
- | SendMsg Text
- runServer :: ServerDefinition config -> IO Int
- runServerWith :: LogAction IO (WithSeverity LspServerLog) -> LogAction (LspM config) (WithSeverity LspServerLog) -> IO ByteString -> (ByteString -> IO ()) -> ServerDefinition config -> IO Int
- runServerWithHandles :: LogAction IO (WithSeverity LspServerLog) -> LogAction (LspM config) (WithSeverity LspServerLog) -> Handle -> Handle -> ServerDefinition config -> IO Int
- data VFSData = VFSData {}
- data ServerDefinition config = ServerDefinition {
- defaultConfig :: config
- configSection :: Text
- parseConfig :: config -> Value -> Either Text config
- onConfigChange :: config -> m ()
- doInitialize :: LanguageContextEnv config -> TMessage 'Method_Initialize -> IO (Either (TResponseError 'Method_Initialize) a)
- staticHandlers :: ClientCapabilities -> Handlers m
- interpretHandler :: a -> m <~> IO
- options :: Options
- data Handlers (m :: Type -> Type) = Handlers {
- reqHandlers :: !(SMethodMap (ClientMessageHandler m 'Request))
- notHandlers :: !(SMethodMap (ClientMessageHandler m 'Notification))
- type family Handler (f :: Type -> Type) (m :: Method from t) = (result :: Type) | result -> from t f m where ...
- transmuteHandlers :: forall (m :: Type -> Type) (n :: Type -> Type). (m <~> n) -> Handlers m -> Handlers n
- mapHandlers :: forall (m :: Type -> Type) (n :: Type -> Type). (forall (a :: Method 'ClientToServer 'Request). Handler m a -> Handler n a) -> (forall (a :: Method 'ClientToServer 'Notification). Handler m a -> Handler n a) -> Handlers m -> Handlers n
- notificationHandler :: forall (m :: Method 'ClientToServer 'Notification) (f :: Type -> Type). SMethod m -> Handler f m -> Handlers f
- requestHandler :: forall (m :: Method 'ClientToServer 'Request) (f :: Type -> Type). SMethod m -> Handler f m -> Handlers f
- newtype ClientMessageHandler (f :: Type -> Type) (t :: MessageKind) (m :: Method 'ClientToServer t) = ClientMessageHandler (Handler f m)
- data Options = Options {
- optTextDocumentSync :: Maybe TextDocumentSyncOptions
- optCompletionTriggerCharacters :: Maybe [Char]
- optCompletionAllCommitCharacters :: Maybe [Char]
- optSignatureHelpTriggerCharacters :: Maybe [Char]
- optSignatureHelpRetriggerCharacters :: Maybe [Char]
- optCodeActionKinds :: Maybe [CodeActionKind]
- optDocumentOnTypeFormattingTriggerCharacters :: Maybe (NonEmpty Char)
- optExecuteCommandCommands :: Maybe [Text]
- optServerInfo :: Maybe ServerInfo
- optSupportClientInitiatedProgress :: Bool
- optProgressStartDelay :: Int
- optProgressUpdateDelay :: Int
- defaultOptions :: Options
- newtype LspT config (m :: Type -> Type) a = LspT {
- unLspT :: ReaderT (LanguageContextEnv config) m a
- type LspM config = LspT config IO
- class MonadUnliftIO m => MonadLsp config (m :: Type -> Type) | m -> config where
- getLspEnv :: m (LanguageContextEnv config)
- runLspT :: LanguageContextEnv config -> LspT config m a -> m a
- data LanguageContextEnv config = LanguageContextEnv {
- resHandlers :: !(Handlers IO)
- resConfigSection :: Text
- resParseConfig :: !(config -> Value -> Either Text config)
- resOnConfigChange :: !(config -> IO ())
- resSendMessage :: !(FromServerMessage -> IO ())
- resState :: !(LanguageContextState config)
- resClientCapabilities :: !ClientCapabilities
- resRootPath :: !(Maybe FilePath)
- resProgressStartDelay :: Int
- resProgressUpdateDelay :: Int
- data (m :: k -> Type) <~> (n :: k -> Type) = Iso {}
- getClientCapabilities :: MonadLsp config m => m ClientCapabilities
- getConfig :: MonadLsp config m => m config
- setConfig :: MonadLsp config m => config -> m ()
- getRootPath :: MonadLsp config m => m (Maybe FilePath)
- getWorkspaceFolders :: MonadLsp config m => m (Maybe [WorkspaceFolder])
- sendRequest :: forall (m :: Method 'ServerToClient 'Request) f config. MonadLsp config f => SServerMethod m -> MessageParams m -> (Either (TResponseError m) (MessageResult m) -> f ()) -> f (LspId m)
- sendNotification :: forall (m :: Method 'ServerToClient 'Notification) f config. MonadLsp config f => SServerMethod m -> MessageParams m -> f ()
- requestConfigUpdate :: m ~ LspM config => LogAction m (WithSeverity LspCoreLog) -> m ()
- tryChangeConfig :: m ~ LspM config => LogAction m (WithSeverity LspCoreLog) -> Value -> m ()
- isShuttingDown :: m ~ LspM config => m Bool
- waitShuttingDown :: m ~ LspM config => m ()
- getVirtualFile :: MonadLsp config m => NormalizedUri -> m (Maybe VirtualFile)
- getVirtualFiles :: MonadLsp config m => m VFS
- persistVirtualFile :: MonadLsp config m => LogAction m (WithSeverity VfsLog) -> FilePath -> NormalizedUri -> m (Maybe FilePath)
- getVersionedTextDoc :: MonadLsp config m => TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
- reverseFileMap :: MonadLsp config m => m (FilePath -> FilePath)
- snapshotVirtualFiles :: LanguageContextEnv c -> STM VFS
- publishDiagnostics :: MonadLsp config m => Int -> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> m ()
- flushDiagnosticsBySource :: MonadLsp config m => Int -> Maybe Text -> m ()
- withProgress :: MonadLsp c m => Text -> Maybe ProgressToken -> ProgressCancellable -> ((ProgressAmount -> m ()) -> m a) -> m a
- withIndefiniteProgress :: MonadLsp c m => Text -> Maybe ProgressToken -> ProgressCancellable -> ((Text -> m ()) -> m a) -> m a
- data ProgressAmount = ProgressAmount (Maybe UInt) (Maybe Text)
- data ProgressCancellable
- data ProgressCancelledException
- registerCapability :: forall f (t :: MessageKind) (m :: Method 'ClientToServer t) config. MonadLsp config f => LogAction f (WithSeverity LspCoreLog) -> SClientMethod m -> RegistrationOptions m -> Handler f m -> f (Maybe (RegistrationToken m))
- unregisterCapability :: forall {t :: MessageKind} config f (m :: Method 'ClientToServer t). MonadLsp config f => RegistrationToken m -> f ()
- data RegistrationToken (m :: Method 'ClientToServer t)
- reverseSortEdit :: WorkspaceEdit -> WorkspaceEdit
Documentation
data LspServerLog Source #
LspProcessingLog LspProcessingLog | |
DecodeInitializeError String | |
HeaderParseFail [String] String | |
EOF | |
Starting | |
ParsedMsg Text | |
SendMsg Text |
Instances
Show LspServerLog Source # | |
Defined in Language.LSP.Server.Control showsPrec :: Int -> LspServerLog -> ShowS # show :: LspServerLog -> String # showList :: [LspServerLog] -> ShowS # | |
Pretty LspServerLog Source # | |
Defined in Language.LSP.Server.Control pretty :: LspServerLog -> Doc ann # prettyList :: [LspServerLog] -> Doc ann # |
runServer :: ServerDefinition config -> IO Int Source #
Convenience function for runServerWithHandles
which:
(1) reads from stdin;
(2) writes to stdout; and
(3) logs to stderr and to the client, with some basic filtering.
:: LogAction IO (WithSeverity LspServerLog) | The logger to use outside the main body of the server where we can't assume the ability to send messages. |
-> LogAction (LspM config) (WithSeverity LspServerLog) | The logger to use once the server has started and can successfully send messages. |
-> IO ByteString | Client input. |
-> (ByteString -> IO ()) | Function to provide output to. |
-> ServerDefinition config | |
-> IO Int |
Starts listening and sending requests and responses using the specified I/O.
:: LogAction IO (WithSeverity LspServerLog) | The logger to use outside the main body of the server where we can't assume the ability to send messages. |
-> LogAction (LspM config) (WithSeverity LspServerLog) | The logger to use once the server has started and can successfully send messages. |
-> Handle | Handle to read client input from. |
-> Handle | Handle to write output to. |
-> ServerDefinition config | |
-> IO Int |
Starts a language server over the specified handles.
This function will return once the exit
notification is received.
data ServerDefinition config Source #
Contains all the callbacks to use for initialized the language server. it is parameterized over a config type variable representing the type for the specific configuration data the language server needs to use.
ServerDefinition | |
|
Handlers
data Handlers (m :: Type -> Type) Source #
A mapping from methods to the static Handler
s that should be used to
handle responses when they come in from the client. To build up a Handlers
,
you should mconcat
a list of notificationHandler
and requestHandler
s:
mconcat [ notificationHandler SInitialized $ notif -> pure () , requestHandler STextDocumentHover $ req responder -> pure () ]
Handlers | |
|
type family Handler (f :: Type -> Type) (m :: Method from t) = (result :: Type) | result -> from t f m where ... Source #
The type of a handler that handles requests and notifications coming in from the server or client
transmuteHandlers :: forall (m :: Type -> Type) (n :: Type -> Type). (m <~> n) -> Handlers m -> Handlers n Source #
mapHandlers :: forall (m :: Type -> Type) (n :: Type -> Type). (forall (a :: Method 'ClientToServer 'Request). Handler m a -> Handler n a) -> (forall (a :: Method 'ClientToServer 'Notification). Handler m a -> Handler n a) -> Handlers m -> Handlers n Source #
notificationHandler :: forall (m :: Method 'ClientToServer 'Notification) (f :: Type -> Type). SMethod m -> Handler f m -> Handlers f Source #
requestHandler :: forall (m :: Method 'ClientToServer 'Request) (f :: Type -> Type). SMethod m -> Handler f m -> Handlers f Source #
newtype ClientMessageHandler (f :: Type -> Type) (t :: MessageKind) (m :: Method 'ClientToServer t) Source #
Wrapper to restrict Handler
s to ClientToServer' Method
s
ClientMessageHandler (Handler f m) |
Options that the server may configure. If you set handlers for some requests, you may need to set some of these options.
Options | |
|
LspT and LspM
newtype LspT config (m :: Type -> Type) a Source #
LspT | |
|
Instances
MonadUnliftIO m => MonadLsp config (LspT config m) Source # | |
Defined in Language.LSP.Server.Core getLspEnv :: LspT config m (LanguageContextEnv config) Source # | |
MonadTrans (LspT config) Source # | |
Defined in Language.LSP.Server.Core | |
MonadFix m => MonadFix (LspT config m) Source # | |
Defined in Language.LSP.Server.Core | |
MonadIO m => MonadIO (LspT config m) Source # | |
Defined in Language.LSP.Server.Core | |
Applicative m => Applicative (LspT config m) Source # | |
Defined in Language.LSP.Server.Core pure :: a -> LspT config m a # (<*>) :: LspT config m (a -> b) -> LspT config m a -> LspT config m b # liftA2 :: (a -> b -> c) -> LspT config m a -> LspT config m b -> LspT config m c # (*>) :: LspT config m a -> LspT config m b -> LspT config m b # (<*) :: LspT config m a -> LspT config m b -> LspT config m a # | |
Functor m => Functor (LspT config m) Source # | |
Monad m => Monad (LspT config m) Source # | |
MonadCatch m => MonadCatch (LspT config m) Source # | |
Defined in Language.LSP.Server.Core | |
MonadMask m => MonadMask (LspT config m) Source # | |
Defined in Language.LSP.Server.Core mask :: HasCallStack => ((forall a. LspT config m a -> LspT config m a) -> LspT config m b) -> LspT config m b # uninterruptibleMask :: HasCallStack => ((forall a. LspT config m a -> LspT config m a) -> LspT config m b) -> LspT config m b # generalBracket :: HasCallStack => LspT config m a -> (a -> ExitCase b -> LspT config m c) -> (a -> LspT config m b) -> LspT config m (b, c) # | |
MonadThrow m => MonadThrow (LspT config m) Source # | |
Defined in Language.LSP.Server.Core throwM :: (HasCallStack, Exception e) => e -> LspT config m a # | |
MonadUnliftIO m => MonadUnliftIO (LspT config m) Source # | |
Defined in Language.LSP.Server.Core | |
(Applicative m, Monoid a) => Monoid (LspT config m a) Source # | |
(Applicative m, Semigroup a) => Semigroup (LspT config m a) Source # | |
class MonadUnliftIO m => MonadLsp config (m :: Type -> Type) | m -> config where Source #
getLspEnv :: m (LanguageContextEnv config) Source #
Instances
MonadLsp c m => MonadLsp c (IdentityT m) Source # | |
Defined in Language.LSP.Server.Core getLspEnv :: IdentityT m (LanguageContextEnv c) Source # | |
MonadLsp c m => MonadLsp c (ReaderT r m) Source # | |
Defined in Language.LSP.Server.Core getLspEnv :: ReaderT r m (LanguageContextEnv c) Source # | |
MonadUnliftIO m => MonadLsp config (LspT config m) Source # | |
Defined in Language.LSP.Server.Core getLspEnv :: LspT config m (LanguageContextEnv config) Source # |
runLspT :: LanguageContextEnv config -> LspT config m a -> m a Source #
data LanguageContextEnv config Source #
LanguageContextEnv | |
|
data (m :: k -> Type) <~> (n :: k -> Type) Source #
How to convert two isomorphic data structures between each other.
getClientCapabilities :: MonadLsp config m => m ClientCapabilities Source #
getConfig :: MonadLsp config m => m config Source #
The current configuration from the client as set via the initialize
and
workspace/didChangeConfiguration
requests, as well as by calls to
setConfig
.
getWorkspaceFolders :: MonadLsp config m => m (Maybe [WorkspaceFolder]) Source #
The current workspace folders, if the client supports workspace folders.
sendRequest :: forall (m :: Method 'ServerToClient 'Request) f config. MonadLsp config f => SServerMethod m -> MessageParams m -> (Either (TResponseError m) (MessageResult m) -> f ()) -> f (LspId m) Source #
sendNotification :: forall (m :: Method 'ServerToClient 'Notification) f config. MonadLsp config f => SServerMethod m -> MessageParams m -> f () Source #
Config
requestConfigUpdate :: m ~ LspM config => LogAction m (WithSeverity LspCoreLog) -> m () Source #
Send a `worksapce/configuration` request to update the server's config.
This is called automatically in response to `workspace/didChangeConfiguration` notifications from the client, so should not normally be called manually.
tryChangeConfig :: m ~ LspM config => LogAction m (WithSeverity LspCoreLog) -> Value -> m () Source #
Given a new config object, try to update our config with it.
Shutdown
isShuttingDown :: m ~ LspM config => m Bool Source #
Checks if the server has received a shutdown
request.
waitShuttingDown :: m ~ LspM config => m () Source #
Blocks until the server receives a shutdown
request.
VFS
getVirtualFile :: MonadLsp config m => NormalizedUri -> m (Maybe VirtualFile) Source #
Return the VirtualFile
associated with a given NormalizedUri
, if there is one.
getVirtualFiles :: MonadLsp config m => m VFS Source #
persistVirtualFile :: MonadLsp config m => LogAction m (WithSeverity VfsLog) -> FilePath -> NormalizedUri -> m (Maybe FilePath) Source #
Dump the current text for a given VFS file to a file in the given directory and return the path to the file.
getVersionedTextDoc :: MonadLsp config m => TextDocumentIdentifier -> m VersionedTextDocumentIdentifier Source #
Given a text document identifier, annotate it with the latest version.
reverseFileMap :: MonadLsp config m => m (FilePath -> FilePath) Source #
If the contents of a VFS has been dumped to a temporary file, map the temporary file name back to the original one.
snapshotVirtualFiles :: LanguageContextEnv c -> STM VFS Source #
Take an atomic snapshot of the current state of the virtual file system.
Diagnostics
publishDiagnostics :: MonadLsp config m => Int -> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> m () Source #
Aggregate all diagnostics pertaining to a particular version of a document,
by source, and sends a textDocument/publishDiagnostics
notification with
the total (limited by the first parameter) whenever it is updated.
flushDiagnosticsBySource Source #
Remove all diagnostics from a particular source, and send the updates to the client.
Progress
:: MonadLsp c m | |
=> Text | The title of the progress operation |
-> Maybe ProgressToken | The progress token provided by the client in the method params, if any |
-> ProgressCancellable | Whether or not this operation is cancellable. If true, the user will be shown a button to allow cancellation. Note that requests can still be cancelled even if this is not set. |
-> ((ProgressAmount -> m ()) -> m a) | An update function to pass progress updates to |
-> m a |
Wrapper for reporting progress to the client during a long running task.
withIndefiniteProgress Source #
:: MonadLsp c m | |
=> Text | The title of the progress operation |
-> Maybe ProgressToken | The progress token provided by the client in the method params, if any |
-> ProgressCancellable | Whether or not this operation is cancellable. If true, the user will be shown a button to allow cancellation. Note that requests can still be cancelled even if this is not set. |
-> ((Text -> m ()) -> m a) | An update function to pass progress updates to |
-> m a |
Same as withProgress
, but for processes that do not report the precentage complete.
data ProgressAmount Source #
A package indicating the percentage of progress complete and a
an optional message to go with it during a withProgress
Since: 0.10.0.0
ProgressAmount (Maybe UInt) (Maybe Text) |
data ProgressCancellable Source #
Whether or not the user should be able to cancel a withProgress
/withIndefiniteProgress
session
Since: 0.11.0.0
data ProgressCancelledException Source #
Thrown if the user cancels a Cancellable
withProgress
withIndefiniteProgress
session
Since: 0.11.0.0
Instances
Dynamic registration
registerCapability :: forall f (t :: MessageKind) (m :: Method 'ClientToServer t) config. MonadLsp config f => LogAction f (WithSeverity LspCoreLog) -> SClientMethod m -> RegistrationOptions m -> Handler f m -> f (Maybe (RegistrationToken m)) Source #
Sends a client/registerCapability
request and dynamically registers
a Method
with a Handler
. Returns Nothing
if the client does not
support dynamic registration for the specified method, otherwise a
RegistrationToken
which can be used to unregister it later.
unregisterCapability :: forall {t :: MessageKind} config f (m :: Method 'ClientToServer t). MonadLsp config f => RegistrationToken m -> f () Source #
Sends a client/unregisterCapability
request and removes the handler
for that associated registration.
data RegistrationToken (m :: Method 'ClientToServer t) Source #
reverseSortEdit :: WorkspaceEdit -> WorkspaceEdit Source #
The changes in a workspace edit should be applied from the end of the file toward the start. Sort them into this order.