Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- data RpcHandler (r :: [(Type -> Type) -> Type -> Type]) = RpcHandler {
- rpcType :: RpcType
- rpcName :: RpcName
- rpcExecution :: Execution
- rpcHandler :: RpcHandlerFun r
- type Handler (r :: [(Type -> Type) -> Type -> Type]) a = Sem (Stop Report ': r) a
- newtype RpcName = RpcName {}
- rpcFunction :: forall (r :: [(Type -> Type) -> Type -> Type]) h. HandlerCodec h r => RpcName -> Execution -> h -> RpcHandler r
- rpcCommand :: forall (r :: [(Type -> Type) -> Type -> Type]) h. (HandlerCodec h r, CommandHandler OptionStateZero h) => RpcName -> Execution -> h -> RpcHandler r
- rpcAutocmd :: forall (r :: [(Type -> Type) -> Type -> Type]) h. HandlerCodec h r => RpcName -> Execution -> AutocmdEvents -> AutocmdOptions -> h -> RpcHandler r
- rpc :: forall (r :: [(Type -> Type) -> Type -> Type]) h. (HandlerCodec h r, CommandHandler OptionStateZero h) => RpcName -> Execution -> h -> [RpcHandler r]
- data Execution
- runNvimPluginIO :: forall r. HigherOrder r (RemoteStack ()) => PluginConfig () -> InterpretersFor r (RemoteStack ()) -> [RpcHandler (r ++ RemoteStack ())] -> IO ()
- runNvimPluginIO_ :: PluginConfig () -> [RpcHandler (RemoteStack ())] -> IO ()
- runNvimPluginCli :: HigherOrder r (RemoteStack c) => PluginConfig c -> InterpretersFor r (RemoteStack c) -> [RpcHandler (r ++ RemoteStack c)] -> IO ()
- withHandlers :: forall (r :: EffectRow) a. Members '[Handlers !! Report, Rpc !! RpcError, Log, Error BootError :: (Type -> Type) -> Type -> Type] r => [RpcHandler r] -> Sem r a -> Sem r a
- remotePlugin :: forall c r. Members HandlerStack r => Members (BasicPluginStack c) r => Sem r ()
- type RemoteStack c = HandlerStack ++ BasicPluginStack c
- runRemoteStack :: PluginConfig () -> Sem (RemoteStack ()) () -> IO ()
- runRemoteStackCli :: PluginConfig c -> Sem (RemoteStack c) () -> IO ()
- interpretPluginRemote :: Members (BasicPluginStack c) r => InterpretersFor HandlerStack r
- type BasicPluginStack c = Reader PluginName ': (Reader (CustomConfig c) ': BasicStack)
- runBasicPluginStack :: PluginName -> HostConfig -> c -> Sem (BasicPluginStack c) () -> IO ()
- runCli :: PluginConfig c -> Sem (BasicPluginStack c) () -> IO ()
- type NvimPlugin = [Scratch !! RpcError, Settings !! SettingError, Rpc !! RpcError, Reader PluginName]
- data Rpc (a :: Type -> Type) b
- data Request = Request RpcMethod [Object]
- data RpcCall a
- sync :: forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a
- async :: forall a (r :: EffectRow). Member Rpc r => RpcCall a -> (Either RpcError a -> Sem r ()) -> Sem r ()
- notify :: forall a (r :: EffectRow). Member Rpc r => RpcCall a -> Sem r ()
- channelId :: forall (r :: EffectRow). Member Rpc r => Sem r ChannelId
- data Buffer
- data Window
- data Tabpage
- data Event = Event EventName [Object]
- newtype EventName = EventName Text
- watchVariables :: Members [VariableWatcher !! Report, Rpc !! RpcError, Resource, Mask mres, Race, Embed IO] r => Map WatchedVariable (Object -> Handler r ()) -> Sem r a -> Sem r a
- newtype WatchedVariable = WatchedVariable {}
- runEmbedPluginIO :: HigherOrder r (EmbedStack ()) => PluginConfig () -> InterpretersFor r (EmbedStack ()) -> [RpcHandler (r ++ EmbedStack ())] -> Sem (r ++ EmbedStack ()) () -> IO ()
- runEmbedPluginIO_ :: PluginConfig () -> [RpcHandler (EmbedStack ())] -> Sem (EmbedStack ()) () -> IO ()
- runEmbedPluginCli :: HigherOrder r (EmbedStack c) => PluginConfig c -> InterpretersFor r (EmbedStack c) -> [RpcHandler (r ++ EmbedStack c)] -> Sem (r ++ EmbedStack c) () -> IO ()
- embedPlugin :: Members (HostDeps er) r => Members BuiltinHandlersDeps r => Sem r a -> Sem r a
- runEmbedStack :: PluginConfig () -> Sem (EmbedStack ()) () -> IO ()
- runEmbedStackCli :: PluginConfig c -> Sem (EmbedStack c) () -> IO ()
- interpretPluginEmbed :: Members [Log, Reader LogConfig, Reader PluginName] r => Members IOStack r => InterpretersFor HandlerEffects r
- class MsgpackDecode a where
- fromMsgpack :: Object -> Either Text a
- class MsgpackEncode a where
- pattern Msgpack :: MsgpackDecode a => a -> Object
- msgpackArray :: MsgpackArray a => a
- msgpackMap :: MsgpackMap a => a
- data Settings :: Effect
- data Setting a = Setting Text Bool (Maybe a)
- data SettingError
- interpretSettingsRpc :: Members [Rpc !! RpcError, Reader PluginName] r => InterpreterFor (Settings !! SettingError) r
- data Scratch :: Effect
- data ScratchOptions
- scratch :: ScratchId -> ScratchOptions
- data FloatOptions
- newtype ScratchId = ScratchId Text
- data ScratchState = ScratchState ScratchId ScratchOptions Buffer Window Window (Maybe Tabpage) AutocmdId
- data Mapping = Mapping MappingAction MappingSpec (Maybe MappingId) (Map Text Object)
- data MappingAction
- newtype MappingId = MappingId Text
- newtype MappingLhs = MappingLhs Text
- data MapMode
- data MappingSpec = MappingSpec MappingLhs (NonEmpty MapMode)
- mappingFor :: RpcHandler r -> MappingLhs -> NonEmpty MapMode -> Maybe MappingId -> Map Text Object -> Mapping
- eventMapping :: EventName -> MappingLhs -> NonEmpty MapMode -> Maybe MappingId -> Map Text Object -> Mapping
- activateBufferMapping :: Member Rpc r => Buffer -> Mapping -> Sem r ()
- activateMapping :: Member Rpc r => Mapping -> Sem r ()
- data Persist a :: Effect
- interpretPersist :: ToJSON a => FromJSON a => Members [PersistPath !! PersistPathError, Error BootError, Log, Embed IO] r => Text -> InterpreterFor (Persist a !! PersistError) r
- interpretPersistNull :: forall a err r. InterpreterFor (Persist a !! err) r
- data PersistPath :: Effect
- persistPath :: forall r. Member PersistPath r => Maybe (Path Rel Dir) -> Sem r (Path Abs Dir)
- interpretPersistPath :: Members [Settings !! SettingError, Reader PluginName, Error BootError, Embed IO] r => Bool -> InterpreterFor (PersistPath !! PersistPathError) r
- interpretPersistPathSetting :: Members [Settings !! SettingError, Embed IO] r => Bool -> Maybe (Path Abs Dir) -> Path Rel Dir -> InterpreterFor (PersistPath !! PersistPathError) r
- interpretPersistPathAt :: Member (Embed IO) r => Bool -> Path Abs Dir -> InterpreterFor (PersistPath !! PersistPathError) r
- data PersistError
- data PersistPathError
- newtype PluginName = PluginName Text
- interpretPluginName :: Member (Reader (PluginConfig c)) r => InterpreterFor (Reader PluginName) r
- completeWith :: forall (r :: [(Type -> Type) -> Type -> Type]). CompleteStyle -> (Text -> Text -> Int -> Handler r [Text]) -> RpcHandler r -> [RpcHandler r]
- completeBuiltin :: forall (r :: [(Type -> Type) -> Type -> Type]). Text -> RpcHandler r -> RpcHandler r
- data CompleteStyle
- class HandlerArg a (r :: EffectRow) where
- handlerArg :: [Object] -> Sem r ([Object], a)
- class CommandHandler (state :: OptionState) h where
- commandOptions :: (Map Text Object, [Text])
- newtype Args = Args {}
- newtype ArgList = ArgList {}
- newtype JsonArgs a = JsonArgs {
- unJsonArgs :: a
- newtype Options a = Options a
- class OptionParser a where
- optionParser :: Parser a
- data Bang
- data Bar = Bar
- data Range (style :: RangeStyle) = Range Int64 (Maybe Int64)
- data RangeStyle
- newtype CommandMods = CommandMods Text
- newtype CommandRegister = CommandRegister Text
- class HandlerCodec h (r :: [(Type -> Type) -> Type -> Type]) | h -> r where
- handlerCodec :: h -> RpcHandlerFun r
- modifyCmd :: forall (r :: EffectRow) a. Member Rpc r => Text -> Sem r a -> Sem r a
- bufdo :: forall (r :: EffectRow) a. Member Rpc r => Buffer -> Sem r a -> Sem r a
- windo :: forall (r :: EffectRow) a. Member Rpc r => Window -> Sem r a -> Sem r a
- noautocmd :: forall (r :: EffectRow) a. Member Rpc r => Sem r a -> Sem r a
- silent :: forall (r :: EffectRow) a. Member Rpc r => Sem r a -> Sem r a
- silentBang :: forall (r :: EffectRow) a. Member Rpc r => Sem r a -> Sem r a
- newtype HostConfig = HostConfig {}
- data LogConfig = LogConfig {
- logFile :: Maybe (Path Abs File)
- logLevelEcho :: Severity
- logLevelStderr :: Severity
- logLevelFile :: Severity
- dataLogConc :: Bool
- setStderr :: Severity -> HostConfig -> HostConfig
- data PluginConfig c = PluginConfig PluginName HostConfig (Parser c)
- pluginNamed :: PluginName -> PluginConfig ()
- resumeReport :: forall (eff :: (Type -> Type) -> Type -> Type) e (r :: EffectRow) a. (Reportable e, Members '[eff !! e, Stop Report] r) => Sem (eff ': r) a -> Sem r a
- mapReport :: forall e (r :: EffectRow) a. (Reportable e, Member (Stop Report) r) => Sem (Stop e ': r) a -> Sem r a
- resumeReports :: ResumeReports effs errs r => InterpretersFor effs r
- mapReports :: MapReports errs r => InterpretersFor (Stops errs) r
- data LogReport = LogReport Report Bool Bool ReportContext
- data Report where
- class Reportable e where
- newtype ReportContext = ReportContext {
- unReportContext :: [Text]
- reportContext :: ReportContext -> Text
- prefixReportContext :: ReportContext -> Text
- reportContext' :: ReportContext -> Maybe Text
- prefixReportContext' :: ReportContext -> Maybe Text
- basicReport :: forall (r :: EffectRow) a. (Member (Stop Report) r, HasCallStack) => Text -> [Text] -> Sem r a
- userReport :: Reportable e => e -> Text
- reportMessages :: Report -> Text
- resumeHoistUserMessage :: forall err (eff :: (Type -> Type) -> Type -> Type) err' (r :: EffectRow). (Reportable err, Members '[eff !! err, Stop err'] r) => (Text -> err') -> InterpreterFor eff r
- mapUserMessage :: forall err err' (r :: EffectRow). (Reportable err, Member (Stop err') r) => (Text -> err') -> InterpreterFor (Stop err) r
- logReport :: Reportable e => Member (DataLog LogReport) r => e -> Sem r ()
- pluginLogReports :: Members [Scratch !! RpcError, Settings !! SettingError, Rpc !! RpcError, Stop Report] r => InterpretersFor [Scratch, Settings, Rpc] r
- data RpcError
- rpcError :: RpcError -> Text
- ignoreRpcError :: forall (r :: EffectRow) a. Member (Rpc !! RpcError) r => Sem (Rpc ': r) a -> Sem r ()
- onRpcError :: forall (r :: EffectRow) a. Member (Rpc !! RpcError) r => (RpcError -> Sem r a) -> Sem (Rpc ': r) a -> Sem r a
- newtype BootError = BootError {
- unBootError :: Text
- data StoredReport = StoredReport Report Time
- data Reports (a :: Type -> Type) b
- storedReports :: forall (r :: EffectRow). Member Reports r => Sem r (Map ReportContext [StoredReport])
- reportStop :: forall err r. Reportable err => Member (DataLog LogReport) r => Sem (Stop err ': r) () -> Sem r ()
- resumeLogReport :: forall eff e r. Reportable e => Members [eff !! e, DataLog LogReport] r => Sem (eff ': r) () -> Sem r ()
- data UserError (a :: Type -> Type) b
- interpretUserErrorPrefixed :: Member (Reader PluginName) r => InterpreterFor UserError r
- data MState s (a :: Type -> Type) b
- type ScopedMState s = PScoped s () (MState s)
- mmodify :: forall s (r :: EffectRow). Member (MState s) r => (s -> s) -> Sem r ()
- mread :: forall s (r :: EffectRow). Member (MState s) r => Sem r s
- mreads :: forall s (r :: EffectRow) a. Member (MState s) r => (s -> a) -> Sem r a
- mstate :: forall s (r :: EffectRow) a. Member (MState s) r => (s -> (s, a)) -> Sem r a
- mtrans :: forall s (r :: EffectRow). Member (MState s) r => (s -> Sem r s) -> Sem r ()
- muse :: forall s (r :: EffectRow) a. Member (MState s) r => (s -> Sem r (s, a)) -> Sem r a
- stateToMState :: forall s (r :: EffectRow). Member (MState s) r => InterpreterFor (State s :: (Type -> Type) -> Type -> Type) r
- withMState :: forall s (r :: EffectRow). Member (ScopedMState s) r => s -> InterpreterFor (MState s) r
- evalMState :: forall s (r :: [Effect]). s -> InterpreterFor (MState s) r
- interpretMState :: forall mres (r :: EffectRow) s. Members '[Resource, Race, Mask mres, Embed IO] r => s -> InterpreterFor (MState s) r
- interpretMStates :: forall s mres (r :: EffectRow). Members '[Mask mres, Resource, Race, Embed IO] r => InterpreterFor (ScopedMState s) r
- simpleHandler :: forall (r :: EffectRow) a. Member (Rpc !! RpcError) r => Sem (Rpc ': (Stop Report ': r)) a -> Handler r a
- noHandlers :: forall (r :: [Effect]). InterpreterFor (Handlers !! Report) r
- interpretHandlers :: forall (r :: EffectRow). Members '[Rpc !! RpcError, Log, Error BootError :: (Type -> Type) -> Type -> Type] r => [RpcHandler r] -> InterpreterFor (Handlers !! Report) r
- data Register
- data RegisterType
- registerRepr :: Register -> Text
- pathText :: Path b t -> Text
- newtype CustomConfig c = CustomConfig c
- type (!!) (eff :: (Type -> Type) -> Type -> Type) err = Resumable err eff
- (<!) :: forall err (eff :: (Type -> Type) -> Type -> Type) (r :: EffectRow) a. Member (Resumable err eff) r => a -> Sem (eff ': r) a -> Sem r a
- data Stop e (a :: Type -> Type) b
Introduction
This library is a framework for building Neovim plugins with Polysemy.
A plugin consists of a set of request handlers that can be executed by Neovim functions, commands, autocmds, or events, and may communicate with Neovim by calling its RPC API.
Here is an example for a simple plugin with a single request handler.
import Ribosome import Ribosome.Api count :: Members NvimPlugin r => Int -> Handler r Int count n = do s <- 0 <! nvimGetVar "sum" let s' = s + n ignoreRpcError (nvimSetVar "sum" s') pure s' main :: IO () main = runNvimPluginIO_ "counter" [rpcFunction "Count" Sync count]
This module can be used as a Neovim plugin by running it with jobstart
from Neovim:
:call jobstart(['/path/to/plugin.exe'], { 'rpc': 1 })
The handler will add up all numbers that are passed to the Neovim function Count
and store the sum in the variable
g:sum
:
:echo Count(5) 5 :echo Count(13) 18 :echo g:sum 18
Creating a project
The most reliable way to set up a repository for a plugin is to use Nix, for which Ribosome provides an app that generates a ready-to-use plugin project that includes Neovim glue that fetches static binaries from Github, as well as config files for Github Actions that release those binaries for every commit and tag:
$ nix run 'github:tek/ribosome#new' my-plugin
The created plugin can be added to Neovim like any other.
For example, linking its directory to ~/.local/share/nvim/site/pack/foo/opt/my-plugin
will allow you to
run:
:packadd my-plugin
Using start
instead of opt
in the pack path will run the plugin at startup.
Or simply use one of the many plugin managers.
On the first start, the plugin will either be built with Nix, if it is available, or a static binary will be fetched from Github. Once that is done, the template project's dummy handler can be executed:
:echo MyPluginPing() 0 :echo MyPluginPing() 1
The second time the plugin ist started, the executable will be run directly, without checking for updates, unless the
result has been garbage collected by Nix (i.e. the result
link in the repo is broken).
In order to force a rebuild after pulling, run the command:
$ nix build
Handlers
A list of RpcHandler
s can be created by passing a handler function to one the smart constructors:
echoHello :: Member (Rpc !! RpcError) => Sem r () echoHello = ignoreRpcError (echo "Hello") handlers = [ rpcFunction "Hello" Async echoHello, rpcCommand "Hello" Async echoHello, rpcAutocmd "HelloHaskellFile" Async "BufEnter" "*.hs" echoHello ]
Passing these handlers to runNvimPluginIO_
starts a plugin that calls echoHello
when running :call Hello()
,
:Hello
, or when entering a Haskell buffer.
When the plugin's main loop starts, withHandlers
registers the triggers in Neovim by running vim code like this:
function! Hello(...) range return call('rpcnotify', [1, 'function:Hello'] + a:000) endfunction command! -nargs=0 Hello call call('rpcnotify', [1, 'command:Hello']) autocmd BufEnter *.hs call call('rpcnotify', [1, 'autocmd:HelloHaskellFile'])
Handler definition
data RpcHandler (r :: [(Type -> Type) -> Type -> Type]) #
This type defines a request handler, using a Handler
function, the request type, a name, and whether it should
block Neovim while executing.
It can be constructed from handler functions using rpcFunction
, rpcCommand
and
rpcAutocmd
.
A list of RpcHandler
s can be used as a Neovim plugin by passing them to runNvimHandlersIO
.
RpcHandler | |
|
Instances
type Handler (r :: [(Type -> Type) -> Type -> Type]) a = Sem (Stop Report ': r) a #
A request handler function is a Sem
with arbitrary stack that has an error of type Report
at its head.
These error messages are reported to the user by return value for synchronous requests and via echo
for
asynchronous ones, provided that the severity specified in the error is greater than the log level set in
UserError
.
If the plugin was started with --log-file
, it is also written to the file log.
Additionally, reports are stored in memory by the effect Reports
.
This name is used for the function or command registered in Neovim as well as to internally identify a handler.
Constructing handlers
:: forall (r :: [(Type -> Type) -> Type -> Type]) h. HandlerCodec h r | |
=> RpcName | Name of the Neovim function that will be created. |
-> Execution | Execute sync or async. |
-> h | The handler function. |
-> RpcHandler r |
Create an RpcHandler
that is triggered by a Neovim function of the specified name.
The handler can take arbitrary parameters, as long as they are instances of MsgpackDecode
(or more
specifically, HandlerArg
), just like the return type.
When invoking the function from Neovim, a value must be passed for each of the handler function's parameters, except
for some special cases, like a number of successive Maybe
parameters at the tail of the parameter list.
The function is converted to use messagepack types by the class HandlerCodec
.
For easier type inference, it is advisable to use
for the return type of the handler instead of using
Handler
r a
.Member
(Stop
LogReport
) r
Example:
import Ribosome ping :: Int -> Handler r Int ping 0 = basicLogReport "Invalid ping number!" ["This is written to the log"] ping i = pure i rpcFunction "Ping" Sync ping
:: forall (r :: [(Type -> Type) -> Type -> Type]) h. (HandlerCodec h r, CommandHandler OptionStateZero h) | |
=> RpcName | Name of the Neovim function that will be created. |
-> Execution | Execute sync or async. |
-> h | The handler function. |
-> RpcHandler r |
Create an RpcHandler
that is triggered by a Neovim command of the specified name.
The handler can take arbitrary parameters, as long as they are instances of MsgpackDecode
(or more
specifically, HandlerArg
), just like the return type.
The function is converted to use messagepack types by the class HandlerCodec
.
Commands have an (open) family of special parameter types that will be translated into command options, like
Range
for the line range specified to the command.
See command params.
For easier type inference, it is advisable to use
for the return type of the handler instead of using
Handler
r a
.Member
(Stop
Report
) r
:: forall (r :: [(Type -> Type) -> Type -> Type]) h. HandlerCodec h r | |
=> RpcName | |
-> Execution | Execute sync or async. While autocommands can not interact with return values, this is still useful to keep Neovim
from continuing execution while the handler is active, which is particularly important for |
-> AutocmdEvents | The Neovim event identifier, like |
-> AutocmdOptions | Various Neovim options like the file pattern. |
-> h | The handler function. |
-> RpcHandler r |
Create an RpcHandler
that is triggered by a Neovim autocommand for the specified event.
For a user autocommand, specify User
for the event and the event name for the file pattern in AutocmdOptions
.
For easier type inference, it is advisable to use
for the return type of the handler instead of using
Handler
r a
.Member
(Stop
Report
) r
rpc :: forall (r :: [(Type -> Type) -> Type -> Type]) h. (HandlerCodec h r, CommandHandler OptionStateZero h) => RpcName -> Execution -> h -> [RpcHandler r] #
Convenience function for creating a handler that is triggered by both a function and a command of the same name.
See rpcFunction
and rpcCommand
.
This type indicates the execution style that Neovim should be instructed to use for RPC messages – synchronous requests that block Neovim until a result is returned and asynchronous notifications.
Instances
Bounded Execution | |
Enum Execution | |
Defined in Ribosome.Host.Data.Execution succ :: Execution -> Execution # pred :: Execution -> Execution # fromEnum :: Execution -> Int # enumFrom :: Execution -> [Execution] # enumFromThen :: Execution -> Execution -> [Execution] # enumFromTo :: Execution -> Execution -> [Execution] # enumFromThenTo :: Execution -> Execution -> Execution -> [Execution] # | |
Show Execution | |
Eq Execution | |
MsgpackDecode Execution | |
Defined in Ribosome.Host.Data.Execution | |
MsgpackEncode Execution | |
Defined in Ribosome.Host.Data.Execution |
Remote plugin execution
There are many ways of running a plugin for different purposes, like as a remote plugin from Neovim (the usual production mode), directly in a test using an embedded Neovim process, or over a socket when testing a plugin in tmux.
runNvimPluginIO :: forall r. HigherOrder r (RemoteStack ()) => PluginConfig () -> InterpretersFor r (RemoteStack ()) -> [RpcHandler (r ++ RemoteStack ())] -> IO () Source #
Run a Neovim plugin using a set of handlers and configuration, with an arbitrary stack of custom effects placed between the handlers and the Ribosome stack. This is important, because the custom effects may want to use the Neovim API, while the handlers want to use both Neovim and the custom effects.
Example:
data Numbers :: Effect where Number :: Int -> Sem r Int makeSem ''Numbers runNumbers :: Member (Rpc !! RpcError) r => InterpreterFor Numbers r runNumbers = \case Number i -> (-1) <! nvimGetVar ("number_" <> show i) type CustomStack = [AtomicState Int, Numbers] currentNumber :: Handler r Int currentNumber = number =<< atomicGet setNumber :: Int -> Handler r () setNumber = atomicPut runCustomStack :: InterpretersFor CustomStack r runCustomStack = interpretAtomic . runNumbers main :: IO () main = runNvimPluginIO @CustomStack "numbers" runCustomStack [ rpcFunction "CurrentNumber" Sync currentNumber, rpcFunction "SetNumber" Async setNumber ]
Note:
PluginConfig
is being constructed viaOverloadedStrings
CustomStack
has to be specified as a type application, because GHC cannot figure it out on its own.- For an explanation of
Rpc !! RpcError
, see Errors
This runs the entire stack to completion, so it can be used in the app's main
function.
For more flexibility and less type inference noise, this can be inlined as:
runRemoteStack conf $ runCustomStack $ withHandlers handlers remotePlugin
runNvimPluginIO_ :: PluginConfig () -> [RpcHandler (RemoteStack ())] -> IO () Source #
Run a Neovim plugin using a set of handlers and configuration.
This function does not allow additional effects to be used. See runNvimPluginIO
for that purpose.
This runs the entire stack to completion, so it can be used in the app's main
function.
runNvimPluginCli :: HigherOrder r (RemoteStack c) => PluginConfig c -> InterpretersFor r (RemoteStack c) -> [RpcHandler (r ++ RemoteStack c)] -> IO () Source #
Run a Neovim plugin using a set of handlers and configuration, with an arbitrary stack of custom effects placed between the handlers and the Ribosome stack.
Like runNvimPluginIO
, but allows the PluginConfig
to contain a CLI parser for an arbitrary type c
that is then
provided in a
to the plugin.Reader
c
This is separate from runNvimPluginIO
because it requires a type hint when using OverloadedStrings
or def
to
construct the config without an option parser.
withHandlers :: forall (r :: EffectRow) a. Members '[Handlers !! Report, Rpc !! RpcError, Log, Error BootError :: (Type -> Type) -> Type -> Type] r => [RpcHandler r] -> Sem r a -> Sem r a #
Add a set of RpcHandler
s to the plugin.
This can be used multiple times and has to be terminated by interpretHandlersNull
, which is done automatically when
using the plugin main functions.
remotePlugin :: forall c r. Members HandlerStack r => Members (BasicPluginStack c) r => Sem r () Source #
Run the main loop for a remote plugin.
type RemoteStack c = HandlerStack ++ BasicPluginStack c Source #
The complete stack of a Neovim plugin.
runRemoteStack :: PluginConfig () -> Sem (RemoteStack ()) () -> IO () Source #
Run plugin internals and IO effects for a remote plugin, reading options from the CLI.
runRemoteStackCli :: PluginConfig c -> Sem (RemoteStack c) () -> IO () Source #
Run plugin internals and IO effects for a remote plugin, reading options from the CLI.
Like runRemoteStack
, but allows the CLI option parser to be specified.
interpretPluginRemote :: Members (BasicPluginStack c) r => InterpretersFor HandlerStack r Source #
Run plugin internals without IO effects.
type BasicPluginStack c = Reader PluginName ': (Reader (CustomConfig c) ': BasicStack) Source #
The effects that are shared by all variants (like embedded, remote, socket) of main functions.
Contains logging effects, IO related stuff and the plugin's name in a Reader
.
runBasicPluginStack :: PluginName -> HostConfig -> c -> Sem (BasicPluginStack c) () -> IO () Source #
Execute the basic plugin stack all the way to an IO
, given the plugin name and logging settings.
runCli :: PluginConfig c -> Sem (BasicPluginStack c) () -> IO () Source #
Execute the basic plugin stack all the way to an IO
like runBasicPluginStack
, reading config overrides from
command line options.
type NvimPlugin = [Scratch !! RpcError, Settings !! SettingError, Rpc !! RpcError, Reader PluginName] Source #
The set of core effects that handlers and API functions commonly use.
Interacting with Neovim
- The effect
Rpc
governs access to Neovim's remote API. - The module Ribosome.Api.Data contains declarative representations of all API calls that are
listed at
:help api
. - The module Ribosome.Api.Effect, reexported from Ribosome.Api, contains
the same set of API functions, but as callable
Sem
functions that use the data declarations withsync
. Ribosome.Api additionally contains many composite functions using the Neovim API.
The API also defines the data types Buffer
, Window
and Tabpage
, which are abstract types carrying an internal
identifier generated by Neovim.
data Rpc (a :: Type -> Type) b #
This effect abstracts interaction with the Neovim RPC API. An RPC call can either be a request or a notification, where the former expects a response to be sent while the latter returns immediately.
For requests, the constructor sync
blocks the current thread while async
takes a callback that is called from a
new thread.
The constructor notify
sends a notification.
The module Ribosome.Api.Data contains RpcCall
s for the entire Neovim API, generated by
calling neovim --api-info
during compilation from Template Haskell.
The module Ribosome.Api contains functions that call sync
with those RpcCall
s, converting the input and return
values to and from msgpack.
These functions have signatures like:
nvimGetVar :: ∀ a r . Member Rpc r => MsgpackDecode a => Text -> Sem r a
A manual call would be constructed like this:
Ribosome.sync (RpcCallRequest (Request "nvim_get_option" [toMsgpack "textwidth"]))
RPC calls may be batched and sent via nvim_call_atomic
, see RpcCall
.
This effect's default interpreter uses Resumable
for error tracking. See Errors.
The payload of an RPC request.
Instances
Generic Request | |
Show Request | |
Eq Request | |
MsgpackEncode Request | |
Defined in Ribosome.Host.Data.Request | |
type Rep Request | |
Defined in Ribosome.Host.Data.Request type Rep Request = D1 ('MetaData "Request" "Ribosome.Host.Data.Request" "ribosome-host-0.9.9.9-5mVeOZw909e7nfaEBEbC5r" 'False) (C1 ('MetaCons "Request" 'PrefixI 'True) (S1 ('MetaSel ('Just "method") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RpcMethod) :*: S1 ('MetaSel ('Just "arguments") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Object]))) |
A wrapper for Request
that allows applicative sequencing of calls for batch processing, used for a declarative
representation of the Neovim API.
Neovim has an API function named nvim_call_atomic
that makes it possible to send multiple RPC requests at once,
reducing the communcation overhead.
Applicative sequences of RpcCall
s are automatically batched into a single call by Rpc
.
This can be combined neatly with ApplicativeDo
:
import Ribosome import qualified Ribosome.Api.Data as Api sync do a :: Int <- Api.nvimGetVar "number1" b :: Int <- Api.nvimGetVar "number2" pure (a + b)
sync :: forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a #
Block the current thread while sending an RPC request.
async :: forall a (r :: EffectRow). Member Rpc r => RpcCall a -> (Either RpcError a -> Sem r ()) -> Sem r () #
Send an RPC request and pass the result to the continuation on a new thread.
notify :: forall a (r :: EffectRow). Member Rpc r => RpcCall a -> Sem r () #
Send an RPC notification and return immediately.
Instances
Show Buffer | |
Eq Buffer | |
MsgpackDecode Buffer | |
Defined in Ribosome.Host.Api.Data | |
MsgpackEncode Buffer | |
Defined in Ribosome.Host.Api.Data |
Instances
Show Window | |
Eq Window | |
MsgpackDecode Window | |
Defined in Ribosome.Host.Api.Data | |
MsgpackEncode Window | |
Defined in Ribosome.Host.Api.Data |
Instances
Show Tabpage | |
Eq Tabpage | |
MsgpackDecode Tabpage | |
Defined in Ribosome.Host.Api.Data | |
MsgpackEncode Tabpage | |
Defined in Ribosome.Host.Api.Data |
An event is an RPC notification sent by Neovim that is not intended to be dispatched to a named handler, but consumed in a broadcasting fashion.
Since they aren't marked as such, the host treats any notification with an unknown method name as an event.
The name of an event, which corresponds to the RPC method in the payload.
Instances
IsString EventName | |
Defined in Ribosome.Host.Data.Event fromString :: String -> EventName # | |
Show EventName | |
Eq EventName | |
Ord EventName | |
Defined in Ribosome.Host.Data.Event | |
MsgpackDecode EventName | |
Defined in Ribosome.Host.Data.Event | |
MsgpackEncode EventName | |
Defined in Ribosome.Host.Data.Event |
Watching variables
Watched variable handlers are called whenever a certain Neovim variable's value has changed:
changed :: Members NvimPlugin r => Object -> Handler r () changed value = ignoreRpcError (echo ("Update value to: " <> show value)) main :: IO () main = runRemoteStack "watch-plugin" (watchVariables [("trigger", changed)] remotePlugin)
This registers the variable named trigger
to be watched for changes.
When a change is detected, the handler changed
whill be executed with the new value as its argument.
Note that the combinators in the main function are simply what's run by runNvimPluginIO
, with watchVariables
being used as the custom effect stack and an empty list of handlers.
watchVariables :: Members [VariableWatcher !! Report, Rpc !! RpcError, Resource, Mask mres, Race, Embed IO] r => Map WatchedVariable (Object -> Handler r ()) -> Sem r a -> Sem r a Source #
This is a reactive system that is triggered by several frequently sent autocommands to inspect a user-defined set of Neovim variables for changes. When a variable's value has been observed to have changed from the previously recorded state, the associated handler is executed.
This handler has to be passed to runNvimPluginIO
or similar as part of the custom effect stack, like:
runNvimPluginIO "my-plugin" (watchVariables [("variable_name", handler)]) mempty
This does not remove VariableWatcher
from the stack, but intercepts and resends it, to make it simpler to use
with the plugin runners.
newtype WatchedVariable Source #
The name of a variable that Ribosome should watch for changes.
Instances
IsString WatchedVariable Source # | |
Defined in Ribosome.Effect.VariableWatcher fromString :: String -> WatchedVariable # | |
Show WatchedVariable Source # | |
Defined in Ribosome.Effect.VariableWatcher showsPrec :: Int -> WatchedVariable -> ShowS # show :: WatchedVariable -> String # showList :: [WatchedVariable] -> ShowS # | |
Eq WatchedVariable Source # | |
Defined in Ribosome.Effect.VariableWatcher (==) :: WatchedVariable -> WatchedVariable -> Bool # (/=) :: WatchedVariable -> WatchedVariable -> Bool # | |
Ord WatchedVariable Source # | |
Defined in Ribosome.Effect.VariableWatcher compare :: WatchedVariable -> WatchedVariable -> Ordering # (<) :: WatchedVariable -> WatchedVariable -> Bool # (<=) :: WatchedVariable -> WatchedVariable -> Bool # (>) :: WatchedVariable -> WatchedVariable -> Bool # (>=) :: WatchedVariable -> WatchedVariable -> Bool # max :: WatchedVariable -> WatchedVariable -> WatchedVariable # min :: WatchedVariable -> WatchedVariable -> WatchedVariable # |
Embedded Neovim execution
While remote plugins are executed from within Neovim, Ribosome can also run Neovim from a Haskell process and attach to the subprocess' stdio.
The primary purpose of embedding Neovim is testing a plugin, but it could also be used to build a GUI application around Neovim.
The library Ribosome.Test provides more comprehensive functionality for the testing use case.
When embedding Neovim, the main loop is forked and the test is run synchronously:
import qualified Data.Text.IO as Text import Ribosome import Ribosome.Api ping :: Handler r Text ping = pure "Ping" main :: IO () main = runEmbedPluginIO_ "ping-plugin" [rpcFunction "Ping" Sync ping] do ignoreRpcError do embed . Text.putStrLn =<< nvimCallFunction "Ping" []
runEmbedPluginIO :: HigherOrder r (EmbedStack ()) => PluginConfig () -> InterpretersFor r (EmbedStack ()) -> [RpcHandler (r ++ EmbedStack ())] -> Sem (r ++ EmbedStack ()) () -> IO () Source #
Run a Sem
in an embedded plugin context by starting a Neovim subprocess, forking the Ribosome main loop and
registering the supplied handlers, using the supplied custom effect stack.
This is a basic version of what ribosome-test provides, which uses polysemy-test and hedgehog for a comprehensive testing framework.
The parameters have the same meaning as for remote plugins.
runEmbedPluginIO_ :: PluginConfig () -> [RpcHandler (EmbedStack ())] -> Sem (EmbedStack ()) () -> IO () Source #
Run a Sem
in an embedded plugin context by starting a Neovim subprocess, forking the Ribosome main loop and
registering the supplied handlers.
Like runEmbedPluginIO
, but without extra effects.
runEmbedPluginCli :: HigherOrder r (EmbedStack c) => PluginConfig c -> InterpretersFor r (EmbedStack c) -> [RpcHandler (r ++ EmbedStack c)] -> Sem (r ++ EmbedStack c) () -> IO () Source #
Run a Sem
in an embedded plugin context by starting a Neovim subprocess, forking the Ribosome main loop and
registering the supplied handlers, using the supplied custom effect stack.
Like runEmbedPluginIO
, but allows the PluginConfig
to contain a CLI parser for an arbitrary type c
that is then
provided in a
to the plugin.Reader
c
This is separate from runEmbedPluginIO
because it requires a type hint when using OverloadedStrings
or def
to
construct the config without an option parser.
embedPlugin :: Members (HostDeps er) r => Members BuiltinHandlersDeps r => Sem r a -> Sem r a Source #
Fork the main loop for a plugin connected to an embedded Neovim.
runEmbedStack :: PluginConfig () -> Sem (EmbedStack ()) () -> IO () Source #
Run an embedded Neovim, plugin internals and IO effects, reading options from the CLI.
runEmbedStackCli :: PluginConfig c -> Sem (EmbedStack c) () -> IO () Source #
Run an embedded Neovim, plugin internals and IO effects, reading options from the CLI.
Like runEmbedStack
, but allows the CLI option parser to be specified.
interpretPluginEmbed :: Members [Log, Reader LogConfig, Reader PluginName] r => Members IOStack r => InterpretersFor HandlerEffects r Source #
Run the internal stack for an embedded Neovim test, without IO effects.
MessagePack codec
Neovim's RPC communication uses the MessagePack protocol.
All API functions convert their arguments and return values using the classes MsgpackEncode
and MsgpackDecode
.
There are several Haskell libraries for this purpose.
Ribosome uses messagepack, simply for the reason that it allows
easy incremental parsing via cereal.
All API functions that are declared as taking or returning an Object
by Neovim are kept
polymorphic, allowing the user to interface with them using arbitrary types.
Codec classes for record types can be derived generically:
data Cat = Cat { name :: Text, age :: Int } deriving stock (Generic) deriving anyclass (MsgpackEncode, MsgpackDecode) nvimSetVar "cat" (Cat "Dr. Boots" 4)
class MsgpackDecode a where #
Class of values that can be decoded from MessagePack Object
s.
Nothing
fromMsgpack :: Object -> Either Text a #
Instances
class MsgpackEncode a where #
Class of values that can be encoded to MessagePack Object
s.
Nothing
Convert a value to MessagePack.
The default implementation uses generic derivation.
Instances
pattern Msgpack :: MsgpackDecode a => a -> Object #
Pattern synonym for decoding an Object
.
msgpackArray :: MsgpackArray a => a #
Encode an arbitrary number of heterogeneously typed values to a single MessagePack array. This function is variadic, meaning that it takes an arbitrary number of arguments:
>>>
msgpackArray (5 :: Int) ("error" :: Text) (3.14 :: Double) :: Object
ObjectArray [ObjectInt 5, ObjectString "error", ObjectFloat 3.14]
This avoids the need to call toMsgpack
once for each element and then once more for the array.
msgpackMap :: MsgpackMap a => a #
Encode an arbitrary number of heterogeneously typed values to a single MessagePack map. This function is variadic, meaning that it takes an arbitrary number of arguments:
>>>
msgpackMap ("number", 5 :: Int) ("status", "error" :: Text) ("intensity", 3.14 :: Double) :: Object
ObjectMap (Map.fromList [(ObjectString "number", ObjectInt 5), (ObjectString "status", ObjectString "error"), (ObjectString "intensity", ObjectFloat 3.14)])
This avoids the need to call toMsgpack
once for each element and then once more for the map.
Utility effects
TODO
Settings
This type is used by the effect Settings
, representing a Neovim variable associated with a plugin.
It has a name, can optionally prefixed by the plugin's name and may define a default value that is used when the variable is undefined.
The type parameter determines how the Neovim value is decoded.
data SettingError Source #
The errors emitted by the effect Settings
.
Instances
Show SettingError Source # | |
Defined in Ribosome.Data.SettingError showsPrec :: Int -> SettingError -> ShowS # show :: SettingError -> String # showList :: [SettingError] -> ShowS # | |
Eq SettingError Source # | |
Defined in Ribosome.Data.SettingError (==) :: SettingError -> SettingError -> Bool # (/=) :: SettingError -> SettingError -> Bool # | |
Reportable SettingError Source # | |
Defined in Ribosome.Data.SettingError toReport :: SettingError -> Report # |
interpretSettingsRpc :: Members [Rpc !! RpcError, Reader PluginName] r => InterpreterFor (Settings !! SettingError) r Source #
Interpret Settings
natively, using Neovim variables.
Scratch buffers
A scratch buffer is what Neovim calls text not associated with a file, used for informational or interactive content. Ribosome provides an interface for maintaining those, by associating a view configuration with an ID and allowing to update the text displayed in it. Its full API is exposed by Ribosome.Scratch.
data Scratch :: Effect Source #
This effect manages scratch buffers, that is, transient buffers displaying text not associated with a file.
See ScratchOptions
for configuration.
data ScratchOptions Source #
Configure the visual properties of a scratch buffer.
If the option float
is specified, the buffer will be opened in a floating window.
Instances
scratch :: ScratchId -> ScratchOptions Source #
The default configuration, setting all flags to False
except for $sel:resize:ScratchOptions
and $sel:bottom:ScratchOptions
, and everything else to
mempty
.
data FloatOptions Source #
The set of options accepted by the float
key of the argument to nvim_open_win
, configuring the appearance and
geometry of a floating window.
Instances
The ID type used to store active scratch buffers.
Instances
IsString ScratchId Source # | |
Defined in Ribosome.Data.ScratchId fromString :: String -> ScratchId # | |
Show ScratchId Source # | |
Eq ScratchId Source # | |
Ord ScratchId Source # | |
Defined in Ribosome.Data.ScratchId | |
MsgpackDecode ScratchId Source # | |
Defined in Ribosome.Data.ScratchId | |
MsgpackEncode ScratchId Source # | |
Defined in Ribosome.Data.ScratchId |
data ScratchState Source #
The configuration and Neovim resources that define a scratch buffer and describe its previously recorded UI state.
Instances
Mappings
The function activateBufferMapping
can be used to dynamically create buffer-local Neovim key mappings that trigger
handlers of a Ribosome plugin.
A slightly reliable way of constructing a Mapping
is to use mappingFor
, which takes an RpcHandler
to ensure
that the name it calls was at least associated with a handler at some point.
One use case for mappings is in a Scratch
buffer, which automatically registers a set of them after initializing
the buffer.
This type associates a sequence of keys and a mode for a Neovim mapping with an RPC handler or event.
It is intended to be used with mappingFor
or eventMapping
and activateBufferMapping
.
Instances
Generic Mapping Source # | |
Show Mapping Source # | |
Eq Mapping Source # | |
type Rep Mapping Source # | |
Defined in Ribosome.Data.Mapping type Rep Mapping = D1 ('MetaData "Mapping" "Ribosome.Data.Mapping" "ribosome-0.9.9.9-2kHabuyTX5NGSYChGwh5iS" 'False) (C1 ('MetaCons "Mapping" 'PrefixI 'True) ((S1 ('MetaSel ('Just "action") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MappingAction) :*: S1 ('MetaSel ('Just "spec") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MappingSpec)) :*: (S1 ('MetaSel ('Just "id") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe MappingId)) :*: S1 ('MetaSel ('Just "opts") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map Text Object))))) |
data MappingAction Source #
The action that should be performed when a mapping is triggered.
MappingCall RpcName | The name of the |
MappingEvent EventName | The event to publish when the mapping is triggered. |
Instances
Show MappingAction Source # | |
Defined in Ribosome.Data.Mapping showsPrec :: Int -> MappingAction -> ShowS # show :: MappingAction -> String # showList :: [MappingAction] -> ShowS # | |
Eq MappingAction Source # | |
Defined in Ribosome.Data.Mapping (==) :: MappingAction -> MappingAction -> Bool # (/=) :: MappingAction -> MappingAction -> Bool # |
This ID type is intended to carry information about what buffer or other component triggered a mapping, if needed.
Instances
IsString MappingId Source # | |
Defined in Ribosome.Data.Mapping fromString :: String -> MappingId # | |
Show MappingId Source # | |
Eq MappingId Source # | |
Ord MappingId Source # | |
Defined in Ribosome.Data.Mapping | |
MsgpackDecode MappingId Source # | |
Defined in Ribosome.Data.Mapping | |
MsgpackEncode MappingId Source # | |
Defined in Ribosome.Data.Mapping |
newtype MappingLhs Source #
The sequence of keys that triggers a mapping.
Instances
IsString MappingLhs Source # | |
Defined in Ribosome.Data.Mapping fromString :: String -> MappingLhs # | |
Show MappingLhs Source # | |
Defined in Ribosome.Data.Mapping showsPrec :: Int -> MappingLhs -> ShowS # show :: MappingLhs -> String # showList :: [MappingLhs] -> ShowS # | |
Eq MappingLhs Source # | |
Defined in Ribosome.Data.Mapping (==) :: MappingLhs -> MappingLhs -> Bool # (/=) :: MappingLhs -> MappingLhs -> Bool # | |
Ord MappingLhs Source # | |
Defined in Ribosome.Data.Mapping compare :: MappingLhs -> MappingLhs -> Ordering # (<) :: MappingLhs -> MappingLhs -> Bool # (<=) :: MappingLhs -> MappingLhs -> Bool # (>) :: MappingLhs -> MappingLhs -> Bool # (>=) :: MappingLhs -> MappingLhs -> Bool # max :: MappingLhs -> MappingLhs -> MappingLhs # min :: MappingLhs -> MappingLhs -> MappingLhs # |
All possible variants of Neovim's map
commands, causing mappings to be registered for different modes.
MapDefault |
|
MapNormal |
|
MapInsertCmdline |
|
MapInsert |
|
MapCmdline |
|
MapLangArg |
|
MapVisual |
|
MapSelect |
|
MapVisualSelect |
|
MapOperator |
|
Instances
Enum MapMode Source # | |
Show MapMode Source # | |
Default MapMode Source # | |
Defined in Ribosome.Data.Mapping | |
Eq MapMode Source # | |
Ord MapMode Source # | |
data MappingSpec Source #
The configuration for a mapping that is specific to Neovim.
Instances
mappingFor :: RpcHandler r -> MappingLhs -> NonEmpty MapMode -> Maybe MappingId -> Map Text Object -> Mapping Source #
Construct a Mapping
using the name from the supplied RpcHandler
.
eventMapping :: EventName -> MappingLhs -> NonEmpty MapMode -> Maybe MappingId -> Map Text Object -> Mapping Source #
activateBufferMapping :: Member Rpc r => Buffer -> Mapping -> Sem r () Source #
Register a mapping in the supplied buffer.
Persisting data across vim sessions
data Persist a :: Effect Source #
This effect abstracts storing data of type a
in the file system to allow loading it when a plugin starts.
Each distinct type corresponds to a separate copy of this effect. When the same type should be stored in separate
files for different components of the plugin, use Tagged
.
The subdirectory or file name used for a type is specified to the interpreter.
If the constructor store
is called with Just
a file name, each value is stored in a separate file, otherwise the
same file is overwritten on every call to store
.
The default interpreter delegates file path resolution to the effect PersistPath
and uses JSON to
codec the data.
interpretPersist :: ToJSON a => FromJSON a => Members [PersistPath !! PersistPathError, Error BootError, Log, Embed IO] r => Text -> InterpreterFor (Persist a !! PersistError) r Source #
Interpret Persist
by writing to the file system.
Paths are determined as follows:
PersistPath
defines the root directory for allPersist
effects, which might be specific to a plugin, or additionally to entities like the currently edited project (e.g. by directory).- The value in the
name
argument is appended to the root depending on the arguments to the effect constructors. - When
store
orload
are invoked withNothing
for thesubpath
argument, a file namedname.json
is used. - When invoked with
Just
a subpath, a file namedname/subpath.json
is used.
interpretPersistNull :: forall a err r. InterpreterFor (Persist a !! err) r Source #
Interpret Persist
by storing nothing.
data PersistPath :: Effect Source #
This is a utility effect for Persist
, determining the root directory for persistence files.
persistPath :: forall r. Member PersistPath r => Maybe (Path Rel Dir) -> Sem r (Path Abs Dir) Source #
interpretPersistPath :: Members [Settings !! SettingError, Reader PluginName, Error BootError, Embed IO] r => Bool -> InterpreterFor (PersistPath !! PersistPathError) r Source #
Interpret PersistPath
by reading the global setting for the root directory, or using the XDG cache directory if
the variable is unset.
The plugin name is used as a subdir of the root.
interpretPersistPathSetting :: Members [Settings !! SettingError, Embed IO] r => Bool -> Maybe (Path Abs Dir) -> Path Rel Dir -> InterpreterFor (PersistPath !! PersistPathError) r Source #
Interpret PersistPath
by reading the global setting for the root directory, or using the given directory if the
variable is unset.
The given name
is appended to the root, which usually identifies the plugin.
interpretPersistPathAt :: Member (Embed IO) r => Bool -> Path Abs Dir -> InterpreterFor (PersistPath !! PersistPathError) r Source #
Interpret PersistPath
by using the specified root directory.
data PersistError Source #
The errors emitted by the effect PersistPath
.
Instances
Show PersistError Source # | |
Defined in Ribosome.Data.PersistError showsPrec :: Int -> PersistError -> ShowS # show :: PersistError -> String # showList :: [PersistError] -> ShowS # | |
Eq PersistError Source # | |
Defined in Ribosome.Data.PersistError (==) :: PersistError -> PersistError -> Bool # (/=) :: PersistError -> PersistError -> Bool # | |
Reportable PersistError Source # | |
Defined in Ribosome.Data.PersistError toReport :: PersistError -> Report # |
data PersistPathError Source #
The errors emitted by the effect PersistPath
.
Instances
Show PersistPathError Source # | |
Defined in Ribosome.Data.PersistPathError showsPrec :: Int -> PersistPathError -> ShowS # show :: PersistPathError -> String # showList :: [PersistPathError] -> ShowS # | |
Eq PersistPathError Source # | |
Defined in Ribosome.Data.PersistPathError (==) :: PersistPathError -> PersistPathError -> Bool # (/=) :: PersistPathError -> PersistPathError -> Bool # | |
Reportable PersistPathError Source # | |
Defined in Ribosome.Data.PersistPathError toReport :: PersistPathError -> Report # |
The plugin's name
newtype PluginName Source #
Represents the name of the plugin, to be used via Reader
by all its components.
The name is usually provided by main function combinators like runNvimPluginIO
via
.Reader
PluginConfig
Instances
IsString PluginName Source # | |
Defined in Ribosome.Data.PluginName fromString :: String -> PluginName # | |
Show PluginName Source # | |
Defined in Ribosome.Data.PluginName showsPrec :: Int -> PluginName -> ShowS # show :: PluginName -> String # showList :: [PluginName] -> ShowS # | |
Eq PluginName Source # | |
Defined in Ribosome.Data.PluginName (==) :: PluginName -> PluginName -> Bool # (/=) :: PluginName -> PluginName -> Bool # | |
Ord PluginName Source # | |
Defined in Ribosome.Data.PluginName compare :: PluginName -> PluginName -> Ordering # (<) :: PluginName -> PluginName -> Bool # (<=) :: PluginName -> PluginName -> Bool # (>) :: PluginName -> PluginName -> Bool # (>=) :: PluginName -> PluginName -> Bool # max :: PluginName -> PluginName -> PluginName # min :: PluginName -> PluginName -> PluginName # |
interpretPluginName :: Member (Reader (PluginConfig c)) r => InterpreterFor (Reader PluginName) r Source #
Interpret
by extracting the name from the plugin config provided by another Reader
PluginName
.Reader
PluginConfig
This interpreter is used by the main function machinery.
More functionality for handlers
Command completion
completeWith :: forall (r :: [(Type -> Type) -> Type -> Type]). CompleteStyle -> (Text -> Text -> Int -> Handler r [Text]) -> RpcHandler r -> [RpcHandler r] #
Add command line completion to another RpcHandler
by creating a new handler that calls the given function to
obtain possible completions.
completeBuiltin :: forall (r :: [(Type -> Type) -> Type -> Type]). Text -> RpcHandler r -> RpcHandler r #
Configure the given RpcHandler
to use the specified builtin completion.
data CompleteStyle #
Neovim command completion can be designated as returning all items that may be completed regardless of the current
word (CompleteUnfiltered
) or only those that match the current word (CompleteFiltered
).
CompleteFiltered | Completion returns matching items. |
CompleteUnfiltered | Completion returns all items. |
Instances
Show CompleteStyle | |
Defined in Ribosome.Host.Data.RpcType showsPrec :: Int -> CompleteStyle -> ShowS # show :: CompleteStyle -> String # showList :: [CompleteStyle] -> ShowS # | |
Eq CompleteStyle | |
Defined in Ribosome.Host.Data.RpcType (==) :: CompleteStyle -> CompleteStyle -> Bool # (/=) :: CompleteStyle -> CompleteStyle -> Bool # |
Special command parameter types
class HandlerArg a (r :: EffectRow) where #
This class is used by HandlerCodec
to decode handler function parameters.
Each parameter may consume zero or arbitrarily many of the RPC message's arguments.
Users may create instances for their types to implement custom decoding, especially for commands, since those don't have structured arguments.
See also CommandHandler
.
handlerArg :: [Object] -> Sem r ([Object], a) #
Instances
Member (Stop Report) r => HandlerArg ArgList r | |
Defined in Ribosome.Host.Handler.Codec | |
Member (Stop Report) r => HandlerArg Args r | |
Defined in Ribosome.Host.Handler.Codec | |
Member (Stop Report) r => HandlerArg Bang r | |
Defined in Ribosome.Host.Handler.Codec | |
HandlerArg Bar r | |
Defined in Ribosome.Host.Handler.Codec | |
(Member (Stop Report) r, MsgpackDecode a) => HandlerArg a r | |
Defined in Ribosome.Host.Handler.Codec handlerArg :: [Object] -> Sem r ([Object], a) # | |
(Member (Stop Report) r, FromJSON a) => HandlerArg (JsonArgs a) r | |
Defined in Ribosome.Host.Handler.Codec | |
(Member (Stop Report) r, OptionParser a) => HandlerArg (Options a) r | |
Defined in Ribosome.Host.Handler.Codec | |
HandlerArg a r => HandlerArg (Maybe a) r | |
Defined in Ribosome.Host.Handler.Codec |
class CommandHandler (state :: OptionState) h where #
Derive the command options and arguments that should be used when registering the Neovim command, from the parameters of the handler function.
See Command params for the list of supported special types.
The parameter state
is a type level value that determines which parameter types may be used after another and
counts the number of command arguments that are required or allowed.
It is transitioned by families in the classes CommandParam
, SpecialParam
and RegularParam
.
commandOptions :: (Map Text Object, [Text]) #
Return the list of command options and special arguments determined by the handler function's parameters.
Instances
(special ~ CommandSpecial a, next ~ TransState special state a, CommandParam special state a, CommandHandler next b) => CommandHandler state (a -> b) | |
Defined in Ribosome.Host.Handler.Command | |
CommandHandler ('OptionState _a 'MinOne c) (Sem r a) | |
Defined in Ribosome.Host.Handler.Command | |
CommandHandler ('OptionState _a 'MinZero c) (Sem r a) | |
Defined in Ribosome.Host.Handler.Command | |
CommandHandler ('OptionState _a 'Zero c) (Sem r a) | |
Defined in Ribosome.Host.Handler.Command |
When this type is used as the (last) parameter of a command handler function, all remaining tokens passed to the command will be consumed and stored in this type.
The command will be declared with the -nargs=*
or -nargs=+
option.
See CommandHandler
.
Instances
IsString Args | |
Defined in Ribosome.Host.Data.Args fromString :: String -> Args # | |
Show Args | |
Eq Args | |
Ord Args | |
Member (Stop Report) r => HandlerArg Args r | |
Defined in Ribosome.Host.Handler.Codec | |
SpecialParam ('OptionState al count ('Nothing :: Maybe Type)) Args | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al count 'Nothing) Args :: OptionState # specialOpt :: Map Text Object # specialArg :: Maybe Text # | |
type TransSpecial ('OptionState al count ('Nothing :: Maybe Type)) Args | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al count ('Nothing :: Maybe Type)) Args = 'OptionState 'True (Max count 'MinZero) ('Just Args) |
When this type is used as the (last) parameter of a command handler function, all remaining tokens passed to the command will be consumed and stored in this type, as a list of whitespace separated tokens.
The command will be declared with the -nargs=*
or -nargs=+
option.
See CommandHandler
.
Instances
Show ArgList | |
Eq ArgList | |
Member (Stop Report) r => HandlerArg ArgList r | |
Defined in Ribosome.Host.Handler.Codec | |
SpecialParam ('OptionState al count ac) ArgList | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al count ac) ArgList :: OptionState # specialOpt :: Map Text Object # specialArg :: Maybe Text # | |
type TransSpecial ('OptionState al count ac) ArgList | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al count ac) ArgList = 'OptionState 'True (Max count 'MinZero) ('Just ArgList) |
When this type is used as the (last) parameter of a command handler function, all remaining tokens passed to the command will be consumed, decoded as JSON and stored in this type.
The command will be declared with the -nargs=*
or -nargs=+
option.
See CommandHandler
.
JsonArgs | |
|
Instances
Show a => Show (JsonArgs a) | |
Eq a => Eq (JsonArgs a) | |
(Member (Stop Report) r, FromJSON a) => HandlerArg (JsonArgs a) r | |
Defined in Ribosome.Host.Handler.Codec | |
SpecialParam ('OptionState al count ac) (JsonArgs a) | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al count ac) (JsonArgs a) :: OptionState # specialOpt :: Map Text Object # specialArg :: Maybe Text # | |
type TransSpecial ('OptionState al count ac) (JsonArgs a) | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al count ac) (JsonArgs a) = 'OptionState 'True (Max count 'MinZero) ('Just (JsonArgs a)) |
When this type is used as the (last) parameter of a command handler function, all remaining tokens passed to the command will be consumed, parsed via optparse-applicative and stored in this type.
The parser associated with a
must be defined as an instance of
.OptionParser
a
The command will be declared with the -nargs=*
or -nargs=+
option.
See CommandHandler
.
Options a |
Instances
Show a => Show (Options a) | |
Eq a => Eq (Options a) | |
(Member (Stop Report) r, OptionParser a) => HandlerArg (Options a) r | |
Defined in Ribosome.Host.Handler.Codec | |
SpecialParam ('OptionState al count ('Nothing :: Maybe Type)) (Options a) | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al count 'Nothing) (Options a) :: OptionState # specialOpt :: Map Text Object # specialArg :: Maybe Text # | |
type TransSpecial ('OptionState al count ('Nothing :: Maybe Type)) (Options a) | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al count ('Nothing :: Maybe Type)) (Options a) = 'OptionState 'True (Max count 'MinZero) ('Just (Options a)) |
class OptionParser a where #
The parser used when declaring command handlers with the special parameter
.Options
a
optionParser :: Parser a #
When this type is used as a parameter of a command handler function, the command is declared with the -bang
option, and when invoked, the argument passed to the handler is Bang
if the user specified the !
and NoBang
otherwise.
Instances
Show Bang | |
Eq Bang | |
MsgpackDecode Bang | |
Defined in Ribosome.Host.Data.Bang | |
Member (Stop Report) r => HandlerArg Bang r | |
Defined in Ribosome.Host.Handler.Codec | |
BeforeRegular al Bang => SpecialParam ('OptionState al c ac) Bang | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al c ac) Bang :: OptionState # specialOpt :: Map Text Object # specialArg :: Maybe Text # | |
type TransSpecial ('OptionState al c ac) Bang | |
Defined in Ribosome.Host.Handler.Command |
When this type is used as a parameter of a command handler function, the command is declared with the -bar
option,
allowing other commands to be chained after it with |
.
This has no effect on the execution.
Instances
Show Bar | |
Eq Bar | |
MsgpackDecode Bar | |
Defined in Ribosome.Host.Data.Bar | |
HandlerArg Bar r | |
Defined in Ribosome.Host.Handler.Codec | |
BeforeRegular al Bar => SpecialParam ('OptionState al c ac) Bar | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al c ac) Bar :: OptionState # specialOpt :: Map Text Object # specialArg :: Maybe Text # | |
type TransSpecial ('OptionState al c ac) Bar | |
Defined in Ribosome.Host.Handler.Command |
data Range (style :: RangeStyle) #
When this type is used as a parameter of a command handler function, the command is declared with the -range
option, and when invoked, the argument passed to the handler contains the line range specified by the user, as in:
:5Reverse :5,20Reverse
In the first case, the field $sel:high:Range
is Nothing
.
The type has a phantom parameter of kind RangeStyle
that configures the semantics of the range, as defined by
Neovim (see :help :command-range
).
Instances
Show (Range style) | |
Eq (Range style) | |
MsgpackDecode (Range style) | |
Defined in Ribosome.Host.Data.Range | |
(BeforeRegular al (Range rs), RangeStyleOpt rs) => SpecialParam ('OptionState al c ac) (Range rs) | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al c ac) (Range rs) :: OptionState # specialOpt :: Map Text Object # specialArg :: Maybe Text # | |
type TransSpecial ('OptionState al c ac) (Range rs) | |
Defined in Ribosome.Host.Handler.Command |
data RangeStyle #
Neovim offers different semantics for the command range (see :help :command-range
).
This type determines the position (prefix line number/postfix count) and default values.
RangeFile | Prefix line range, defaulting to the entire file ( |
RangeLine (Maybe Nat) |
|
RangeCount (Maybe Nat) |
|
newtype CommandMods #
When this type is used as a parameter of a command handler function, the RPC trigger uses the special token
q-mods
in the call.
This type then contains the list of pre-command modifiers specified by the user, like :belowright
.
Instances
Show CommandMods | |
Defined in Ribosome.Host.Data.CommandMods showsPrec :: Int -> CommandMods -> ShowS # show :: CommandMods -> String # showList :: [CommandMods] -> ShowS # | |
Eq CommandMods | |
Defined in Ribosome.Host.Data.CommandMods (==) :: CommandMods -> CommandMods -> Bool # (/=) :: CommandMods -> CommandMods -> Bool # | |
MsgpackDecode CommandMods | |
Defined in Ribosome.Host.Data.CommandMods fromMsgpack :: Object -> Either Text CommandMods # missingKey :: String -> Object -> Either Text CommandMods # | |
BeforeRegular al CommandMods => SpecialParam ('OptionState al c ac) CommandMods | |
Defined in Ribosome.Host.Handler.Command type TransSpecial ('OptionState al c ac) CommandMods :: OptionState # specialOpt :: Map Text Object # specialArg :: Maybe Text # | |
type TransSpecial ('OptionState al c ac) CommandMods | |
Defined in Ribosome.Host.Handler.Command |
newtype CommandRegister #
When this type is used as a parameter of a command handler function, the RPC trigger uses the special token
reg
in the call.
This type then contains the name of the register specified by the user.
Instances
class HandlerCodec h (r :: [(Type -> Type) -> Type -> Type]) | h -> r where #
The class of functions that can be converted to canonical RPC handlers of type RpcHandlerFun
.
handlerCodec :: h -> RpcHandlerFun r #
Convert a type containing a Sem
to a canonicalized RpcHandlerFun
by transforming each function parameter with
HandlerArg
.
Instances
MsgpackEncode a => HandlerCodec (Handler r a) r | |
Defined in Ribosome.Host.Handler.Codec handlerCodec :: Handler r a -> RpcHandlerFun r # | |
(HandlerArg a (Stop Report ': r), HandlerCodec b r) => HandlerCodec (a -> b) r | |
Defined in Ribosome.Host.Handler.Codec handlerCodec :: (a -> b) -> RpcHandlerFun r # |
Command Modifiers
modifyCmd :: forall (r :: EffectRow) a. Member Rpc r => Text -> Sem r a -> Sem r a #
Prefix all nvim_commands
called in an action with the given string.
bufdo :: forall (r :: EffectRow) a. Member Rpc r => Buffer -> Sem r a -> Sem r a #
Prefix all nvim_commands
called in an action with bufdo N
where N
is the number of the given buffer.
windo :: forall (r :: EffectRow) a. Member Rpc r => Window -> Sem r a -> Sem r a #
Prefix all nvim_commands
called in an action with windo N
where N
is the number of the given window.
noautocmd :: forall (r :: EffectRow) a. Member Rpc r => Sem r a -> Sem r a #
Prefix all nvim_commands
called in an action with noautocmd
.
silent :: forall (r :: EffectRow) a. Member Rpc r => Sem r a -> Sem r a #
Prefix all nvim_commands
called in an action with silent
.
silentBang :: forall (r :: EffectRow) a. Member Rpc r => Sem r a -> Sem r a #
Prefix all nvim_commands
called in an action with silent!
.
Configuring the host
newtype HostConfig #
The configuration for a host, which consists only of a LogConfig
.
Instances
Generic HostConfig | |
Defined in Ribosome.Host.Data.HostConfig type Rep HostConfig :: Type -> Type # from :: HostConfig -> Rep HostConfig x # to :: Rep HostConfig x -> HostConfig # | |
Show HostConfig | |
Defined in Ribosome.Host.Data.HostConfig showsPrec :: Int -> HostConfig -> ShowS # show :: HostConfig -> String # showList :: [HostConfig] -> ShowS # | |
Default HostConfig | |
Defined in Ribosome.Host.Data.HostConfig def :: HostConfig # | |
Eq HostConfig | |
Defined in Ribosome.Host.Data.HostConfig (==) :: HostConfig -> HostConfig -> Bool # (/=) :: HostConfig -> HostConfig -> Bool # | |
type Rep HostConfig | |
Defined in Ribosome.Host.Data.HostConfig type Rep HostConfig = D1 ('MetaData "HostConfig" "Ribosome.Host.Data.HostConfig" "ribosome-host-0.9.9.9-5mVeOZw909e7nfaEBEbC5r" 'True) (C1 ('MetaCons "HostConfig" 'PrefixI 'True) (S1 ('MetaSel ('Just "hostLog") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 LogConfig))) |
Logging config for a host, with different levels for Neovim echoing, stderr and file logs.
Note that stderr logging will be sent to Neovim when the plugin is running in remote mode, which will be ignored unless the plugin is started with a stderr handler.
LogConfig | |
|
Instances
Generic LogConfig | |
Show LogConfig | |
Default LogConfig | |
Defined in Ribosome.Host.Data.HostConfig | |
Eq LogConfig | |
type Rep LogConfig | |
Defined in Ribosome.Host.Data.HostConfig type Rep LogConfig = D1 ('MetaData "LogConfig" "Ribosome.Host.Data.HostConfig" "ribosome-host-0.9.9.9-5mVeOZw909e7nfaEBEbC5r" 'False) (C1 ('MetaCons "LogConfig" 'PrefixI 'True) ((S1 ('MetaSel ('Just "logFile") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (Path Abs File))) :*: S1 ('MetaSel ('Just "logLevelEcho") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Severity)) :*: (S1 ('MetaSel ('Just "logLevelStderr") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Severity) :*: (S1 ('MetaSel ('Just "logLevelFile") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Severity) :*: S1 ('MetaSel ('Just "dataLogConc") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool))))) |
setStderr :: Severity -> HostConfig -> HostConfig #
Set the stderr level on a HostConfig
.
data PluginConfig c Source #
The full configuration for a Ribosome plugin, consisting of the HostConfig
, the plugin's name, and an arbitrary
type for additional config defined by individual plugins.
Instances
pluginNamed :: PluginName -> PluginConfig () Source #
Construct a simple PluginConfig
with the default config for the host, given the plugin's name.
Reports
Ribosome uses polysemy-resume extensively, which is a concept for tracking errors across interpreters by attaching them to a wrapper effect.
In short, when an interpreter is written for the effect
(which is a symbolic alias for
Rpc
!! RpcError
), every use of the bare effect Resumable
RpcError
Rpc
Rpc
must be converted at some point, with the
possiblity of exposing the error on another interpreter that uses the effect.
Take the effect Scratch
for example, whose interpreter is for the effect
.
In there is the expression:Scratch
!! RpcError
restop @RpcError @Rpc (setScratchContent s text)
The function setScratchContent
has a dependency on the bare effect Rpc
.
The function restop
converts this dependency into
and Rpc
!! RpcError
, meaning that
this expression acknowledges that Stop
RpcError
Rpc
might fail with RpcError
, and rethrows the error, which is then turned into
by the special interpreter combinator Scratch
!! RpcError
interpretResumable
.
Instead of rethrowing, the error can also be caught, by using a combinator like resume
or the operator <!
that is
similar to <$
.
The concept is similar to Error
, with the difference that a Resumable
interpreter can communicate that it throws
this type of error, while with plain Error
, this would have to be tracked manually by the developer.
Since handler functions yield the control flow to Ribosome's internal machinery when returning, all Stop
effects
have to be converted to Report
(which is expected by the request dispatcher and part of the Handler
stack),
and all bare effects like Rpc
have to be resumed or restopped since their interpreters only operate on the
Resumable
variants.
To make this chore a little less verbose, the class Reportable
can be leveraged to convert errors to
Report
, which consists of an Report
and ReportContext
, which optionally identifies the plugin
component that threw the error.
Since RpcError
is an instance of Reportable
, the combinators resumeReport
and mapReport
can be used to
reinterpret to
.Stop
Report
resumeReport :: forall (eff :: (Type -> Type) -> Type -> Type) e (r :: EffectRow) a. (Reportable e, Members '[eff !! e, Stop Report] r) => Sem (eff ': r) a -> Sem r a #
Convert the effect eff
to
and Resumable
err eff
if Stop
Report
err
is an instance of Reportable
.
mapReport :: forall e (r :: EffectRow) a. (Reportable e, Member (Stop Report) r) => Sem (Stop e ': r) a -> Sem r a #
Reinterpret
to Stop
err
if Stop
Report
err
is an instance of Reportable
.
resumeReports :: ResumeReports effs errs r => InterpretersFor effs r #
Resume multiple effects as Report
s.
This needs both effects and errors specified as type applications (though only the shape for the errors).
resumeReports @[Rpc, Settings] @[_, _]
mapReports :: MapReports errs r => InterpretersFor (Stops errs) r #
Map multiple errors to Report
.
This needs the errors specified as type applications.
mapReports @[RpcError, SettingError]
The type used by request handlers and expected by the RPC dispatcher.
Instances
IsString LogReport | |
Defined in Ribosome.Host.Data.Report fromString :: String -> LogReport # | |
Generic LogReport | |
Show LogReport | |
type Rep LogReport | |
Defined in Ribosome.Host.Data.Report type Rep LogReport = D1 ('MetaData "LogReport" "Ribosome.Host.Data.Report" "ribosome-host-0.9.9.9-5mVeOZw909e7nfaEBEbC5r" 'False) (C1 ('MetaCons "LogReport" 'PrefixI 'True) ((S1 ('MetaSel ('Just "report") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Report) :*: S1 ('MetaSel ('Just "echo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool)) :*: (S1 ('MetaSel ('Just "store") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool) :*: S1 ('MetaSel ('Just "context") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ReportContext)))) |
An report with different messages intended to be sent to Neovim and the log, respectively.
Used by request handlers and expected by the RPC dispatcher.
Also contains the Severity
of the report, or minimum log level, which determines whether the report should be
logged and echoed in Neovim, and what kind of highlighting should be used in Neovim (red for errors, orange for
warnings, none for infomrational errors).
The log message may span multiple lines.
Instances
IsString Report | |
Defined in Ribosome.Host.Data.Report fromString :: String -> Report # | |
Show Report | |
Reportable Report | |
Defined in Ribosome.Host.Data.Report | |
MsgpackEncode a => HandlerCodec (Handler r a) r | |
Defined in Ribosome.Host.Handler.Codec handlerCodec :: Handler r a -> RpcHandlerFun r # |
class Reportable e where #
The class of types that are convertible to a Report
.
This is used to create a uniform format for handlers, since control flow is passed on to the internal machinery when
they return.
If an error would be thrown that is not caught by the request dispatcher, the entire plugin would stop, so all Stop
and Resumable
effects need to be converted to Report
before returning (see Errors).
The combinators associated with this class make this task a little less arduous:
data NumbersError = InvalidNumber instance Reportable NumbersError where toReport InvalidNumber = Report "Invalid number!" ["The user entered an invalid number"] Warn count :: Int -> Sem r Int count i = resumeReport @Rpc $ mapReport @NumbersError do when (i == 0) (stop InvalidNumber) nvimGetVar ("number_" <> show i)
Here resumeReport
converts a potential RpcError
from nvimGetVar
to Report
(e.g. if the variable
is not set), while mapReport
uses the instance
to convert the call to Reportable
NumbersError
stop
.
Instances
Reportable Void | |
Defined in Ribosome.Host.Data.Report | |
Reportable PersistError Source # | |
Defined in Ribosome.Data.PersistError toReport :: PersistError -> Report # | |
Reportable PersistPathError Source # | |
Defined in Ribosome.Data.PersistPathError toReport :: PersistPathError -> Report # | |
Reportable SettingError Source # | |
Defined in Ribosome.Data.SettingError toReport :: SettingError -> Report # | |
Reportable Report | |
Defined in Ribosome.Host.Data.Report | |
Reportable RpcError | |
Defined in Ribosome.Host.Data.RpcError |
newtype ReportContext #
The provenance of a report, for use in logs.
Instances
reportContext :: ReportContext -> Text #
Render a ReportContext
by interspersing it with dots, using global
if it is empty.
prefixReportContext :: ReportContext -> Text #
Render a ReportContext
by interspersing it with dots, followed by a colon, using global
if it is empty.
reportContext' :: ReportContext -> Maybe Text #
Render a ReportContext
by interspersing it with dots, returning Nothing
if it is empty.
prefixReportContext' :: ReportContext -> Maybe Text #
Render a ReportContext
by interspersing it with dots, followed by a colon, returning Nothing
if it is empty.
basicReport :: forall (r :: EffectRow) a. (Member (Stop Report) r, HasCallStack) => Text -> [Text] -> Sem r a #
Stop with a LogReport
.
userReport :: Reportable e => e -> Text #
Extract the user message from an instance of Reportable
.
reportMessages :: Report -> Text #
Extract both user and log messages from an Report
, for use in tests.
resumeHoistUserMessage :: forall err (eff :: (Type -> Type) -> Type -> Type) err' (r :: EffectRow). (Reportable err, Members '[eff !! err, Stop err'] r) => (Text -> err') -> InterpreterFor eff r #
Resume an effect with an error that's an instance of Reportable
by passing its user message to a function.
mapUserMessage :: forall err err' (r :: EffectRow). (Reportable err, Member (Stop err') r) => (Text -> err') -> InterpreterFor (Stop err) r #
Map an error that's an instance of Reportable
by passing its user message to a function.
logReport :: Reportable e => Member (DataLog LogReport) r => e -> Sem r () Source #
Convert a value to Report
via Reportable
and send it to the log.
pluginLogReports :: Members [Scratch !! RpcError, Settings !! SettingError, Rpc !! RpcError, Stop Report] r => InterpretersFor [Scratch, Settings, Rpc] r Source #
Resume all plugin effects.
The basic error type for the plugin host, used by the listener, Rpc
and several other components.
Instances
ignoreRpcError :: forall (r :: EffectRow) a. Member (Rpc !! RpcError) r => Sem (Rpc ': r) a -> Sem r () #
onRpcError :: forall (r :: EffectRow) a. Member (Rpc !! RpcError) r => (RpcError -> Sem r a) -> Sem (Rpc ': r) a -> Sem r a #
This type represents the singular fatal error used by Ribosome.
Contrary to all other errors, this one is used with Error
instead of Stop
.
It is only thrown from intialization code of interpreters when operation of the plugin is impossible due to the error
condition.
Instances
IsString BootError | |
Defined in Ribosome.Host.Data.BootError fromString :: String -> BootError # | |
Show BootError | |
Eq BootError | |
Ord BootError | |
Defined in Ribosome.Host.Data.BootError |
data StoredReport #
Data type that attaches a time stamp to a Report
.
Instances
Show StoredReport | |
Defined in Ribosome.Host.Data.StoredReport showsPrec :: Int -> StoredReport -> ShowS # show :: StoredReport -> String # showList :: [StoredReport] -> ShowS # |
data Reports (a :: Type -> Type) b #
This internal effect stores all errors in memory that have been created through the Report
system.
storedReports :: forall (r :: EffectRow). Member Reports r => Sem r (Map ReportContext [StoredReport]) #
Get all reports.
reportStop :: forall err r. Reportable err => Member (DataLog LogReport) r => Sem (Stop err ': r) () -> Sem r () Source #
resumeLogReport :: forall eff e r. Reportable e => Members [eff !! e, DataLog LogReport] r => Sem (eff ': r) () -> Sem r () Source #
Resume an effect by converting the error to a Report
and logging it, continuing execution for a unit action.
interpretUserErrorPrefixed :: Member (Reader PluginName) r => InterpreterFor UserError r Source #
Interpret UserError
by prefixing messages with the plugin name.
Mutex State
data MState s (a :: Type -> Type) b #
A state effect that allows atomic updates with monadic actions.
The constructor muse
is analogous to the usual state
combinator, in that it transforms the state monadically
alongside a return value, but unlike State
and AtomicState
, the callback may be a Sem
.
This is accomplished by locking every call with an MVar
.
For read-only access to the state that doesn't care about currently running updates, the constructor mread
directly
returns the state without consulting the lock.
type ScopedMState s = PScoped s () (MState s) #
mmodify :: forall s (r :: EffectRow). Member (MState s) r => (s -> s) -> Sem r () #
Apply a pure function to the state.
mreads :: forall s (r :: EffectRow) a. Member (MState s) r => (s -> a) -> Sem r a #
Obtain the current state, transformed by a pure function.
mstate :: forall s (r :: EffectRow) a. Member (MState s) r => (s -> (s, a)) -> Sem r a #
Apply a pure function to the state that additionally returns a value.
mtrans :: forall s (r :: EffectRow). Member (MState s) r => (s -> Sem r s) -> Sem r () #
Run a monadic action on the state in a mutually exclusive fashion.
muse :: forall s (r :: EffectRow) a. Member (MState s) r => (s -> Sem r (s, a)) -> Sem r a #
Run a monadic action on the state in a mutually exclusive fashion that additionally returns a value.
stateToMState :: forall s (r :: EffectRow). Member (MState s) r => InterpreterFor (State s :: (Type -> Type) -> Type -> Type) r #
withMState :: forall s (r :: EffectRow). Member (ScopedMState s) r => s -> InterpreterFor (MState s) r #
evalMState :: forall s (r :: [Effect]). s -> InterpreterFor (MState s) r #
interpretMState :: forall mres (r :: EffectRow) s. Members '[Resource, Race, Mask mres, Embed IO] r => s -> InterpreterFor (MState s) r #
Interpret MState
using AtomicState
and Lock
.
interpretMStates :: forall s mres (r :: EffectRow). Members '[Mask mres, Resource, Race, Embed IO] r => InterpreterFor (ScopedMState s) r #
Interpret MState
as a scoped effect.
Misc
simpleHandler :: forall (r :: EffectRow) a. Member (Rpc !! RpcError) r => Sem (Rpc ': (Stop Report ': r)) a -> Handler r a #
noHandlers :: forall (r :: [Effect]). InterpreterFor (Handlers !! Report) r #
Interpret Handlers
by performing no actions.
interpretHandlers :: forall (r :: EffectRow). Members '[Rpc !! RpcError, Log, Error BootError :: (Type -> Type) -> Type -> Type] r => [RpcHandler r] -> InterpreterFor (Handlers !! Report) r #
Interpret Handlers
with a set of RpcHandlers
.
A Neovim register.
Instances
data RegisterType Source #
The type of a Neovim register, corresponding to concepts like line- or character-wise visual mode.
Instances
registerRepr :: Register -> Text Source #
Render a register name as is usual for Neovim.
newtype CustomConfig c Source #
Disambiguation type used for the custom CLI configuration that is polymorphic in the stack.
Instances
Show c => Show (CustomConfig c) Source # | |
Defined in Ribosome.Data.CustomConfig showsPrec :: Int -> CustomConfig c -> ShowS # show :: CustomConfig c -> String # showList :: [CustomConfig c] -> ShowS # | |
Eq c => Eq (CustomConfig c) Source # | |
Defined in Ribosome.Data.CustomConfig (==) :: CustomConfig c -> CustomConfig c -> Bool # (/=) :: CustomConfig c -> CustomConfig c -> Bool # |
Reexports
type (!!) (eff :: (Type -> Type) -> Type -> Type) err = Resumable err eff #
Infix alias for Resumable
.
Member (Stopper !! Boom) r =>
(<!) :: forall err (eff :: (Type -> Type) -> Type -> Type) (r :: EffectRow) a. Member (Resumable err eff) r => a -> Sem (eff ': r) a -> Sem r a #
Operator version of resumeAs
.
Since: polysemy-resume-0.2.0.0
data Stop e (a :: Type -> Type) b #
An effect similar to Error
without the ability to be caught.
Used to signal that an error is supposed to be expected by dependent programs.
interpretStopper :: Member (Stop Boom) r => InterpreterFor Stopper r interpretStopper = interpret \case StopBang -> stop (Bang 13) StopBoom -> stop (Boom "ouch")
Instances
MsgpackEncode a => HandlerCodec (Handler r a) r | |
Defined in Ribosome.Host.Handler.Codec handlerCodec :: Handler r a -> RpcHandlerFun r # |