Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- runServer :: forall config. 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 LspServerLog
- = LspProcessingLog LspProcessingLog
- | DecodeInitializeError String
- | HeaderParseFail [String] String
- | EOF
- | Starting
- | ParsedMsg Text
- | SendMsg Text
- data VFSData = VFSData {}
- data ServerDefinition config = forall m a.ServerDefinition {
- defaultConfig :: config
- onConfigurationChange :: config -> Value -> Either Text config
- doInitialize :: LanguageContextEnv config -> Message Initialize -> IO (Either ResponseError a)
- staticHandlers :: Handlers m
- interpretHandler :: a -> m <~> IO
- options :: Options
- data Handlers m = Handlers {
- reqHandlers :: !(SMethodMap (ClientMessageHandler m Request))
- notHandlers :: !(SMethodMap (ClientMessageHandler m Notification))
- type family Handler (f :: Type -> Type) (m :: Method from t) = (result :: Type) | result -> f t m where ...
- transmuteHandlers :: (m <~> n) -> Handlers m -> Handlers n
- mapHandlers :: (forall (a :: Method FromClient Request). Handler m a -> Handler n a) -> (forall (a :: Method FromClient Notification). Handler m a -> Handler n a) -> Handlers m -> Handlers n
- notificationHandler :: forall (m :: Method FromClient Notification) f. SMethod m -> Handler f m -> Handlers f
- requestHandler :: forall (m :: Method FromClient Request) f. SMethod m -> Handler f m -> Handlers f
- newtype ClientMessageHandler f (t :: MethodType) (m :: Method FromClient t) = ClientMessageHandler (Handler f m)
- data Options = Options {
- textDocumentSync :: Maybe TextDocumentSyncOptions
- completionTriggerCharacters :: Maybe [Char]
- completionAllCommitCharacters :: Maybe [Char]
- signatureHelpTriggerCharacters :: Maybe [Char]
- signatureHelpRetriggerCharacters :: Maybe [Char]
- codeActionKinds :: Maybe [CodeActionKind]
- documentOnTypeFormattingTriggerCharacters :: Maybe (NonEmpty Char)
- executeCommandCommands :: Maybe [Text]
- serverInfo :: Maybe ServerInfo
- defaultOptions :: Options
- newtype LspT config m a = LspT {
- unLspT :: ReaderT (LanguageContextEnv config) m a
- type LspM config = LspT config IO
- class MonadUnliftIO m => MonadLsp config m | m -> config where
- getLspEnv :: m (LanguageContextEnv config)
- runLspT :: LanguageContextEnv config -> LspT config m a -> m a
- data LanguageContextEnv config = LanguageContextEnv {
- resHandlers :: !(Handlers IO)
- resParseConfig :: !(config -> Value -> Either Text config)
- resSendMessage :: !(FromServerMessage -> IO ())
- resState :: !(LanguageContextState config)
- resClientCapabilities :: !ClientCapabilities
- resRootPath :: !(Maybe FilePath)
- data m <~> n = 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 FromServer Request) f config. MonadLsp config f => SServerMethod m -> MessageParams m -> (Either ResponseError (ResponseResult m) -> f ()) -> f (LspId m)
- sendNotification :: forall (m :: Method FromServer Notification) f config. MonadLsp config f => SServerMethod m -> MessageParams m -> f ()
- getVirtualFile :: MonadLsp config m => NormalizedUri -> m (Maybe VirtualFile)
- getVirtualFiles :: MonadLsp config m => m VFS
- persistVirtualFile :: MonadLsp config m => LogAction m (WithSeverity VfsLog) -> 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 -> TextDocumentVersion -> DiagnosticsBySource -> m ()
- flushDiagnosticsBySource :: MonadLsp config m => Int -> Maybe DiagnosticSource -> m ()
- withProgress :: MonadLsp c m => Text -> ProgressCancellable -> ((ProgressAmount -> m ()) -> m a) -> m a
- withIndefiniteProgress :: MonadLsp c m => Text -> ProgressCancellable -> m a -> m a
- data ProgressAmount = ProgressAmount (Maybe UInt) (Maybe Text)
- data ProgressCancellable
- data ProgressCancelledException
- registerCapability :: forall f t (m :: Method FromClient t) config. MonadLsp config f => SClientMethod m -> RegistrationOptions m -> Handler f m -> f (Maybe (RegistrationToken m))
- unregisterCapability :: MonadLsp config f => RegistrationToken m -> f ()
- data RegistrationToken (m :: Method FromClient t)
- reverseSortEdit :: WorkspaceEdit -> WorkspaceEdit
Running
runServer :: forall config. 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 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 # |
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.
forall m a. ServerDefinition | |
|
Handlers
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 -> f t m where ... Source #
The type of a handler that handles requests and notifications coming in from the server or client
Handler f (m :: Method _from Request) = RequestMessage m -> (Either ResponseError (ResponseResult m) -> f ()) -> f () | |
Handler f (m :: Method _from Notification) = NotificationMessage m -> f () |
mapHandlers :: (forall (a :: Method FromClient Request). Handler m a -> Handler n a) -> (forall (a :: Method FromClient Notification). Handler m a -> Handler n a) -> Handlers m -> Handlers n Source #
notificationHandler :: forall (m :: Method FromClient Notification) f. SMethod m -> Handler f m -> Handlers f Source #
requestHandler :: forall (m :: Method FromClient Request) f. SMethod m -> Handler f m -> Handlers f Source #
newtype ClientMessageHandler f (t :: MethodType) (m :: Method FromClient t) Source #
Wrapper to restrict Handler
s to FromClient
Method
s
ClientMessageHandler (Handler f m) |
Language Server Protocol 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 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 # | |
MonadMask m => MonadMask (LspT config m) Source # | |
Defined in Language.LSP.Server.Core mask :: ((forall a. LspT config m a -> LspT config m a) -> LspT config m b) -> LspT config m b # uninterruptibleMask :: ((forall a. LspT config m a -> LspT config m a) -> LspT config m b) -> LspT config m b # generalBracket :: 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 | |
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 | 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 | |
|
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 FromServer Request) f config. MonadLsp config f => SServerMethod m -> MessageParams m -> (Either ResponseError (ResponseResult m) -> f ()) -> f (LspId m) Source #
sendNotification :: forall (m :: Method FromServer Notification) f config. MonadLsp config f => SServerMethod m -> MessageParams m -> f () Source #
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) -> NormalizedUri -> m (Maybe FilePath) Source #
Dump the current text for a given VFS file to a temporary file, 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 -> TextDocumentVersion -> 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 #
:: MonadLsp config m | |
=> Int | Max number of diagnostics to send |
-> Maybe DiagnosticSource | |
-> m () |
Remove all diagnostics from a particular source, and send the updates to the client.
Progress
withProgress :: MonadLsp c m => Text -> ProgressCancellable -> ((ProgressAmount -> m ()) -> m a) -> m a Source #
Wrapper for reporting progress to the client during a long running
task.
withProgress
title cancellable f
starts a new progress reporting
session, and finishes it once f is completed.
f is provided with an update function that allows it to report on
the progress during the session.
If cancellable
is Cancellable
, f
will be thrown a
ProgressCancelledException
if the user cancels the action in
progress.
withIndefiniteProgress :: MonadLsp c m => Text -> ProgressCancellable -> m a -> m a Source #
Same as withProgress
, but for processes that do not report the
precentage complete.
Since: 0.10.0.0
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 (m :: Method FromClient t) config. MonadLsp config f => 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 :: MonadLsp config f => RegistrationToken m -> f () Source #
Sends a client/unregisterCapability
request and removes the handler
for that associated registration.
data RegistrationToken (m :: Method FromClient 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.