-- Description: The high-level API to Ribosome module Ribosome ( -- * Introduction -- $intro -- * Creating a project -- $project -- * Handlers -- $handlers -- ** Handler definition RpcHandler (..), Handler, RpcName (..), -- ** Constructing handlers rpcFunction, rpcCommand, rpcAutocmd, rpc, Execution (..), -- * Remote plugin execution #execution# -- $execution runNvimPluginIO, runNvimPluginIO_, runNvimPluginCli, withHandlers, remotePlugin, RemoteStack, runRemoteStack, runRemoteStackCli, interpretPluginRemote, BasicPluginStack, runBasicPluginStack, runCli, NvimPlugin, -- * Interacting with Neovim -- $api Rpc, Request (Request), RpcCall, sync, async, notify, channelId, Buffer, Window, Tabpage, Event (Event), EventName (EventName), -- * Watching variables -- $watched-variables watchVariables, WatchedVariable (..), -- * Embedded Neovim execution -- $embed runEmbedPluginIO, runEmbedPluginIO_, runEmbedPluginCli, embedPlugin, runEmbedStack, runEmbedStackCli, interpretPluginEmbed, -- * MessagePack codec -- $msgpack MsgpackDecode (fromMsgpack), MsgpackEncode (toMsgpack), pattern Msgpack, msgpackArray, msgpackMap, -- * Utility effects -- $util -- ** Settings Settings, Setting (Setting), SettingError, interpretSettingsRpc, -- ** Scratch buffers -- $scratch Scratch, ScratchOptions, scratch, FloatOptions, ScratchId (ScratchId), ScratchState (ScratchState), -- ** Mappings #mappings# -- $mappings Mapping (Mapping), MappingAction (..), MappingId (MappingId), MappingLhs (MappingLhs), MapMode (..), MappingSpec (MappingSpec), mappingFor, eventMapping, activateBufferMapping, activateMapping, -- ** Persisting data across vim sessions Persist, interpretPersist, interpretPersistNull, PersistPath, persistPath, interpretPersistPath, interpretPersistPathSetting, interpretPersistPathAt, PersistError, PersistPathError, -- ** The plugin's name PluginName (PluginName), interpretPluginName, -- * More functionality for handlers -- ** Command completion completeWith, completeBuiltin, CompleteStyle (..), -- ** Special command parameter types #command-params# HandlerArg (handlerArg), CommandHandler (commandOptions), Args (..), ArgList (..), JsonArgs (..), Options (..), OptionParser (..), Bang (..), Bar (..), Range (Range), RangeStyle (..), CommandMods (..), CommandRegister (..), HandlerCodec (handlerCodec), -- * Command Modifiers modifyCmd, bufdo, windo, noautocmd, silent, silentBang, -- * Configuring the host HostConfig (..), LogConfig (..), setStderr, PluginConfig (PluginConfig), pluginNamed, -- * Reports -- $errors resumeReport, mapReport, resumeReports, mapReports, LogReport (LogReport), Report (Report), Reportable (toReport), ReportContext (..), reportContext, prefixReportContext, reportContext', prefixReportContext', basicReport, userReport, reportMessages, resumeHoistUserMessage, mapUserMessage, logReport, pluginLogReports, RpcError, rpcError, ignoreRpcError, onRpcError, BootError (..), StoredReport (..), Reports, storedReports, reportStop, resumeLogReport, UserError, interpretUserErrorPrefixed, -- * Mutex State MState, ScopedMState, mmodify, mread, mreads, mstate, mtrans, muse, stateToMState, withMState, evalMState, interpretMState, interpretMStates, -- * Misc simpleHandler, noHandlers, interpretHandlers, Register, RegisterType, registerRepr, pathText, CustomConfig (CustomConfig), -- * Reexports module Prelate.Prelude, ) where import Prelate.Prelude (Stop, type (!!), ( import Ribosome -- > import Ribosome.Api -- > -- > count :: -- > Members NvimPlugin r => -- > Int -> -- > Handler r Int -- > count n = do -- > s <- 0 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 -- $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']) -- $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. -- $watched-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. -- $api -- -- - The effect 'Rpc' governs access to Neovim's remote API. -- -- - The module [Ribosome.Api.Data]("Ribosome.Api.Data") contains declarative representations of all API calls that are -- listed at @:help api@. -- -- - The module [Ribosome.Api.Effect]("Ribosome.Api.Effect"), reexported from [Ribosome.Api]("Ribosome.Api"), contains -- the same set of API functions, but as callable 'Sem' functions that use the data declarations with 'sync'. -- [Ribosome.Api]("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. -- $embed -- While [remote plugins]("Ribosome#execution") 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](https://hackage.haskell.org/package/ribosome-test/docs/Ribosome-Test.html) 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" [] -- $msgpack -- 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](https://hackage.haskell.org/package/messagepack), simply for the reason that it allows -- easy incremental parsing via [cereal](https://hackage.haskell.org/package/cereal). -- -- All API functions that are declared as taking or returning an 'Data.MessagePack.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) -- $util -- TODO -- $scratch -- 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]("Ribosome.Scratch"). -- $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. -- $errors -- Ribosome uses -- [polysemy-resume](https://hackage.haskell.org/package/polysemy-resume/docs/Polysemy-Resume.html) -- 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 @'Rpc' !! 'RpcError'@ (which is a symbolic alias for -- @'Resumable' 'RpcError' 'Rpc'@), every use of the bare effect '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 @'Scratch' !! 'RpcError'@. -- In there is the expression: -- -- > restop @RpcError @Rpc (setScratchContent s text) -- -- The function @setScratchContent@ has a dependency on the bare effect 'Rpc'. -- The function 'restop' converts this dependency into @'Rpc' !! 'RpcError'@ /and/ @'Stop' 'RpcError'@, meaning that -- this expression acknowledges that 'Rpc' might fail with 'RpcError', and rethrows the error, which is then turned into -- @'Scratch' !! 'RpcError'@ by the special interpreter combinator 'interpretResumable'. -- -- Instead of rethrowing, the error can also be caught, by using a combinator like 'resume' or the operator '