packages feed

ribosome 0.4.0.0 → 0.9.9.9

raw patch · 179 files changed

+4829/−7016 lines, 179 filesdep +exondep +hedgehogdep +optparse-applicativedep −ansi-terminaldep −bytestringdep −cerealdep ~basesetup-changed

Dependencies added: exon, hedgehog, optparse-applicative, polysemy, polysemy-conc, polysemy-plugin, polysemy-test, prelate, ribosome, ribosome-host, ribosome-host-test, tasty

Dependencies removed: ansi-terminal, bytestring, cereal, cereal-conduit, chiasma, composition, composition-extra, conduit, conduit-extra, containers, cornea, data-default, deepseq, directory, either, exceptions, filepath, free, fuzzy, hourglass, hslogger, lens, lifted-async, lifted-base, monad-control, monad-loops, mtl, nvim-hs, pretty-terminal, prettyprinter-ansi-terminal, process, relude, resourcet, safe, split, stm, stm-chans, stm-conduit, template-haskell, text, th-abstraction, time, transformers, transformers-base, typed-process, unix, unliftio, unliftio-core, utf8-string

Dependency ranges changed: base

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2020 Torsten Schmits+Copyright (c) 2022 Torsten Schmits  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− lib/Prelude.hs 
@@ -1,5 +0,0 @@-module Prelude (-  module Ribosome.Prelude-) where--import Ribosome.Prelude
+ lib/Ribosome.hs view
@@ -0,0 +1,586 @@+-- 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 Prelude hiding (async)++import Ribosome.Data.CustomConfig (CustomConfig (CustomConfig))+import Ribosome.Data.FloatOptions (FloatOptions)+import Ribosome.Data.Mapping (+  MapMode (..),+  Mapping (Mapping),+  MappingAction (..),+  MappingId (MappingId),+  MappingLhs (MappingLhs),+  MappingSpec (MappingSpec),+  )+import Ribosome.Data.PersistError (PersistError)+import Ribosome.Data.PersistPathError (PersistPathError)+import Ribosome.Data.PluginConfig (PluginConfig (PluginConfig), pluginNamed)+import Ribosome.Data.PluginName (PluginName (PluginName))+import Ribosome.Data.Register (Register, registerRepr)+import Ribosome.Data.RegisterType (RegisterType)+import Ribosome.Data.ScratchId (ScratchId (ScratchId))+import Ribosome.Data.ScratchOptions (ScratchOptions, scratch)+import Ribosome.Data.ScratchState (ScratchState (ScratchState))+import Ribosome.Data.Setting (Setting (Setting))+import Ribosome.Data.SettingError (SettingError)+import Ribosome.Effect.Persist (Persist)+import Ribosome.Effect.PersistPath (PersistPath, persistPath)+import Ribosome.Effect.Scratch (Scratch)+import Ribosome.Effect.Settings (Settings)+import Ribosome.Effect.VariableWatcher (WatchedVariable (..))+import Ribosome.Embed (+  embedPlugin,+  interpretPluginEmbed,+  runEmbedPluginCli,+  runEmbedPluginIO,+  runEmbedPluginIO_,+  runEmbedStack,+  runEmbedStackCli,+  )+import Ribosome.Host.Api.Data (Buffer, Tabpage, Window)+import Ribosome.Host.Class.Msgpack.Array (msgpackArray)+import Ribosome.Host.Class.Msgpack.Decode (pattern Msgpack, MsgpackDecode (fromMsgpack))+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (toMsgpack))+import Ribosome.Host.Class.Msgpack.Map (msgpackMap)+import Ribosome.Host.Data.Args (ArgList (..), Args (..), JsonArgs (..), OptionParser (..), Options (..))+import Ribosome.Host.Data.Bang (Bang (..))+import Ribosome.Host.Data.Bar (Bar (Bar))+import Ribosome.Host.Data.BootError (BootError (..))+import Ribosome.Host.Data.CommandMods (CommandMods (CommandMods))+import Ribosome.Host.Data.CommandRegister (CommandRegister (CommandRegister))+import Ribosome.Host.Data.Event (Event (Event), EventName (EventName))+import Ribosome.Host.Data.Execution (Execution (..))+import Ribosome.Host.Data.HostConfig (HostConfig (..), LogConfig (..), setStderr)+import Ribosome.Host.Data.Range (Range (Range), RangeStyle (..))+import Ribosome.Host.Data.Report (+  LogReport (LogReport),+  Report (Report),+  ReportContext (..),+  Reportable (toReport),+  basicReport,+  mapReport,+  mapReports,+  mapUserMessage,+  prefixReportContext,+  prefixReportContext',+  reportContext,+  reportContext',+  reportMessages,+  resumeHoistUserMessage,+  resumeReport,+  resumeReports,+  toReport,+  userReport,+  )+import Ribosome.Host.Data.Request (Request (Request))+import Ribosome.Host.Data.RpcCall (RpcCall)+import Ribosome.Host.Data.RpcError (RpcError, rpcError)+import Ribosome.Host.Data.RpcHandler (Handler, RpcHandler (..), simpleHandler)+import Ribosome.Host.Data.RpcName (RpcName (..))+import Ribosome.Host.Data.RpcType (CompleteStyle (..))+import Ribosome.Host.Data.StoredReport (StoredReport (StoredReport))+import Ribosome.Host.Effect.MState (+  MState,+  ScopedMState,+  mmodify,+  mread,+  mreads,+  mstate,+  mtrans,+  muse,+  stateToMState,+  withMState,+  )+import Ribosome.Host.Effect.Reports (Reports, storedReports)+import Ribosome.Host.Effect.Rpc (Rpc, async, channelId, notify, sync)+import Ribosome.Host.Effect.UserError (UserError)+import Ribosome.Host.Error (ignoreRpcError, onRpcError)+import Ribosome.Host.Handler (+  completeBuiltin,+  completeWith,+  rpc,+  rpcAutocmd,+  rpcCommand,+  rpcFunction,+  )+import Ribosome.Host.Handler.Codec (HandlerArg (handlerArg), HandlerCodec (handlerCodec))+import Ribosome.Host.Handler.Command (CommandHandler (commandOptions))+import Ribosome.Host.Interpreter.Handlers (interpretHandlers, noHandlers, withHandlers)+import Ribosome.Host.Interpreter.MState (evalMState, interpretMState, interpretMStates)+import Ribosome.Host.Modify (bufdo, modifyCmd, noautocmd, silent, silentBang, windo)+import Ribosome.Host.Path (pathText)+import Ribosome.IOStack (BasicPluginStack, runBasicPluginStack, runCli)+import Ribosome.Interpreter.Persist (interpretPersist, interpretPersistNull)+import Ribosome.Interpreter.PersistPath (interpretPersistPath, interpretPersistPathAt, interpretPersistPathSetting)+import Ribosome.Interpreter.PluginName (interpretPluginName)+import Ribosome.Interpreter.Settings (interpretSettingsRpc)+import Ribosome.Interpreter.UserError (interpretUserErrorPrefixed)+import Ribosome.Interpreter.VariableWatcher (watchVariables)+import Ribosome.Mapping (activateBufferMapping, activateMapping, eventMapping, mappingFor)+import Ribosome.Remote (+  RemoteStack,+  interpretPluginRemote,+  remotePlugin,+  runNvimPluginCli,+  runNvimPluginIO,+  runNvimPluginIO_,+  runRemoteStack,+  runRemoteStackCli,+  )+import Ribosome.Report (logReport, pluginLogReports, reportStop, resumeLogReport)+import Ribosome.Run (NvimPlugin)++-- $intro+-- This library is a framework for building [Neovim](https://neovim.io) plugins with+-- [Polysemy](https://hackage.haskell.org/package/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++-- $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 '<!' 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'@.
+ lib/Ribosome/Api.hs view
@@ -0,0 +1,40 @@+-- |All exports for the composite and atomic Neovim API functions.+module Ribosome.Api (+  module Ribosome.Api.Autocmd,+  module Ribosome.Api.Buffer,+  FileBuffer (FileBuffer),+  module Ribosome.Api.Echo,+  module Ribosome.Api.Function,+  module Ribosome.Api.Mode,+  module Ribosome.Api.Normal,+  module Ribosome.Api.Option,+  module Ribosome.Api.Path,+  module Ribosome.Api.Position,+  module Ribosome.Api.Process,+  module Ribosome.Api.Register,+  module Ribosome.Api.Sleep,+  module Ribosome.Api.Syntax,+  module Ribosome.Api.Tabpage,+  module Ribosome.Api.Undo,+  module Ribosome.Api.Window,+  module Ribosome.Host.Api.Effect,+) where++import Ribosome.Api.Autocmd+import Ribosome.Api.Buffer+import Ribosome.Api.Echo+import Ribosome.Api.Function+import Ribosome.Api.Mode+import Ribosome.Api.Normal+import Ribosome.Api.Option+import Ribosome.Api.Path+import Ribosome.Api.Position+import Ribosome.Api.Process+import Ribosome.Api.Register+import Ribosome.Api.Sleep+import Ribosome.Api.Syntax+import Ribosome.Api.Tabpage+import Ribosome.Api.Undo+import Ribosome.Api.Window+import Ribosome.Data.FileBuffer (FileBuffer (FileBuffer))+import Ribosome.Host.Api.Effect
− lib/Ribosome/Api/Atomic.hs 
@@ -1,60 +0,0 @@-module Ribosome.Api.Atomic where--import Data.MessagePack (Object(ObjectNil, ObjectArray, ObjectString))-import Neovim.Plugin.Classes (FunctionName(F))-import qualified Ribosome.Nvim.Api.RpcCall as RpcError (RpcError(Atomic))--import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Msgpack.Decode (MsgpackDecode(..), fromMsgpack')-import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))-import Ribosome.Msgpack.Error (DecodeError)-import qualified Ribosome.Msgpack.Util as Util (illegalType)-import Ribosome.Nvim.Api.IO (nvimCallAtomic)-import Ribosome.Nvim.Api.RpcCall (RpcCall(RpcCall))--data AtomicStatus =-  Failure Text-  |-  Success-  deriving (Eq, Show)--instance MsgpackDecode AtomicStatus where-  fromMsgpack ObjectNil =-    Right Success-  fromMsgpack (ObjectArray [_, _, ObjectString msg]) =-    Right (Failure (decodeUtf8 msg))-  fromMsgpack o =-    Util.illegalType "AtomicStatus" o---- |Bundle a list of 'RpcCall's into a single call to nvim_call_atomic.--- The result is checked for an error message, and if it is present, the call will fail.-atomic ::-  MonadDeepError e DecodeError m =>-  NvimE e m =>-  [RpcCall] ->-  m [Object]-atomic calls = do-  (results, statusObject) <- unpack =<< nvimCallAtomic (call <$> calls)-  status <- fromMsgpack' statusObject-  check results status-  where-    call (RpcCall (F name) args) =-      toMsgpack @[Object] [toMsgpack name, toMsgpack args]-    unpack [ObjectArray results, status] =-      return (results, status)-    unpack o =-      throwHoist (RpcError.Atomic ("unexpected result structure: " <> show o))-    check _ (Failure err) =-      throwHoist (RpcError.Atomic err)-    check results Success =-      return results---- |Bundle calls into one and decode all results to the same type.-atomicAs ::-  MonadDeepError e DecodeError m =>-  MsgpackDecode a =>-  NvimE e m =>-  [RpcCall] ->-  m [a]-atomicAs =-  traverse fromMsgpack' <=< atomic
lib/Ribosome/Api/Autocmd.hs view
@@ -1,55 +1,71 @@-module Ribosome.Api.Autocmd where+-- |Autocmd functions.+module Ribosome.Api.Autocmd (+  module Ribosome.Api.Autocmd,+  autocmd,+) where -import Control.Exception.Lifted (bracket)+import Data.MessagePack (Object) -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Msgpack.Encode (toMsgpack)-import Ribosome.Nvim.Api.Data (Buffer)-import Ribosome.Nvim.Api.IO (bufferGetNumber, vimCommand, vimGetOption, vimSetOption)+import Ribosome.Host.Api.Autocmd (autocmd)+import Ribosome.Host.Api.Data (Buffer)+import Ribosome.Host.Api.Effect (bufferGetNumber, nvimExecAutocmds, vimGetOption, vimSetOption)+import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)+import Ribosome.Host.Data.RpcType (AutocmdBuffer (AutocmdBuffer), AutocmdEvents, AutocmdId, AutocmdOptions, target)+import qualified Ribosome.Host.Effect.Rpc as Rpc+import Ribosome.Host.Effect.Rpc (Rpc) +-- |Trigger a set of autocmds.+--+-- Same as 'nvimExecAutocmds', but specializing the parameter type.+doautocmdWith ::+  Member Rpc r =>+  AutocmdEvents ->+  Map Text Object ->+  Sem r ()+doautocmdWith =+  nvimExecAutocmds++-- |Trigger a set of autocmds. doautocmd ::-  NvimE e m =>-  Bool ->-  Text ->-  m ()-doautocmd silent name =-  vimCommand $ pre <> "doautocmd " <> name-  where-    pre =-      if silent then "silent! " else ""+  Member Rpc r =>+  AutocmdEvents ->+  Sem r ()+doautocmd events =+  nvimExecAutocmds events mempty +-- |Trigger a user autocmd. uautocmd ::-  NvimE e m =>-  Bool ->+  Member Rpc r =>   Text ->-  m ()-uautocmd silent name =-  doautocmd silent $ "User " <> name+  Sem r ()+uautocmd name =+  doautocmdWith "User" [("pattern", toMsgpack name)] +-- |Execute an action with all autocmds disabled. eventignore ::-  NvimE e m =>-  MonadBaseControl IO m =>-  m a ->-  m a+  Members [Rpc, Resource] r =>+  Sem r a ->+  Sem r a eventignore =   bracket getAndSet restore . const   where     getAndSet = do-      previous <- vimGetOption "eventignore"-      vimSetOption "eventignore" (toMsgpack ("all" :: Text))-      return previous+      previous :: Text <- vimGetOption "eventignore"+      vimSetOption "eventignore" ("all" :: Text)+      pure previous     restore =       vimSetOption "eventignore" +-- |Create an autocmd in a buffer. bufferAutocmd ::-  NvimE e m =>+  Member Rpc r =>   Buffer ->-  Text ->-  Text ->+  AutocmdEvents ->+  AutocmdOptions ->+  -- |Command to execute when the autocmd triggers.   Text ->-  m ()-bufferAutocmd buffer grp event cmd = do-  number <- bufferGetNumber buffer-  vimCommand $ "augroup " <> grp-  vimCommand $ "autocmd " <> " " <> event <> " <buffer=" <> show number <> "> " <> cmd-  vimCommand "augroup end"+  Sem r AutocmdId+bufferAutocmd buf events options cmd = do+  number <- bufferGetNumber buf+  Rpc.sync do+    autocmd events options { target = Left (AutocmdBuffer number) } cmd
lib/Ribosome/Api/Buffer.hs view
@@ -1,165 +1,245 @@+-- |API functions for buffers. module Ribosome.Api.Buffer where -import Data.MessagePack (Object) import qualified Data.Text as Text (null)-import System.FilePath ((</>))+import Exon (exon)+import Path (Abs, Dir, File, Path, parseAbsFile, parseRelFile, (</>)) -import Ribosome.Api.Atomic (atomicAs) import Ribosome.Api.Path (nvimCwd)-import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Msgpack.Encode (toMsgpack)-import Ribosome.Msgpack.Error (DecodeError)-import Ribosome.Nvim.Api.Data (Buffer)-import qualified Ribosome.Nvim.Api.Data as ApiData (bufferGetName)-import Ribosome.Nvim.Api.IO (+import Ribosome.Data.FileBuffer (FileBuffer (FileBuffer))+import qualified Ribosome.Host.Api.Data as Data+import Ribosome.Host.Api.Data (Buffer)+import Ribosome.Host.Api.Effect (   bufferGetLines,   bufferGetName,   bufferGetNumber,   bufferGetOption,   bufferIsValid,   bufferSetLines,+  nvimBufDelete,+  nvimCallFunction,+  nvimCommand,+  nvimGetCurrentBuf,   nvimWinSetBuf,-  vimCallFunction,-  vimCommand,   vimGetBuffers,   vimGetCurrentBuffer,   vimGetCurrentWindow,   )-import Ribosome.Nvim.Api.RpcCall (RpcError, syncRpcCall)--edit :: NvimE e m => FilePath -> m ()-edit path = vimCommand $ "silent! edit " <> toText path+import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)+import Ribosome.Host.Data.RpcError (RpcError)+import qualified Ribosome.Host.Effect.Rpc as Rpc+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Host.Modify (silentBang)+import Ribosome.Host.Path (pathText) -nvimCallBool :: NvimE e m => Text -> [Object] -> m Bool-nvimCallBool =-  vimCallFunction+-- |Load a 'Path' into a buffer in the current window using @:edit@.+edit ::+  Member Rpc r =>+  Path b t ->+  Sem r ()+edit path =+  silentBang do+    nvimCommand [exon|edit #{pathText path}|] -buflisted :: NvimE e m => Buffer -> m Bool+-- |Call the Neovim function @buflisted@ for a buffer, indicating whether it is shown in the buffer list (@:ls@).+buflisted ::+  Member (Rpc !! RpcError) r =>+  Buffer ->+  Sem r Bool buflisted buf = do-  catchAs @RpcError False do+  resumeAs False do     num <- bufferGetNumber buf-    nvimCallBool "buflisted" [toMsgpack num]+    nvimCallFunction "buflisted" [toMsgpack num] -bufferContent :: NvimE e m => Buffer -> m [Text]+-- |Return the entire content of the given buffer.+bufferContent ::+  Member Rpc r =>+  Buffer ->+  Sem r [Text] bufferContent buffer =   bufferGetLines buffer 0 (-1) False -currentBufferContent :: NvimE e m => m [Text]+-- |Return the entire content of the current buffer.+currentBufferContent ::+  Member Rpc r =>+  Sem r [Text] currentBufferContent =   bufferContent =<< vimGetCurrentBuffer -setBufferContent :: NvimE e m => Buffer -> [Text] -> m ()+-- |Replace the content of the given buffer.+setBufferContent ::+  Member Rpc r =>+  Buffer ->+  [Text] ->+  Sem r () setBufferContent buffer =   bufferSetLines buffer 0 (-1) False -setBufferLine :: NvimE e m => Buffer -> Int -> Text -> m ()-setBufferLine buffer line text =-  bufferSetLines buffer line (line + 1) False [text]-+-- |Replace the content of the current buffer. setCurrentBufferContent ::-  NvimE e m =>+  Member Rpc r =>   [Text] ->-  m ()+  Sem r () setCurrentBufferContent content = do   buffer <- vimGetCurrentBuffer   setBufferContent buffer content +-- |Replace a single line in the given buffer.+setBufferLine ::+  Member Rpc r =>+  Buffer ->+  Int ->+  Text ->+  Sem r ()+setBufferLine buffer line text =+  bufferSetLines buffer line (line + 1) False [text]++-- |Execute an action only if the given buffer is valid, i.e. it exists but may be unloaded.+whenValid ::+  Member Rpc r =>+  (Buffer -> Sem r ()) ->+  Buffer ->+  Sem r ()+whenValid use buffer =+  whenM (bufferIsValid buffer) (use buffer)++-- |Execute an action with the given buffer's number if it is valid. withBufferNumber ::-  NvimE e m =>-  (Int -> m ()) ->+  Member Rpc r =>+  (Int -> Sem r ()) ->   Buffer ->-  m ()-withBufferNumber run buffer =-  whenM (bufferIsValid buffer) (run =<< bufferGetNumber buffer)+  Sem r ()+withBufferNumber run =+ whenValid (run <=< bufferGetNumber) +-- |Force-delete a buffer, discarding changes. closeBuffer ::-  NvimE e m =>+  Member Rpc r =>   Buffer ->-  m ()+  Sem r () closeBuffer =-  withBufferNumber del+  silentBang . withBufferNumber del   where     del number =-      vimCommand ("silent! bdelete! " <> show number)+      nvimCommand [exon|bdelete! #{show number}|] +-- |Force-wipe a buffer, discarding changes. wipeBuffer ::-  NvimE e m =>+  Member Rpc r =>   Buffer ->-  m ()+  Sem r () wipeBuffer =-  withBufferNumber wipe-  where-    wipe number =-      vimCommand ("silent! bwipeout! " <> show number)+  whenValid \ b -> nvimBufDelete b [("force", toMsgpack True)] +-- |Force-unload a buffer, discarding changes. unloadBuffer ::-  NvimE e m =>+  Member Rpc r =>   Buffer ->-  m ()+  Sem r () unloadBuffer =-  withBufferNumber unload-  where-    unload number =-      vimCommand ("silent! bunload! " <> show number)+  whenValid \ b -> nvimBufDelete b [("force", toMsgpack True), ("unload", toMsgpack True)] +-- |Add a buffer to the list without loading it. addBuffer ::-  NvimE e m =>+  Member Rpc r =>   Text ->-  m ()+  Sem r () addBuffer path =-  vimCommand ("badd " <> path)+  nvimCommand [exon|badd #{path}|] -buffersAndNames ::-  MonadIO m =>-  MonadDeepError e DecodeError m =>-  NvimE e m =>-  m [(Buffer, Text)]-buffersAndNames = do+-- |Construct a file buffer from a path if it is parseable.+fileBuffer ::+  Path Abs Dir ->+  Buffer ->+  Text ->+  Maybe FileBuffer+fileBuffer cwd buffer (toString -> path) =+  FileBuffer buffer <$> (parseAbsFile path <|> (cwd </>) <$> parseRelFile path)++-- |Get all buffers in the buffer list whose name is a path.+fileBuffers ::+  Member Rpc r =>+  Sem r [FileBuffer]+fileBuffers = do+  cwd <- nvimCwd   buffers <- vimGetBuffers-  names <- atomicAs (syncRpcCall . ApiData.bufferGetName <$> buffers)-  return (zip buffers names)+  names <- Rpc.sync (foldMap (fmap pure . Data.bufferGetName) buffers)+  pure (catMaybes (zipWith (fileBuffer cwd) buffers names)) +-- |Find the buffer whose name is the given path. bufferForFile ::-  MonadIO m =>-  MonadDeepError e DecodeError m =>-  NvimE e m =>-  Text ->-  m (Maybe Buffer)-bufferForFile target = do-  cwd <- nvimCwd-  fmap fst . find sameBuffer . fmap (second (toText . absolute cwd . toString)) <$> buffersAndNames+  Member Rpc r =>+  Path Abs File ->+  Sem r (Maybe FileBuffer)+bufferForFile target =+  find sameBuffer <$> fileBuffers   where-    sameBuffer (_, name) = name == target-    absolute dir ('.' : '/' : rest) =-      dir </> rest-    absolute _ p@('/' : _) =-      p-    absolute dir path =-      dir </> path+    sameBuffer (FileBuffer _ path) =+      path == target +-- |Return the name of the current buffer. currentBufferName ::-  NvimE e m =>-  m Text+  Member Rpc r =>+  Sem r Text currentBufferName =   bufferGetName =<< vimGetCurrentBuffer +-- |Set the current buffer. setCurrentBuffer ::-  NvimE e m =>+  Member Rpc r =>   Buffer ->-  m ()+  Sem r () setCurrentBuffer buf = do   win <- vimGetCurrentWindow   nvimWinSetBuf win buf +-- |Indicate whether the given buffer is a file, i.e. has empty @buftype@. bufferIsFile ::-  NvimE e m =>+  Member Rpc r =>   Buffer ->-  m Bool+  Sem r Bool bufferIsFile buf =   Text.null <$> bufferGetOption buf "buftype" +-- |Return the number of buffers in the list. bufferCount ::-  NvimE e m =>-  m Natural+  Member Rpc r =>+  Sem r Natural bufferCount =   fromIntegral . length <$> vimGetBuffers++-- |Return the file system path of the given buffer, if its name is a valid path.+bufferPath ::+  Member Rpc r =>+  Buffer ->+  Sem r (Maybe (Path Abs File))+bufferPath buffer = do+  Rpc.sync do+    cwd <- Data.vimCallFunction "getcwd" []+    name <- Data.bufferGetName buffer+    pure (fileBuffer cwd buffer name <&> \ (FileBuffer _ path) -> path)++-- |Return the file system path of the current buffer, if its name is a valid path.+currentBufferPath ::+  Member Rpc r =>+  Sem r (Maybe (Path Abs File))+currentBufferPath =+  bufferPath =<< nvimGetCurrentBuf++-- |Filter out the unlisted buffers from the given list.+filterListed ::+  Member Rpc r =>+  [Buffer] ->+  Sem r [Buffer]+filterListed bufs = do+  nums <- Rpc.sync (traverse Data.bufferGetNumber bufs)+  listedFlags <- Rpc.sync (traverse (Data.nvimCallFunction "buflisted" . pure . toMsgpack) nums)+  let listed = mapMaybe chooseListed (zip bufs listedFlags)+  buftypes :: [Text] <- Rpc.sync (traverse (\ buf -> Data.bufferGetOption buf "buftype") listed)+  pure (mapMaybe chooseEmptyTypes (zip bufs buftypes))+  where+    chooseListed (b, l) =+      if l then Just b else Nothing+    chooseEmptyTypes = \case+      (b, "") -> Just b+      (_, _) -> Nothing
+ lib/Ribosome/Api/Data.hs view
@@ -0,0 +1,6 @@+-- |Reexport of the declarative Neovim API+module Ribosome.Api.Data (+  module Ribosome.Host.Api.Data+) where++import Ribosome.Host.Api.Data
lib/Ribosome/Api/Echo.hs view
@@ -1,46 +1,53 @@+-- |API functions for echoing messages in Neovim. module Ribosome.Api.Echo where -import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, pluginName)-import Ribosome.Data.Text (escapeQuotes)-import Ribosome.Nvim.Api.IO (vimCommand)+import Ribosome.Data.PluginName (PluginName)+import Ribosome.Host.Api.Effect (nvimEcho)+import Ribosome.Host.Class.Msgpack.Array (msgpackArray)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.PluginName (pluginNamePrefixed) -echoWith :: NvimE e m => Text -> Text -> m ()-echoWith cmd msg =-  vimCommand $ cmd <> " '" <> escapeQuotes msg <> "'"+-- |Echo a string, adding it to the message history if the first argument is 'True'.+simpleEcho ::+  Member Rpc r =>+  Bool ->+  Text ->+  Sem r ()+simpleEcho history msg =+  nvimEcho [msgpackArray msg] history mempty -echoWithName :: MonadRibo m => NvimE e m => Text -> Text -> m ()-echoWithName cmd msg = do-  name <- pluginName-  echoWith cmd $ name <> ": " <> msg+-- |Echo a string prefixed with the plugin name, adding it to the message history if the first argument is 'True'.+prefixedEcho ::+  Members [Rpc, Reader PluginName] r =>+  Bool ->+  Text ->+  Sem r ()+prefixedEcho history msg = do+  pref <- pluginNamePrefixed msg+  simpleEcho history pref -echo' :: NvimE e m => Text -> m ()-echo' =-  echoWith "echo"+-- |Echo a string with a highlight group.+echohl ::+  Member Rpc r =>+  Bool ->+  Text ->+  Text ->+  Sem r ()+echohl history hl msg =+  nvimEcho [msgpackArray msg hl] history mempty -echo :: MonadRibo m => NvimE e m => Text -> m ()+-- |Echo a string prefixed with the plugin name, without adding it to the message history.+echo ::+  Members [Rpc, Reader PluginName] r =>+  Text ->+  Sem r () echo =-  echoWithName "echo"--echom' :: NvimE e m => Text -> m ()-echom' =-  echoWith "echom"+  prefixedEcho False -echom :: MonadRibo m => NvimE e m => Text -> m ()+-- |Echo a string prefixed with the plugin name and add it to the message history.+echom ::+  Members [Rpc, Reader PluginName] r =>+  Text ->+  Sem r () echom =-  echoWithName "echom"--echomS ::-  MonadRibo m =>-  NvimE e m =>-  Show a =>-  a ->-  m ()-echomS = echom . show--echon :: MonadRibo m => NvimE e m => Text -> m ()-echon =-  echoWithName "echom"--echohl :: NvimE e m => Text -> m ()-echohl =-  vimCommand . ("echohl " <>)+  prefixedEcho True
− lib/Ribosome/Api/Exists.hs 
@@ -1,115 +0,0 @@-module Ribosome.Api.Exists where--import Data.Text.Prettyprint.Doc (viaShow, (<+>))-import Neovim (AnsiStyle, Doc, Object(ObjectInt))--import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Msgpack.Decode (MsgpackDecode, fromMsgpack)-import Ribosome.Msgpack.Encode (toMsgpack)-import Ribosome.Nvim.Api.IO (vimCallFunction)-import Ribosome.System.Time (epochSeconds, sleep)--data Retry =-  Retry Int Double-  deriving Show--instance Default Retry where-  def = Retry 3 0.1--retry ::-  MonadIO f =>-  f a ->-  (a -> f (Either c b)) ->-  Retry ->-  f (Either c b)-retry thunk check (Retry timeout interval) = do-  start <- epochSeconds-  step start-  where-    step start = do-      result <- thunk-      checked <- check result-      recurse start checked-    recurse _ (Right b) = return (Right b)-    recurse start (Left e) = do-      current <- epochSeconds-      if (current - start) < timeout-      then do-        sleep interval-        step start-      else return $ Left e--waitFor ::-  NvimE e m =>-  MonadIO m =>-  m Object ->-  (Object -> m (Either (Doc AnsiStyle) b)) ->-  Retry ->-  m (Either (Doc AnsiStyle) b)-waitFor thunk check' =-  retry thunk check-  where-    check result =-      case fromMsgpack result of-        Right a -> check' a-        Left e -> return $ Left e--existsResult :: Object -> Either (Doc AnsiStyle) ()-existsResult (ObjectInt 1) = Right ()-existsResult a =-  Left $ "weird return type " <+> viaShow a--vimExists ::-  NvimE e m =>-  Text ->-  m Object-vimExists entity =-  vimCallFunction "exists" [toMsgpack entity]--vimDoesExist ::-  NvimE e m =>-  Text ->-  m Bool-vimDoesExist entity =-  fmap (isRight . existsResult) (vimExists entity)--function ::-  NvimE e m =>-  Text ->-  m Bool-function name =-  vimDoesExist ("*" <> name)--waitForFunction ::-  NvimE e m =>-  MonadIO m =>-  Text ->-  Retry ->-  m (Either (Doc AnsiStyle) ())-waitForFunction name =-  waitFor thunk (return . existsResult)-  where-    thunk = vimExists ("*" <> name)--waitForFunctionResult ::-  NvimE e m =>-  MonadIO m =>-  Eq a =>-  Show a =>-  MsgpackDecode a =>-  Text ->-  a ->-  Retry ->-  m (Either (Doc AnsiStyle) ())-waitForFunctionResult name a retry' =-  waitForFunction name retry' >>= \case-    Right _ -> waitFor thunk (return . check . fromMsgpack) retry'-    Left e -> return (Left e)-  where-    thunk = vimCallFunction name []-    check (Right a') | a == a' =-      Right ()-    check (Right a') =-      Left $ "results differ:" <+> show a <+> "/" <+> show a'-    check (Left e) =-      Left $ "weird return type: " <+> e
lib/Ribosome/Api/Function.hs view
@@ -1,18 +1,24 @@+-- |Defining Neovim functions. module Ribosome.Api.Function where -import qualified Data.Text as Text (intercalate)+import qualified Data.Text as Text+import Exon (exon) -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Nvim.Api.IO (vimCommand)+import Ribosome.Host.Api.Effect (nvimExec)+import Ribosome.Host.Effect.Rpc (Rpc) +-- |Define a Neovim function. defineFunction ::-  NvimE e m =>+  Member Rpc r =>+  -- |Function name.   Text ->+  -- |Function parameters.   [Text] ->+  -- |Vimscript lines that form the function body.   [Text] ->-  m ()+  Sem r () defineFunction name params body =-  vimCommand $ unlines $ sig : body ++ ["endfunction"]+  void $ nvimExec (unlines (sig : body ++ ["endfunction"])) True   where     sig =-      "function! " <> name <> "(" <> Text.intercalate ", " params <> ")"+      [exon|function! #{name}(#{Text.intercalate ", " params})|]
lib/Ribosome/Api/Input.hs view
@@ -1,17 +1,53 @@+-- |Functions for simulating user input in tests. module Ribosome.Api.Input where -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Nvim.Api.IO (vimInput)-import Ribosome.System.Time (sleep)+import Conc (withAsync_)+import qualified Polysemy.Time as Time+import Time (MilliSeconds, NanoSeconds, convert) +import Ribosome.Host.Api.Effect (nvimInput, nvimReplaceTermcodes, nvimFeedkeys)+import Ribosome.Host.Effect.Rpc (Rpc)++-- |Send a list of character sequences as user input to Neovim with an optional wait interval.+--+-- Uses @nvim_input@. syntheticInput ::-  MonadIO m =>-  NvimE e m =>-  Maybe Double ->+  Members [Rpc, Time t d] r =>+  Maybe NanoSeconds ->   [Text] ->-  m ()+  Sem r () syntheticInput interval =-  traverse_ send-  where-    send c =-      traverse_ sleep interval *> vimInput c+  traverse_ \ c ->+    traverse_ Time.sleep interval *> nvimInput c++-- |Send a sequence of keys using @nvim_feedkeys@ after replacing terminal codes.+feedKey ::+  Member Rpc r =>+  Text ->+  Sem r ()+feedKey k = do+  key <- nvimReplaceTermcodes k True False True+  nvimFeedkeys key "mt" False++-- |Send a list of character sequences as user input to Neovim with an optional wait interval.+--+-- Uses @nvim_feedkeys@.+syntheticInputFk ::+  Members [Rpc, Time t d] r =>+  Maybe NanoSeconds ->+  [Text] ->+  Sem r ()+syntheticInputFk interval =+  traverse_ \ c ->+    traverse_ Time.sleep interval *> feedKey c++-- |Run an action after forking a thread that sends user input to Neovim. +withInput ::+  Members [Rpc, Resource, Race, Async, Time t d] r =>+  Maybe MilliSeconds ->+  Maybe MilliSeconds ->+  [Text] ->+  Sem r a ->+  Sem r a+withInput delay interval chrs =+  withAsync_ (traverse_ Time.sleep delay *> syntheticInput (convert <$> interval) chrs)
lib/Ribosome/Api/Mode.hs view
@@ -1,10 +1,13 @@+-- |API functions for obtaining Neovim's current mode. module Ribosome.Api.Mode where -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Msgpack.Decode (MsgpackDecode(..), msgpackFromString)-import Ribosome.Nvim.Api.IO (vimCallFunction)+import Ribosome.Data.Mode (NvimMode)+import Ribosome.Host.Api.Effect (nvimGetMode, vimCallFunction)+import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode (..), msgpackFromString)+import Ribosome.Host.Effect.Rpc (Rpc) -data NvimMode =+-- |An encoding of Neovim's mode for only the most basic variants.+data SimpleMode =   Normal   |   Visual@@ -12,9 +15,9 @@   Insert   |   Other Text-  deriving (Eq, Show)+  deriving stock (Eq, Show) -instance IsString NvimMode where+instance IsString SimpleMode where   fromString "n" = Normal   fromString "v" = Visual   fromString "V" = Visual@@ -22,17 +25,27 @@   fromString "i" = Insert   fromString a = Other (toText a) -instance MsgpackDecode NvimMode where-  fromMsgpack = msgpackFromString "NvimMode"+instance MsgpackDecode SimpleMode where+  fromMsgpack =+    msgpackFromString "SimpleMode" -mode ::-  NvimE e m =>-  m NvimMode-mode =+-- |Get the current mode as a 'SimpleMode'.+simpleMode ::+  Member Rpc r =>+  Sem r SimpleMode+simpleMode =   vimCallFunction "mode" [] +-- |Indicate whether Neovim is in visual mode. visualModeActive ::-  NvimE e m =>-  m Bool+  Member Rpc r =>+  Sem r Bool visualModeActive =-  (== Visual) <$> mode+  (== Visual) <$> simpleMode++-- |Get the current mode.+mode ::+  Member Rpc r =>+  Sem r NvimMode+mode =+  nvimGetMode
lib/Ribosome/Api/Normal.hs view
@@ -1,25 +1,23 @@+-- |Functions for triggering normal mode commands. module Ribosome.Api.Normal where -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Nvim.Api.IO (vimCommand)+import Ribosome.Host.Api.Effect (nvimCommand) +import Ribosome.Host.Effect.Rpc (Rpc)+import Exon (exon)++-- |Execute a sequence of characters in normal mode that may trigger mappings. normalm ::-  NvimE e m =>+  Member Rpc r =>   Text ->-  m ()+  Sem r () normalm cmd =-  vimCommand $ "normal " <> cmd+  nvimCommand [exon|normal #{cmd}|] +-- |Execute a sequence of characters in normal mode that may not trigger mappings. normal ::-  NvimE e m =>+  Member Rpc r =>   Text ->-  m ()+  Sem r () normal cmd =-  vimCommand $ "normal! " <> cmd--noautocmdNormal ::-  NvimE e m =>-  Text ->-  m ()-noautocmdNormal cmd =-  vimCommand $ "noautocmd normal! " <> cmd+  nvimCommand [exon|normal! #{cmd}|]
lib/Ribosome/Api/Option.hs view
@@ -1,40 +1,54 @@+-- |API functions for Neovim options. module Ribosome.Api.Option where -import Control.Exception.Lifted (bracket)+import Data.MessagePack (Object) import Data.Text (splitOn)+import Exon (exon) -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))-import Ribosome.Nvim.Api.IO (vimGetOption, vimSetOption)+import Ribosome.Host.Api.Effect (vimGetOption, vimSetOption)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode)+import Ribosome.Host.Effect.Rpc (Rpc) -optionCat :: NvimE e m => Text -> Text -> m ()+-- |Append a string to a comma-separated option.+optionCat ::+  Member Rpc r =>+  Text ->+  Text ->+  Sem r () optionCat name extra = do   current <- vimGetOption name-  vimSetOption name $ toMsgpack $ current <> "," <> extra--rtpCat :: NvimE e m => Text -> m ()-rtpCat = optionCat "runtimepath"+  vimSetOption name [exon|#{current},#{extra}|] -optionString :: NvimE e m => Text -> m Text-optionString = vimGetOption+-- |Append a string to the option @runtimepath@.+rtpCat ::+  Member Rpc r =>+  Text ->+  Sem r ()+rtpCat =+  optionCat "runtimepath" -optionList :: NvimE e m => Text -> m [Text]+-- |Get a list of strings from a comma-separated option.+optionList ::+  Member Rpc r =>+  Text ->+  Sem r [Text] optionList name = do   s <- vimGetOption name-  return $ splitOn "," s+  pure (splitOn "," s) +-- |Run an action with an option temporarily set to a value, then restore the old value. withOption ::-  NvimE e m =>+  ∀ a r b .+  Members [Rpc, Resource] r =>   MsgpackEncode a =>-  MonadBaseControl IO m =>   Text ->   a ->-  m b ->-  m b+  Sem r b ->+  Sem r b withOption name value =-  bracket set reset . const+  bracket setOpt reset . const   where-    set =-      vimGetOption name <* vimSetOption name (toMsgpack value)+    setOpt =+      vimGetOption @Object name <* vimSetOption name value     reset =       vimSetOption name
lib/Ribosome/Api/Path.hs view
@@ -1,7 +1,77 @@+-- |API function for file system paths. module Ribosome.Api.Path where -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Nvim.Api.IO (vimCallFunction)+import Exon (exon)+import Path (Abs, Dir, File, Path, SomeBase (Abs, Rel), parseSomeDir, parseSomeFile, (</>)) -nvimCwd :: NvimE e m => m FilePath-nvimCwd = vimCallFunction "getcwd" []+import Ribosome.Host.Api.Effect (nvimCommand, vimCallFunction)+import Ribosome.Host.Data.Report (Report)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Internal.Path (failInvalidPath)+import Ribosome.Host.Path (pathText)++-- |Get Neovim's current working directory.+nvimCwd ::+  Member Rpc r =>+  Sem r (Path Abs Dir)+nvimCwd =+  vimCallFunction "getcwd" []++-- |Set Neovim's current working directory.+nvimSetCwd ::+  Member Rpc r =>+  Path Abs Dir ->+  Sem r ()+nvimSetCwd dir =+  nvimCommand [exon|cd #{pathText dir}|]++-- |Convert an abstract path to an absolute one, using Neovim's current working directory as the base for relative+-- paths.+nvimRelativePath ::+  Member Rpc r =>+  SomeBase t ->+  Sem r (Path Abs t)+nvimRelativePath = \case+  Abs p ->+    pure p+  Rel p -> do+    cwd <- nvimCwd+    pure (cwd </> p)++-- |Parse a directory path and prepend Neovim's current working directory to it if it's relative.+parseNvimDir ::+  Member Rpc r =>+  Text ->+  Sem r (Maybe (Path Abs Dir))+parseNvimDir "" =+  Just <$> nvimCwd+parseNvimDir p =+  traverse nvimRelativePath (parseSomeDir (toString p))++-- |Parse a file path and prepend Neovim's current working directory to it if it's relative.+parseNvimFile ::+  Member Rpc r =>+  Text ->+  Sem r (Maybe (Path Abs File))+parseNvimFile =+  traverse nvimRelativePath . parseSomeFile . toString++-- |Parse a directory path and prepend Neovim's current working directory to it if it's relative.+--+-- If parsing fails, emit an error 'Report'.+nvimDir ::+  Members [Rpc, Stop Report] r =>+  Text ->+  Sem r (Path Abs Dir)+nvimDir spec =+  failInvalidPath spec =<< parseNvimDir spec++-- |Parse a file path and prepend Neovim's current working directory to it if it's relative.+--+-- If parsing fails, emit an error 'Report'.+nvimFile ::+  Members [Rpc, Stop Report] r =>+  Text ->+  Sem r (Path Abs File)+nvimFile spec =+  failInvalidPath spec =<< parseNvimFile spec
+ lib/Ribosome/Api/Position.hs view
@@ -0,0 +1,34 @@+-- |API functions for @getpos@.+module Ribosome.Api.Position where++import Ribosome.Host.Api.Data (nvimCallFunction)+import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)+import Ribosome.Host.Data.RpcCall (RpcCall)+import qualified Ribosome.Host.Effect.Rpc as Rpc+import Ribosome.Host.Effect.Rpc (Rpc)++-- |'RpcCall' for the function @getpos@ that returns a 4-tuple.+getposCall ::+  Text ->+  RpcCall (Int, Int, Int, Int)+getposCall expr =+  nvimCallFunction "getpos" [toMsgpack expr]++-- |Call the function @getpos@ and return a 4-tuple.+getpos ::+  Member Rpc r =>+  Text ->+  Sem r (Int, Int, Int, Int)+getpos =+  Rpc.sync . getposCall++-- |Return the start and end coordinates of visual mode.+visualPos ::+  Member Rpc r =>+  Sem r ((Int, Int), (Int, Int))+visualPos = do+  ((_, lnumStart, colStart, _), (_, lnumEnd, colEnd, _)) <- Rpc.sync do+    start <- getposCall "'<"+    end <- getposCall "'>"+    pure (start, end)+  pure ((lnumStart, colStart), (lnumEnd, colEnd))
lib/Ribosome/Api/Process.hs view
@@ -1,9 +1,12 @@+-- |API functions for process IDs. module Ribosome.Api.Process where -import Ribosome.Control.Monad.Ribo (Nvim)-import Ribosome.Nvim.Api.IO (vimCallFunction)-import Ribosome.Nvim.Api.RpcCall (RpcError)+import Ribosome.Host.Api.Effect (vimCallFunction)+import Ribosome.Host.Effect.Rpc (Rpc) -vimPid :: (MonadDeepError e RpcError m, Nvim m) => m Int+-- |Return Neovim's process ID.+vimPid ::+  Member Rpc r =>+  Sem r Int vimPid =   vimCallFunction "getpid" []
lib/Ribosome/Api/Register.hs view
@@ -1,68 +1,87 @@+-- |API functions for registers. module Ribosome.Api.Register where -import Ribosome.Control.Monad.Ribo (NvimE) import Ribosome.Data.Register (Register)-import qualified Ribosome.Data.Register as Register (Register(..))+import qualified Ribosome.Data.Register as Register (Register (..)) import Ribosome.Data.RegisterType (RegisterType)-import qualified Ribosome.Data.RegisterType as RegisterType (RegisterType(..))-import Ribosome.Msgpack.Decode (MsgpackDecode)-import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))-import Ribosome.Nvim.Api.IO (vimCallFunction)+import qualified Ribosome.Data.RegisterType as RegisterType (RegisterType (..))+import Ribosome.Host.Api.Effect (vimCallFunction)+import Ribosome.Host.Class.Msgpack.Array (msgpackArray)+import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (toMsgpack))+import Ribosome.Host.Effect.Rpc (Rpc) +-- |The special register referring to the primary X11 selection. starRegister :: Register starRegister =   Register.Special "*" +-- |The special register referring to the clipboard X11 selection.+plusRegister :: Register+plusRegister =+  Register.Special "+"++-- |The special register referring to the unnamed register. unnamedRegister :: Register unnamedRegister =   Register.Special "\"" +-- |Set a Neovim register's contents, using the specified type.+--+-- A register's type determines whether the contents are supposed to be pasted as lines or characters, for example. setregAs ::-  NvimE e m =>+  Member Rpc r =>   MsgpackEncode a =>   RegisterType ->   Register ->   a ->-  m ()+  Sem r () setregAs regType register text =-  vimCallFunction "setreg" [toMsgpack register, toMsgpack text, toMsgpack regType]+  vimCallFunction "setreg" (msgpackArray register text regType) +-- |Set a Neovim register's contents as inline characters. setreg ::-  NvimE e m =>+  Member Rpc r =>   Register ->   Text ->-  m ()+  Sem r () setreg =   setregAs RegisterType.Character +-- |Set a Neovim register's contents as whole lines. setregLine ::-  NvimE e m =>+  Member Rpc r =>   Register ->   [Text] ->-  m ()+  Sem r () setregLine =   setregAs RegisterType.Line +-- |Get the type of a register's contents. getregtype ::-  NvimE e m =>+  Member Rpc r =>   Register ->-  m RegisterType+  Sem r RegisterType getregtype register =   vimCallFunction "getregtype" [toMsgpack register] +-- |Get a Neovim register's contents, using the specified type.+--+-- A register's type determines whether the contents are supposed to be pasted as lines or characters, for example. getregAs ::-  NvimE e m =>+  Member Rpc r =>   MsgpackDecode a =>   Bool ->   Register ->-  m a+  Sem r a getregAs list register =-  vimCallFunction "getreg" [toMsgpack register, toMsgpack (0 :: Int), toMsgpack list]+  vimCallFunction "getreg" (msgpackArray register (0 :: Int) list) +-- |Get a Neovim register's contents as inline characters. getreg ::-  NvimE e m =>+  Member Rpc r =>   Register ->-  m (Either [Text] Text)+  Sem r (Either [Text] Text) getreg register =   withType =<< getregtype register   where@@ -71,9 +90,10 @@     withType _ =       Right <$> getregAs False register -getregList ::-  NvimE e m =>+-- |Get a Neovim register's contents as whole lines.+getregLines ::+  Member Rpc r =>   Register ->-  m [Text]-getregList =+  Sem r [Text]+getregLines =   getregAs True
− lib/Ribosome/Api/Response.hs 
@@ -1,26 +0,0 @@-module Ribosome.Api.Response(-  nvimFatal,-  nvimResponseString,-  nvimResponseStringArray,-  nvimValidateFatal,-)-where--import Neovim--nvimFatal :: Either NeovimException a -> Neovim env a-nvimFatal (Right a) = return a-nvimFatal (Left e) = (liftIO . fail . show) e--nvimResponseString :: Object -> Neovim env Text-nvimResponseString (ObjectString a) = return $ decodeUtf8 a-nvimResponseString a = liftIO . fail $ "invalid nvim type for Text: " <> show a--nvimResponseStringArray :: Object -> Neovim env [Text]-nvimResponseStringArray (ObjectArray a) = traverse nvimResponseString a-nvimResponseStringArray a = liftIO . fail $ "invalid nvim type for Array: " <> show a--nvimValidateFatal :: (Object -> Neovim env a) -> Either NeovimException Object -> Neovim env a-nvimValidateFatal validate response = do-  result <- nvimFatal response-  validate result
lib/Ribosome/Api/Sleep.hs view
@@ -1,18 +1,23 @@+-- |API functions for sleeping in Neovim. module Ribosome.Api.Sleep where -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Nvim.Api.IO (vimCommand)+import Exon (exon) +import Ribosome.Host.Api.Effect (nvimCommand)+import Ribosome.Host.Effect.Rpc (Rpc)++-- |Run the @sleep@ command. nvimSleep ::-  NvimE e m =>+  Member Rpc r =>   Int ->-  m ()+  Sem r () nvimSleep interval =-  vimCommand $ "sleep " <> show interval+  nvimCommand [exon|sleep #{show interval}|] +-- |Run the @sleep@ command with the number interpreted as milliseconds. nvimMSleep ::-  NvimE e m =>+  Member Rpc r =>   Int ->-  m ()+  Sem r () nvimMSleep interval =-  vimCommand $ "sleep " <> show interval <> "m"+  nvimCommand [exon|sleep #{show interval}m|]
lib/Ribosome/Api/Syntax.hs view
@@ -1,107 +1,38 @@+-- |API functions for applying syntax rules to Neovim. module Ribosome.Api.Syntax where -import qualified Data.Map.Strict as Map (toList)-import Data.MessagePack (Object)-import Neovim.Plugin.Classes (FunctionName(F))--import Ribosome.Api.Atomic (atomic)-import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Data.Syntax (-  HiLink(HiLink),-  Highlight(Highlight),-  Syntax(Syntax),-  SyntaxItem(SyntaxItem),-  SyntaxItemDetail(Keyword, Match, Region, Verbatim),-  )-import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))-import Ribosome.Msgpack.Error (DecodeError)-import Ribosome.Nvim.Api.Data (Window)-import Ribosome.Nvim.Api.IO (nvimWinGetNumber, vimCallFunction, vimGetCurrentWindow, vimSetCurrentWindow)-import Ribosome.Nvim.Api.RpcCall (RpcCall(RpcCall))--joinEquals :: Map Text Text -> Text-joinEquals =-  unwords . (equals <$$> Map.toList)-  where-    equals (a, b) = a <> "=" <> b--rpcCommand :: [Text] -> RpcCall-rpcCommand cmd =-  RpcCall (F "nvim_command") [toMsgpack $ unwords cmd]--synPattern :: Text -> Text-synPattern text =-  "/" <> text <> "/"--namedPattern :: Text -> Text -> Text -> Text-namedPattern param text offset =-  param <> "=" <> synPattern text <> offset--syntaxItemDetailCmd :: SyntaxItemDetail -> [Text]-syntaxItemDetailCmd (Keyword group' keyword keywords) =-  ["syntax", "keyword", group', keyword, unwords keywords]-syntaxItemDetailCmd (Match group' pat) =-  ["syntax", "match", group', synPattern pat]-syntaxItemDetailCmd (Region group' start end skip ms me) =-  ["syntax", "region", group', namedPattern "start" start ms] <> foldMap skipArg skip <> [namedPattern "end" end me]-  where-    skipArg a = [namedPattern "skip" a ""]-syntaxItemDetailCmd (Verbatim cmd) =-  [cmd]--syntaxItemCmd :: SyntaxItem -> [Text]-syntaxItemCmd (SyntaxItem detail options params) =-  syntaxItemDetailCmd detail <> [unwords options, joinEquals params]--highlightCmd :: Highlight -> [Text]-highlightCmd (Highlight group' values) =-  ["highlight", group', joinEquals values]--hilinkCmd :: HiLink -> [Text]-hilinkCmd (HiLink group' target) =-  ["highlight", "link", group', target]--syntaxCmds :: Syntax -> [[Text]]-syntaxCmds (Syntax items highlights hilinks) =-  (syntaxItemCmd <$> items) <> (highlightCmd <$> highlights) <> (hilinkCmd <$> hilinks)+import Ribosome.Data.Syntax (Syntax)+import Ribosome.Host.Api.Data (Window)+import Ribosome.Host.Api.Effect (vimCallFunction)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (toMsgpack))+import qualified Ribosome.Host.Effect.Rpc as Rpc+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Host.Modify (windo)+import Ribosome.Internal.Syntax (catCmds, syntaxCmds) +-- |Apply syntax rules to the current window. executeSyntax ::-  MonadDeepError e DecodeError m =>-  NvimE e m =>+  Member Rpc r =>   Syntax ->-  m [Object]+  Sem r () executeSyntax =-  atomic . (rpcCommand <$$> syntaxCmds)--executeCurrentWindowSyntax ::-  MonadDeepError e DecodeError m =>-  NvimE e m =>-  Syntax ->-  m [Object]-executeCurrentWindowSyntax syntax =-  atomic $ rpcCommand <$> syntaxCmds syntax+  Rpc.sync . catCmds . syntaxCmds +-- |Apply syntax rules to a window. executeWindowSyntax ::-  MonadDeepError e DecodeError m =>-  NvimE e m =>+  Member Rpc r =>   Window ->   Syntax ->-  m [Object]-executeWindowSyntax win syntax = do-  previous <- vimGetCurrentWindow-  number <- nvimWinGetNumber win-  exec number <* vimSetCurrentWindow previous-  where-    exec number =-      atomic $ wrapCmd (show number <> "windo") <$> syntaxCmds syntax-    wrapCmd wrap cmd =-      rpcCommand (wrap : cmd)+  Sem r ()+executeWindowSyntax win syntax =+  windo win (executeSyntax syntax) +-- |Get the name of the syntax group at a given position. syntaxName ::-  NvimE e m =>+  Member Rpc r =>   Int ->   Int ->-  m (Text, Text)+  Sem r (Text, Text) syntaxName l c = do   synId <- vimCallFunction "synID" (toMsgpack <$> [l, c, 0])-  tuple (vimCallFunction "getline" [toMsgpack l]) (vimCallFunction "synIDattr" [synId, toMsgpack ("name" :: Text)])+  (,) <$> vimCallFunction "getline" [toMsgpack l] <*> vimCallFunction "synIDattr" [synId, toMsgpack ("name" :: Text)]
lib/Ribosome/Api/Tabpage.hs view
@@ -1,15 +1,20 @@+-- |API functions for tabpages. module Ribosome.Api.Tabpage where -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Nvim.Api.Data (Tabpage)-import Ribosome.Nvim.Api.IO (nvimTabpageGetNumber, tabpageIsValid, vimCommand)+import Exon (exon) +import Ribosome.Host.Api.Data (Tabpage)+import Ribosome.Host.Api.Effect (nvimTabpageGetNumber, tabpageIsValid, vimCommand)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Host.Modify (silentBang)++-- |Close a tabpage. closeTabpage ::-  NvimE e m =>+  Member Rpc r =>   Tabpage ->-  m ()-closeTabpage tabpage = do-  valid <- tabpageIsValid tabpage-  when valid $ do+  Sem r ()+closeTabpage tabpage =+  whenM (tabpageIsValid tabpage) do     number <- nvimTabpageGetNumber tabpage-    vimCommand ("silent! tabclose! " <> show number)+    silentBang do+      vimCommand [exon|tabclose! #{show number}|]
lib/Ribosome/Api/Undo.hs view
@@ -1,10 +1,12 @@+-- |API functions for @:undo@. module Ribosome.Api.Undo where -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Nvim.Api.IO (vimCommand)+import Ribosome.Host.Api.Effect (nvimCommand)+import Ribosome.Host.Effect.Rpc (Rpc) +-- |Run @:undo@. undo ::-  NvimE e m =>-  m ()+  Member Rpc r =>+  Sem r () undo =-  vimCommand "undo"+  nvimCommand "undo"
− lib/Ribosome/Api/Variable.hs 
@@ -1,25 +0,0 @@-module Ribosome.Api.Variable where--import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, pluginName)-import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))-import Ribosome.Nvim.Api.IO (vimSetVar)--setVar ::-  NvimE e m =>-  MsgpackEncode a =>-  Text ->-  a ->-  m ()-setVar name =-  vimSetVar name . toMsgpack--setPVar ::-  MonadRibo m =>-  NvimE e m =>-  MsgpackEncode a =>-  Text ->-  a ->-  m ()-setPVar name a = do-  pn <- pluginName-  setVar (pn <> "_" <> name) a
lib/Ribosome/Api/Window.hs view
@@ -1,99 +1,116 @@+-- |API functions for windows. module Ribosome.Api.Window where -import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Nvim.Api.Data (Window)-import Ribosome.Nvim.Api.IO (+import Ribosome.Data.WindowView (PartialWindowView, WindowView)+import Ribosome.Host.Api.Data (Window)+import Ribosome.Host.Api.Effect (   nvimBufGetOption,+  nvimCallFunction,+  nvimCommand,   nvimGetCurrentWin,   nvimWinClose,   nvimWinGetBuf,   nvimWinGetCursor,   nvimWinSetCursor,-  vimCommand,+  vimCallFunction,   vimGetWindows,   vimSetCurrentWindow,   windowIsValid,   )+import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Host.Modify (silentBang) +-- |Close a window if it is valid and not the last one. closeWindow ::-  NvimE e m =>+  Member Rpc r =>   Window ->-  m ()+  Sem r () closeWindow window = do   valid <- windowIsValid window   last' <- (1 ==) . length <$> vimGetWindows   when (valid && not last') $ nvimWinClose window True +-- |Get the zero-based position of the cursor in a window. cursor ::-  NvimE e m =>+  Member Rpc r =>   Window ->-  m (Int, Int)+  Sem r (Int, Int) cursor window = do   (line, col) <- nvimWinGetCursor window-  return (line - 1, col)+  pure (line - 1, col) +-- |Get the zero-based position of the cursor in the active window. currentCursor ::-  NvimE e m =>-  m (Int, Int)+  Member Rpc r =>+  Sem r (Int, Int) currentCursor =   cursor =<< nvimGetCurrentWin +-- |Get the zero-based line number of the cursor in a window. windowLine ::-  NvimE e m =>+  Member Rpc r =>   Window ->-  m Int+  Sem r Int windowLine window =   fst <$> cursor window +-- |Get the zero-based line number of the cursor in the active window. currentLine ::-  NvimE e m =>-  m Int+  Member Rpc r =>+  Sem r Int currentLine =   windowLine =<< nvimGetCurrentWin +-- |Set the zero-based position of the cursor in a window. setCursor ::-  NvimE e m =>+  Member Rpc r =>   Window ->   Int ->   Int ->-  m ()+  Sem r () setCursor window line col =   nvimWinSetCursor window (line + 1, col) +-- |Set the zero-based position of the cursor in the current window. setCurrentCursor ::-  NvimE e m =>+  Member Rpc r =>   Int ->   Int ->-  m ()+  Sem r () setCurrentCursor line col = do   window <- nvimGetCurrentWin   setCursor window line col +-- |Set the zero-based line number of the cursor in a window, using the beginning of the line for the column. setLine ::-  NvimE e m =>+  Member Rpc r =>   Window ->   Int ->-  m ()+  Sem r () setLine window line =   setCursor window line 0 +-- |Set the zero-based line number of the cursor in the current window, using the beginning of the line for the column. setCurrentLine ::-  NvimE e m =>+  Member Rpc r =>   Int ->-  m ()+  Sem r () setCurrentLine line =   setCurrentCursor line 0 +-- |Redraw the screen. redraw ::-  NvimE e m =>-  m ()+  Member Rpc r =>+  Sem r () redraw =-  vimCommand "silent! redraw!"+  silentBang do+    nvimCommand "redraw!" --- |A main window means here any non-window that may be used to edit a file, i.e. one with an empty 'buftype'.+-- |A main window means here any non-window that may be used to edit a file, i.e. one with an empty @buftype@. findMainWindow ::-  NvimE e m =>-  m (Maybe Window)+  Member Rpc r =>+  Sem r (Maybe Window) findMainWindow =   listToMaybe <$> (filterM isFile =<< vimGetWindows)   where@@ -101,18 +118,40 @@       buf <- nvimWinGetBuf w       (("" :: Text) ==) <$> nvimBufGetOption buf "buftype" --- |Create a new window at the top if no existing window has empty 'buftype'.+-- |Create a new window at the top if no existing window has empty @buftype@. -- Focuses the window. ensureMainWindow ::-  NvimE e m =>-  m Window+  Member Rpc r =>+  Sem r Window ensureMainWindow =   maybe create focus =<< findMainWindow   where     create = do-      vimCommand "aboveleft new"-      win <- nvimGetCurrentWin-      vimCommand "wincmd K"-      return win+      nvimCommand "aboveleft new"+      nvimGetCurrentWin <* nvimCommand "wincmd K"     focus w =       w <$ vimSetCurrentWindow w++-- |Call @winsaveview@.+saveView ::+  Member Rpc r =>+  Sem r WindowView+saveView =+  vimCallFunction "winsaveview" []++-- |Call @winrestview@ with a previously obtained view from 'saveView'.+restoreView ::+  Member Rpc r =>+  PartialWindowView ->+  Sem r ()+restoreView v =+  vimCallFunction "winrestview" [toMsgpack v]++-- |Execute a command in a window.+windowExec ::+  Member Rpc r =>+  Window ->+  Text ->+  Sem r ()+windowExec window cmd =+  nvimCallFunction "win_execute" [toMsgpack window, toMsgpack cmd]
+ lib/Ribosome/Cli.hs view
@@ -0,0 +1,83 @@+-- |@optparse-applicative@ parsers for the Ribosome CLI.+module Ribosome.Cli where++import Exon (exon)+import Options.Applicative (+  Parser,+  customExecParser,+  fullDesc,+  header,+  helper,+  info,+  long,+  option,+  prefs,+  showHelpOnEmpty,+  showHelpOnError,+  )+import Path (Abs, Dir, Path)+import Path.IO (getCurrentDir)++import Ribosome.Host.Optparse (filePathOption, severityOption)+import Ribosome.Data.CliConfig (CliConfig (CliConfig), CliLogConfig (CliLogConfig))+import Ribosome.Data.PluginName (PluginName (PluginName))+import Ribosome.Host.Data.HostConfig (HostConfig (HostConfig), LogConfig (LogConfig))++-- |Parse the options related to logging.+logParser ::+  Path Abs Dir ->+  Parser CliLogConfig+logParser cwd = do+  logFile <- optional (option (filePathOption cwd) (long "log-file"))+  levelEcho <- optional (option severityOption (long "log-level-echo"))+  levelStderr <- optional (option severityOption (long "log-level-stderr"))+  levelFile <- optional (option severityOption (long "log-level-file"))+  pure (CliLogConfig logFile levelEcho levelStderr levelFile)++-- |Parse the host config as well as the arbitrary user defined config.+confParser ::+  Path Abs Dir ->+  Parser c ->+  Parser (CliConfig, c)+confParser cwd customParser = do+  cli <- CliConfig <$> logParser cwd+  custom <- customParser+  pure (cli, custom)++-- |Parse the host config as well as the arbitrary user defined config, in 'IO'.+parseCli ::+  PluginName ->+  Parser c ->+  IO (CliConfig, c)+parseCli (PluginName name) customParser = do+  cwd <- getCurrentDir+  customExecParser parserPrefs (info (helper <*> confParser cwd customParser) desc)+  where+    parserPrefs =+      prefs (showHelpOnEmpty <> showHelpOnError)+    desc =+      fullDesc <> header [exon|#{toString name} is a Neovim plugin.|]++-- |Parse the CLI options for a plugin config and update a default 'HostConfig' with the CLI options.+withDefault :: HostConfig -> CliConfig -> HostConfig+withDefault (HostConfig defLog) cliConfig =+  HostConfig log+  where+    CliConfig (CliLogConfig file levelEcho levelStderr levelFile) =+      cliConfig+    LogConfig defFile defLevelEcho defLevelStderr defLevelFile conc =+      defLog+    log =+      LogConfig (file <|> defFile) (fromMaybe defLevelEcho levelEcho) (fromMaybe defLevelStderr levelStderr)+      (fromMaybe defLevelFile levelFile) conc++-- |Parse the CLI options for a plugin config and pass an updated default 'HostConfig' to a callback.+withCli ::+  PluginName ->+  HostConfig ->+  Parser c ->+  (HostConfig -> c -> IO a) ->+  IO a+withCli name defaultConf customParser f = do+  (cliConfig, custom) <- parseCli name customParser+  f (withDefault defaultConf cliConfig) custom
− lib/Ribosome/Config/Setting.hs 
@@ -1,73 +0,0 @@-module Ribosome.Config.Setting where--import Ribosome.Control.Monad.Ribo (MonadRibo, Nvim, NvimE, pluginName)-import Ribosome.Data.Setting (Setting(Setting))-import Ribosome.Data.SettingError (SettingError)-import qualified Ribosome.Data.SettingError as SettingError (SettingError(..))-import Ribosome.Msgpack.Decode (MsgpackDecode)-import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))-import Ribosome.Nvim.Api.IO-import Ribosome.Nvim.Api.RpcCall (RpcError)-import qualified Ribosome.Nvim.Api.RpcCall as RpcError (RpcError(..))--settingVariableName ::-  (MonadRibo m) =>-  Setting a ->-  m Text-settingVariableName (Setting settingName False _) =-  return settingName-settingVariableName (Setting settingName True _) = do-  name <- pluginName-  return $ name <> "_" <> settingName--settingRaw :: (MonadRibo m, Nvim m, MsgpackDecode a, MonadDeepError e RpcError m) => Setting a -> m a-settingRaw s =-  vimGetVar =<< settingVariableName s--setting ::-  ∀ e m a.-  NvimE e m =>-  MonadRibo m =>-  MonadDeepError e SettingError m =>-  MsgpackDecode a =>-  Setting a ->-  m a-setting s@(Setting n _ fallback') =-  catchAt handleError $ settingRaw s-  where-    handleError (RpcError.Nvim _ _) =-      case fallback' of-        (Just fb) -> return fb-        Nothing -> throwHoist $ SettingError.Unset n-    handleError a =-      throwHoist a--data SettingOrError =-  Sett SettingError-  |-  Rpc RpcError--deepPrisms ''SettingOrError--settingOr ::-  (MonadIO m, Nvim m, MonadRibo m, MsgpackDecode a) =>-  a ->-  Setting a ->-  m a-settingOr a =-  (fromRight a <$>) . runExceptT . setting @SettingOrError--settingMaybe ::-  (MonadIO m, Nvim m, MonadRibo m, MsgpackDecode a) =>-  Setting a ->-  m (Maybe a)-settingMaybe =-  (rightToMaybe <$>) . runExceptT . setting @SettingOrError--updateSetting ::-  (MonadRibo m, Nvim m, MonadDeepError e RpcError m, MsgpackEncode a) =>-  Setting a ->-  a ->-  m ()-updateSetting s a =-  (`vimSetVar` toMsgpack a) =<< settingVariableName s
− lib/Ribosome/Config/Settings.hs 
@@ -1,13 +0,0 @@-module Ribosome.Config.Settings where--import Ribosome.Data.Setting (Setting(Setting))--persistenceDir :: Setting FilePath-persistenceDir = Setting "ribosome_persistence_dir" False Nothing--tmuxSocket :: Setting FilePath-tmuxSocket = Setting "tmux_socket" True Nothing--menuCloseFloats :: Setting Bool-menuCloseFloats =-  Setting "ribosome_menu_close_floats" False (Just True)
− lib/Ribosome/Control/Concurrent/Wait.hs 
@@ -1,99 +0,0 @@-module Ribosome.Control.Concurrent.Wait where--import Control.Exception.Lifted (try)-import qualified Text.Show--import Ribosome.System.Time (sleep)---- |Specifies the maximum number of retries and the interval in seconds for 'waitIO'.-data Retry =-  Retry Int Double-  deriving Show--instance Default Retry where-  def = Retry 20 0.25---- |Error description for 'waitIO'-data WaitError e =-  NotStarted-  |-  ConditionUnmet e-  |-  ∀ excp. Exception excp => Thrown excp--instance Show e => Show (WaitError e) where-  show NotStarted =-    "NotStarted"-  show (ConditionUnmet reason) =-    "ConditionUnmet(" <> show reason <> ")"-  show (Thrown _) =-    "Thrown"---- |Execute an IO thunk repeatedly until either the supplied condition produces a 'Right' or the maximum number of--- retries specified in the `Retry` parameter has been reached.--- Returns the value produced by the condition.-waitIO ::-  MonadIO m =>-  MonadBaseControl IO m =>-  Retry ->-  m a ->-  (a -> m (Either e b)) ->-  m (Either (WaitError e) b)-waitIO (Retry maxRetry interval) thunk cond =-  wait maxRetry (Left NotStarted)-  where-    wait 0 reason = return reason-    wait count _ = do-      ea <- try thunk-      result <- try $ check ea-      case result of-        Right (Right a) ->-          return $ Right a-        Right (Left reason) ->-          recurse reason count-        Left (SomeException e) ->-          recurse (Thrown e) count-    recurse reason count = do-      sleep interval-      wait (count - 1) (Left reason)-    check (Right a) =-      cond a <&> \case-        Right b -> Right b-        Left reason -> Left (ConditionUnmet reason)-    check (Left (SomeException e)) =-      return $ Left (Thrown e)---- |Calls 'waitIO' with the default configuration of 30 retries every 100ms.-waitIODef ::-  MonadIO m =>-  MonadBaseControl IO m =>-  m a ->-  (a -> m (Either e b)) ->-  m (Either (WaitError e) b)-waitIODef =-  waitIO def---- |Same as 'waitIO', but the condition returns 'Bool' and the result is the result of the thunk.-waitIOPred ::-  MonadIO m =>-  MonadBaseControl IO m =>-  Retry ->-  m a ->-  (a -> m Bool) ->-  m (Either (WaitError Text) a)-waitIOPred retry thunk pred' =-  waitIO retry thunk cond-  where-    cond a = pred' a <&> \case-      True -> Right a-      False -> Left ("predicate returned False" :: Text)---- |Calls 'waitIOPred' with the default configuration of 30 retries every 100ms.-waitIOPredDef ::-  MonadIO m =>-  MonadBaseControl IO m =>-  m a ->-  (a -> m Bool) ->-  m (Either (WaitError Text) a)-waitIOPredDef =-  waitIOPred def
− lib/Ribosome/Control/Exception.hs 
@@ -1,33 +0,0 @@-module Ribosome.Control.Exception where--import Control.Exception.Lifted (IOException, catch, try)--tryIO ::-  MonadBaseControl IO m =>-  m a ->-  m (Either IOException a)-tryIO =-  try--tryAny ::-  MonadBaseControl IO m =>-  m a ->-  m (Either SomeException a)-tryAny =-  try--catchAny ::-  MonadBaseControl IO m =>-  (SomeException -> m a) ->-  m a ->-  m a-catchAny =-  flip catch--catchAnyAs ::-  MonadBaseControl IO m =>-  a ->-  m a ->-  m a-catchAnyAs =-  catchAny . const . return
− lib/Ribosome/Control/Lock.hs 
@@ -1,60 +0,0 @@-module Ribosome.Control.Lock where--import Control.Exception.Lifted (finally)-import qualified Control.Lens as Lens (at, view)-import qualified Data.Map.Strict as Map (insert)--import Ribosome.Control.Monad.Ribo (MonadRibo, pluginInternalL, pluginInternalModifyL)-import Ribosome.Control.Ribosome (Locks)-import qualified Ribosome.Control.Ribosome as Ribosome (locks)-import qualified Ribosome.Log as Log (debug)--getLocks :: MonadRibo m => m Locks-getLocks =-  pluginInternalL Ribosome.locks--inspectLocks :: MonadRibo m => (Locks -> a) -> m a-inspectLocks = (<$> getLocks)--modifyLocks :: MonadRibo m => (Locks -> Locks) -> m ()-modifyLocks =-  pluginInternalModifyL Ribosome.locks--getOrCreateLock :: MonadRibo m => Text -> m (TMVar ())-getOrCreateLock key = do-  currentLock <- inspectLocks $ Lens.view $ Lens.at key-  case currentLock of-    Just tv -> return tv-    Nothing -> do-      tv <- newTMVarIO ()-      modifyLocks $ Map.insert key tv-      getOrCreateLock key--lockOrSkip ::-  MonadRibo m =>-  MonadBaseControl IO m =>-  Text ->-  m () ->-  m ()-lockOrSkip key thunk = do-  currentLock <- getOrCreateLock key-  currentState <- atomically $ tryTakeTMVar currentLock-  case currentState of-    Just _ -> do-      Log.debug $ "locking TMVar `" <> key <> "`"-      finally thunk $ atomically $ tryPutTMVar currentLock ()-      Log.debug $ "unlocking TMVar `" <> key <> "`"-    Nothing -> return ()--lockOrWait ::-  MonadRibo m =>-  MonadBaseControl IO m =>-  Text ->-  m () ->-  m ()-lockOrWait key thunk = do-  currentLock <- getOrCreateLock key-  atomically $ takeTMVar currentLock-  Log.debug $ "locking TMVar `" <> key <> "`"-  finally thunk $ atomically $ putTMVar currentLock ()-  Log.debug $ "unlocking TMVar `" <> key <> "`"
− lib/Ribosome/Control/Monad/Error.hs 
@@ -1,12 +0,0 @@-module Ribosome.Control.Monad.Error(-  recoverAs,-  recoveryFor,-) where--import Control.Monad.Error.Class (MonadError(catchError))--recoveryFor :: MonadError e m => m a -> m a -> m a-recoveryFor = flip catchError . const--recoverAs :: MonadError e m => m a -> m a -> m a-recoverAs = flip recoveryFor
− lib/Ribosome/Control/Monad/Ribo.hs 
@@ -1,260 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Ribosome.Control.Monad.Ribo where--import Control.Exception.Lifted (onException)-import Control.Lens (Lens')-import qualified Control.Lens as Lens (mapMOf, over, view)-import Control.Monad.Base (MonadBase(..))-import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)-import Control.Monad.Error.Class (MonadError(..))-import qualified Control.Monad.Reader as ReaderT-import Control.Monad.Trans.Free (FreeT)-import Control.Monad.Trans.Resource (MonadResource(..), runResourceT)-import qualified Control.Monad.Trans.State.Strict as StateT (gets, modify)-import Data.DeepLenses (DeepLenses(deepLens))-import Data.DeepPrisms (DeepPrisms)-import Neovim.Context.Internal (Neovim(..))--import Ribosome.Control.Ribosome (Ribosome, RibosomeInternal, RibosomeState)-import qualified Ribosome.Control.Ribosome as Ribosome (_errors, errors, name, state)-import qualified Ribosome.Control.Ribosome as RibosomeState (internal, public)-import Ribosome.Control.StrictRibosome (StrictRibosome)-import qualified Ribosome.Control.StrictRibosome as StrictRibosome (name, state)-import Ribosome.Data.Errors (Errors)-import Ribosome.Nvim.Api.RpcCall (Rpc, RpcError)-import qualified Ribosome.Nvim.Api.RpcCall as Rpc (Rpc(..))-import Ribosome.Orphans ()-import Ribosome.Plugin.RpcHandler (RpcHandler(..))--type RNeovim s = Neovim (Ribosome s)--instance MonadBase IO (Neovim e) where-  liftBase = liftIO--instance MonadBaseControl IO (Neovim e) where-  type StM (Neovim e) a = a-  liftBaseWith f =-    Neovim (lift $ ReaderT $ \r -> f (peel r))-    where-      peel r ma =-        runReaderT (runResourceT (unNeovim ma)) r-  restoreM = return--newtype Ribo s e a =-  Ribo { unRibo :: ExceptT e (RNeovim s) a }-  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask, MonadFail, MonadBase IO)--deriving newtype instance MonadError e (Ribo s e)--modifyTMVar ::-  MonadIO m =>-  (a -> a) ->-  TMVar a ->-  m a-modifyTMVar f tmvar = do-  a <- f <$> atomically (takeTMVar tmvar)-  atomically $ putTMVar tmvar a-  return a--safeModifyTMVarM ::-  MonadIO m =>-  MonadBaseControl IO m =>-  (a -> m a) ->-  TMVar a ->-  m a-safeModifyTMVarM f tmvar =-  process =<< atomically (takeTMVar tmvar)-  where-    process a =-      onException (restore =<< f a) (restore a)-    restore a =-      a <$ (atomically . putTMVar tmvar $ a)--deriving newtype instance MonadReader (Ribosome s) (Ribo s e)--riboStateVar ::-  MonadReader (Ribosome s) m =>-  m (TMVar (RibosomeState s))-riboStateVar =-  ReaderT.asks (Lens.view Ribosome.state)--public ::-  DeepLenses s s' =>-  Lens' (RibosomeState s) s'-public =-  RibosomeState.public . deepLens--instance DeepLenses s s' => MonadDeepState s s' (Ribo s e) where-  get =-    Lens.view public <$> (atomically . readTMVar =<< riboStateVar)--  modifyM' f =-    Lens.view public <$> (safeModifyTMVarM trans =<< riboStateVar)-    where-      trans = Lens.mapMOf public f--  put =-    modify . const--class Monad m => Nvim m where-  call :: Rpc c a => c -> m (Either RpcError a)--instance Nvim (Neovim e) where-  call = Rpc.call--instance (MonadTrans t, Monad (t m), Nvim m) => Nvim (t m) where-  call = lift . call--instance Nvim (Ribo s e) where-  call = Ribo . call--class (Nvim m, MonadDeepError e RpcError m) => NvimE e m where--instance DeepPrisms e RpcError => NvimE e (Ribo s e) where--instance (DeepPrisms e RpcError, Nvim m, Monad m) => NvimE e (ExceptT e m) where--instance (Functor f, MonadDeepError e RpcError m, Nvim m, Monad m) => NvimE e (FreeT f m) where--instance MonadBaseControl IO (Ribo s e) where-    type StM (Ribo s e) a = Either e a-    liftBaseWith f =-      Ribo $ liftBaseWith $ \ q -> f (q . unRibo)-    {-# INLINABLE liftBaseWith #-}-    restoreM =-      Ribo . restoreM-    {-# INLINABLE restoreM #-}--instance MonadResource (Ribo s e) where-    liftResourceT = Ribo . liftResourceT--instance RpcHandler e (Ribosome s) (Ribo s e) where-  native = runRiboE--acall :: (Monad m, Nvim m, Rpc c ()) => c -> m ()-acall c = fromRight () <$> call c--readTv :: Lens' (RibosomeState s) s' -> TMVar (RibosomeState s) -> IO s'-readTv l t = Lens.view l <$> atomically (readTMVar t)--runRibo :: Ribo s e a -> RNeovim s (Either e a)-runRibo =-  runExceptT . unRibo--runRiboE :: Ribo s e a -> ExceptT e (RNeovim s) a-runRiboE =-  unRibo--class PluginName m where-  pluginName1 :: m Text--instance PluginName IO where-  pluginName1 = pure "io"--instance PluginName (RNeovim s) where-  pluginName1 =-    ReaderT.asks (Lens.view Ribosome.name)--class MonadIO m => MonadRibo m where-  pluginName :: m Text-  pluginInternal :: m RibosomeInternal-  pluginInternalModify :: (RibosomeInternal -> RibosomeInternal) -> m ()--pluginInternals :: MonadRibo m => (RibosomeInternal -> a) -> m a-pluginInternals = (<$> pluginInternal)--pluginInternalL :: MonadRibo m => Lens' RibosomeInternal a -> m a-pluginInternalL = pluginInternals . Lens.view--pluginInternalPut' :: MonadRibo m => RibosomeInternal -> m ()-pluginInternalPut' s =-  pluginInternalModify (const s)--pluginInternalModifyL :: MonadRibo m => Lens' RibosomeInternal a -> (a -> a) -> m ()-pluginInternalModifyL l f =-  pluginInternalModify $ Lens.over l f--instance MonadRibo (RNeovim s) where-  pluginName =-    ReaderT.asks (Lens.view Ribosome.name)--  pluginInternal =-    Lens.view RibosomeState.internal <$$> atomically . readTMVar =<< ReaderT.asks (Lens.view Ribosome.state)--  pluginInternalModify f =-    void . modifyTMVar (Lens.over RibosomeState.internal f) =<< riboStateVar--instance MonadRibo (Ribo s e) where-  pluginName = Ribo pluginName-  pluginInternal = Ribo pluginInternal-  pluginInternalModify = Ribo . pluginInternalModify--instance {-# OVERLAPPABLE #-} (MonadTrans t, MonadIO (t m), MonadRibo m) => MonadRibo (t m) where-  pluginName = lift pluginName-  pluginInternal = lift pluginInternal-  pluginInternalModify = lift . pluginInternalModify--instance {-# OVERLAPPING #-} MonadIO m => MonadRibo (StateT (StrictRibosome s) m) where-  pluginName =-    StateT.gets (Lens.view StrictRibosome.name)-  pluginInternal =-    StateT.gets (Lens.view $ StrictRibosome.state . RibosomeState.internal)-  pluginInternalModify =-    StateT.modify . Lens.over (StrictRibosome.state . RibosomeState.internal)--getErrors :: MonadRibo m => m Errors-getErrors =-  pluginInternals Ribosome._errors--inspectErrors :: MonadRibo m => (Errors -> a) -> m a-inspectErrors = (<$> getErrors)--modifyErrors :: MonadRibo m => (Errors -> Errors) -> m ()-modifyErrors =-  pluginInternalModifyL Ribosome.errors--prepend :: ∀s' s m a. MonadDeepState s s' m => Lens' s' [a] -> a -> m ()-prepend lens a =-  modify $ Lens.over lens (a:)--prependUnique ::-  ∀ s' s m a .-  Eq a =>-  MonadDeepState s s' m =>-  Lens' s' [a] ->-  a ->-  m ()-prependUnique lens a =-  modify $ Lens.over lens modder-  where-    modder as =-      a : filter (a /=) as--prependUniqueBy ::-  ∀ s' s m a b .-  Eq b =>-  MonadDeepState s s' m =>-  Lens' a b ->-  Lens' s' [a] ->-  a ->-  m ()-prependUniqueBy attr lens a =-  modify $ Lens.over lens modder-  where-    modder as =-      a : filter pred' as-    pred' b =-      Lens.view attr a /= Lens.view attr b--inspectHeadE ::-  ∀ s' s e e' m a .-  (MonadDeepState s s' m, MonadDeepError e e' m) =>-  e' ->-  Lens' s' [a] ->-  m a-inspectHeadE err lens = do-  as <- gets $ Lens.view lens-  case as of-    (a : _) -> return a-    _ -> throwHoist err
− lib/Ribosome/Control/Ribosome.hs 
@@ -1,47 +0,0 @@-module Ribosome.Control.Ribosome where--import Data.MessagePack (Object)-import Prelude hiding (state)--import Path (Abs, Dir, Path)-import Ribosome.Data.Errors (Errors)-import Ribosome.Data.Scratch (Scratch)--type Locks = Map Text (TMVar ())--data RibosomeInternal =-  RibosomeInternal {-    _locks :: Locks,-    _errors :: Errors,-    _scratch :: Map Text Scratch,-    _watchedVariables :: Map Text Object,-    _projectDir :: Maybe (Path Abs Dir)-  }-  deriving (Generic, Default)--makeClassy ''RibosomeInternal--data RibosomeState s =-  RibosomeState {-    _internal :: RibosomeInternal,-    _public :: s-  }-  deriving (Generic, Default)--makeClassy ''RibosomeState--data Ribosome s =-  Ribosome {-    _name :: Text,-    _state :: TMVar (RibosomeState s)-  }--makeClassy ''Ribosome--newRibosomeTMVar :: MonadIO m => s -> m (TMVar (RibosomeState s))-newRibosomeTMVar s =-  liftIO $ newTMVarIO (RibosomeState def s)--newRibosome :: MonadIO m => Text -> s -> m (Ribosome s)-newRibosome name' =-  Ribosome name' <$$> newRibosomeTMVar
− lib/Ribosome/Control/StrictRibosome.hs 
@@ -1,16 +0,0 @@-module Ribosome.Control.StrictRibosome where--import Prelude hiding (state)--import Ribosome.Control.Ribosome (RibosomeState)--data StrictRibosome s =-  StrictRibosome {-    _name :: Text,-    _state :: RibosomeState s-    }--makeClassy ''StrictRibosome--instance Default s => Default (StrictRibosome s) where-  def = StrictRibosome "default" def
+ lib/Ribosome/Data/CliConfig.hs view
@@ -0,0 +1,22 @@+-- |Config data types for the CLI option parser.+module Ribosome.Data.CliConfig where++import Log (Severity)+import Path (Abs, File, Path)++-- |Intermediate data type with optional fields for 'Ribosome.LogConfig'.+data CliLogConfig =+  CliLogConfig {+    logFile :: Maybe (Path Abs File),+    logLevelEcho :: Maybe Severity,+    logLevelStderr :: Maybe Severity,+    logLevelFile :: Maybe Severity+  }+  deriving stock (Eq, Show)++-- |Intermediate data type with optional fields for 'Ribosome.HostConfig'.+data CliConfig =+  CliConfig {+    log :: CliLogConfig+  }+  deriving stock (Eq, Show)
− lib/Ribosome/Data/Conduit.hs 
@@ -1,140 +0,0 @@-module Ribosome.Data.Conduit where--import Conduit (ConduitT, MonadResource, bracketP, runConduit, yield, (.|))-import Control.Concurrent (forkIO)-import Control.Concurrent.Lifted (fork, killThread)-import Control.Concurrent.STM.TBMChan (TBMChan, closeTBMChan, newTBMChan, readTBMChan, writeTBMChan)-import Control.Exception.Lifted (bracket, finally)-import Control.Monad.Trans.Control (embed)-import qualified Data.Conduit.Combinators as Conduit (mapM_)--import Ribosome.Control.Monad.Ribo (modifyTMVar)--withTBMChan ::-  MonadIO m =>-  MonadBaseControl IO m =>-  Int ->-  (TBMChan a -> m b) ->-  m b-withTBMChan bound =-  bracket acquire release-  where-    acquire =-      atomically (newTBMChan bound)-    release =-      atomically . closeTBMChan--sourceChan ::-  MonadIO m =>-  TBMChan a ->-  ConduitT () a m ()-sourceChan chan =-  loop-  where-    loop =-      traverse_ recurse =<< atomically (readTBMChan chan)-    recurse a =-      yield a *> loop--sourceTerminated ::-  MonadIO m =>-  TMVar Int ->-  TBMChan a ->-  m ()-sourceTerminated var chan = do-  n <- modifyTMVar (subtract 1) var-  when (n == 0) (atomically $ closeTBMChan chan)--mergeSourcesWith ::-  MonadResource m =>-  TMVar Int ->-  TBMChan a ->-  (ConduitT () a m () -> IO (StM m ())) ->-  [ConduitT () a m ()] ->-  ConduitT () a m ()-mergeSourcesWith activeSources chan sourceRunner sources =-  bracketP acquire release (const combinedSource)-  where-    acquire =-      traverse (forkIO . start) sources-    start source = do-      void $ sourceRunner source-      sourceTerminated activeSources chan-    release ids =-      traverse_ killThread ids *>-      atomically (closeTBMChan chan)-    combinedSource =-      sourceChan chan--mergeSources ::-  MonadResource m =>-  MonadBaseControl IO m =>-  Int ->-  [ConduitT () a m ()] ->-  ConduitT () a m ()-mergeSources bound sources = do-  activeSources <- atomically $ newTMVar (length sources)-  chan <- atomically (newTBMChan bound)-  embeddedRunner <- lift $ embed (embedSourceRunner chan)-  mergeSourcesWith activeSources chan embeddedRunner sources-  where-    embedSourceRunner chan source =-      runConduit (source .| Conduit.mapM_ (atomically . writeTBMChan chan))--withSourcesInChanAs ::-  MonadIO m =>-  MonadBaseControl IO m =>-  (ConduitT () a m () -> m b) ->-  [ConduitT () a m ()] ->-  TBMChan a ->-  m b-withSourcesInChanAs executor sources chan = do-  activeSources <- atomically $ newTMVar (length sources)-  threadIds <- traverse (fork . start activeSources) sources-  finally listen (release threadIds)-  where-    release =-      traverse_ killThread-    listen =-      executor $ sourceChan chan-    start activeSources source = do-      runConduit (source .| Conduit.mapM_ (atomically . writeTBMChan chan))-      sourceTerminated activeSources chan--simpleExecutor ::-  Monad m =>-  ConduitT a Void m b ->-  ConduitT () a m () ->-  m b-simpleExecutor consumer s =-  runConduit $ s .| consumer--withSourcesInChan ::-  MonadIO m =>-  MonadBaseControl IO m =>-  ConduitT a Void m b ->-  [ConduitT () a m ()] ->-  TBMChan a ->-  m b-withSourcesInChan =-  withSourcesInChanAs . simpleExecutor--withMergedSourcesAs ::-  MonadIO m =>-  MonadBaseControl IO m =>-  (ConduitT () a m () -> m b) ->-  Int ->-  [ConduitT () a m ()] ->-  m b-withMergedSourcesAs executor bound sources =-  withTBMChan bound (withSourcesInChanAs executor sources)--withMergedSources ::-  MonadIO m =>-  MonadBaseControl IO m =>-  ConduitT a Void m b ->-  Int ->-  [ConduitT () a m ()] ->-  m b-withMergedSources =-  withMergedSourcesAs . simpleExecutor
− lib/Ribosome/Data/Conduit/Composition.hs 
@@ -1,416 +0,0 @@-{-# LANGUAGE CPP #-}--module Ribosome.Data.Conduit.Composition where--import Conduit-import qualified Control.Concurrent.Async.Lifted as A-import Control.Concurrent.Async.Lifted hiding (link2)-import Control.Concurrent.STM hiding (atomically, newTVarIO)-import Control.Exception.Lifted (finally)-import Control.Monad hiding (forM_)-import Control.Monad.Base (MonadBase, liftBase)-import Control.Monad.Loops-import Control.Monad.Trans.Resource-import qualified Data.Conduit.Binary as CB-import qualified Data.Conduit.Cereal as C-import qualified Data.Conduit.List as CL-import Data.Serialize-import Prelude hiding (get, put)-import System.Directory (removeFile)-import System.IO---- | Concurrently join the producer and consumer, using a bounded queue of the--- given size. The producer will block when the queue is full, if it is--- producing faster than the consumers is taking from it. Likewise, if the--- consumer races ahead, it will block until more input is available.------ Exceptions are properly managed and propagated between the two sides, so--- the net effect should be equivalent to not using buffer at all, save for--- the concurrent interleaving of effects.------ The underlying monad must always be an instance of--- 'MonadBaseControl IO'.  If at least one of the two conduits is a--- 'CFConduit', it must additionally be a in instance of--- 'MonadResource'.------ This function is similar to '$$'; for one more like '=$=', see--- 'buffer''.------ >>> buffer 1 (CL.sourceList [1,2,3]) CL.consume--- [1,2,3]-buffer :: (CCatable c1 c2 c3, CRunnable c3, RunConstraints c3 m)-          => Natural -- ^ Size of the bounded queue in memory.-          -> c1 () x m ()-          -> c2 x Void m r-          -> m r-buffer i c1 c2 = runCConduit (buffer' i c1 c2)---- | An operator form of 'buffer'.  In general you should be able to replace--- any use of '$$' with '$$&' and suddenly reap the benefit of--- concurrency, if your conduits were spending time waiting on each other.------ The underlying monad must always be an instance of--- 'MonadBaseControl IO'.  If at least one of the two conduits is a--- 'CFConduit', it must additionally be a in instance of--- 'MonadResource'.------ >>> CL.sourceList [1,2,3] $$& CL.consume--- [1,2,3]------ It can be combined with '$=&' and '$='.  This creates two threads;--- the first thread produces the list and the second thread does the--- map and the consume:------ >>> CL.sourceList [1,2,3] $$& mapC (*2) $= CL.consume--- [2,4,6]------ This creates three threads.  The three conduits all run in their--- own threads:------ >>> CL.sourceList [1,2,3] $$& mapC (*2) $=& CL.consume--- [2,4,6]------ >>> CL.sourceList [1,2,3] $$& (mapC (*2) $= mapC (+1)) $=& CL.consume--- [3,5,7]-($$&) :: (CCatable c1 c2 c3, CRunnable c3, RunConstraints c3 m) => c1 () x m () -> c2 x Void m r -> m r-a $$& b = runCConduit (a =$=& b)-infixr 0 $$&---- | An operator form of 'buffer''.  In general you should be able to replace--- any use of '=$=' with '=$=&' and '$$' either with '$$&' or '=$='--- and 'runCConduit' and suddenly reap the benefit of concurrency, if--- your conduits were spending time waiting on each other.------ >>> runCConduit $ CL.sourceList [1,2,3] =$=& CL.consume--- [1,2,3]-(=$=&) :: (CCatable c1 c2 c3) => c1 i x m () -> c2 x o m r -> c3 i o m r-a =$=& b = buffer' 64 a b-infixr 2 =$=&---- | An alias for '=$=&' by analogy with '=$=' and '$='.-($=&) :: (CCatable c1 c2 c3) => c1 i x m () -> c2 x o m r -> c3 i o m r-($=&) = (=$=&)-infixl 1 $=&---- | An alias for '=$=&' by analogy with '=$=' and '=$'.-(=$&) :: (CCatable c1 c2 c3) => c1 i x m () -> c2 x o m r -> c3 i o m r-(=$&) = (=$=&)-infixr 2 =$&---- | Conduits are concatenable; this class describes how.--- class CCatable (c1 :: * -> * -> (* -> *) -> * -> *) (c2 :: * -> * -> (* -> *) -> * -> *) (c3 :: * -> * -> (* -> *) -> * -> *) | c1 c2 -> c3 where-class CCatable c1 c2 (c3 :: * -> * -> (* -> *) -> * -> *) | c1 c2 -> c3 where-  -- | Concurrently join the producer and consumer, using a bounded queue of the-  -- given size. The producer will block when the queue is full, if it is-  -- producing faster than the consumers is taking from it. Likewise, if the-  -- consumer races ahead, it will block until more input is available.-  ---  -- Exceptions are properly managed and propagated between the two sides, so-  -- the net effect should be equivalent to not using buffer at all, save for-  -- the concurrent interleaving of effects.-  ---  -- This function is similar to '=$='; for one more like '$$', see-  -- 'buffer'.-  ---  -- >>> runCConduit $ buffer' 1 (CL.sourceList [1,2,3]) CL.consume-  -- [1,2,3]-  buffer' :: Natural -- ^ Size of the bounded queue in memory-             -> c1 i x m ()-             -> c2 x o m r-             -> c3 i o m r---- | Like 'buffer', except that when the bounded queue is overflowed, the--- excess is cached in a local file so that consumption from upstream may--- continue. When the queue becomes exhausted by yielding, it is filled--- from the cache until all elements have been yielded.------ Note that the maximum amount of memory consumed is equal to (2 *--- memorySize + 1), so take this into account when picking a chunking size.------ This function is similar to '$$'; for one more like '=$=', see--- 'bufferToFile''.------ >>> runResourceT $ bufferToFile 1 Nothing "/tmp" (CL.sourceList [1,2,3]) CL.consume--- [1,2,3]-bufferToFile :: (CFConduitLike c1, CFConduitLike c2, Serialize x, MonadBaseControl IO m, MonadResource m, MonadThrow m)-                => Natural -- ^ Size of the bounded queue in memory-                -> Maybe Int -- ^ Max elements to keep on disk at one time-                -> FilePath -- ^ Directory to write temp files to-                -> c1 () x m ()-                -> c2 x Void m r-                -> m r-bufferToFile bufsz dsksz tmpDir c1 c2 = runCConduit (bufferToFile' bufsz dsksz tmpDir c1 c2)---- | Like 'buffer'', except that when the bounded queue is overflowed, the--- excess is cached in a local file so that consumption from upstream may--- continue. When the queue becomes exhausted by yielding, it is filled--- from the cache until all elements have been yielded.------ Note that the maximum amount of memory consumed is equal to (2 *--- memorySize + 1), so take this into account when picking a chunking size.------ This function is similar to '=$='; for one more like '$$', see--- 'bufferToFile'.------ >>> runResourceT $ runCConduit $ bufferToFile' 1 Nothing "/tmp" (CL.sourceList [1,2,3]) CL.consume--- [1,2,3]------ It is frequently convenient to define local function to use this in operator form:------ >>> :{--- runResourceT $ do---   let buf c = bufferToFile' 10 Nothing "/tmp" c -- eta-conversion to avoid monomorphism restriction---   runCConduit $ CL.sourceList [0x30, 0x31, 0x32] `buf` mapC (toEnum :: Int -> Char) `buf` CL.consume--- :}--- "012"-bufferToFile' :: (CFConduitLike c1, CFConduitLike c2, Serialize x)-                 => Natural -- ^ Size of the bounded queue in memory-                 -> Maybe Int -- ^ Max elements to keep on disk at one time-                 -> FilePath -- ^ Directory to write temp files to-                 -> c1 i x m ()-                 -> c2 x o m r-                 -> CFConduit i o m r-bufferToFile' bufsz dsksz tmpDir c1 c2 = combine (asCFConduit c1) (asCFConduit c2)-  where combine (FSingle a) b = FMultipleF bufsz dsksz tmpDir a b-        combine (FMultiple i a as) b = FMultiple i a (bufferToFile' bufsz dsksz tmpDir as b)-        combine (FMultipleF bufsz' dsksz' tmpDir' a as) b = FMultipleF bufsz' dsksz' tmpDir' a (bufferToFile' bufsz dsksz tmpDir as b)---- | Conduits are, once there's a producer on one end and a consumer--- on the other, runnable.-class CRunnable c where-  type RunConstraints c (m :: * -> *) :: Constraint-  -- | Execute a conduit concurrently.  This is the concurrent-  -- equivalent of 'runConduit'.-  ---  -- The underlying monad must always be an instance of-  -- 'MonadBaseControl IO'.  If the conduits is a 'CFConduit', it must-  -- additionally be a in instance of 'MonadResource'.-  runCConduit :: (RunConstraints c m) => c () Void m r -> m r--instance CCatable ConduitT ConduitT CConduit where-  buffer' i a b = buffer' i (Single a) (Single b)--instance CCatable ConduitT CConduit CConduit where-  buffer' i a b = buffer' i (Single a) b--instance CCatable ConduitT CFConduit CFConduit where-  buffer' i a b = buffer' i (asCFConduit a) b--instance CCatable CConduit ConduitT CConduit where-  buffer' i a b = buffer' i a (Single b)--instance CCatable CConduit CConduit CConduit where-  buffer' i (Single a) b = Multiple i a b-  buffer' i (Multiple i' a as) b = Multiple i' a (buffer' i as b)--instance CCatable CConduit CFConduit CFConduit where-  buffer' i a b = buffer' i (asCFConduit a) b--instance CCatable CFConduit ConduitT CFConduit where-  buffer' i a b = buffer' i a (asCFConduit b)--instance CCatable CFConduit CConduit CFConduit where-  buffer' i a b = buffer' i a (asCFConduit b)--instance CCatable CFConduit CFConduit CFConduit where-  buffer' i (FSingle a) b = FMultiple i a b-  buffer' i (FMultiple i' a as) b = FMultiple i' a (buffer' i as b)-  buffer' i (FMultipleF bufsz dsksz tmpDir a as) b = FMultipleF bufsz dsksz tmpDir a (buffer' i as b)--instance CRunnable ConduitT where-  type RunConstraints ConduitT m = (Monad m)-  runCConduit = runConduit--instance CRunnable CConduit where-  type RunConstraints CConduit m = (MonadBaseControl IO m, MonadIO m)-  runCConduit (Single c) = runConduit c-  runCConduit (Multiple bufsz c cs) = do-    chan <- liftIO $ newTBQueueIO bufsz-    withAsync (sender chan c) $ \c' ->-      stage chan c' cs--instance CRunnable CFConduit where-  type RunConstraints CFConduit m = (MonadBaseControl IO m, MonadIO m, MonadResource m, MonadThrow m)-  runCConduit (FSingle c) = runConduit c-  runCConduit (FMultiple bufsz c cs) = do-    chan <- liftIO $ newTBQueueIO bufsz-    withAsync (sender chan c) $ \c' ->-      fstage (receiver chan) c' cs-  runCConduit (FMultipleF bufsz filemax tempDir c cs) = do-    context <- liftIO $ BufferContext <$> newTBQueueIO bufsz-                                      <*> newTQueueIO-                                      <*> newTVarIO filemax-                                      <*> newTVarIO False-                                      <*> pure tempDir-    withAsync (fsender context c) $ \c' ->-      fstage (freceiver context) c' cs---- | A "concurrent conduit", in which the stages run in parallel with--- a buffering queue between them.-data CConduit i o m r where-  Single :: ConduitT i o m r -> CConduit i o m r-  Multiple :: Natural -> ConduitT i x m () -> CConduit x o m r -> CConduit i o m r---- C.C.A.L's link2 has the wrong type:  https://github.com/maoe/lifted-async/issues/16-link2 :: MonadBase IO m => Async a -> Async b -> m ()-link2 = (liftBase .) . A.link2---- Combines a producer with a queue, sending it everything the--- producer produces.-sender :: (MonadIO m) => TBQueue (Maybe o) -> ConduitT () o m () -> m ()-sender chan input = do-  runConduit $ input .| mapM_C (send chan . Just)-  send chan Nothing---- One "layer" of withAsync in a CConduit run.-stage :: (MonadBaseControl IO m, MonadIO m) => TBQueue (Maybe i) -> Async x -> CConduit i Void m r -> m r-stage chan prevAsync (Single c) =-  -- The last layer; feed the output of "chan" into the conduit and-  -- wait for the result.-  withAsync (runConduit $ receiver chan .| c) $ \c' -> do-    link2 prevAsync c'-    wait c'-stage chan prevAsync (Multiple bufsz c cs) = do-  -- not the last layer, so take the input from "chan", have this-  -- layer's conduit process it, and send the conduit's output to the-  -- next layer.-  chan' <- liftIO $ newTBQueueIO bufsz-  withAsync (sender chan' $ receiver chan .| c) $ \c' -> do-    link2 prevAsync c'-    stage chan' c' cs---- A Producer which produces the values of the given channel until--- Nothing is received.  This is the other half of "sender".-receiver :: (MonadIO m) => TBQueue (Maybe o) -> ConduitT () o m ()-receiver chan = do-  mx <- recv chan-  case mx of-   Nothing -> return ()-   Just x -> yield x >> receiver chan---- | A "concurrent conduit", in which the stages run in parallel with--- a buffering queue and possibly a disk file between them.-data CFConduit i o m r where-  FSingle :: ConduitT i o m r -> CFConduit i o m r-  FMultiple :: Natural -> ConduitT i x m () -> CFConduit x o m r -> CFConduit i o m r-  FMultipleF :: (Serialize x) => Natural -> Maybe Int -> FilePath -> ConduitT i x m () -> CFConduit x o m r -> CFConduit i o m r--class CFConduitLike a where-  asCFConduit :: a i o m r -> CFConduit i o m r--instance CFConduitLike ConduitT where-  asCFConduit = FSingle--instance CFConduitLike CConduit where-  asCFConduit (Single c) = FSingle c-  asCFConduit (Multiple i c cs) = FMultiple i c (asCFConduit cs)--instance CFConduitLike CFConduit where-  asCFConduit = id--data BufferContext m a = BufferContext { chan :: TBQueue a-                                       , restore :: TQueue (ConduitT () a m ())-                                       , slotsFree :: TVar (Maybe Int)-                                       , done :: TVar Bool-                                       , tempDir :: FilePath-                                       }---- The file-backed equivlent of "sender".  This sends the values--- generated by "input" to the "chan" in the BufferContext until it--- gets full, then flushes it to disk via "persistChan".-fsender :: (MonadIO m, MonadResource m, Serialize x, MonadThrow m) => BufferContext m x -> ConduitT () x m () -> m ()-fsender bc@BufferContext{..} input = do-  runConduit $ input .| mapM_C f-  liftIO $ atomically $ writeTVar done True-  where-    f x = join $ liftIO $ atomically $-      (writeTBQueue chan x >> return (return ())) `orElse` do-        action <- persistChan bc-        writeTBQueue chan x-        return action---- Connect a stage to another stage via either an in-memory queue or a--- disk buffer.  This is the file-backed equivalent of "stage".-fstage :: (MonadBaseControl IO m, MonadResource m, MonadThrow m) => ConduitT () i m () -> Async x -> CFConduit i Void m r -> m r-fstage prevStage prevAsync (FSingle c) =-  -- The final conduit in the chain; just accept everything from-  -- the previous stage and wait for the result.-  withAsync (runConduit $ prevStage .| c) $ \c' -> do-    link2 prevAsync c'-    wait c'-fstage prevStage prevAsync (FMultiple bufsz c cs) = do-  -- This stage is connected to the next via a non-file-backed-  -- channel, so it just uses "sender" and "reciever" in the same way-  -- "stage" does.-  chan' <- liftIO $ newTBQueueIO bufsz-  withAsync (sender chan' $ prevStage .| c) $ \c' -> do-    link2 prevAsync c'-    fstage (receiver chan') c' cs-fstage prevStage prevAsync (FMultipleF bufsz dsksz tempDir c cs) = do-  -- This potentially needs to write its output to a file, so it uses-  -- "fsender" send and tells the next stage to use "freceiver" to read.-  bc <- liftIO $ BufferContext <$> newTBQueueIO bufsz-                               <*> newTQueueIO-                               <*> newTVarIO dsksz-                               <*> newTVarIO False-                               <*> pure tempDir-  withAsync (fsender bc $ prevStage .| c) $ \c' -> do-    link2 prevAsync c'-    fstage (freceiver bc) c' cs---- Receives from disk files or the in-memory queue if no spill-to-disk--- has occurred.-freceiver :: (MonadIO m) => BufferContext m o -> ConduitT () o m ()-freceiver BufferContext{..} = loop where-  loop = do-    (src, exit) <- liftIO $ atomically $ do-      (readTQueue restore >>= (\action -> return (action, False))) `orElse` do-        xs <- exhaust chan-        isDone <- readTVar done-        return (CL.sourceList xs, isDone)-    src-    unless exit loop---- The channel is full, so (return an action which will) spill it to disk, unless too--- many items are there already.-persistChan :: (MonadIO m, MonadResource m, Serialize o, MonadThrow m) => BufferContext m o -> STM (m ())-persistChan BufferContext{..} = do-  xs <- exhaust chan-  mslots <- readTVar slotsFree-  let len = length xs-  forM_ mslots $ \slots -> check (len < slots)-  filePath <- newEmptyTMVar-  writeTQueue restore $ do-    (path, key) <- liftIO $ atomically $ takeTMVar filePath-    CB.sourceFile path .| do-      C.conduitGet2 get-      liftIO $ atomically $ modifyTVar slotsFree (fmap (+ len))-      release key-  case xs of-   [] -> return (return ())-   _ -> do-     modifyTVar slotsFree (fmap (subtract len))-     return $ do-       (key, (path, h)) <- allocate (openBinaryTempFile tempDir "conduit.bin") (\(path, h) -> hClose h `finally` removeFile path)-       liftIO $ do-         runConduit $ CL.sourceList xs .| C.conduitPut put .| CB.sinkHandle h-         hClose h-         atomically $ putTMVar filePath (path, key)--exhaust :: TBQueue a -> STM [a]-exhaust chan = whileM (not <$> isEmptyTBQueue chan) (readTBQueue chan)--recv :: (MonadIO m) => TBQueue a -> m a-recv c = liftIO . atomically $ readTBQueue c--send :: (MonadIO m) => TBQueue a -> a -> m ()-send c = liftIO . atomically . writeTBQueue c--ccMap :: (∀ i1 . ConduitT i1 o1 m a -> ConduitT i1 o2 m a) -> CConduit i o1 m a -> CConduit i o2 m a-ccMap f =-  go-  where-    go (Single c) =-      Single (f c)-    go (Multiple bufsz l r) =-      Multiple bufsz l (ccMap f r)
+ lib/Ribosome/Data/CustomConfig.hs view
@@ -0,0 +1,7 @@+-- |Disambiguation type for @Reader@.+module Ribosome.Data.CustomConfig where++-- |Disambiguation type used for the custom CLI configuration that is polymorphic in the stack.+newtype CustomConfig c =+  CustomConfig { unCustomConfig :: c }+  deriving stock (Eq, Show)
− lib/Ribosome/Data/ErrorReport.hs 
@@ -1,18 +0,0 @@-module Ribosome.Data.ErrorReport(-  ErrorReport(..),-  user,-  log,-  priority,-) where--import System.Log (Priority)--data ErrorReport =-  ErrorReport {-    _user :: Text,-    _log :: [Text],-    _priority :: Priority-  }-  deriving (Eq, Show)--makeClassy ''ErrorReport
− lib/Ribosome/Data/Errors.hs 
@@ -1,48 +0,0 @@-module Ribosome.Data.Errors(-  ComponentName(..),-  Errors(..),-  Error(..),-  componentErrors,-  timestamp,-  report,-) where--import qualified Data.Map.Strict as Map (toList)-import Data.Text.Prettyprint.Doc (Doc, Pretty(..), align, line, vsep, (<+>))-import Prelude hiding (error)--import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))--newtype ComponentName =-  ComponentName Text-  deriving (Eq, Ord, Show)--data Error =-  Error {-    _timestamp :: Int,-    _report :: ErrorReport-  }-  deriving (Eq, Show)--makeClassy ''Error--instance Pretty Error where-  pretty (Error stamp (ErrorReport _ lines' _)) =-    pretty stamp <+> align (vsep (pretty <$> lines'))--newtype Errors =-  Errors {-    _componentErrors :: Map ComponentName [Error]-    }-  deriving (Eq, Show)-  deriving newtype Default--makeClassy ''Errors--prettyComponentErrors :: ComponentName -> [Error] -> Doc a-prettyComponentErrors (ComponentName name) errors' =-  line <> line <> pretty name <> ":" <> line <> vsep (pretty <$> errors')--instance Pretty Errors where-  pretty (Errors errors') =-    vsep (uncurry prettyComponentErrors <$> Map.toList errors')
+ lib/Ribosome/Data/FileBuffer.hs view
@@ -0,0 +1,14 @@+-- |Data type representing a buffer associated with a file system path.+module Ribosome.Data.FileBuffer where++import Path (Abs, File, Path)++import Ribosome.Host.Api.Data (Buffer)++-- |Data type representing a buffer associated with a file system path.+data FileBuffer =+  FileBuffer {+    buffer :: Buffer,+    path :: Path Abs File+  }+  deriving stock (Eq, Show)
lib/Ribosome/Data/FloatOptions.hs view
@@ -1,16 +1,17 @@+-- |Data types for floating window API codec. module Ribosome.Data.FloatOptions where -import qualified Data.Map as Map--import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (toMsgpack))+import Ribosome.Host.Class.Msgpack.Map (msgpackMap) +-- |The reference point to which a floating window's position is defined. data FloatRelative =   Editor   |   Win   |   Cursor-  deriving (Eq, Show)+  deriving stock (Eq, Show)  instance MsgpackEncode FloatRelative where   toMsgpack Editor = toMsgpack ("editor" :: Text)@@ -20,6 +21,7 @@ instance Default FloatRelative where   def = Cursor +-- |The corner of a floating window that is positioned at the specified coordinates. data FloatAnchor =   NW   |@@ -28,7 +30,7 @@   SW   |   SE-  deriving (Eq, Show)+  deriving stock (Eq, Show)  instance MsgpackEncode FloatAnchor where   toMsgpack NW = toMsgpack ("NW" :: Text)@@ -39,6 +41,64 @@ instance Default FloatAnchor where   def = NW +-- |The border style of a floating window.+data FloatBorder =+  None+  |+  Single+  |+  Double+  |+  Rounded+  |+  Solid+  |+  Shadow+  |+  -- |A list of characters that is drawn for the border, starting with the top left corner, going clockwise, repeating+  -- if too short.+  Manual [Text]+  deriving stock (Eq, Show, Generic)++instance MsgpackEncode FloatBorder where+  toMsgpack = \case+    None -> toMsgpack @Text "none"+    Single -> toMsgpack @Text "single"+    Double -> toMsgpack @Text "double"+    Rounded -> toMsgpack @Text "rounded"+    Solid -> toMsgpack @Text "solid"+    Shadow -> toMsgpack @Text "shadow"+    Manual cs -> toMsgpack cs++instance Default FloatBorder where+  def =+    Rounded++-- |Neovim has a style option for floating windows that sets a few options in bulk, with only one possible value.+data FloatStyle =+  FloatStyleMinimal+  deriving stock (Eq, Show)++instance Default FloatStyle where+  def =+    FloatStyleMinimal++instance MsgpackEncode FloatStyle where+  toMsgpack FloatStyleMinimal =+    toMsgpack @Text "minimal"++-- |The z-index of a floating window, determining occlusion.+newtype FloatZindex =+  FloatZindex { unFloatZindex :: Int }+  deriving stock (Eq, Show, Generic)+  deriving newtype (Num, Real, Enum, Integral, Ord)++instance MsgpackEncode FloatZindex where+  toMsgpack (FloatZindex i) =+    toMsgpack i++-- |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. data FloatOptions =   FloatOptions {     relative :: FloatRelative,@@ -48,26 +108,31 @@     col :: Int,     focusable :: Bool,     anchor :: FloatAnchor,-    bufpos :: Maybe (Int, Int)+    bufpos :: Maybe (Int, Int),+    border :: FloatBorder,+    noautocmd :: Bool,+    enter :: Bool,+    style :: Maybe FloatStyle,+    zindex :: Maybe FloatZindex   }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)  instance MsgpackEncode FloatOptions where   toMsgpack FloatOptions {..} =-    toMsgpack $ Map.fromList (simple ++ maybe [] (pure . ("bufpos",) . toMsgpack) bufpos)-    where-      simple =-        [-          ("relative" :: Text, toMsgpack relative),-          ("width", toMsgpack width),-          ("height", toMsgpack height),-          ("row", toMsgpack row),-          ("col", toMsgpack col),-          ("focusable", toMsgpack focusable),-          ("anchor", toMsgpack anchor),-          ("relative", toMsgpack relative)-        ]+    msgpackMap+    ("relative", relative)+    ("width", width)+    ("height", height)+    ("row", row)+    ("col", col)+    ("focusable", focusable)+    ("anchor", anchor)+    ("bufpos", bufpos)+    ("border", border)+    ("noautocmd", noautocmd)+    ("style", style)+    ("zindex", zindex)  instance Default FloatOptions where   def =-    FloatOptions def 30 10 1 1 False def def+    FloatOptions def 30 10 1 1 False def def def False True (Just FloatStyleMinimal) Nothing
− lib/Ribosome/Data/Foldable.hs 
@@ -1,12 +0,0 @@-module Ribosome.Data.Foldable(-  findMapMaybeM,-) where--import Control.Monad (foldM)--findMapMaybeM :: (Monad m, Foldable f) => (a -> m (Maybe b)) -> f a -> m (Maybe b)-findMapMaybeM f fa =-  foldM evaluate Nothing fa-  where-    evaluate (Just b) _ = return (Just b)-    evaluate Nothing a = f a
− lib/Ribosome/Data/List.hs 
@@ -1,21 +0,0 @@-module Ribosome.Data.List where--import qualified Data.Set as Set (difference, fromList, toList)--mapSelectors :: (a -> a) -> [Int] -> [a] -> [a]-mapSelectors f indexes =-  reverse . go 0 (sort indexes) []-  where-    go current (i : is) result (a : asTail) | i == current =-      go (current + 1) is (f a : result) asTail-    go current is result (a : asTail) =-      go (current + 1) is (a : result) asTail-    go _ _ result _ =-      result--indexesComplement :: Int -> [Int] -> [Int]-indexesComplement total =- Set.toList . Set.difference allIndexes . Set.fromList-  where-    allIndexes =-      Set.fromList [0..total - 1]
lib/Ribosome/Data/Mapping.hs view
@@ -1,34 +1,121 @@+-- |Data types for Neovim mappings module Ribosome.Data.Mapping where  import Data.MessagePack (Object)-import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))-import Ribosome.Error.Report.Class (ReportError(..))-import System.Log (Priority(NOTICE, ERROR)) -newtype MappingIdent =-  MappingIdent Text-  deriving (Eq, Show)+import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode)+import Ribosome.Host.Data.Event (EventName)+import Ribosome.Host.Data.RpcName (RpcName) -data Mapping =-  Mapping {-    mappingIdent :: MappingIdent,-    mappingLhs :: Text,-    mappingMode :: Text,-    mappingRemap :: Bool,-    mappingBuffer :: Bool-  }-  deriving (Eq, Show)+-- |The sequence of keys that triggers a mapping.+newtype MappingLhs =+  MappingLhs { unMappingLhs :: Text }+  deriving stock (Eq, Show)+  deriving newtype (IsString, Ord) -data MappingError =-  NoSuchMapping MappingIdent+-- |This ID type is intended to carry information about what buffer or other component triggered a mapping, if needed.+newtype MappingId =+  MappingId { unMappingId :: Text }+  deriving stock (Eq, Show)+  deriving newtype (IsString, Ord, MsgpackDecode, MsgpackEncode)++-- |All possible variants of Neovim's @map@ commands, causing mappings to be registered for different modes.+data MapMode =+  -- |@:map@ – normal, visual, select and operator-pending+  MapDefault   |-  InvalidArgs [Object]-  deriving (Eq, Show)+  -- |@:nmap@ – normal+  MapNormal+  |+  -- |@:map!@ – insert and cmdline+  MapInsertCmdline+  |+  -- |@:imap@ – insert+  MapInsert+  |+  -- |@:cmap@ – cmdline+  MapCmdline+  |+  -- |@:lmap@ – insert, cmdline, lang-arg+  MapLangArg+  |+  -- |@:xmap@ – visual+  MapVisual+  |+  -- |@:smap@ – select+  MapSelect+  |+  -- |@:vmap@ – visual and select+  MapVisualSelect+  |+  -- |@:omap@ – operator-pending+  MapOperator+  deriving stock (Eq, Show, Ord, Enum) -deepPrisms ''MappingError+instance Default MapMode where+  def =+    MapNormal -instance ReportError MappingError where-  errorReport (NoSuchMapping (MappingIdent ident)) =-    ErrorReport ("no mapping defined for `" <> ident <>"`") ["no such mapping: " <> ident] NOTICE-  errorReport (InvalidArgs args) =-    ErrorReport "internal error while executing mapping" ["invalid mapping args:", show args] ERROR+-- |The character representing a map mode prefixing a @map@ command.+mapModePrefix :: MapMode -> Text+mapModePrefix = \case+  MapDefault -> ""+  MapNormal -> "n"+  MapInsertCmdline -> ""+  MapInsert -> "i"+  MapCmdline -> "c"+  MapLangArg -> "l"+  MapVisual -> "x"+  MapSelect -> "s"+  MapVisualSelect -> "v"+  MapOperator -> "o"++-- |The bang suffixing the insert+cmdline map cmd.+mapModeSuffix :: MapMode -> Text+mapModeSuffix = \case+  MapInsertCmdline -> "!"+  _ -> ""++-- |The character representing a map mode when passing it to an api function.+mapModeShortName :: MapMode -> Text+mapModeShortName m =+  mapModePrefix m <> mapModeSuffix m++-- |The action that should be performed when a mapping is triggered.+data MappingAction =+  -- |The name of the 'Ribosome.RpcHandler' that should be called when the mapping is triggered.+  MappingCall RpcName+  |+  -- |The event to publish when the mapping is triggered.+  MappingEvent EventName+  deriving stock (Eq, Show)++-- |The configuration for a mapping that is specific to Neovim.+data MappingSpec =+  MappingSpec {+    -- |The key sequence that triggers the mapping.+    lhs :: MappingLhs,+    -- |The modes in which the mapping should be installed.+    mode :: NonEmpty MapMode+  }+  deriving stock (Eq, Show, Ord, Generic)++instance IsString MappingSpec where+  fromString s =+    MappingSpec (fromString s) [def]++-- |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 'Ribosome.mappingFor' or 'Ribosome.eventMapping' and 'Ribosome.activateBufferMapping'.+data Mapping =+  Mapping {+    -- |The action to take when the mapping is triggered.+    action :: MappingAction,+    -- |The Neovim related configuration for the mapping, i.e. its key sequence and modes.+    spec :: MappingSpec,+    -- |An optional string identifying the source of the mapping, for example when adding it to multiple buffers.+    id :: Maybe MappingId,+    -- |Options like @remap@, @nowait@ or @desc@.+    opts :: Map Text Object+  }+  deriving stock (Eq, Show, Generic)
+ lib/Ribosome/Data/Mode.hs view
@@ -0,0 +1,14 @@+-- |Codec data type for the result type of @nvim_get_mode@.+module Ribosome.Data.Mode where++import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode)++-- |Codec data type for the result type of @nvim_get_mode@.+data NvimMode =+  NvimMode {+    mode :: Text,+    blocking :: Bool+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (MsgpackEncode, MsgpackDecode)
lib/Ribosome/Data/PersistError.hs view
@@ -1,31 +1,35 @@+-- |Error for 'Ribosome.Persist'. module Ribosome.Data.PersistError where -import System.Log (Priority(INFO, NOTICE, ERROR))+import Exon (exon)+import Polysemy.Log (Severity (Error)) -import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))-import Ribosome.Error.Report.Class (ReportError(..))+import Ribosome.Data.PersistPathError (PersistPathError)+import Ribosome.Host.Data.Report (Report (Report), Reportable (toReport)) --- TODO use Path+-- |The errors emitted by the effect 'Ribosome.PersistPath'. data PersistError =-  FileNotReadable FilePath+  -- |Can't access the persistence files.+  Permission Text   |-  NoSuchFile FilePath+  -- |Data in the persistence file has invalid format.+  Decode Text Text   |-  Decode FilePath Text-  deriving (Eq, Show)--deepPrisms ''PersistError+  -- |'Ribosome.PeristPath' threw an error.+  Path PersistPathError+  deriving stock (Eq, Show) -instance ReportError PersistError where-  errorReport (FileNotReadable path) =-    ErrorReport msg ["PersistError.FileNotReadable:", toText path] NOTICE-    where-      msg = "persistence file not readable: " <> toText path-  errorReport (NoSuchFile path) =-    ErrorReport msg ["PersistError.SoSuchFile:", toText path] INFO-    where-      msg = "no persistence file present at " <> toText path-  errorReport (Decode path err) =-    ErrorReport msg ["PersistError.Decode:", toText path, err] ERROR-    where-      msg = "invalid data in persistence file, please delete it: " <> toText path+instance Reportable PersistError where+  toReport = \case+    Permission path ->+      Report msg ["PersistError.Permission:", path] Error+      where+        msg =+          [exon|Insufficient permissions for persistence file: #{path}|]+    Decode path err ->+      Report msg ["PersistError.Decode:", path, err] Error+      where+        msg =+          [exon|invalid data in persistence file, please delete it: #{path}|]+    Path err ->+      toReport err
+ lib/Ribosome/Data/PersistPathError.hs view
@@ -0,0 +1,31 @@+-- |Error for 'Ribosome.PersistPath'.+module Ribosome.Data.PersistPathError where++import Exon (exon)+import Path (Abs, Dir, Path)+import Polysemy.Log (Severity (Error))++import Ribosome.Host.Data.Report (Report (Report), Reportable (toReport))+import Ribosome.Host.Path (pathText)++-- |The errors emitted by the effect 'Ribosome.PersistPath'.+data PersistPathError =+  -- |Cannot determine the cache directory.+  Undefined+  |+  -- |General permissions error.+  Permissions (Path Abs Dir)+  deriving stock (Eq, Show)++instance Reportable PersistPathError where+  toReport = \case+    Undefined ->+      Report msg ["PersistPathError.Undefined"] Error+      where+        msg =+          "g:ribosome_persistence_dir unset and XDG not available."+    Permissions (pathText -> path) ->+      Report msg ["PersistPathError.Permissions:", path] Error+      where+        msg =+          [exon|Couldn't create persistence dir '#{path}'|]
+ lib/Ribosome/Data/PluginConfig.hs view
@@ -0,0 +1,36 @@+-- |Global configuration for a Ribosome plugin.+module Ribosome.Data.PluginConfig where++import Ribosome.Data.PluginName (PluginName)+import Ribosome.Host.Data.HostConfig (HostConfig)+import Options.Applicative (Parser)+import GHC.Show (showParen)+import Text.Show (showsPrec)+import Exon (exon)++-- |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.+data PluginConfig c =+  PluginConfig {+    name :: PluginName,+    host :: HostConfig,+    custom :: Parser c+  }+  deriving stock (Generic)++instance Show (PluginConfig c) where+  showsPrec d PluginConfig {..} =+    showParen (d > 10) [exon|PluginConfing { name = #{showsPrec 11 name}, host = #{showsPrec 11 host} }|]++instance Eq (PluginConfig c) where+  PluginConfig ln lh _ == PluginConfig rn rh _ =+    ln == rn && lh == rh++-- |Construct a simple 'PluginConfig' with the default config for the host, given the plugin's name.+pluginNamed :: PluginName -> PluginConfig ()+pluginNamed name =+  PluginConfig name def unit++instance IsString (PluginConfig ()) where+  fromString =+    pluginNamed . fromString
+ lib/Ribosome/Data/PluginName.hs view
@@ -0,0 +1,11 @@+-- |Data type 'PluginName'+module Ribosome.Data.PluginName where++-- |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 'Ribosome.runNvimPluginIO' via @'Reader'+-- 'Ribosome.PluginConfig'@.+newtype PluginName =+  PluginName { unPluginName :: Text }+  deriving stock (Eq, Show)+  deriving newtype (IsString, Ord)
lib/Ribosome/Data/Register.hs view
@@ -1,12 +1,15 @@+-- |Data types for register-related API functions. module Ribosome.Data.Register where  import Data.Char (isAlpha, isNumber)-import qualified Data.Text as Text (singleton)-import Data.Text.Prettyprint.Doc (Doc, Pretty(..))+import qualified Data.Text as Text+import Exon (exon)+import Prettyprinter (Pretty (pretty)) -import Ribosome.Msgpack.Decode (MsgpackDecode(..), msgpackFromString)-import Ribosome.Msgpack.Encode (MsgpackEncode(..))+import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode (..), msgpackFromString)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (..)) +-- |A Neovim register. data Register =   Named Text   |@@ -15,20 +18,22 @@   Special Text   |   Empty-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)  instance IsString Register where-  fromString "" =-    Empty-  fromString [a] | isAlpha a =-    Named $ Text.singleton a-  fromString [a] | isNumber a =-    Numbered $ Text.singleton a-  fromString a =-    Special $ toText a+  fromString = \case+    "" ->+      Empty+    [a] | isAlpha a ->+      Named (Text.singleton a)+    [a] | isNumber a ->+      Numbered (Text.singleton a)+    a ->+      Special (toText a)  instance MsgpackDecode Register where-  fromMsgpack = msgpackFromString "Register"+  fromMsgpack =+    msgpackFromString "Register"  instance MsgpackEncode Register where   toMsgpack (Named a) =@@ -40,22 +45,26 @@   toMsgpack Empty =     toMsgpack ("" :: Text) -prettyRegister :: Text -> Doc a-prettyRegister a =-  "\"" <> pretty a--instance Pretty Register where-  pretty (Named a) = prettyRegister a-  pretty (Numbered a) = prettyRegister (show a)-  pretty (Special a) = prettyRegister a-  pretty Empty = "no register"+-- |Render a register name by prefixing it with @"@.+quoted :: Text -> Text+quoted a =+  [exon|"#{a}|] +-- |Render a register name as is usual for Neovim. registerRepr :: Register -> Text-registerRepr (Named a) =-  "\"" <> a-registerRepr (Numbered a) =-  "\"" <> a-registerRepr (Special a) =-  "\"" <> a-registerRepr Empty =-  ""+registerRepr = \case+  Named a ->+    quoted a+  Numbered a ->+    quoted a+  Special a ->+    quoted a+  Empty ->+    ""++instance Pretty Register where+  pretty = \case+    Empty ->+      "no register"+    a ->+      pretty (registerRepr a)
lib/Ribosome/Data/RegisterType.hs view
@@ -1,10 +1,11 @@+-- |Codec data type for Neovim register types. module Ribosome.Data.RegisterType where -import Data.Text.Prettyprint.Doc (Pretty(..))--import Ribosome.Msgpack.Decode (MsgpackDecode(..), msgpackFromString)-import Ribosome.Msgpack.Encode (MsgpackEncode(..))+import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode (..), msgpackFromString)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (..))+import Prettyprinter (Pretty (pretty)) +-- |The type of a Neovim register, corresponding to concepts like line- or character-wise visual mode. data RegisterType =   Character   |@@ -15,7 +16,7 @@   BlockWidth Int   |   Unknown Text-  deriving (Eq, Show)+  deriving stock (Eq, Show, Ord)  instance IsString RegisterType where   fromString "v" =@@ -28,7 +29,8 @@     Unknown (toText a)  instance MsgpackDecode RegisterType where-  fromMsgpack = msgpackFromString "RegisterType"+  fromMsgpack =+    msgpackFromString "RegisterType"  instance MsgpackEncode RegisterType where   toMsgpack Character =@@ -43,8 +45,14 @@     toMsgpack ("" :: Text)  instance Pretty RegisterType where-  pretty Character = "c"-  pretty Line = "v"-  pretty Block = "<c-v>"-  pretty (BlockWidth width) = "<c-v>" <> pretty width-  pretty (Unknown a) = pretty a+  pretty = \case+    Character ->+      "c"+    Line ->+      "v"+    Block ->+      "<c-v>"+    BlockWidth width ->+      "<c-v>" <> pretty width+    Unknown a ->+      pretty a
− lib/Ribosome/Data/RiboError.hs 
@@ -1,22 +0,0 @@-module Ribosome.Data.RiboError where--import Ribosome.Data.Mapping (MappingError)-import Ribosome.Data.PersistError (PersistError)-import Ribosome.Data.SettingError (SettingError)-import Ribosome.Error.Report.Class (ReportError(..))-import Ribosome.Msgpack.Error (DecodeError)-import Ribosome.Nvim.Api.RpcCall (RpcError)--data RiboError =-  Mapping MappingError-  |-  Decode DecodeError-  |-  Rpc RpcError-  |-  Persist PersistError-  |-  Setting SettingError-  deriving (Show, Generic, ReportError)--deepPrisms ''RiboError
− lib/Ribosome/Data/Scratch.hs 
@@ -1,13 +0,0 @@-module Ribosome.Data.Scratch where--import Ribosome.Nvim.Api.Data (Buffer, Tabpage, Window)--data Scratch =-  Scratch {-    scratchName :: Text,-    scratchBuffer :: Buffer,-    scratchWindow :: Window,-    scratchPrevious :: Window,-    scratchTab :: Maybe Tabpage-  }-  deriving (Eq, Show)
+ lib/Ribosome/Data/ScratchId.hs view
@@ -0,0 +1,11 @@+-- |The ID type used to store active scratch buffers.+module Ribosome.Data.ScratchId where++import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode)++-- |The ID type used to store active scratch buffers.+newtype ScratchId =+  ScratchId { unScratchId :: Text }+  deriving stock (Eq, Show)+  deriving newtype (IsString, Ord, MsgpackDecode, MsgpackEncode)
lib/Ribosome/Data/ScratchOptions.hs view
@@ -1,58 +1,67 @@+-- |Scratch buffer configuration. module Ribosome.Data.ScratchOptions where -import Control.Lens (set)-import Prelude hiding (modify)- import Ribosome.Data.FloatOptions (FloatOptions) import Ribosome.Data.Mapping (Mapping)+import Ribosome.Data.ScratchId (ScratchId) import Ribosome.Data.Syntax (Syntax) +-- |Configure the visual properties of a scratch buffer.+-- If the option @float@ is specified, the buffer will be opened in a floating window. data ScratchOptions =   ScratchOptions {-    _tab :: Bool,-    _vertical :: Bool,-    _wrap :: Bool,-    _focus :: Bool,-    _resize :: Bool,-    _bottom :: Bool,-    _modify :: Bool,-    _float :: Maybe FloatOptions,-    _size :: Maybe Int,-    _maxSize :: Maybe Int,-    _syntax :: [Syntax],-    _mappings :: [Mapping],-    _name :: Text+    -- |Whether to open the buffer in a new tab.+    tab :: Bool,+    -- |Whether to split the current window vertically, only relevant for non-floating windows.+    vertical :: Bool,+    -- |Whether to set the @wrap@ option in the window, to disable breaking long lines.+    wrap :: Bool,+    -- |Whether to move the cursor to the window after opening it.+    focus :: Bool,+    -- |Whether to adapt the buffer's size to the number of lines, for horizontal splits.+    resize :: Bool,+    -- |Whether to place the window at the bottom of the stack, only relevant for non-floating windows.+    bottom :: Bool,+    -- |Whether to set the @modifiable@ option for the buffer.+    modify :: Bool,+    -- |If 'Just', creates a floating window with the given config.+    float :: Maybe FloatOptions,+    -- |The initial size of the window.+    size :: Maybe Int,+    -- |When resizing automatically, do not exceed this size.+    maxSize :: Maybe Int,+    -- |A set of syntax rules to apply to the buffer.+    syntax :: [Syntax],+    -- |A set of key mappings to define buffer-locally. See [Ribosome.Mappings]("Ribosome#mappings").+    mappings :: [Mapping],+    -- |The value for the @filetype@ option.+    filetype :: Maybe Text,+    -- |The ID of the scratch buffer.+    name :: ScratchId   }-  deriving (Eq, Show)--makeClassy ''ScratchOptions+  deriving stock (Eq, Show, Generic) -defaultScratchOptions :: Text -> ScratchOptions-defaultScratchOptions = ScratchOptions False False False False True True False Nothing Nothing Nothing [] []+-- |The default configuration, setting all flags to 'False' except for 'resize' and 'bottom', and everything else to+-- 'mempty'.+scratch :: ScratchId -> ScratchOptions+scratch name =+  ScratchOptions {+      tab = False,+      vertical = False,+      wrap = False,+      focus = False,+      resize = True,+      bottom = True,+      modify = False,+      float = Nothing,+      size = Nothing,+      maxSize = Nothing,+      syntax = [],+      mappings = [],+      filetype = Nothing,+      ..+    }  instance Default ScratchOptions where-  def = defaultScratchOptions "scratch"--scratchFocus :: ScratchOptions -> ScratchOptions-scratchFocus =-  set focus True--scratchSyntax :: [Syntax] -> ScratchOptions -> ScratchOptions-scratchSyntax =-  set syntax--scratchMappings :: [Mapping] -> ScratchOptions -> ScratchOptions-scratchMappings =-  set mappings--scratchFloat :: FloatOptions -> ScratchOptions -> ScratchOptions-scratchFloat =-  set float . Just--scratchSize :: Int -> ScratchOptions -> ScratchOptions-scratchSize =-  set size . Just--scratchModify :: ScratchOptions -> ScratchOptions-scratchModify =-  set modify True+  def =+    scratch "scratch"
+ lib/Ribosome/Data/ScratchState.hs view
@@ -0,0 +1,28 @@+-- |Scratch buffer state.+module Ribosome.Data.ScratchState where++import Ribosome.Data.ScratchId (ScratchId)+import Ribosome.Data.ScratchOptions (ScratchOptions)+import Ribosome.Host.Api.Data (Buffer, Tabpage, Window)+import Ribosome.Host.Data.RpcType (AutocmdId)++-- |The configuration and Neovim resources that define a scratch buffer and describe its previously recorded UI state.+data ScratchState =+  ScratchState {+    -- |The scratch buffer's ID stored in the state.+    id :: ScratchId,+    -- |The configuration used to create the scratch buffer.+    options :: ScratchOptions,+    -- |The Neovim buffer handle that was returned when it was last updated.+    buffer :: Buffer,+    -- |The Neovim window handle that was returned when it was last updated.+    window :: Window,+    -- |The Neovim window handle that denotes the window that was active when the scratch buffer was created.+    previous :: Window,+    -- |The Neovim tabpage handle that was returned when it was last updated, if a tab was requested by the+    -- configuration.+    tab :: Maybe Tabpage,+    -- |The ID of the autocmd that fires when the user deletes the scratch buffer.+    autocmdId :: AutocmdId+  }+  deriving stock (Eq, Show, Generic)
lib/Ribosome/Data/Setting.hs view
@@ -1,12 +1,15 @@+-- |Data type abstracting a Neovim variable with a default value. module Ribosome.Data.Setting where +-- |This type is used by the effect 'Ribosome.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 Setting a =   Setting {-    name :: Text,+    key :: Text,     prefix :: Bool,     fallback :: Maybe a   }--data GSetting a where-  SettingWithoutDefault :: Text -> Bool -> GSetting a-  SettingWithDefault :: Text -> Bool -> a -> GSetting a
lib/Ribosome/Data/SettingError.hs view
@@ -1,22 +1,29 @@+-- |Error for 'Ribosome.Settings'. module Ribosome.Data.SettingError where -import Data.Text.Prettyprint.Doc (Doc)-import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)-import System.Log (Priority(NOTICE))+import Exon (exon)+import Log (Severity (Error)) -import Ribosome.Data.ErrorReport (ErrorReport(..))-import Ribosome.Error.Report.Class (ReportError(..))+import Ribosome.Host.Data.Report (Report (Report), Reportable (toReport))+import Ribosome.Host.Data.RpcError (RpcError, rpcError) +-- |The errors emitted by the effect 'Ribosome.Settings'. data SettingError =-  Decode Text (Doc AnsiStyle)-  |+  -- |The variable is unset and has no associated default.   Unset Text-  deriving Show--deepPrisms ''SettingError+  |+  -- |The variable contains data that is incompatible with the type parameter of the 'Ribosome.Setting'.+  Decode Text Text+  |+  -- |Something went wrong while attempting to set a variable.+  UpdateFailed Text RpcError+  deriving stock (Eq, Show) -instance ReportError SettingError where-  errorReport (Decode name message) =-    ErrorReport ("invalid setting: " <> name) ["failed to decode setting `" <> name <> "`", show message] NOTICE-  errorReport (Unset name) =-    ErrorReport ("required setting unset: " <> name) ["unset setting: `" <> name <> "`"] NOTICE+instance Reportable SettingError where+  toReport = \case+    Unset key ->+      Report [exon|Mandatory setting '#{key}' is unset|] ["SettingError.Unset:", key] Error+    Decode key msg ->+      Report [exon|Setting '#{key}' has invalid value: #{msg}|] ["SettingError.Decode:", key, msg] Error+    UpdateFailed key err ->+      Report [exon|Failed to update setting '#{key}': #{rpcError err}|] ["SettingError.UpdateFailed:", key, show err] Error
− lib/Ribosome/Data/String.hs 
@@ -1,11 +0,0 @@-module Ribosome.Data.String where--import Data.Char (toUpper)--escapeQuotes :: Char -> String-escapeQuotes '\'' = "''"-escapeQuotes a = [a]--capitalize :: String -> String-capitalize [] = []-capitalize (head' : tail') = toUpper head' : tail'
lib/Ribosome/Data/Syntax.hs view
@@ -1,7 +1,7 @@+-- |Data types for the Neovim syntax API. module Ribosome.Data.Syntax where -import qualified Data.Map.Strict as Map (fromList)-+-- |Different kinds of syntax items. data SyntaxItemDetail =   Keyword {     kwGroup :: Text,@@ -26,62 +26,39 @@   Verbatim {     verbatimCommand :: Text   }-  deriving (Eq, Show)+  deriving stock (Eq, Show) +-- |A syntax item like @keyword@ or @match@, bundled with options for the @:syntax@ command. data SyntaxItem =   SyntaxItem {     siDetail :: SyntaxItemDetail,     siOptions :: [Text],     siParams :: Map Text Text   }-  deriving (Eq, Show)--syntaxItem :: SyntaxItemDetail -> SyntaxItem-syntaxItem detail =-  SyntaxItem detail def def--syntaxKeyword :: Text -> Text -> SyntaxItem-syntaxKeyword group' keyword =-  syntaxItem $ Keyword group' keyword def--syntaxMatch :: Text -> Text -> SyntaxItem-syntaxMatch group' pat =-  syntaxItem $ Match group' pat--syntaxRegionOffset :: Text -> Text -> Text -> Maybe Text -> Text -> Text -> SyntaxItem-syntaxRegionOffset group' start end skip ms me =-  syntaxItem $ Region group' start end skip ms me--syntaxRegion :: Text -> Text -> Text -> Maybe Text -> SyntaxItem-syntaxRegion group' start end skip =-  syntaxRegionOffset group' start end skip "" ""--syntaxVerbatim :: Text -> SyntaxItem-syntaxVerbatim =-  syntaxItem . Verbatim+  deriving stock (Eq, Show) +-- |Options for a highlight group. data Highlight =   Highlight {     hiGroup :: Text,     hiValues :: Map Text Text   }-  deriving (Eq, Show)--syntaxHighlight :: Text -> [(Text, Text)] -> Highlight-syntaxHighlight group' =-  Highlight group' . Map.fromList+  deriving stock (Eq, Show) +-- |Options for a @:highlight link@ command. data HiLink =   HiLink {     hlGroup :: Text,     hlTarget :: Text   }-  deriving (Eq, Show)+  deriving stock (Eq, Show) +-- |A set of syntax settings, consisting of syntax items like @keyword@ and @match@, highlights and highlight links. data Syntax =   Syntax {      syntaxItems :: [SyntaxItem],      syntaxHighlights :: [Highlight],      syntaxHiLinks :: [HiLink]   }-  deriving (Eq, Show, Generic, Default)+  deriving stock (Eq, Show, Generic)+  deriving anyclass (Default)
− lib/Ribosome/Data/Text.hs 
@@ -1,17 +0,0 @@-module Ribosome.Data.Text where--import Data.Char (toUpper)-import qualified Data.Text as Text (concatMap, cons, singleton, uncons)--escapeQuote :: Char -> Text-escapeQuote '\'' = "''"-escapeQuote a = Text.singleton a--escapeQuotes :: Text -> Text-escapeQuotes = Text.concatMap escapeQuote--capitalize :: Text -> Text-capitalize a =-  maybe "" run (Text.uncons a)-  where-    run (h, t) = Text.cons (toUpper h) t
lib/Ribosome/Data/WindowConfig.hs view
@@ -1,13 +1,15 @@+-- |Codec data type for @vim_get_windows@. module Ribosome.Data.WindowConfig where -import Ribosome.Msgpack.Decode (MsgpackDecode)-import Ribosome.Msgpack.Encode (MsgpackEncode)+import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode) +-- |Codec data type for @vim_get_windows@. data WindowConfig =   WindowConfig {      relative :: Text,      focusable :: Bool,      external :: Bool   }-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)   deriving anyclass (MsgpackEncode, MsgpackDecode)
+ lib/Ribosome/Data/WindowView.hs view
@@ -0,0 +1,35 @@+-- |Codec data type for @winsaveview@.+module Ribosome.Data.WindowView where++import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode)++-- |Codec data type for @winsaveview@.+data WindowView =+  WindowView {+    lnum :: Int,+    topline :: Int+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (MsgpackEncode, MsgpackDecode)++-- |Codec data type for @winrestview@.+data PartialWindowView =+  PartialWindowView {+    lnum :: Maybe Int,+    topline :: Maybe Int+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (MsgpackEncode, MsgpackDecode)++-- |Convert between the return type of @winsaveview@ and the parameter type of @winrestview@.+class AsPartialWindowView a where+  asPartialWindowView :: a -> PartialWindowView++instance AsPartialWindowView WindowView where+  asPartialWindowView (WindowView l t) =+    PartialWindowView (Just l) (Just t)++instance AsPartialWindowView PartialWindowView where+  asPartialWindowView =+    id
+ lib/Ribosome/Effect/Persist.hs view
@@ -0,0 +1,90 @@+-- |Persisting data across vim sessions+module Ribosome.Effect.Persist where++import Path (File, Path, Rel)++-- |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 'Ribosome.Persist.PersistPath' and uses JSON to+-- codec the data.+data Persist a :: Effect where+  -- |Store a value in the persistence file or, if the first argument is 'Just', in that file in the persistence+  -- directory.+  Store :: Maybe (Path Rel File) -> a -> Persist a m ()+  -- |Load a value from the persistence file or, if the first argument is 'Just', from that file in the persistence+  -- directory.+  -- Returns 'Nothing' if the file doesn't exist.+  Load :: Maybe (Path Rel File) -> Persist a m (Maybe a)++makeSem_ ''Persist++-- |Store a value in the persistence file or, if the first argument is 'Just', in that file in the persistence+-- directory.+store ::+  ∀ a r .+  Member (Persist a) r =>+  Maybe (Path Rel File) ->+  a ->+  Sem r ()++-- |Load a value from the persistence file or, if the first argument is 'Just', from that file in the persistence+-- directory.+-- Returns 'Nothing' if the file doesn't exist.+load ::+  ∀ a r .+  Member (Persist a) r =>+  Maybe (Path Rel File) ->+  Sem r (Maybe a)++-- |Load a value from the persistence file or, if the first argument is 'Just', from that file in the persistence+-- directory.+-- Returns the fallback value if the file doesn't exist.+loadOr ::+  Member (Persist a) r =>+  Maybe (Path Rel File) ->+  a ->+  Sem r a+loadOr path a =+  fromMaybe a <$> load path++-- |Load a value from the persistence file.+-- Returns 'Nothing' if the file doesn't exist.+loadSingle ::+  Member (Persist a) r =>+  Sem r (Maybe a)+loadSingle =+  load Nothing++-- |Load a value from the persistence file.+-- Returns the fallback value if the file doesn't exist.+loadSingleOr ::+  Member (Persist a) r =>+  a ->+  Sem r a+loadSingleOr a =+  fromMaybe a <$> loadSingle++-- |Load a value from the specified file in the persistence directory.+-- Returns 'Nothing' if the file doesn't exist.+loadPath ::+  Member (Persist a) r =>+  Path Rel File ->+  Sem r (Maybe a)+loadPath path =+  load (Just path)++-- |Load a value from the specified file in the persistence directory.+-- Returns the fallback value if the file doesn't exist.+loadPathOr ::+  Member (Persist a) r =>+  Path Rel File ->+  a ->+  Sem r a+loadPathOr path a =+  fromMaybe a <$> loadPath path
+ lib/Ribosome/Effect/PersistPath.hs view
@@ -0,0 +1,41 @@+-- |Provide paths for 'Ribosome.Persist'+module Ribosome.Effect.PersistPath where++import Path (Abs, Dir, Path, Rel)++import Ribosome.Data.Setting (Setting (Setting))++-- |This is a utility effect for 'Ribosome.Persist', determining the root directory for persistence files.+data PersistPath :: Effect where+  -- |Return the root if 'Nothing' is given, or the subdir of the root if 'Just' is given.+  PersistPath :: Maybe (Path Rel Dir) -> PersistPath m (Path Abs Dir)++makeSem_ ''PersistPath++-- |Return the root if 'Nothing' is given, or the subdir of the root if 'Just' is given.+persistPath ::+  ∀ r .+  Member PersistPath r =>+  Maybe (Path Rel Dir) ->+  Sem r (Path Abs Dir)++-- |This setting may be used to specify the root directory for all plugins.+-- The default is to use the XDG cache dir.+setting :: Setting (Path Abs Dir)+setting =+  Setting "ribosome_persistence_dir" False Nothing++-- |Get the root directory for persistence files.+persistRoot ::+  Member PersistPath r =>+  Sem r (Path Abs Dir)+persistRoot =+  persistPath Nothing++-- |Get a subdir of the root directory for persistence files.+persistSubPath ::+  Member PersistPath r =>+  Path Rel Dir ->+  Sem r (Path Abs Dir)+persistSubPath p =+  persistPath (Just p)
+ lib/Ribosome/Effect/Scratch.hs view
@@ -0,0 +1,34 @@+{-# options_haddock prune #-}++-- |Scratch buffers+module Ribosome.Effect.Scratch where++import Prelude hiding (show)++import Ribosome.Data.ScratchId (ScratchId)+import Ribosome.Data.ScratchOptions (ScratchOptions)+import Ribosome.Data.ScratchState (ScratchState)++-- |This effect manages scratch buffers, that is, transient buffers displaying text not associated with a file.+-- See 'ScratchOptions' for configuration.+data Scratch :: Effect where+  -- |Open a new scratch buffer and set its content to the supplied text.+  Show :: Foldable t => t Text -> ScratchOptions -> Scratch m ScratchState+  -- |Find a previously defined scratch buffer, ensure it is open and set its content to the supplied text.+  Update :: Foldable t => ScratchId -> t Text -> Scratch m ScratchState+  -- |Close a scratch buffer.+  Delete :: ScratchId -> Scratch m ()+  -- |Return the state of all currently managed scratch buffers.+  Get :: Scratch m [ScratchState]+  -- |Look up a scratch buffer by its ID.+  Find :: ScratchId -> Scratch m (Maybe ScratchState)++makeSem ''Scratch++-- |Create an empty scratch buffer.+open ::+  Member Scratch r =>+  ScratchOptions ->+  Sem r ScratchState+open =+  show @_ @[] mempty
+ lib/Ribosome/Effect/Settings.hs view
@@ -0,0 +1,56 @@+-- |The effect 'Settings' abstracts Neovim variables+module Ribosome.Effect.Settings where++import Prelude hiding (get)++import Ribosome.Data.Setting (Setting)+import Ribosome.Data.SettingError (SettingError)+import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode)+import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode)++-- |This effects abstracts Neovim variables with associated defaults.+data Settings :: Effect where+  -- |Get the value of the setting's Neovim variable or return the default if it is undefined.+  Get :: MsgpackDecode a => Setting a -> Settings m a+  -- |Set the value of the setting's Neovim variable.+  Update :: MsgpackEncode a => Setting a -> a -> Settings m ()++makeSem_ ''Settings++-- |Get the value of the setting's Neovim variable or return the default if it is undefined.+get ::+  ∀ a r .+  MsgpackDecode a =>+  Member Settings r =>+  Setting a ->+  Sem r a++-- |Set the value of the setting's Neovim variable.+update ::+  ∀ a r .+  MsgpackEncode a =>+  Member Settings r =>+  Setting a ->+  a ->+  Sem r ()++-- |Get the setting's value or return the supplied fallback value if the Neovim variable is undefined and the setting+-- has no default value.+or ::+  MsgpackDecode a =>+  Member (Settings !! SettingError) r =>+  a ->+  Setting a ->+  Sem r a+or a s =+  a <! get s++-- |Get 'Just' the setting's value or return 'Nothing' if the Neovim variable is undefined and the setting has no+-- default value.+maybe ::+  MsgpackDecode a =>+  Member (Settings !! SettingError) r =>+  Setting a ->+  Sem r (Maybe a)+maybe s =+  Nothing <! (Just <$> get s)
+ lib/Ribosome/Effect/VariableWatcher.hs view
@@ -0,0 +1,28 @@+-- |An effect used internally to execute handlers when Neovim variables are changed.+module Ribosome.Effect.VariableWatcher where++-- |The name of a variable that Ribosome should watch for changes.+newtype WatchedVariable =+  WatchedVariable { unWatchedVariable :: Text }+  deriving stock (Eq, Show)+  deriving newtype (IsString, Ord)++-- |An effect used internally to execute handlers when Neovim variables are changed.+data VariableWatcher :: Effect where+  -- |Called when the internal logic determines that variables should be examined for updates.+  Update :: VariableWatcher m ()+  -- |Stop running update handlers for the given variable.+  Unwatch :: WatchedVariable -> VariableWatcher m ()++makeSem_ ''VariableWatcher++-- |Called when the internal logic determines that variables should be examined for updates.+update ::+  Member VariableWatcher r =>+  Sem r ()++-- |Stop running update handlers for the given variable.+unwatch ::+  Member VariableWatcher r =>+  WatchedVariable ->+  Sem r ()
+ lib/Ribosome/Embed.hs view
@@ -0,0 +1,138 @@+{-# options_haddock prune #-}++-- |Main function combinators for embedding Neovim+module Ribosome.Embed where++import Ribosome.Data.PluginConfig (PluginConfig)+import Ribosome.Data.PluginName (PluginName)+import Ribosome.Host.Data.BootError (BootError)+import Ribosome.Host.Data.HostConfig (LogConfig)+import Ribosome.Host.Data.RpcHandler (RpcHandler)+import Ribosome.Host.Embed (EmbedExtra, interpretEmbedExtra)+import Ribosome.Host.IOStack (IOStack)+import Ribosome.Host.Interpret (HigherOrder)+import Ribosome.Host.Interpreter.Handlers (interpretHandlersNull, withHandlers)+import Ribosome.Host.Interpreter.Host (HostDeps, withHost)+import Ribosome.Host.Interpreter.Process.Embed (interpretProcessCerealNvimEmbed)+import Ribosome.Host.Run (RpcDeps, RpcStack, interpretRpcStack)+import Ribosome.IOStack (BasicPluginStack, runCli)+import Ribosome.Interpreter.Scratch (interpretScratch)+import Ribosome.Interpreter.Settings (interpretSettingsRpc)+import Ribosome.Interpreter.UserError (interpretUserErrorPrefixed)+import Ribosome.Interpreter.VariableWatcher (interpretVariableWatcherNull)+import Ribosome.Plugin.Builtin (BuiltinHandlersDeps, interceptHandlersBuiltin)+import Ribosome.Run (PluginEffects)++type HandlerEffects =+  PluginEffects ++ RpcStack ++ EmbedExtra ++ RpcDeps++-- |The complete stack for an embedded plugin test.+type EmbedStack c =+  HandlerEffects ++ BasicPluginStack c++interpretRpcDeps ::+  Members [Reader PluginName, Error BootError, Log, Resource, Race, Async, Embed IO] r =>+  InterpretersFor RpcDeps r+interpretRpcDeps =+  interpretUserErrorPrefixed .+  interpretProcessCerealNvimEmbed Nothing Nothing++-- |Run the internal stack for an embedded Neovim test, without IO effects.+interpretPluginEmbed ::+  Members [Log, Reader LogConfig, Reader PluginName] r =>+  Members IOStack r =>+  InterpretersFor HandlerEffects r+interpretPluginEmbed =+  interpretRpcDeps .+  interpretEmbedExtra .+  interpretRpcStack .+  interpretHandlersNull .+  interpretVariableWatcherNull .+  interpretSettingsRpc .+  interpretScratch++-- |Fork the main loop for a plugin connected to an embedded Neovim.+embedPlugin ::+  Members (HostDeps er) r =>+  Members BuiltinHandlersDeps r =>+  Sem r a ->+  Sem r a+embedPlugin =+  interceptHandlersBuiltin .+  withHost .+  insertAt @0++-- |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.+runEmbedStackCli ::+  PluginConfig c ->+  Sem (EmbedStack c) () ->+  IO ()+runEmbedStackCli conf =+  runCli conf . interpretPluginEmbed++-- |Run an embedded Neovim, plugin internals and IO effects, reading options from the CLI.+runEmbedStack ::+  PluginConfig () ->+  Sem (EmbedStack ()) () ->+  IO ()+runEmbedStack conf =+  runCli conf . interpretPluginEmbed++-- |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 @'Reader' c@ to the plugin.+--+-- This is separate from 'runEmbedPluginIO' because it requires a type hint when using @OverloadedStrings@ or 'def' to+-- construct the config without an option parser.+runEmbedPluginCli ::+  HigherOrder r (EmbedStack c) =>+  PluginConfig c ->+  InterpretersFor r (EmbedStack c) ->+  [RpcHandler (r ++ EmbedStack c)] ->+  Sem (r ++ EmbedStack c) () ->+  IO ()+runEmbedPluginCli conf effs handlers =+  runEmbedStackCli conf .+  effs .+  withHandlers handlers .+  embedPlugin++-- |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](https://hackage.haskell.org/package/ribosome-test/docs/Ribosome-Test.html) provides, which uses+-- [polysemy-test](https://hackage.haskell.org/package/polysemy-test/docs/Polysemy-Test.html) and+-- [hedgehog](https://hackage.haskell.org/package/hedgehog) for a comprehensive testing framework.+--+-- The parameters have the same meaning as for [remote plugins]("Ribosome#execution").+runEmbedPluginIO ::+  HigherOrder r (EmbedStack ()) =>+  PluginConfig () ->+  InterpretersFor r (EmbedStack ()) ->+  [RpcHandler (r ++ EmbedStack ())] ->+  Sem (r ++ EmbedStack ()) () ->+  IO ()+runEmbedPluginIO conf effs handlers =+  runEmbedStack conf .+  effs .+  withHandlers handlers .+  embedPlugin++-- |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.+runEmbedPluginIO_ ::+  PluginConfig () ->+  [RpcHandler (EmbedStack ())] ->+  Sem (EmbedStack ()) () ->+  IO ()+runEmbedPluginIO_ conf handlers =+  runEmbedStack conf .+  withHandlers handlers .+  embedPlugin
− lib/Ribosome/Error/Report.hs 
@@ -1,117 +0,0 @@-module Ribosome.Error.Report where--import qualified Data.Map.Strict as Map (alter)-import Data.Text.Prettyprint.Doc (line, pretty)-import Data.Text.Prettyprint.Doc.Render.Terminal (putDoc)-import System.Log (Priority(NOTICE))--import Ribosome.Api.Echo (echom)-import Ribosome.Control.Monad.Ribo (MonadRibo, Nvim, NvimE, RNeovim, Ribo, runRibo)-import qualified Ribosome.Control.Monad.Ribo as Ribo (getErrors, modifyErrors, pluginName)-import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))-import Ribosome.Data.Errors (ComponentName(ComponentName), Error(Error), Errors(Errors))-import Ribosome.Error.Report.Class (ReportError(..))-import Ribosome.Log (logAs)-import Ribosome.Nvim.Api.RpcCall (RpcError)-import Ribosome.System.Time (epochSeconds)--storeError' :: Int -> Text -> ErrorReport -> Errors -> Errors-storeError' time name report (Errors errors) =-  Errors (Map.alter alter (ComponentName name) errors)-  where-    err = Error time report-    alter Nothing = Just [err]-    alter (Just current) = Just (err:current)--storeError :: MonadRibo m => Text -> ErrorReport -> m ()-storeError name e = do-  time <- epochSeconds-  Ribo.modifyErrors $ storeError' time name e--logErrorReport ::-  (MonadRibo m, NvimE e m) =>-  ErrorReport ->-  m ()-logErrorReport (ErrorReport user logMsgs prio) = do-  name <- Ribo.pluginName-  liftIO $ traverse_ (logAs prio name) logMsgs-  when (prio >= NOTICE) (echom user)--processErrorReport ::-  (MonadRibo m, NvimE e m) =>-  Text ->-  ErrorReport ->-  m ()-processErrorReport name report = do-  storeError name report-  logErrorReport report--processErrorReport' ::-  (MonadRibo m, Nvim m) =>-  Text ->-  ErrorReport ->-  m ()-processErrorReport' name =-  void . runExceptT @RpcError . processErrorReport name--reportErrorWith ::-  (MonadRibo m, NvimE e m) =>-  Text ->-  (a -> ErrorReport) ->-  a ->-  m ()-reportErrorWith name cons err =-  processErrorReport name (cons err)--reportError ::-  MonadRibo m =>-  NvimE e m =>-  ReportError a =>-  Text ->-  a ->-  m ()-reportError name =-  reportErrorWith name errorReport--reportErrorOr ::-  (MonadRibo m, NvimE e m, ReportError e) =>-  Text ->-  (a -> m ()) ->-  Either e a ->-  m ()-reportErrorOr name =-  either $ reportError name--reportErrorOr_ ::-  (MonadRibo m, NvimE e m, ReportError e) =>-  Text ->-  m () ->-  Either e a ->-  m ()-reportErrorOr_ name =-  reportErrorOr name . const--reportError' ::-  ∀ e m a .-  (MonadRibo m, Nvim m, ReportError e) =>-  Text ->-  Either e a ->-  m ()-reportError' _ (Right _) =-  return ()-reportError' componentName (Left e) =-  void $ runExceptT @RpcError $ reportError componentName e--printAllErrors :: MonadRibo m => m ()-printAllErrors = do-  errors <- Ribo.getErrors-  liftIO $ putDoc (pretty errors <> line)--runRiboReport ::-  ∀ e s.-  ReportError e =>-  Text ->-  Ribo s e () ->-  RNeovim s ()-runRiboReport componentName =-  reportError' componentName <=< runRibo
− lib/Ribosome/Error/Report/Class.hs 
@@ -1,52 +0,0 @@-module Ribosome.Error.Report.Class where--import qualified Data.Text as Text (pack)-import GHC.Generics (K1(..), M1(..), Rep, from, (:+:)(..))-import System.Log.Logger (Priority(NOTICE, DEBUG))--import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))--class ReportError a where-  errorReport :: a -> ErrorReport-  default errorReport ::-    Generic a =>-    GenReportError (Rep a) =>-    a ->-    ErrorReport-  errorReport =-    genErrorReport . from--class GenReportError f where-  genErrorReport :: f a -> ErrorReport--instance GenReportError f => GenReportError (M1 i c f) where-  genErrorReport =-    genErrorReport . unM1--instance (GenReportError f, GenReportError g) => GenReportError (f :+: g) where-  genErrorReport (L1 a) =-    genErrorReport a-  genErrorReport (R1 a) =-    genErrorReport a--instance ReportError a => GenReportError (K1 i a) where-  genErrorReport =-    errorReport . unK1--instance ReportError [Char] where-  errorReport msg = ErrorReport (Text.pack msg) (Text.pack <$> [msg]) NOTICE--instance ReportError [[Char]] where-  errorReport (msg : extra) = ErrorReport (Text.pack msg) (Text.pack <$> (msg : extra)) NOTICE-  errorReport [] = ErrorReport "empty error" ["empty error"] DEBUG--instance ReportError Text where-  errorReport msg = ErrorReport msg [msg] NOTICE--instance ReportError [Text] where-  errorReport (msg : extra) =-    ErrorReport msg (msg : extra) NOTICE-  errorReport [] = ErrorReport "empty error" ["empty error"] DEBUG--instance ReportError () where-  errorReport _ = ErrorReport "" [] DEBUG
+ lib/Ribosome/Examples/Example1.hs view
@@ -0,0 +1,21 @@+{-# options_haddock prune, hide #-}++-- |An example for the docs.+module Ribosome.Examples.Example1 where++import Ribosome+import Ribosome.Api++count ::+  Member (Rpc !! RpcError) r =>+  Int ->+  Handler r Int+count n = do+  s <- 0 <! nvimGetVar "counter"+  let s' = s + n+  ignoreRpcError (nvimSetVar "counter" s')+  pure s'++main :: IO ()+main =+  runNvimPluginIO_ "counter" [rpcFunction "Count" Sync count]
+ lib/Ribosome/Examples/Example2.hs view
@@ -0,0 +1,20 @@+{-# options_haddock prune, hide #-}++-- |An example for the docs.+module Ribosome.Examples.Example2 where++import Data.MessagePack (Object)++import Ribosome+import Ribosome.Api++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)
+ lib/Ribosome/Examples/Example3.hs view
@@ -0,0 +1,19 @@+{-# options_haddock prune, hide #-}++-- |An example for the docs.+module Ribosome.Examples.Example3 where++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" []
− lib/Ribosome/File.hs 
@@ -1,19 +0,0 @@-module Ribosome.File where--import qualified Data.Text as Text-import System.Directory (canonicalizePath, getHomeDirectory)--canonicalPathWithHome :: FilePath -> FilePath -> FilePath-canonicalPathWithHome home path =-  toString (Text.replace "~" (toText home) (toText path))--canonicalPath :: MonadIO m => FilePath -> m FilePath-canonicalPath path = do-  home <- liftIO getHomeDirectory-  return $ canonicalPathWithHome home path--canonicalPaths :: MonadIO m => [FilePath] -> m [FilePath]-canonicalPaths paths = do-  home <- liftIO getHomeDirectory-  let withHome = fmap (canonicalPathWithHome home) paths-  liftIO $ mapM canonicalizePath withHome
+ lib/Ribosome/Final.hs view
@@ -0,0 +1,31 @@+{-# options_haddock prune, hide #-}++-- |Combinators for using 'Final', used internally.+module Ribosome.Final where++import Polysemy.Final (withWeavingToFinal)++inFinal ::+  ∀ r a .+  Member (Final IO) r =>+  (∀ f . Functor f => f () -> (∀ x . Sem r x -> IO (f x)) -> (∀ x . x -> IO (f x)) -> (∀ x . f x -> Maybe x) -> IO (f a)) ->+  Sem r a+inFinal f =+  withWeavingToFinal \ s wv ex ->+    f s (\ ma -> wv (ma <$ s)) (\ a -> pure (a <$ s)) ex++inFinal_ ::+  ∀ r a .+  Member (Final IO) r =>+  (∀ f . Functor f => (∀ x . Sem r x -> IO (Maybe x)) -> (Sem r () -> IO ()) -> (∀ x . x -> IO (f x)) -> IO (f a)) ->+  Sem r a+inFinal_ f =+  withWeavingToFinal \ s wv ex ->+    let+      lowerMaybe :: ∀ x . Sem r x -> IO (Maybe x)+      lowerMaybe sem =+        ex <$> wv (sem <$ s)+      lowerUnit :: ∀ x . Sem r x -> IO ()+      lowerUnit =+        fmap (fromMaybe ()) . lowerMaybe . void+    in f lowerMaybe lowerUnit (\ a -> pure (a <$ s))
+ lib/Ribosome/Float.hs view
@@ -0,0 +1,13 @@+-- |Data types for floating window configuration.+module Ribosome.Float (+  module Ribosome.Data.FloatOptions+) where++import Ribosome.Data.FloatOptions (+  FloatAnchor (..),+  FloatBorder (..),+  FloatOptions (..),+  FloatRelative (..),+  FloatStyle (..),+  FloatZindex (..),+  )
+ lib/Ribosome/IOStack.hs view
@@ -0,0 +1,37 @@+-- |Interpreters for basic plugin effects down to 'IO'+module Ribosome.IOStack where++import Ribosome.Cli (withCli)+import Ribosome.Data.CustomConfig (CustomConfig (CustomConfig))+import Ribosome.Data.PluginConfig (PluginConfig (PluginConfig))+import Ribosome.Data.PluginName (PluginName)+import Ribosome.Host.Data.HostConfig (HostConfig)+import Ribosome.Host.IOStack (BasicStack, runBasicStack)++-- |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'.+type BasicPluginStack c =+  Reader PluginName : Reader (CustomConfig c) : BasicStack++-- |Execute the basic plugin stack all the way to an 'IO', given the plugin name and logging settings.+runBasicPluginStack ::+  PluginName ->+  HostConfig ->+  c ->+  Sem (BasicPluginStack c) () ->+  IO ()+runBasicPluginStack name conf custom =+  runBasicStack conf .+  runReader (CustomConfig custom) .+  runReader name++-- |Execute the basic plugin stack all the way to an 'IO' like 'runBasicPluginStack', reading config overrides from+-- command line options.+runCli ::+  PluginConfig c ->+  Sem (BasicPluginStack c) () ->+  IO ()+runCli (PluginConfig name defaultConf customParser) prog =+  withCli name defaultConf customParser \ conf custom ->+    runBasicPluginStack name conf custom prog
− lib/Ribosome/Internal/IO.hs 
@@ -1,19 +0,0 @@-module Ribosome.Internal.IO where--import Control.Concurrent (forkIO)-import Control.Monad.Trans.Resource (runResourceT)-import Neovim.Context.Internal (Config(..), Neovim(..), retypeConfig, runNeovim)-import qualified Control.Monad.Reader as ReaderT--retypeNeovim :: (e0 -> e1) -> Neovim e1 a -> Neovim e0 a-retypeNeovim transform thunk = do-  env <- Neovim ReaderT.ask-  liftIO $ runReaderT (withReaderT (newEnv env) $ runResourceT $ unNeovim thunk) env-  where-    newEnv = retypeConfig . transform . customConfig--forkNeovim :: Neovim e () -> Neovim e ()-forkNeovim thunk = do-  env <- Neovim ReaderT.ask-  _ <- liftIO $ forkIO $ void $ runNeovim env thunk-  return ()
− lib/Ribosome/Internal/NvimObject.hs 
@@ -1,23 +0,0 @@-module Ribosome.Internal.NvimObject where--import Data.Map.Strict ((!?))-import Data.Text.Prettyprint.Doc (pretty, (<+>))-import Neovim (AnsiStyle, Doc, NvimObject, Object(ObjectString), fromObject)--deriveString :: (Text -> a) -> Object -> Either (Doc AnsiStyle) a-deriveString cons o = fmap cons (fromObject o :: Either (Doc AnsiStyle) Text)--objectKeyMissing :: Text -> Maybe Object -> Either (Doc AnsiStyle) Object-objectKeyMissing _ (Just o) = Right o-objectKeyMissing key Nothing = Left (pretty ("missing key in nvim data:" :: Text) <+> pretty key)--extractObject :: NvimObject o => Text -> Map Object Object -> Either (Doc AnsiStyle) o-extractObject key data' = do-  value <- objectKeyMissing key $ data' !? (ObjectString . encodeUtf8) key-  fromObject value--extractObjectOr :: NvimObject o => Text -> o -> Map Object Object -> o-extractObjectOr key default' data' =-  case extractObject key data' of-    Right a -> a-    Left _ -> default'
+ lib/Ribosome/Internal/Path.hs view
@@ -0,0 +1,17 @@+{-# options_haddock prune, hide #-}++-- |Internal combinators for paths.+module Ribosome.Internal.Path where++import Exon (exon)++import Ribosome.Host.Data.Report (Report)++failInvalidPath ::+  Member (Stop Report) r =>+  Text ->+  Maybe a ->+  Sem r a+failInvalidPath spec result =+  withFrozenCallStack do+    stopNote (fromText [exon|Invalid path: #{spec}|]) result
+ lib/Ribosome/Internal/Scratch.hs view
@@ -0,0 +1,334 @@+{-# options_haddock prune #-}++-- |Internal logic for 'Ribosome.Scratch'.+module Ribosome.Internal.Scratch where++import qualified Data.Map.Strict as Map+import Data.MessagePack (Object)+import Exon (exon)+import qualified Polysemy.Log as Log+import Prelude hiding (group)++import Ribosome.Api.Autocmd (bufferAutocmd, eventignore)+import Ribosome.Api.Buffer (setBufferContent, wipeBuffer)+import Ribosome.Api.Syntax (executeWindowSyntax)+import Ribosome.Api.Tabpage (closeTabpage)+import Ribosome.Api.Window (closeWindow)+import Ribosome.Data.FloatOptions (FloatOptions, enter)+import Ribosome.Data.PluginName (PluginName (PluginName))+import Ribosome.Data.ScratchId (ScratchId (ScratchId, unScratchId))+import Ribosome.Data.ScratchOptions (ScratchOptions (ScratchOptions, filetype, name), focus, mappings, syntax)+import qualified Ribosome.Data.ScratchState as ScratchState+import Ribosome.Data.ScratchState (ScratchState (ScratchState))+import Ribosome.Host.Api.Data (Buffer, Tabpage, Window)+import Ribosome.Host.Api.Effect (+  bufferGetName,+  bufferSetName,+  bufferSetOption,+  nvimBufIsLoaded,+  nvimCreateBuf,+  nvimDelAutocmd,+  nvimOpenWin,+  vimCommand,+  vimGetCurrentBuffer,+  vimGetCurrentTabpage,+  vimGetCurrentWindow,+  vimSetCurrentWindow,+  windowGetBuffer,+  windowIsValid,+  windowSetHeight,+  windowSetOption,+  windowSetWidth,+  )+import Ribosome.Host.Class.Msgpack.Decode (fromMsgpack)+import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Data.RpcType (AutocmdId (AutocmdId), group)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Mapping (activateBufferMapping)+import Ribosome.PluginName (pluginNamePascalCase)++createScratchTab :: Member Rpc r => Sem r Tabpage+createScratchTab = do+  vimCommand "tabnew"+  vimGetCurrentTabpage++createRegularWindow ::+  Member Rpc r =>+  Bool ->+  Bool ->+  Maybe Int ->+  Sem r (Buffer, Window)+createRegularWindow vertical bottom size = do+  vimCommand prefixedCmd+  buf <- vimGetCurrentBuffer+  win <- vimGetCurrentWindow+  pure (buf, win)+  where+    prefixedCmd = locationPrefix <> " " <> sizePrefix <> cmd+    cmd = if vertical then "vnew" else "new"+    sizePrefix = maybe "" show size+    locationPrefix = if bottom then "belowright" else "aboveleft"++floatConfig ::+  FloatOptions ->+  Map Text Object+floatConfig =+  fromRight Map.empty . fromMsgpack . toMsgpack++createFloatWith ::+  Member Rpc r =>+  Bool ->+  Bool ->+  FloatOptions ->+  Sem r (Buffer, Window)+createFloatWith listed scratch options = do+  buffer <- nvimCreateBuf listed scratch+  window <- nvimOpenWin buffer (enter options) (floatConfig options)+  pure (buffer, window)++createFloat ::+  Member Rpc r =>+  FloatOptions ->+  Sem r (Buffer, Window)+createFloat =+  createFloatWith True True++createScratchWindow ::+  Member Rpc r =>+  Bool ->+  Bool ->+  Bool ->+  Maybe FloatOptions ->+  Maybe Int ->+  Sem r (Buffer, Window)+createScratchWindow vertical wrap bottom float size = do+  (buffer, win) <- createWindow+  windowSetOption win "wrap" (toMsgpack wrap)+  windowSetOption win "number" (toMsgpack False)+  windowSetOption win "cursorline" (toMsgpack True)+  windowSetOption win "colorcolumn" (toMsgpack ("" :: Text))+  windowSetOption win "foldmethod" (toMsgpack ("manual" :: Text))+  windowSetOption win "conceallevel" (toMsgpack (2 :: Int))+  windowSetOption win "concealcursor" (toMsgpack ("nvic" :: Text))+  pure (buffer, win)+  where+    createWindow =+      maybe regular createFloat float+    regular =+      createRegularWindow vertical bottom size++createScratchUiInTab :: Member Rpc r => Sem r (Buffer, Window, Maybe Tabpage)+createScratchUiInTab = do+  tab <- createScratchTab+  win <- vimGetCurrentWindow+  buffer <- windowGetBuffer win+  pure (buffer, win, Just tab)++createScratchUi ::+  Member Rpc r =>+  ScratchOptions ->+  Sem r (Buffer, Window, Maybe Tabpage)+createScratchUi (ScratchOptions False vertical wrap _ _ bottom _ float size _ _ _ _ _) =+  uncurry (,,Nothing) <$> createScratchWindow vertical wrap bottom float size+createScratchUi _ =+  createScratchUiInTab++configureScratchBuffer ::+  Member Rpc r =>+  Buffer ->+  Maybe Text ->+  ScratchId ->+  Sem r ()+configureScratchBuffer buffer ft (ScratchId name) = do+  bufferSetOption buffer "bufhidden" ("wipe" :: Text)+  bufferSetOption buffer "buftype" ("nofile" :: Text)+  bufferSetOption buffer "swapfile" False+  traverse_ (bufferSetOption buffer "filetype") ft+  bufferSetName buffer name++setupScratchBuffer ::+  Members [Rpc, Log] r =>+  Window ->+  Buffer ->+  Maybe Text ->+  ScratchId ->+  Sem r Buffer+setupScratchBuffer window buffer ft name = do+  valid <- nvimBufIsLoaded buffer+  Log.debug [exon|#{if valid then "" else "in"}valid scratch buffer|]+  validBuffer <- if valid then pure buffer else windowGetBuffer window+  configureScratchBuffer validBuffer ft name+  pure validBuffer++setupDeleteAutocmd ::+  Members [Rpc, Reader PluginName] r =>+  ScratchId ->+  Buffer ->+  Sem r AutocmdId+setupDeleteAutocmd (ScratchId name) buffer = do+  PluginName pname <- pluginNamePascalCase+  bufferAutocmd buffer "BufDelete" def { group = Just "RibosomeScratch" } (deleteCall pname)+  where+    deleteCall pname =+      [exon|silent! call #{pname}DeleteScratch('#{name}')|]++setupScratchIn ::+  Members [Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log] r =>+  Buffer ->+  Window ->+  Window ->+  Maybe Tabpage ->+  ScratchOptions ->+  Sem r ScratchState+setupScratchIn buffer previous window tab options@(ScratchOptions {..}) = do+  validBuffer <- setupScratchBuffer window buffer filetype name+  traverse_ (executeWindowSyntax window) syntax+  traverse_ (activateBufferMapping validBuffer) mappings+  unless focus (vimSetCurrentWindow previous)+  auId <- setupDeleteAutocmd name validBuffer+  let scratch = ScratchState name options validBuffer window previous tab auId+  atomicModify' (Map.insert name scratch)+  pure scratch++createScratch ::+  Members [Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>+  ScratchOptions ->+  Sem r ScratchState+createScratch options = do+  Log.debug [exon|creating new scratch: #{show options}|]+  previous <- vimGetCurrentWindow+  (buffer, window, tab) <- eventignore (createScratchUi options)+  eventignore $ setupScratchIn buffer previous window tab options++bufferStillLoaded ::+  Members [Rpc !! RpcError, Rpc] r =>+  ScratchId ->+  Buffer ->+  Sem r Bool+bufferStillLoaded (ScratchId name) buffer =+  (&&) <$> loaded <*> loadedName+  where+    loaded =+      nvimBufIsLoaded buffer+    loadedName =+      resumeAs @RpcError False ((name ==) <$> bufferGetName buffer)++updateScratch ::+  Members [Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>+  ScratchState ->+  ScratchOptions ->+  Sem r ScratchState+updateScratch oldScratch@(ScratchState name _ oldBuffer oldWindow _ _ _) options = do+  Log.debug [exon|updating existing scratch `#{coerce name}`|]+  ifM (windowIsValid oldWindow) attemptReuseWindow reset+  where+    attemptReuseWindow =+      ifM (bufferStillLoaded name oldBuffer) (pure oldScratch) closeAndReset+    closeAndReset =+      closeWindow oldWindow *> reset+    reset =+      createScratch options++lookupScratch ::+  Member (AtomicState (Map ScratchId ScratchState)) r =>+  ScratchId ->+  Sem r (Maybe ScratchState)+lookupScratch name =+  atomicGets (Map.lookup name)++ensureScratch ::+  Members [Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>+  ScratchOptions ->+  Sem r ScratchState+ensureScratch options = do+  f <- maybe createScratch updateScratch <$> lookupScratch (options ^. #name)+  f options++withModifiable ::+  Member Rpc r =>+  Buffer ->+  ScratchOptions ->+  Sem r a ->+  Sem r a+withModifiable buffer options thunk =+  if isWrite then thunk else wrap+  where+    isWrite =+      options ^. #modify+    wrap =+      update True *> thunk <* update False+    update =+      bufferSetOption buffer "modifiable"++setScratchContent ::+  Foldable t =>+  Members [Rpc !! RpcError, Rpc] r =>+  ScratchState ->+  t Text ->+  Sem r ()+setScratchContent (ScratchState _ options buffer win _ _ _) lines' = do+  withModifiable buffer options $ setBufferContent buffer (toList lines')+  when (options ^. #resize) (resume_ @RpcError @Rpc (setSize win size))+  where+    size =+      max 1 calculateSize+    calculateSize =+      if vertical then fromMaybe 50 maxSize else min (length lines') (fromMaybe 30 maxSize)+    maxSize =+      options ^. #maxSize+    vertical =+      options ^. #vertical+    setSize =+      if vertical then windowSetWidth else windowSetHeight++showInScratch ::+  Foldable t =>+  Members [Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>+  t Text ->+  ScratchOptions ->+  Sem r ScratchState+showInScratch lines' options = do+  scratch <- ensureScratch options+  scratch <$ setScratchContent scratch lines'++showInScratchDef ::+  Foldable t =>+  Members [Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>+  t Text ->+  Sem r ScratchState+showInScratchDef lines' =+  showInScratch lines' def++killScratch ::+  Members [Rpc !! RpcError, AtomicState (Map ScratchId ScratchState), Log] r =>+  ScratchState ->+  Sem r ()+killScratch (ScratchState name _ buffer window _ tab (AutocmdId auId)) = do+  Log.debug [exon|Killing scratch buffer `#{unScratchId name}`|]+  atomicModify' (Map.delete @_ @ScratchState name)+  resume_ (nvimDelAutocmd auId)+  traverse_ (resume_ . closeTabpage) tab+  resume_ (closeWindow window)+  resume_ (wipeBuffer buffer)++scratchPreviousWindow ::+  Member (AtomicState (Map ScratchId ScratchState)) r =>+  ScratchId ->+  Sem r (Maybe Window)+scratchPreviousWindow =+  fmap (fmap ScratchState.previous) . lookupScratch++scratchWindow ::+  Member (AtomicState (Map ScratchId ScratchState)) r =>+  ScratchId ->+  Sem r (Maybe Window)+scratchWindow =+  fmap (fmap ScratchState.window) . lookupScratch++scratchBuffer ::+  Member (AtomicState (Map ScratchId ScratchState)) r =>+  ScratchId ->+  Sem r (Maybe Buffer)+scratchBuffer =+  fmap (fmap ScratchState.buffer) . lookupScratch
+ lib/Ribosome/Internal/Syntax.hs view
@@ -0,0 +1,69 @@+{-# options_haddock prune #-}++-- |Internal combinators for syntax.+module Ribosome.Internal.Syntax where++import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import Exon (exon)++import Ribosome.Data.Syntax (+  HiLink (HiLink),+  Highlight (Highlight),+  Syntax (Syntax),+  SyntaxItem (SyntaxItem),+  SyntaxItemDetail (Keyword, Match, Region, Verbatim),+  )+import qualified Ribosome.Host.Api.Data as Data+import Ribosome.Host.Data.RpcCall (RpcCall)++joinEquals :: Map Text Text -> Text+joinEquals =+  unwords . fmap equals . Map.toList+  where+    equals (a, b) =+      [exon|#{a}=#{b}|]++synPattern :: Text -> Text+synPattern pat =+  [exon|/#{pat}/|]++namedPattern :: Text -> Text -> Text -> Text+namedPattern param pat offset =+  [exon|#{param}=#{synPattern pat}#{offset}|]++syntaxItemDetailCmd :: SyntaxItemDetail -> [Text]+syntaxItemDetailCmd (Keyword group' keyword keywords) =+  ["syntax", "keyword", group', keyword, unwords keywords]+syntaxItemDetailCmd (Match group' pat) =+  ["syntax", "match", group', synPattern pat]+syntaxItemDetailCmd (Region group' start end skip ms me) =+  ["syntax", "region", group', namedPattern "start" start ms] <> foldMap skipArg skip <> [namedPattern "end" end me]+  where+    skipArg a = [namedPattern "skip" a ""]+syntaxItemDetailCmd (Verbatim cmd) =+  [cmd]++syntaxItemCmd :: SyntaxItem -> [Text]+syntaxItemCmd (SyntaxItem detail options params) =+  syntaxItemDetailCmd detail <> [unwords options, joinEquals params]++highlightCmd :: Highlight -> [Text]+highlightCmd (Highlight group' values) =+  ["highlight", "default", group', joinEquals values]++hilinkCmd :: HiLink -> [Text]+hilinkCmd (HiLink group' target) =+  ["highlight", "default", "link", group', target]++syntaxCmds :: Syntax -> [[Text]]+syntaxCmds (Syntax items highlights hilinks) =+  (syntaxItemCmd <$> items) <> (highlightCmd <$> highlights) <> (hilinkCmd <$> hilinks)++catCmd :: [Text] -> RpcCall ()+catCmd =+  Data.nvimCommand . Text.unwords++catCmds :: [[Text]] -> RpcCall ()+catCmds =+  foldMap catCmd
+ lib/Ribosome/Interpreter/Persist.hs view
@@ -0,0 +1,103 @@+-- |Interpreters for 'Persist'+module Ribosome.Interpreter.Persist where++import Data.Aeson (eitherDecodeFileStrict', encodeFile)+import Exon (exon)+import qualified Log+import Path (Abs, Dir, File, Path, Rel, parent, parseRelDir, parseRelFile, toFilePath, (</>))+import Path.IO (createDirIfMissing, doesFileExist)++import qualified Ribosome.Data.PersistError as PersistError+import Ribosome.Data.PersistError (PersistError)+import Ribosome.Data.PersistPathError (PersistPathError)+import qualified Ribosome.Effect.Persist as Persist+import Ribosome.Effect.Persist (Persist)+import Ribosome.Effect.PersistPath (PersistPath, persistRoot)+import Ribosome.Host.Data.BootError (BootError (BootError))+import Ribosome.Host.Interpret (with)+import Ribosome.Host.Path (pathText)++-- |Obtain the root directory or stop.+persistBase ::+  Members [PersistPath !! PersistPathError, Stop PersistError] r =>+  Sem r (Path Abs Dir)+persistBase =+  resumeHoist PersistError.Path persistRoot++-- |Load a file and JSON-decode it.+loadFile ::+  FromJSON a =>+  Members [Stop PersistError, Log, Embed IO] r =>+  Path Abs File ->+  Sem r a+loadFile file = do+  Log.debug [exon|Loading persistence file: #{show file}|]+  stopEitherWith decodeFailed =<< stopNote notReadable =<< tryMaybe (eitherDecodeFileStrict' (toFilePath file))+  where+    notReadable =+      PersistError.Permission (pathText file)+    decodeFailed =+      PersistError.Decode (pathText file) . toText++-- |Determine the path to use for a 'Persist' action.+-- If a @subpath@ is given, append it to @dir@, otherwise use @singleFile@.+-- Append the result of the first step to the root dir given by 'PersistPath'.+filepath ::+  Members [PersistPath !! PersistPathError, Stop PersistError] r =>+  Path Rel File ->+  Path Rel Dir ->+  Maybe (Path Rel File) ->+  Sem r (Path Abs File)+filepath singleFile dir subpath = do+  base <- persistBase+  pure (base </> maybe singleFile (dir </>) subpath)++-- |Interpret 'Persist' by writing to the file system.+--+-- Paths are determined as follows:+--+-- - 'PersistPath' defines the root directory for all 'Persist' 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 'Ribosome.Effect.Persist.store' or 'Ribosome.Effect.Persist.load' are invoked with 'Nothing' for the @subpath@+-- argument, a file named @<name>.json@ is used.+--+-- - When invoked with 'Just' a subpath, a file named @<name>/<subpath>.json@ is used.+--+-- This uses 'Resumable', see [Errors]("Ribosome#errors").+interpretPersist ::+  ToJSON a =>+  FromJSON a =>+  Members [PersistPath !! PersistPathError, Error BootError, Log, Embed IO] r =>+  Text ->+  InterpreterFor (Persist a !! PersistError) r+interpretPersist name =+  with parse \ (singleFile, dir) ->+    interpretResumable \case+      Persist.Store subpath a -> do+        path <- filepath singleFile dir subpath+        let base = parent path+        stopNote (PersistError.Permission (pathText base)) =<< tryMaybe (createDirIfMissing True base)+        embed (encodeFile (toFilePath path) a)+      Persist.Load subpath -> do+        path <- filepath singleFile dir subpath+        Log.debug [exon|Persistence path requested: #{show path}|]+        ifM (fromMaybe False <$> tryMaybe (doesFileExist path)) (loadFile path) (pure Nothing)+  where+    parse =+      note (BootError [exon|Invalid persist name: #{name}|]) namePaths+    namePaths =+      (,) <$> parseRelFile (toString [exon|#{name}.json|]) <*> parseRelDir (toString name)++-- |Interpret 'Persist' by storing nothing.+interpretPersistNull ::+  ∀ a err r .+  InterpreterFor (Persist a !! err) r+interpretPersistNull =+  interpretResumable \case+    Persist.Store _ _ ->+      unit+    Persist.Load _ ->+      pure Nothing
+ lib/Ribosome/Interpreter/PersistPath.hs view
@@ -0,0 +1,86 @@+-- |Interpreters for 'PersistPath'+module Ribosome.Interpreter.PersistPath where++import Path (Abs, Dir, Path, Rel, parseRelDir, (</>))+import Path.IO (XdgDirectory (XdgCache), createDirIfMissing, getXdgDir)++import Ribosome.Data.PersistPathError (PersistPathError (Permissions, Undefined))+import Ribosome.Data.PluginName (PluginName (unPluginName))+import Ribosome.Data.SettingError (SettingError)+import qualified Ribosome.Effect.PersistPath as PersistPath+import Ribosome.Effect.PersistPath (PersistPath (PersistPath))+import qualified Ribosome.Effect.Settings as Settings+import Ribosome.Effect.Settings (Settings)+import Ribosome.Host.Data.BootError (BootError)+import Ribosome.PluginName (pluginName)++-- |Append an optional subdir to a dir.+maybeSubdir :: Path b Dir -> Maybe (Path Rel Dir) -> Path b Dir+maybeSubdir root = \case+  Just sub ->+    root </> sub+  Nothing ->+    root++-- |Append an optional subdir to a dir and ensure existence of the resulting directory if 'True' is given.+persistPath ::+  Members [Stop PersistPathError, Embed IO] r =>+  Bool ->+  Path Abs Dir ->+  Maybe (Path Rel Dir) ->+  Sem r (Path Abs Dir)+persistPath create base sub = do+  when create (stopTryAny (const (Permissions path)) (createDirIfMissing True path))+  pure path+  where+    path =+      maybeSubdir base sub++-- |Interpret 'PersistPath' by using the specified root directory.+interpretPersistPathAt ::+  Member (Embed IO) r =>+  Bool ->+  Path Abs Dir ->+  InterpreterFor (PersistPath !! PersistPathError) r+interpretPersistPathAt create base =+  interpretResumable \case+    PersistPath sub ->+      persistPath create base sub++-- |Look up the XDG cache directory, returning 'Nothing' if it is unavailable.+xdgCache ::+  Member (Embed IO) r =>+  Sem r (Maybe (Path Abs Dir))+xdgCache =+  rightToMaybe <$> tryAny (getXdgDir XdgCache Nothing)++-- |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.+interpretPersistPathSetting ::+  Members [Settings !! SettingError, Embed IO] r =>+  Bool ->+  Maybe (Path Abs Dir) ->+  Path Rel Dir ->+  InterpreterFor (PersistPath !! PersistPathError) r+interpretPersistPathSetting create fallback name =+  interpretResumable \case+    PersistPath sub -> do+      base <- stopNote Undefined . (<|> fallback) =<< Settings.maybe PersistPath.setting+      persistPath create (base </> name) sub++-- |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.+--+-- This uses 'Resumable', see [Errors]("Ribosome#errors").+interpretPersistPath ::+  Members [Settings !! SettingError, Reader PluginName, Error BootError, Embed IO] r =>+  Bool ->+  InterpreterFor (PersistPath !! PersistPathError) r+interpretPersistPath create sem = do+  xdg <- xdgCache+  name <- note "plugin name not suitable for file system paths" . parseRelDir . toString . unPluginName =<< pluginName+  interpretPersistPathSetting create xdg name sem
+ lib/Ribosome/Interpreter/PluginName.hs view
@@ -0,0 +1,16 @@+-- |Interpreters for @'Reader' ('PluginConfig' c)@+module Ribosome.Interpreter.PluginName where++import Ribosome.Data.PluginConfig (PluginConfig (PluginConfig, name))+import Ribosome.Data.PluginName (PluginName)++-- |Interpret @'Reader' 'PluginName'@ by extracting the name from the plugin config provided by another @'Reader'+-- 'PluginConfig'@.+--+-- This interpreter is used by the main function machinery.+interpretPluginName ::+  Member (Reader (PluginConfig c)) r =>+  InterpreterFor (Reader PluginName) r+interpretPluginName sem =+  ask >>= \ PluginConfig {name} ->+    runReader name sem
+ lib/Ribosome/Interpreter/Scratch.hs view
@@ -0,0 +1,44 @@+-- |Interpreters for 'Scratch'+module Ribosome.Interpreter.Scratch where++import Conc (interpretAtomic)+import qualified Data.Map.Strict as Map+import Exon (exon)++import Ribosome.Data.PluginName (PluginName)+import Ribosome.Data.ScratchId (ScratchId (ScratchId))+import Ribosome.Data.ScratchState (ScratchState)+import Ribosome.Effect.Scratch (Scratch (Delete, Find, Get, Show, Update))+import qualified Ribosome.Host.Data.RpcError as RpcError+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Internal.Scratch (killScratch, lookupScratch, setScratchContent, showInScratch)++-- |Interpret 'Scratch' by storing the Neovim UI handles in 'AtomicState'.+-- This uses 'Resumable', see [Errors]("Ribosome#errors").+interpretScratchAtomic ::+  Members [Rpc !! RpcError, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>+  InterpreterFor (Scratch !! RpcError) r+interpretScratchAtomic =+  interpretResumable \case+    Show text options ->+      restop (showInScratch text options)+    Update i text -> do+      s <- stopNote (RpcError.Unexpected [exon|No scratch buffer named '#{coerce i}' exists|]) =<< lookupScratch i+      s <$ restop @_ @Rpc (setScratchContent s text)+    Delete i ->+      traverse_ killScratch =<< lookupScratch i+    Get ->+      atomicGets Map.elems+    Find i ->+      atomicGets (Map.lookup i)++-- |Interpret 'Scratch' by storing the Neovim UI handles in 'AtomicState'.+-- This uses 'Resumable', see [Errors]("Ribosome#errors").+interpretScratch ::+  Members [Rpc !! RpcError, Reader PluginName, Log, Resource, Embed IO] r =>+  InterpreterFor (Scratch !! RpcError) r+interpretScratch =+  interpretAtomic mempty .+  interpretScratchAtomic .+  raiseUnder
+ lib/Ribosome/Interpreter/Settings.hs view
@@ -0,0 +1,68 @@+-- |Interpreters for 'Settings'+module Ribosome.Interpreter.Settings where++import Exon (exon)++import Ribosome.Data.PluginName (PluginName (PluginName))+import Ribosome.Data.Setting (Setting (Setting))+import qualified Ribosome.Data.SettingError as SettingError+import Ribosome.Data.SettingError (SettingError)+import Ribosome.Effect.Settings (Settings (Get, Update))+import Ribosome.Host.Api.Effect (nvimGetVar, nvimSetVar)+import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode)+import qualified Ribosome.Host.Data.RpcError as RpcError+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.PluginName (pluginName)++-- |Assemble the name of a setting variable by prefixing the 'Setting' key with the plugin name if the flag is set.+settingVariableName ::+  Member (Reader PluginName) r =>+  Setting a ->+  Sem r Text+settingVariableName = \case+  Setting key False _ ->+    pure key+  Setting key True _ -> do+    PluginName name <- pluginName+    pure [exon|#{name}_#{key}|]++-- |Fetch the value for a setting stored in its Neovim variable.+settingRaw ::+  Members [Rpc, Reader PluginName] r =>+  MsgpackDecode a =>+  Setting a ->+  Sem r a+settingRaw s =+  nvimGetVar =<< settingVariableName s++-- |Return the default value for a setting or stop with an error if none is set.+fallback ::+  Members [Reader PluginName, Stop SettingError] r =>+  Setting a ->+  Sem r a+fallback = \case+  Setting _ _ (Just a) ->+    pure a+  s@(Setting _ _ Nothing) -> do+    n <- settingVariableName s+    stop (SettingError.Unset n)++-- |Interpret 'Settings' natively, using Neovim variables.+interpretSettingsRpc ::+  Members [Rpc !! RpcError, Reader PluginName] r =>+  InterpreterFor (Settings !! SettingError) r+interpretSettingsRpc =+  interpretResumable \case+    Get s ->+      settingRaw s !! \case+        RpcError.Decode e -> do+          n <- settingVariableName s+          stop (SettingError.Decode n e)+        RpcError.Api _ _ _ ->+          fallback s+        RpcError.Unexpected _ ->+          fallback s+    Update s a -> do+      n <- settingVariableName s+      resumeHoist (SettingError.UpdateFailed n) (nvimSetVar n a)
+ lib/Ribosome/Interpreter/UserError.hs view
@@ -0,0 +1,19 @@+-- |Interpreters for 'UserError'.+module Ribosome.Interpreter.UserError where++import Log (Severity (Info))++import Ribosome.Data.PluginName (PluginName)+import Ribosome.Host.Effect.UserError (UserError (UserError))+import Ribosome.PluginName (pluginNamePrefixed)++-- |Interpret 'UserError' by prefixing messages with the plugin name.+interpretUserErrorPrefixed ::+  Member (Reader PluginName) r =>+  InterpreterFor UserError r+interpretUserErrorPrefixed =+  interpret \case+    UserError e severity | severity >= Info ->+      Just . pure <$> pluginNamePrefixed e+    UserError _ _ ->+      pure Nothing
+ lib/Ribosome/Interpreter/VariableWatcher.hs view
@@ -0,0 +1,80 @@+-- |Interpreters for 'VariableWatcher'+module Ribosome.Interpreter.VariableWatcher where++import Conc (interpretAtomic, interpretLockReentrant, lockOrSkip_)+import qualified Data.Map.Strict as Map+import Data.MessagePack (Object (ObjectNil))++import Ribosome.Effect.VariableWatcher (WatchedVariable (WatchedVariable))+import qualified Ribosome.Effect.VariableWatcher as VariableWatcher+import Ribosome.Effect.VariableWatcher (VariableWatcher)+import Ribosome.Host.Api.Effect (nvimGetVar)+import Ribosome.Host.Data.Report (Report)+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Data.RpcHandler (Handler)+import Ribosome.Host.Effect.Rpc (Rpc)++-- |Interpret 'VariableWatcher' by doing nothing.+interpretVariableWatcherNull :: InterpreterFor (VariableWatcher !! Report) r+interpretVariableWatcherNull =+  interpretResumable \case+    VariableWatcher.Update -> unit+    VariableWatcher.Unwatch _ -> unit++-- |Run the handler if the two 'Object's are different.+runIfDifferent ::+  (Object -> Handler r ()) ->+  Object ->+  Object ->+  Handler r ()+runIfDifferent handler new old =+  unless (old == new) (handler new)++-- |Fetch the current value of the watched variable and call the handler if its value has changed.+checkVar ::+  Member (Rpc !! RpcError) r =>+  WatchedVariable ->+  Object ->+  (Object -> Handler r ()) ->+  Handler r Object+checkVar (WatchedVariable var) old handler =+  resumeAs old do+    new <- nvimGetVar var+    new <$ raise (runIfDifferent handler new old)++-- |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 'Ribosome.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.+watchVariables ::+  Members [VariableWatcher !! Report, Rpc !! RpcError, Resource, Mask mres, Race, Embed IO] r =>+  Map WatchedVariable (Object -> Handler r ()) ->+  Sem r a ->+  Sem r a+watchVariables vars =+  interpretLockReentrant .+  interpretAtomic ((ObjectNil,) <$> vars) .+  interceptResumable \case+    VariableWatcher.Update -> do+      lockOrSkip_ do+        atomicPut =<< Map.traverseWithKey (\ var (old, h) -> (,h) <$> raiseUnder2 (checkVar var old h)) =<< atomicGet+      restop @Report VariableWatcher.update+    VariableWatcher.Unwatch var -> do+      atomicModify' (Map.delete var)+      restop @Report (VariableWatcher.unwatch var)+  . raise . raise++-- |Interpret 'VariableWatcher' with 'watchVariables', but eliminate the effect from the stack.+interpretVariableWatcher ::+  Members [Rpc !! RpcError, Resource, Mask mres, Race, Embed IO] r =>+  Map WatchedVariable (Object -> Handler (VariableWatcher !! Report : r) ()) ->+  InterpreterFor (VariableWatcher !! Report) r+interpretVariableWatcher vars =+  interpretVariableWatcherNull . watchVariables vars
+ lib/Ribosome/Lens.hs view
@@ -0,0 +1,9 @@+{-# options_haddock prune, hide #-}++-- |Lens combinators, used internally+module Ribosome.Lens where++(<|>~) :: Alternative f => ASetter s t (f a) (f a) -> f a -> s -> t+l <|>~ fa =+  over l (<|> fa)+{-# inline (<|>~) #-}
− lib/Ribosome/Log.hs 
@@ -1,146 +0,0 @@-module Ribosome.Log where--import qualified Data.ByteString.UTF8 as ByteString (toString)-import qualified Data.Text as Text (unpack)-import System.Log.Logger (Priority(DEBUG, ERROR, INFO), logM)--import Ribosome.Control.Monad.Ribo (MonadRibo, pluginName)--class Loggable a where-  logLines :: a -> [String]--instance {-# OVERLAPPABLE #-} Loggable a => Loggable [a] where-  logLines =-    (>>= logLines)--instance {-# OVERLAPPING #-} Loggable String where-  logLines = pure--instance Loggable ByteString where-  logLines = pure . ByteString.toString--instance Loggable Text where-  logLines = pure . Text.unpack--logAs ::-  Loggable a =>-  MonadIO m =>-  Priority ->-  Text ->-  a ->-  m ()-logAs prio name = liftIO . traverse_ (logM (toString name) prio) . logLines--debugAs ::-  Loggable a =>-  MonadIO m =>-  Text ->-  a ->-  m ()-debugAs =-  logAs DEBUG--infoAs ::-  Loggable a =>-  MonadIO m =>-  Text ->-  a ->-  m ()-infoAs =-  logAs INFO--errAs ::-  Loggable a =>-  MonadIO m =>-  Text ->-  a ->-  m ()-errAs =-  logAs ERROR--prefixed :: (MonadIO m, Show a) => Text -> a -> m ()-prefixed prefix a = liftIO . putStrLn . toString $ prefix <> ": " <> show a--logR ::-  Loggable a =>-  MonadRibo m =>-  Priority ->-  a ->-  m ()-logR prio message = do-  n <- pluginName-  logAs prio n message--debug ::-  Loggable a =>-  MonadRibo m =>-  a ->-  m ()-debug =-  logR DEBUG--logDebug ::-  Loggable a =>-  MonadRibo m =>-  a ->-  m ()-logDebug = debug--showDebug ::-  Show a =>-  MonadRibo m =>-  Text ->-  a ->-  m ()-showDebug prefix a =-  logDebug @Text (prefix <> " " <> show a)--showDebugM ::-  Show a =>-  MonadRibo m =>-  Text ->-  m a ->-  m a-showDebugM prefix ma = do-  a <- ma-  logDebug @Text (prefix <> " " <> show a)-  return a--info ::-  Loggable a =>-  MonadRibo m =>-  a ->-  m ()-info =-  logR INFO--logInfo ::-  Loggable a =>-  MonadRibo m =>-  a ->-  m ()-logInfo = info--err ::-  Loggable a =>-  MonadRibo m =>-  a ->-  m ()-err =-  logR ERROR--logError ::-  Loggable a =>-  MonadRibo m =>-  a ->-  m ()-logError = err--showError ::-  Show a =>-  MonadRibo m =>-  Text ->-  a ->-  m ()-showError prefix a =-  logError @Text (prefix <> " " <> show a)
lib/Ribosome/Mapping.hs view
@@ -1,33 +1,104 @@+-- |Functions for constructing and activating 'Mapping's module Ribosome.Mapping where -import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, pluginName)-import Ribosome.Data.Mapping (Mapping(Mapping), MappingIdent(MappingIdent))-import Ribosome.Data.Text (capitalize)-import Ribosome.Nvim.Api.Data (Buffer)-import Ribosome.Nvim.Api.IO (bufferGetNumber, vimCommand, vimGetCurrentBuffer, vimSetCurrentBuffer)+import Data.MessagePack (Object)+import Exon (exon) -activateMapping :: Mapping -> m ()-activateMapping _ =-  undefined+import Ribosome.Data.Mapping (+  MapMode,+  Mapping (Mapping),+  MappingAction (MappingCall, MappingEvent),+  MappingId (MappingId),+  MappingLhs (MappingLhs),+  MappingSpec (MappingSpec),+  mapModeShortName,+  unMappingId,+  )+import qualified Ribosome.Host.Api.Data as Data+import Ribosome.Host.Api.Data (Buffer)+import Ribosome.Host.Data.ChannelId (ChannelId (ChannelId))+import Ribosome.Host.Data.Event (EventName (EventName))+import Ribosome.Host.Data.RpcCall (RpcCall)+import Ribosome.Host.Data.RpcHandler (RpcHandler (RpcHandler, rpcName))+import Ribosome.Host.Data.RpcName (RpcName (RpcName))+import qualified Ribosome.Host.Effect.Rpc as Rpc+import Ribosome.Host.Effect.Rpc (Rpc) -mapCommand :: Text -> Bool -> Text-mapCommand mode remap =-  mode <> (if remap then "map" else "noremap")+-- |Generate an atomic call executing a mapping cmd for all modes specified in the 'Mapping' and run it.+mappingCmdWith ::+  Member Rpc r =>+  (Text -> Text -> Text -> Map Text Object -> RpcCall ()) ->+  Mapping ->+  Sem r ()+mappingCmdWith call (Mapping action (MappingSpec (MappingLhs lhs) modes) ident opts) = do+  cmd <- command action+  Rpc.sync $ for_ modes \ mode ->+    call (mapModeShortName mode) lhs [exon|<cmd>#{cmd}<cr>|] opts+  where+    command = \case+      MappingCall (RpcName name) ->+        pure [exon|silent #{name}#{i}|]+      MappingEvent (EventName name) -> do+        ChannelId cid <- Rpc.channelId+        pure [exon|call rpcnotify(#{show cid}, '#{name}'#{foldMap idArg ident})|]+    i =+      foldMap unMappingId ident+    idArg = \case+      MappingId mi -> [exon|, '#{mi}'|] +-- |Generate an atomic call executing a mapping cmd for all modes specified in the 'Mapping' and run it.+mappingCmd ::+  Member Rpc r =>+  Mapping ->+  Sem r ()+mappingCmd = do+  mappingCmdWith Data.nvimSetKeymap++-- |Generate an atomic call executing a buffer mapping cmd for all modes specified in the 'Mapping' and run it.+bufferMappingCmd ::+  Member Rpc r =>+  -- |Use @<buffer>@ to create a buffer-local mapping.+  Buffer ->+  Mapping ->+  Sem r ()+bufferMappingCmd buffer =+  mappingCmdWith (Data.nvimBufSetKeymap buffer)++-- |Register a mapping globally.+activateMapping ::+  Member Rpc r =>+  Mapping ->+  Sem r ()+activateMapping =+  mappingCmd++-- |Register a mapping in the supplied buffer. activateBufferMapping ::-  MonadRibo m =>-  NvimE e m =>+  Member Rpc r =>   Buffer ->   Mapping ->-  m ()-activateBufferMapping buffer (Mapping (MappingIdent ident) lhs mode remap _) = do-  previous <- vimGetCurrentBuffer-  name <- pluginName-  number <- bufferGetNumber buffer-  vimCommand (unwords (cmdline name number))-  when (buffer /= previous) (vimSetCurrentBuffer previous)-  where-    cmdline name number =-      [show number, "bufdo ", cmd, "<buffer>", lhs, ":silent call", func name <> "('" <> ident <> "')<cr>"]-    cmd = mapCommand mode remap-    func name = capitalize name <> "Mapping"+  Sem r ()+activateBufferMapping buffer =+  bufferMappingCmd buffer++-- |Construct a 'Mapping' using the name from the supplied 'RpcHandler'.+mappingFor ::+  RpcHandler r ->+  MappingLhs ->+  NonEmpty MapMode ->+  Maybe MappingId ->+  Map Text Object ->+  Mapping+mappingFor RpcHandler {rpcName} lhs mode =+  Mapping (MappingCall rpcName) (MappingSpec lhs mode)++-- |Construct a 'Mapping' using the supplied 'EventName'.+eventMapping ::+  EventName ->+  MappingLhs ->+  NonEmpty MapMode ->+  Maybe MappingId ->+  Map Text Object ->+  Mapping+eventMapping event lhs mode =+  Mapping (MappingEvent event) (MappingSpec lhs mode)
− lib/Ribosome/Menu/Action.hs 
@@ -1,111 +0,0 @@-module Ribosome.Menu.Action where--import Control.Lens (over, set)--import Ribosome.Data.List (indexesComplement)-import Ribosome.Menu.Data.Menu (Menu(Menu))-import qualified Ribosome.Menu.Data.Menu as Menu (marked, selected)-import Ribosome.Menu.Data.MenuConsumerAction (MenuConsumerAction)-import qualified Ribosome.Menu.Data.MenuConsumerAction as MenuConsumerAction (MenuConsumerAction(..))-import Ribosome.Menu.Prompt.Data.Prompt (Prompt)--menuContinue ::-  Applicative m =>-  Menu i ->-  m (MenuConsumerAction m a, Menu i)-menuContinue =-  pure . (MenuConsumerAction.Continue,)--menuExecute ::-  Applicative m =>-  m () ->-  Menu i ->-  m (MenuConsumerAction m a, Menu i)-menuExecute thunk =-  pure . (MenuConsumerAction.Execute thunk,)--menuRender ::-  Applicative m =>-  Bool ->-  Menu i ->-  m (MenuConsumerAction m a, Menu i)-menuRender changed =-  pure . (MenuConsumerAction.Render changed,)--menuQuit ::-  Applicative m =>-  Menu i ->-  m (MenuConsumerAction m a, Menu i)-menuQuit =-  pure . (MenuConsumerAction.Quit,)--menuQuitWith ::-  Applicative m =>-  m a ->-  Menu i ->-  m (MenuConsumerAction m a, Menu i)-menuQuitWith next =-  pure . (MenuConsumerAction.QuitWith next,)--menuReturn ::-  Applicative m =>-  a ->-  Menu i ->-  m (MenuConsumerAction m a, Menu i)-menuReturn a =-  pure . (MenuConsumerAction.Return a,)--menuFilter ::-  Applicative m =>-  Menu i ->-  m (MenuConsumerAction m a, Menu i)-menuFilter =-  pure . (MenuConsumerAction.Filter,)--menuCycle ::-  Monad m =>-  Int ->-  Menu i ->-  Prompt ->-  m (MenuConsumerAction m a, Menu i)-menuCycle offset m@(Menu _ filtered _ _ _ maxItems) _ =-  menuRender False (over Menu.selected add m)-  where-    count =-      maybe id min maxItems (length filtered)-    add current =-      if count == 0 then 0 else (current + offset) `mod` count--menuToggle ::-  Monad m =>-  Menu i ->-  Prompt ->-  m (MenuConsumerAction m a, Menu i)-menuToggle m@(Menu _ _ selected marked _ _) prompt =-  menuRender True . snd =<< menuCycle 1 newMenu prompt-  where-    newMenu =-      set Menu.marked newMarked m-    newMarked =-      if length removed == length marked then selected : marked else removed-    removed =-      filter (selected /=) marked--menuToggleAll ::-  Monad m =>-  Menu i ->-  Prompt ->-  m (MenuConsumerAction m a, Menu i)-menuToggleAll m@(Menu _ filtered _ marked _ _) _ =-  menuRender True newMenu-  where-    newMenu =-      set Menu.marked (indexesComplement (length filtered) marked) m--menuUpdatePrompt ::-  Applicative m =>-  Prompt ->-  Menu i ->-  m (MenuConsumerAction m a, Menu i)-menuUpdatePrompt prompt =-  pure . (MenuConsumerAction.UpdatePrompt prompt,)
− lib/Ribosome/Menu/Data/BasicMenuAction.hs 
@@ -1,18 +0,0 @@-module Ribosome.Menu.Data.BasicMenuAction where--import Ribosome.Menu.Data.Menu (Menu)-import Ribosome.Menu.Data.MenuEvent (QuitReason)--data BasicMenuChange =-  NoChange-  |-  Change-  |-  Reset-  deriving (Eq, Show)--data BasicMenuAction m a i =-  Continue BasicMenuChange (Menu i)-  |-  Quit (QuitReason m a)-  deriving (Show)
− lib/Ribosome/Menu/Data/FilteredMenuItem.hs 
@@ -1,12 +0,0 @@-module Ribosome.Menu.Data.FilteredMenuItem where--import Ribosome.Menu.Data.MenuItem (MenuItem)--data FilteredMenuItem a =-  FilteredMenuItem {-    _index :: Int,-    _item :: MenuItem a-  }-  deriving (Eq, Show)--makeClassy ''FilteredMenuItem
− lib/Ribosome/Menu/Data/Menu.hs 
@@ -1,29 +0,0 @@-module Ribosome.Menu.Data.Menu where--import Data.DeepLenses (DeepLenses(..))--import Ribosome.Menu.Data.FilteredMenuItem (FilteredMenuItem)-import Ribosome.Menu.Data.MenuItem (MenuItem)--newtype MenuFilter =-  MenuFilter Text-  deriving (Eq, Show)--instance Default MenuFilter where-  def = MenuFilter ""--data Menu a =-  Menu {-    _items :: [MenuItem a],-    _filtered :: [FilteredMenuItem a],-    _selected :: Int,-    _marked :: [Int],-    _currentFilter :: MenuFilter,-    _maxItems :: Maybe Int-  }-  deriving (Eq, Show, Generic, Default)--makeClassy ''Menu--instance DeepLenses (Menu a) (Menu a) where-  deepLens = id
− lib/Ribosome/Menu/Data/MenuAction.hs 
@@ -1,29 +0,0 @@-module Ribosome.Menu.Data.MenuAction where--import qualified Text.Show as Show (show)--import Ribosome.Menu.Data.MenuEvent (QuitReason)-import Ribosome.Menu.Prompt.Data.Prompt (Prompt)--data MenuAction m a =-  Quit (QuitReason m a)-  |-  Continue-  |-  Execute (m ())-  |-  Render Bool-  |-  UpdatePrompt Prompt--instance Show (MenuAction m a) where-  show (Quit r) =-    "Quit(" <> show r <> ")"-  show Continue =-    "Continue"-  show (Execute _) =-    "Execute"-  show (Render changed) =-    "Render(" <> show changed <> ")"-  show (UpdatePrompt prompt) =-    "UpdatePrompt(" <> show prompt <> ")"
− lib/Ribosome/Menu/Data/MenuConfig.hs 
@@ -1,19 +0,0 @@-module Ribosome.Menu.Data.MenuConfig where--import Conduit (ConduitT)--import Ribosome.Menu.Data.MenuConsumer (MenuConsumer)-import Ribosome.Menu.Data.MenuItem (MenuItem)-import Ribosome.Menu.Data.MenuRenderEvent (MenuRenderEvent)-import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig)--data MenuConfig m a i =-  MenuConfig {-    _items :: ConduitT () [MenuItem i] m (),-    _handle :: MenuConsumer m a i,-    _render :: MenuRenderEvent m a i -> m (),-    _prompt :: PromptConfig m,-    _maxItems :: Maybe Int-  }--makeClassy ''MenuConfig
− lib/Ribosome/Menu/Data/MenuConsumer.hs 
@@ -1,8 +0,0 @@-module Ribosome.Menu.Data.MenuConsumer where--import Ribosome.Menu.Data.Menu (Menu)-import Ribosome.Menu.Data.MenuAction (MenuAction)-import Ribosome.Menu.Data.MenuUpdate (MenuUpdate)--newtype MenuConsumer m a i =-  MenuConsumer { unMenuConsumer :: MenuUpdate m a i -> m (MenuAction m a, Menu i) }
− lib/Ribosome/Menu/Data/MenuConsumerAction.hs 
@@ -1,23 +0,0 @@-module Ribosome.Menu.Data.MenuConsumerAction where--import Ribosome.Menu.Prompt.Data.Prompt (Prompt)--data MenuConsumerAction m a =-  Quit-  |-  QuitWith (m a)-  |-  Continue-  |-  Execute (m ())-  |-  Filter-  |-  Render Bool-  |-  Return a-  |-  UpdatePrompt Prompt-  -- |-  -- Error Text-  deriving (Functor)
− lib/Ribosome/Menu/Data/MenuConsumerUpdate.hs 
@@ -1,9 +0,0 @@-module Ribosome.Menu.Data.MenuConsumerUpdate where--import Ribosome.Menu.Data.MenuUpdate (MenuUpdate)--data MenuConsumerUpdate m a i =-  MenuConsumerUpdate {-    _changed :: Bool,-    _menu :: MenuUpdate m a i-  }
− lib/Ribosome/Menu/Data/MenuEvent.hs 
@@ -1,41 +0,0 @@-module Ribosome.Menu.Data.MenuEvent where--import qualified Text.Show--import Ribosome.Menu.Data.MenuItem (MenuItem)-import Ribosome.Menu.Prompt.Data.Prompt (Prompt)--data QuitReason m a =-  Aborted-  |-  PromptError Text-  |-  NoOutput-  |-  Return a-  |-  Execute (m a)--instance Show (QuitReason m a) where-  show Aborted =-    "Aborted"-  show (PromptError err) =-    "PromptError(" <> toString err <> ")"-  show NoOutput =-    "NoOutput"-  show (Return _) =-    "Return"-  show (Execute _) =-    "Execute"--data MenuEvent m a i =-  Init Prompt-  |-  PromptChange Prompt-  |-  Mapping Text Prompt-  |-  NewItems [MenuItem i]-  |-  Quit (QuitReason m a)-  deriving Show
− lib/Ribosome/Menu/Data/MenuItem.hs 
@@ -1,15 +0,0 @@-module Ribosome.Menu.Data.MenuItem where--data MenuItem a =-  MenuItem {-    _meta :: a,-    _text :: Text,-    _abbreviated :: Text-  }-  deriving (Eq, Show, Ord, Functor)--makeClassy ''MenuItem--simpleMenuItem :: a -> Text -> MenuItem a-simpleMenuItem a t =-  MenuItem a t t
− lib/Ribosome/Menu/Data/MenuItemFilter.hs 
@@ -1,7 +0,0 @@-module Ribosome.Menu.Data.MenuItemFilter where--import Ribosome.Menu.Data.FilteredMenuItem (FilteredMenuItem)-import Ribosome.Menu.Data.MenuItem (MenuItem)--newtype MenuItemFilter a =-  MenuItemFilter (Text -> [MenuItem a] -> [FilteredMenuItem a])
− lib/Ribosome/Menu/Data/MenuRenderEvent.hs 
@@ -1,10 +0,0 @@-module Ribosome.Menu.Data.MenuRenderEvent where--import Ribosome.Menu.Data.Menu (Menu)-import Ribosome.Menu.Data.MenuEvent (QuitReason)--data MenuRenderEvent m a i =-  Render Bool (Menu i)-  |-  Quit (QuitReason m a)-  deriving Show
− lib/Ribosome/Menu/Data/MenuResult.hs 
@@ -1,13 +0,0 @@-module Ribosome.Menu.Data.MenuResult where--data MenuResult a =-  NoOutput-  |-  Error Text-  |-  Executed-  |-  Aborted-  |-  Return a-  deriving (Eq, Show)
− lib/Ribosome/Menu/Data/MenuUpdate.hs 
@@ -1,12 +0,0 @@-module Ribosome.Menu.Data.MenuUpdate where--import Ribosome.Menu.Data.Menu (Menu)-import Ribosome.Menu.Data.MenuEvent (MenuEvent)--data MenuUpdate m a i =-  MenuUpdate {-    _event :: MenuEvent m a i,-    _menu :: Menu i-  }--makeClassy ''MenuUpdate
− lib/Ribosome/Menu/Nvim.hs 
@@ -1,83 +0,0 @@-module Ribosome.Menu.Nvim where--import Control.Lens (view)-import qualified Data.Map as Map (fromList)-import qualified Data.Text as Text (cons, snoc)--import Ribosome.Api.Window (redraw, setLine)-import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)-import Ribosome.Data.List (mapSelectors)-import Ribosome.Data.Scratch (Scratch(scratchWindow))-import Ribosome.Data.ScratchOptions (ScratchOptions)-import Ribosome.Data.Syntax (-  HiLink(..),-  Syntax(Syntax),-  SyntaxItem(..),-  syntaxMatch,-  )-import Ribosome.Log (logDebug)-import qualified Ribosome.Menu.Data.FilteredMenuItem as FilteredMenuItem (item)-import Ribosome.Menu.Data.Menu (Menu(Menu))-import qualified Ribosome.Menu.Data.MenuItem as MenuItem (abbreviated)-import Ribosome.Menu.Data.MenuRenderEvent (MenuRenderEvent)-import qualified Ribosome.Menu.Data.MenuRenderEvent as MenuRenderEvent (MenuRenderEvent(..))-import Ribosome.Scratch (killScratch, setScratchContent)--marker :: Char-marker =-  '†'--markerConceal :: SyntaxItem-markerConceal =-  item { siOptions = options, siParams = params }-  where-    item = syntaxMatch "RibosomeMenuMarker" (Text.snoc "^" marker)-    options = ["conceal"]-    params = Map.fromList [("nextgroup", "RibosomeMenuMarkedLine")]--markedLine :: SyntaxItem-markedLine =-  item { siOptions = options }-  where-    item = syntaxMatch "RibosomeMenuMarkedLine" ".*$"-    options = ["contained"]--hlMarkedLine :: HiLink-hlMarkedLine =-  HiLink "RibosomeMenuMarkedLine" "Tag"--menuSyntax :: Syntax-menuSyntax =-  Syntax [markerConceal, markedLine] [] [hlMarkedLine]--withMarks :: [Int] -> [Text] -> [Text]-withMarks =-  mapSelectors (Text.cons marker)--renderNvimMenu ::-  MonadRibo m =>-  NvimE e m =>-  ScratchOptions ->-  Scratch ->-  MenuRenderEvent m a i ->-  m ()-renderNvimMenu _ scratch (MenuRenderEvent.Quit _) =-  killScratch scratch-renderNvimMenu options scratch (MenuRenderEvent.Render changed (Menu _ allItems selected marked _ maxItems)) =-  when changed (setScratchContent options scratch (reverse text)) *>-  logDebug @Text logMsg *>-  updateCursor *>-  redraw-  where-    lineNumber =-      max 0 $ length items - selected - 1-    text =-      withMarks marked (view (FilteredMenuItem.item . MenuItem.abbreviated) <$> items)-    items =-      limit allItems-    limit =-      maybe id take maxItems-    updateCursor =-      setLine (scratchWindow scratch) lineNumber-    logMsg =-      "updating menu cursor to line " <> show lineNumber <> "; " <> show selected <> "/" <> show (length items)
− lib/Ribosome/Menu/Prompt.hs 
@@ -1,17 +0,0 @@-module Ribosome.Menu.Prompt where--import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)-import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig(PromptConfig), PromptFlag)-import Ribosome.Menu.Prompt.Nvim (getCharC, nvimPromptRenderer)-import Ribosome.Menu.Prompt.Run (basicTransition)-import Ribosome.Msgpack.Error (DecodeError)--defaultPrompt ::-  NvimE e m =>-  MonadRibo m =>-  MonadBaseControl IO m =>-  MonadDeepError e DecodeError m =>-  [PromptFlag] ->-  PromptConfig m-defaultPrompt =-  PromptConfig (getCharC 0.033) basicTransition nvimPromptRenderer
− lib/Ribosome/Menu/Prompt/Data/Codes.hs 
@@ -1,123 +0,0 @@-module Ribosome.Menu.Prompt.Data.Codes where--import Control.Exception.Lifted (try)-import Data.Map.Strict ((!?))-import qualified Data.Map.Strict as Map (fromList)-import qualified Data.Text as Text (singleton)--specialCodes :: Map Text Text-specialCodes =-  Map.fromList [-    ("\x80\xffX", "c-@"),-    ("\65533kb", "bs"),-    ("\x80kB", "s-tab"),-    ("\x0", "c-k"),-    ("\x80kD", "del"),-    ("\x9B", "csi"),-    ("\x80\xfdP", "xcsi"),-    ("\x80ku", "up"),-    ("\x80kd", "down"),-    ("\x80kl", "left"),-    ("\x80kr", "right"),-    -- ("\x80\xfd", "s-up"),-    -- ("\x80\xfd", "s-down"),-    ("\x80#4", "s-left"),-    ("\x80%i", "s-right"),-    ("\x80\xfdT", "c-left"),-    ("\x80\xfdU", "c-right"),-    ("\x80k1", "f1"),-    ("\x80k2", "f2"),-    ("\x80k3", "f3"),-    ("\x80k4", "f4"),-    ("\x80k5", "f5"),-    ("\x80k6", "f6"),-    ("\x80k7", "f7"),-    ("\x80k8", "f8"),-    ("\x80k9", "f9"),-    ("\x80k;", "f10"),-    ("\x80F1", "f11"),-    ("\x80F2", "f12"),-    ("\x80\xfd\x06", "s-f1"),-    ("\x80\xfd\x07", "s-f2"),-    ("\x80\xfd\x08", "s-f3"),-    ("\x80\xfd\x09", "s-f4"),-    ("\x80\xfd\x0A", "s-f5"),-    ("\x80\xfd\x0B", "s-f6"),-    ("\x80\xfd\x0C", "s-f7"),-    ("\x80\xfd\x0D", "s-f8"),-    ("\x80\xfd\x0E", "s-f9"),-    ("\x80\xfd\x0F", "s-f10"),-    ("\x80\xfd\x10", "s-f11"),-    ("\x80\xfd\x11", "s-f12"),-    ("\x80%1", "help"),-    ("\x80&8", "undo"),-    ("\x80kI", "insert"),-    ("\x80kh", "home"),-    ("\x80@7", "end"),-    ("\x80kP", "pageup"),-    ("\x80kN", "pagedown"),-    ("\x80K1", "khome"),-    ("\x80K4", "kend"),-    ("\x80K3", "kpageup"),-    ("\x80K5", "kpagedown"),-    ("\x80K6", "kplus"),-    ("\x80K7", "kminus"),-    ("\x80K9", "kmultiply"),-    ("\x80K8", "kdivide"),-    ("\x80KA", "kenter"),-    ("\x80KB", "kpoint"),-    ("\x80KC", "k0"),-    ("\x80KD", "k1"),-    ("\x80KE", "k2"),-    ("\x80KF", "k3"),-    ("\x80KG", "k4"),-    ("\x80KH", "k5"),-    ("\x80KI", "k6"),-    ("\x80KJ", "k7"),-    ("\x80KK", "k8"),-    ("\x80KL", "k9")-    ]--specialNumCodes :: Map Int Text-specialNumCodes =-  Map.fromList [-    (9, "tab"),-    (10, "c-j"),-    (11, "c-k"),-    (12, "fe"),-    (13, "cr"),-    (14, "c-n"),-    (25, "c-y"),-    (27, "esc"),-    (32, "space"),-    (60, "lt"),-    (92, "bslash"),-    (124, "bar")-    ]--modifierCodes :: [(Int, Text)]-modifierCodes =-  [-    (2, "shift"),-    (4, "control"),-    (8, "alt"),-    (16, "meta"),-    (32, "mouse_double"),-    (64, "mouse_triple"),-    (96, "mouse_quadruple"),-    (128, "command")-    ]--decodeInputChar :: Text -> Maybe Text-decodeInputChar =-  (specialCodes !?)--decodeInputNum ::-  MonadBaseControl IO m =>-  Int ->-  m (Maybe Text)-decodeInputNum a =-  maybe codepoint (return . Just) (specialNumCodes !? a)-  where-    codepoint =-      fmap Text.singleton . rightToMaybe @SomeException <$> try (return $ chr a)
− lib/Ribosome/Menu/Prompt/Data/CursorUpdate.hs 
@@ -1,15 +0,0 @@-module Ribosome.Menu.Prompt.Data.CursorUpdate where--data CursorUpdate =-  Unmodified-  |-  OneLeft-  |-  OneRight-  |-  Append-  |-  Prepend-  |-  Index Int-  deriving (Eq, Show)
− lib/Ribosome/Menu/Prompt/Data/InputEvent.hs 
@@ -1,13 +0,0 @@-module Ribosome.Menu.Prompt.Data.InputEvent where--data InputEvent =-  Character Text-  |-  NoInput-  |-  Unexpected Int-  |-  Interrupt-  |-  Error Text-  deriving (Eq, Show)
− lib/Ribosome/Menu/Prompt/Data/Prompt.hs 
@@ -1,15 +0,0 @@-module Ribosome.Menu.Prompt.Data.Prompt where--import Prelude hiding (state)--import Ribosome.Menu.Prompt.Data.PromptState (PromptState)--data Prompt =-  Prompt {-     _cursor :: Int,-     _state :: PromptState,-     _text :: Text-  }-  deriving (Eq, Show)--deepLenses ''Prompt
− lib/Ribosome/Menu/Prompt/Data/PromptConfig.hs 
@@ -1,44 +0,0 @@-module Ribosome.Menu.Prompt.Data.PromptConfig where--import Conduit (ConduitT)-import Control.Lens (view)--import Ribosome.Menu.Prompt.Data.PromptEvent (PromptEvent)-import Ribosome.Menu.Prompt.Data.PromptRenderer (PromptRenderer)-import Ribosome.Menu.Prompt.Data.PromptState (PromptState)-import Ribosome.Menu.Prompt.Data.PromptUpdate (PromptUpdate)--data PromptFlag =-  StartInsert-  |-  OnlyInsert-  deriving (Eq, Show)--data PromptConfig m =-  PromptConfig {-    _source :: ConduitT () PromptEvent m (),-    _modes :: [PromptFlag] -> PromptEvent -> PromptState -> m PromptUpdate,-    _render :: PromptRenderer m,-    _flags :: [PromptFlag]-  }--makeClassy ''PromptConfig--class TestPromptFlag a where-  promptFlag :: PromptFlag -> a -> Bool--instance TestPromptFlag [PromptFlag] where-  promptFlag =-    elem--instance TestPromptFlag (PromptConfig m) where-  promptFlag flag =-    promptFlag flag . view flags--startInsert :: TestPromptFlag a => a -> Bool-startInsert =-  promptFlag StartInsert--onlyInsert :: TestPromptFlag a => a -> Bool-onlyInsert =-  promptFlag OnlyInsert
− lib/Ribosome/Menu/Prompt/Data/PromptConsumed.hs 
@@ -1,7 +0,0 @@-module Ribosome.Menu.Prompt.Data.PromptConsumed where--data PromptConsumed =-  Yes-  |-  No-  deriving (Eq, Show)
− lib/Ribosome/Menu/Prompt/Data/PromptConsumerUpdate.hs 
@@ -1,13 +0,0 @@-module Ribosome.Menu.Prompt.Data.PromptConsumerUpdate where--import Ribosome.Menu.Prompt.Data.Prompt (Prompt)-import Ribosome.Menu.Prompt.Data.PromptConsumed (PromptConsumed)-import Ribosome.Menu.Prompt.Data.PromptEvent (PromptEvent)--data PromptConsumerUpdate =-  PromptConsumerUpdate {-    _event :: PromptEvent,-    _prompt :: Prompt,-    _consumed :: PromptConsumed-  }-  deriving (Eq, Show)
− lib/Ribosome/Menu/Prompt/Data/PromptEvent.hs 
@@ -1,19 +0,0 @@-module Ribosome.Menu.Prompt.Data.PromptEvent where--import Ribosome.Menu.Prompt.Data.Prompt (Prompt)--data PromptEvent =-  Init-  |-  Character Text-  |-  -- SpecialCharacter Text-  -- |-  Unexpected Int-  |-  Interrupt-  |-  Error Text-  |-  Set Prompt-  deriving (Eq, Show)
− lib/Ribosome/Menu/Prompt/Data/PromptRenderer.hs 
@@ -1,10 +0,0 @@-module Ribosome.Menu.Prompt.Data.PromptRenderer where--import Ribosome.Menu.Prompt.Data.Prompt (Prompt)--data PromptRenderer m =-  ∀ a. PromptRenderer {-    _acquire :: m a,-    _release :: a -> m (),-    _render :: Prompt -> m ()-  }
− lib/Ribosome/Menu/Prompt/Data/PromptState.hs 
@@ -1,11 +0,0 @@-module Ribosome.Menu.Prompt.Data.PromptState where--data PromptState =-  Insert-  |-  Normal-  |-  Quit-  deriving (Eq, Show)--deepLenses ''PromptState
− lib/Ribosome/Menu/Prompt/Data/PromptUpdate.hs 
@@ -1,15 +0,0 @@-module Ribosome.Menu.Prompt.Data.PromptUpdate where--import Ribosome.Menu.Prompt.Data.CursorUpdate (CursorUpdate)-import Ribosome.Menu.Prompt.Data.PromptConsumed (PromptConsumed)-import Ribosome.Menu.Prompt.Data.PromptState (PromptState)-import Ribosome.Menu.Prompt.Data.TextUpdate (TextUpdate)--data PromptUpdate =-  PromptUpdate {-    _state :: PromptState,-    _cursor :: CursorUpdate,-    _text :: TextUpdate,-    _consumed :: PromptConsumed-  }-  deriving (Eq, Show)
− lib/Ribosome/Menu/Prompt/Data/TextUpdate.hs 
@@ -1,13 +0,0 @@-module Ribosome.Menu.Prompt.Data.TextUpdate where--data TextUpdate =-  Unmodified-  |-  Insert Text-  |-  DeleteLeft-  |-  DeleteRight-  |-  Set Text-  deriving (Eq, Show)
− lib/Ribosome/Menu/Prompt/Nvim.hs 
@@ -1,193 +0,0 @@-module Ribosome.Menu.Prompt.Nvim where--import Conduit (ConduitT, yield)-import Control.Exception.Lifted (bracket_)-import qualified Data.Text as Text (singleton, splitAt, uncons)--import Ribosome.Api.Atomic (atomic)-import Ribosome.Api.Function (defineFunction)-import Ribosome.Api.Variable (setVar)-import Ribosome.Api.Window (redraw)-import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)-import Ribosome.Data.Text (escapeQuotes)-import Ribosome.Menu.Prompt.Data.Codes (decodeInputChar, decodeInputNum)-import Ribosome.Menu.Prompt.Data.InputEvent (InputEvent)-import qualified Ribosome.Menu.Prompt.Data.InputEvent as InputEvent (InputEvent(..))-import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))-import Ribosome.Menu.Prompt.Data.PromptEvent (PromptEvent)-import qualified Ribosome.Menu.Prompt.Data.PromptEvent as PromptEvent (PromptEvent(..))-import Ribosome.Menu.Prompt.Data.PromptRenderer (PromptRenderer(PromptRenderer))-import Ribosome.Msgpack.Encode (toMsgpack)-import Ribosome.Msgpack.Error (DecodeError)-import qualified Ribosome.Nvim.Api.Data as ApiData (vimCommand)-import Ribosome.Nvim.Api.IO (vimCallFunction, vimCommand, vimCommandOutput, vimGetOption, vimSetOption)-import Ribosome.Nvim.Api.RpcCall (RpcError, syncRpcCall)-import Ribosome.System.Time (sleep)--quitChar :: Char-quitChar =-  '†'--quitCharOrd :: Int-quitCharOrd =-  ord quitChar--getChar ::-  NvimE e m =>-  MonadBaseControl IO m =>-  m InputEvent-getChar =-  catchAs @RpcError InputEvent.Interrupt request-  where-    request =-      ifM peek consume (return InputEvent.NoInput)-    peek =-      (/= (0 :: Int)) <$> getchar True-    consume =-      event =<< getchar False-    getchar peek' =-      vimCallFunction "getchar" [toMsgpack peek']-    event (Right c) =-      return $ InputEvent.Character (fromMaybe c (decodeInputChar c))-    event (Left 0) =-      return InputEvent.NoInput-    event (Left num) | num == quitCharOrd =-      return InputEvent.Interrupt-    event (Left num) =-      maybe (InputEvent.Unexpected num) InputEvent.Character <$> decodeInputNum num--getCharC ::-  NvimE e m =>-  MonadRibo m =>-  MonadBaseControl IO m =>-  Double ->-  ConduitT () PromptEvent m ()-getCharC interval =-  recurse-  where-    recurse =-      translate =<< lift getChar-    translate (InputEvent.Character a) =-      yield (PromptEvent.Character a) *> recurse-    translate InputEvent.Interrupt =-      yield PromptEvent.Interrupt-    translate (InputEvent.Error e) =-      yield (PromptEvent.Error e)-    translate InputEvent.NoInput =-      sleep interval *> recurse-    translate (InputEvent.Unexpected _) =-      recurse--promptFragment :: Text -> Text -> [Text]-promptFragment hl text =-  ["echohl " <> hl, "echon '" <> escapeQuotes text <> "'"]--nvimRenderPrompt ::-  Monad m =>-  NvimE e m =>-  MonadDeepError e DecodeError m =>-  Prompt ->-  m ()-nvimRenderPrompt (Prompt cursor _ text) =-  void $ atomic calls-  where-    calls = syncRpcCall . ApiData.vimCommand <$> ("silent! redraw!" : (fragments >>= uncurry promptFragment))-    fragments =-      [-        ("RibosomePromptSign", sign),-        ("None", pre),-        ("RibosomePromptCaret", Text.singleton cursorChar),-        ("None", post)-        ]-    (pre, rest) =-      Text.splitAt cursor text-    (cursorChar, post) =-      fromMaybe (' ', "") (Text.uncons rest)-    sign =-      "% "--loopFunctionName :: Text-loopFunctionName =-  "RibosomeMenuLoop"--loopVarName :: Text-loopVarName =-  "ribosome_menu_looping"--defineLoopFunction ::-  NvimE e m =>-  m ()-defineLoopFunction =-  defineFunction loopFunctionName [] lns-  where-    lns =-      [-        "echo ''",-        "while g:" <> loopVarName,-        "try",-        "sleep 5m",-        "catch /^Vim:Interrupt$/",-        "silent! call feedkeys('" <> Text.singleton quitChar <> "')",-        "endtry",-        "endwhile"-        ]--startLoop ::-  NvimE e m =>-  m ()-startLoop = do-  defineLoopFunction-  setVar loopVarName True-  vimCommand $ "call feedkeys(\":call " <> loopFunctionName <> "()\\<cr>\")"---- FIXME need to wait for the loop to stop before deleting the function-killLoop ::-  NvimE e m =>-  m ()-killLoop = do-  setVar loopVarName False-  ignoreError @RpcError $ vimCommand $ "delfunction! " <> loopFunctionName--promptBlocker ::-  NvimE e m =>-  MonadBaseControl IO m =>-  m a ->-  m a-promptBlocker =-  bracket_ startLoop killLoop--newtype NvimPromptResources =-  NvimPromptResources {-    _guicursor :: Text-  }-  deriving (Eq, Show)--nvimAcquire ::-  NvimE e m =>-  m NvimPromptResources-nvimAcquire = do-  highlightSet <- catchAs @RpcError False $ True <$ vimCommandOutput "highlight RibosomePromptCaret"-  unless highlightSet $ vimCommand "highlight link RibosomePromptCaret TermCursor"-  res <- NvimPromptResources <$> vimGetOption "guicursor"-  vimSetOption "guicursor" (toMsgpack ("a:hor20" :: Text))-  () <- vimCallFunction "inputsave" []-  startLoop-  return res--nvimRelease ::-  NvimE e m =>-  NvimPromptResources ->-  m ()-nvimRelease (NvimPromptResources gc) = do-  vimSetOption "guicursor" (toMsgpack gc)-  redraw-  vimCommand "echon ''"-  () <- vimCallFunction "inputrestore" []-  killLoop--nvimPromptRenderer ::-  NvimE e m =>-  MonadDeepError e DecodeError m =>-  PromptRenderer m-nvimPromptRenderer =-  PromptRenderer nvimAcquire nvimRelease nvimRenderPrompt
− lib/Ribosome/Menu/Prompt/Run.hs 
@@ -1,233 +0,0 @@-module Ribosome.Menu.Prompt.Run where--import Conduit (ConduitT, MonadResource, await, awaitForever, bracketP, evalStateC, yield, (.|))-import Data.Conduit.Combinators (peek)-import Data.Conduit.TMChan (TMChan, closeTMChan, newTMChan, sourceTMChan)-import qualified Data.Text as Text (drop, dropEnd, isPrefixOf, length, splitAt)-import Prelude hiding (state)--import Ribosome.Control.Monad.Ribo (MonadRibo)-import Ribosome.Data.Conduit (mergeSources)-import Ribosome.Log (logDebug)-import Ribosome.Menu.Prompt.Data.CursorUpdate (CursorUpdate)-import qualified Ribosome.Menu.Prompt.Data.CursorUpdate as CursorUpdate (CursorUpdate(..))-import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))-import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig(PromptConfig), PromptFlag, onlyInsert, startInsert)-import Ribosome.Menu.Prompt.Data.PromptConsumed (PromptConsumed)-import qualified Ribosome.Menu.Prompt.Data.PromptConsumed as PromptConsumed (PromptConsumed(..))-import Ribosome.Menu.Prompt.Data.PromptConsumerUpdate (PromptConsumerUpdate(PromptConsumerUpdate))-import Ribosome.Menu.Prompt.Data.PromptEvent (PromptEvent)-import qualified Ribosome.Menu.Prompt.Data.PromptEvent as PromptEvent (PromptEvent(..))-import Ribosome.Menu.Prompt.Data.PromptRenderer (PromptRenderer(PromptRenderer))-import Ribosome.Menu.Prompt.Data.PromptState (PromptState)-import qualified Ribosome.Menu.Prompt.Data.PromptState as PromptState (PromptState(..))-import Ribosome.Menu.Prompt.Data.PromptUpdate (PromptUpdate(PromptUpdate))-import Ribosome.Menu.Prompt.Data.TextUpdate (TextUpdate)-import qualified Ribosome.Menu.Prompt.Data.TextUpdate as TextUpdate (TextUpdate(..))--updateCursor :: Int -> Text -> CursorUpdate -> Int-updateCursor current text =-  update-  where-    update CursorUpdate.OneLeft | current > 0 =-      current - 1-    update CursorUpdate.OneLeft =-      current-    update CursorUpdate.OneRight | current <= textLength =-      current + 1-    update CursorUpdate.OneRight =-      current-    update CursorUpdate.Prepend =-      0-    update CursorUpdate.Append =-      Text.length text + 1-    update (CursorUpdate.Index index) =-      min textLength (max 0 index)-    update CursorUpdate.Unmodified =-      current-    textLength =-      Text.length text--updateText :: Int -> Text -> TextUpdate -> Text-updateText cursor text =-  update-  where-    update TextUpdate.Unmodified =-      text-    update (TextUpdate.Insert new) =-      pre <> new <> post-    update TextUpdate.DeleteLeft =-      Text.dropEnd 1 pre <> post-    update TextUpdate.DeleteRight =-      pre <> Text.drop 1 post-    update (TextUpdate.Set newText) =-      newText-    (pre, post) = Text.splitAt cursor text--updatePrompt ::-  Monad m =>-  (PromptEvent -> PromptState -> m PromptUpdate) ->-  PromptEvent ->-  Prompt ->-  m (PromptConsumed, Prompt)-updatePrompt modes update (Prompt cursor state text) = do-  (PromptUpdate newState cursorUpdate textUpdate consumed) <- modes update state-  let-    updatedText =-      updateText cursor text textUpdate-    newPrompt =-      Prompt (updateCursor cursor updatedText cursorUpdate) newState updatedText-  return (consumed, newPrompt)--processPromptEvent ::-  MonadIO m =>-  MonadRibo m =>-  PromptConfig m ->-  PromptEvent ->-  ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()-processPromptEvent (PromptConfig _ modes (PromptRenderer _ _ render) flags) event = do-  logDebug @Text $ "prompt event: " <> show event-  consumed <- lift . stateM $ lift . updatePrompt (modes flags) event-  newPrompt <- get-  yield (PromptConsumerUpdate event newPrompt consumed)-  lift . lift . render $ newPrompt--skippingRenderer ::-  Monad m =>-  (Prompt -> m ()) ->-  ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()-skippingRenderer render =-  go-  where-    go =-      check =<< await-    check (Just next@(PromptConsumerUpdate _ prompt _)) = do-      yield next-      renderIfIdle prompt =<< peek-      go-    check Nothing =-      return ()-    renderIfIdle _ (Just _) =-      return ()-    renderIfIdle prompt Nothing =-      lift (render prompt)--promptWithBackchannel ::-  MonadRibo m =>-  MonadResource m =>-  MonadBaseControl IO m =>-  PromptConfig m ->-  TMChan PromptEvent ->-  ConduitT () PromptConsumerUpdate m ()-promptWithBackchannel config@(PromptConfig source _ (PromptRenderer _ _ render) _) chan =-  mergeSources 64 [sourceWithInit, sourceTMChan chan] .| process .| skippingRenderer render-  where-    sourceWithInit =-      yield PromptEvent.Init *> source <* atomically (closeTMChan chan)-    process =-      evalStateC (pristinePrompt (startInsert config)) (awaitForever (processPromptEvent config))--promptC ::-  MonadRibo m =>-  MonadResource m =>-  MonadBaseControl IO m =>-  PromptConfig m ->-  m (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ())-promptC config = do-  chan <- atomically newTMChan-  return (chan, bracketP (pure chan) release (promptWithBackchannel config))-  where-    release chan =-      atomically $ closeTMChan chan--unprocessableChars :: [Text]-unprocessableChars =-  [-    "cr",-    "tab"-    ]--unprocessable :: Text -> Bool-unprocessable char =-  char `elem` unprocessableChars || Text.isPrefixOf "c-" char--consumeUnmodified :: PromptState -> CursorUpdate -> PromptUpdate-consumeUnmodified s u =-  PromptUpdate s u TextUpdate.Unmodified PromptConsumed.Yes--basicTransitionNormal ::-  PromptEvent ->-  PromptUpdate-basicTransitionNormal (PromptEvent.Character "esc") =-  consumeUnmodified PromptState.Quit CursorUpdate.Unmodified-basicTransitionNormal (PromptEvent.Character "q") =-  consumeUnmodified PromptState.Quit CursorUpdate.Unmodified-basicTransitionNormal (PromptEvent.Character "i") =-  consumeUnmodified PromptState.Insert CursorUpdate.Unmodified-basicTransitionNormal (PromptEvent.Character "I") =-  consumeUnmodified PromptState.Insert CursorUpdate.Prepend-basicTransitionNormal (PromptEvent.Character "a") =-  consumeUnmodified PromptState.Insert CursorUpdate.OneRight-basicTransitionNormal (PromptEvent.Character "A") =-  consumeUnmodified PromptState.Insert CursorUpdate.Append-basicTransitionNormal (PromptEvent.Character "h") =-  consumeUnmodified PromptState.Normal CursorUpdate.OneLeft-basicTransitionNormal (PromptEvent.Character "l") =-  consumeUnmodified PromptState.Normal CursorUpdate.OneRight-basicTransitionNormal (PromptEvent.Character "x") =-  PromptUpdate PromptState.Normal CursorUpdate.OneLeft TextUpdate.DeleteRight PromptConsumed.Yes-basicTransitionNormal _ =-  PromptUpdate PromptState.Normal CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.No--basicTransitionInsert ::-  [PromptFlag] ->-  PromptEvent ->-  PromptUpdate-basicTransitionInsert flags =-  trans-  where-    trans (PromptEvent.Character "esc") | onlyInsert flags =-      PromptUpdate PromptState.Quit CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.Yes-    trans (PromptEvent.Character "esc") =-      normal-    trans (PromptEvent.Character "c-n") =-      normal-    trans (PromptEvent.Character "bs") =-      insert CursorUpdate.OneLeft TextUpdate.DeleteLeft PromptConsumed.Yes-    trans (PromptEvent.Character c) | unprocessable c =-      insert CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.No-    trans (PromptEvent.Character "space") =-      insert CursorUpdate.OneRight (TextUpdate.Insert " ") PromptConsumed.Yes-    trans (PromptEvent.Character c) =-      insert CursorUpdate.OneRight (TextUpdate.Insert c) PromptConsumed.Yes-    trans _ =-      insert CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.No-    insert =-      PromptUpdate PromptState.Insert-    normal =-      PromptUpdate PromptState.Normal CursorUpdate.OneLeft TextUpdate.Unmodified PromptConsumed.Yes--basicTransition ::-  Monad m =>-  [PromptFlag] ->-  PromptEvent ->-  PromptState ->-  m PromptUpdate-basicTransition _ (PromptEvent.Set (Prompt cursor state text)) _ =-  return $ PromptUpdate state (CursorUpdate.Index cursor) (TextUpdate.Set text) PromptConsumed.Yes-basicTransition _ event PromptState.Normal =-  return $ basicTransitionNormal event-basicTransition flags event PromptState.Insert =-  return $ basicTransitionInsert flags event-basicTransition _ _ PromptState.Quit =-  return $ PromptUpdate PromptState.Quit CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.No--pristinePrompt :: Bool -> Prompt-pristinePrompt insert =-  Prompt 0 (if insert then PromptState.Insert else PromptState.Normal) ""--noPromptRenderer ::-  Applicative m =>-  PromptRenderer m-noPromptRenderer =-  PromptRenderer unit (const unit) (const unit)
− lib/Ribosome/Menu/Run.hs 
@@ -1,236 +0,0 @@-module Ribosome.Menu.Run where--import Conduit (ConduitT, MonadResource, await, awaitForever, mapC, runConduit, yield, (.|))-import Control.Concurrent.STM.TMChan (TMChan, writeTMChan)-import Control.Exception.Lifted (bracket)-import Control.Lens (over, set, view)-import Data.Conduit.Combinators (iterM)-import qualified Data.Conduit.Combinators as Conduit (last)-import Data.Conduit.Lift (evalStateC)-import qualified Data.Text as Text--import Ribosome.Api.Window (closeWindow)-import Ribosome.Config.Setting (settingOr)-import qualified Ribosome.Config.Settings as Settings-import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)-import Ribosome.Data.Conduit (mergeSources)-import Ribosome.Data.Scratch (scratchWindow)-import Ribosome.Data.ScratchOptions (ScratchOptions)-import qualified Ribosome.Data.ScratchOptions as ScratchOptions (size, syntax)-import Ribosome.Data.WindowConfig (WindowConfig(WindowConfig))-import Ribosome.Log (showDebug)-import Ribosome.Menu.Data.Menu (Menu)-import qualified Ribosome.Menu.Data.Menu as Menu (maxItems)-import Ribosome.Menu.Data.MenuAction (MenuAction)-import qualified Ribosome.Menu.Data.MenuAction as MenuAction (MenuAction(..))-import Ribosome.Menu.Data.MenuConfig (MenuConfig(MenuConfig))-import qualified Ribosome.Menu.Data.MenuConfig as MenuConfig (prompt)-import Ribosome.Menu.Data.MenuConsumer (MenuConsumer(MenuConsumer))-import Ribosome.Menu.Data.MenuEvent (MenuEvent, QuitReason)-import qualified Ribosome.Menu.Data.MenuEvent as MenuEvent (MenuEvent(..))-import qualified Ribosome.Menu.Data.MenuEvent as QuitReason (QuitReason(..))-import Ribosome.Menu.Data.MenuItem (MenuItem)-import qualified Ribosome.Menu.Data.MenuItem as MenuItem (MenuItem(_text))-import Ribosome.Menu.Data.MenuRenderEvent (MenuRenderEvent)-import qualified Ribosome.Menu.Data.MenuRenderEvent as MenuRenderEvent (MenuRenderEvent(..))-import Ribosome.Menu.Data.MenuResult (MenuResult)-import qualified Ribosome.Menu.Data.MenuResult as MenuResult (MenuResult(..))-import Ribosome.Menu.Data.MenuUpdate (MenuUpdate(MenuUpdate))-import Ribosome.Menu.Nvim (menuSyntax, renderNvimMenu)-import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))-import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig)-import qualified Ribosome.Menu.Prompt.Data.PromptConfig as PromptConfig (render)-import Ribosome.Menu.Prompt.Data.PromptConsumed (PromptConsumed)-import qualified Ribosome.Menu.Prompt.Data.PromptConsumed as PromptConsumed (PromptConsumed(..))-import Ribosome.Menu.Prompt.Data.PromptConsumerUpdate (PromptConsumerUpdate(PromptConsumerUpdate))-import Ribosome.Menu.Prompt.Data.PromptEvent (PromptEvent)-import qualified Ribosome.Menu.Prompt.Data.PromptEvent as PromptEvent (PromptEvent(..))-import Ribosome.Menu.Prompt.Data.PromptRenderer (PromptRenderer(PromptRenderer))-import qualified Ribosome.Menu.Prompt.Data.PromptState as PromptState (PromptState(..))-import Ribosome.Menu.Prompt.Run (promptC)-import Ribosome.Msgpack.Decode (fromMsgpack)-import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))-import Ribosome.Msgpack.Error (DecodeError)-import Ribosome.Nvim.Api.Data (Window)-import Ribosome.Nvim.Api.IO (nvimWinGetConfig, vimCallFunction, vimGetWindows, windowSetOption)-import Ribosome.Scratch (showInScratch)--promptEvent ::-  PromptEvent ->-  Prompt ->-  PromptConsumed ->-  MenuEvent m a i-promptEvent _ (Prompt _ PromptState.Quit _) _ =-  MenuEvent.Quit QuitReason.Aborted-promptEvent (PromptEvent.Character a) prompt PromptConsumed.No =-  MenuEvent.Mapping a prompt-promptEvent (PromptEvent.Character _) prompt@(Prompt _ PromptState.Insert _) _ =-  MenuEvent.PromptChange prompt-promptEvent (PromptEvent.Character _) prompt PromptConsumed.Yes =-  MenuEvent.PromptChange prompt-promptEvent (PromptEvent.Set _) prompt _ =-  MenuEvent.PromptChange prompt-promptEvent PromptEvent.Init prompt _ =-  MenuEvent.Init prompt-promptEvent (PromptEvent.Unexpected code) _ _ =-  MenuEvent.Quit . QuitReason.PromptError $ "unexpected input character code: " <> show code-promptEvent PromptEvent.Interrupt _ _ =-  MenuEvent.Quit QuitReason.Aborted-promptEvent (PromptEvent.Error e) _ _ =-  MenuEvent.Quit (QuitReason.PromptError e)--menuEvent ::-  Either PromptConsumerUpdate [MenuItem i] ->-  MenuEvent m a i-menuEvent =-  either promptUpdate MenuEvent.NewItems-  where-    promptUpdate (PromptConsumerUpdate event prompt consumed) =-      promptEvent event prompt consumed--updateMenu ::-  MonadRibo m =>-  TMChan PromptEvent ->-  MenuConsumer m a i ->-  Either PromptConsumerUpdate [MenuItem i] ->-  ConduitT (Either PromptConsumerUpdate [MenuItem i]) (MenuRenderEvent m a i) (StateT (Menu i) m) ()-updateMenu backchannel (MenuConsumer consumer) input = do-  showDebug "menu update:" (MenuItem._text <$$> input)-  action <- lift . stateM $ lift . consumer . MenuUpdate (menuEvent input)-  showDebug "menu action:" action-  emit action-  where-    emit MenuAction.Continue =-      return ()-    emit (MenuAction.Execute thunk) =-      lift $ lift thunk-    emit (MenuAction.Render changed) =-      yield . MenuRenderEvent.Render changed =<< get-    emit (MenuAction.UpdatePrompt prompt) =-      atomically $ writeTMChan backchannel (PromptEvent.Set prompt)-    emit (MenuAction.Quit reason) =-      yield (MenuRenderEvent.Quit reason)--menuTerminator ::-  Monad m =>-  ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()-menuTerminator =-  traverse_ check =<< await-  where-    check (MenuRenderEvent.Quit reason) =-      yield reason-    check _ =-      menuTerminator--menuResult ::-  Monad m =>-  QuitReason m a ->-  m (MenuResult a)-menuResult (QuitReason.Return a) =-  return (MenuResult.Return a)-menuResult (QuitReason.Execute ma) =-  MenuResult.Return <$> ma-menuResult (QuitReason.PromptError err) =-  return (MenuResult.Error err)-menuResult QuitReason.NoOutput =-  return MenuResult.NoOutput-menuResult QuitReason.Aborted =-  return MenuResult.Aborted--menuC ::-  MonadRibo m =>-  MonadResource m =>-  MonadBaseControl IO m =>-  MenuConfig m a i ->-  ConduitT () (QuitReason m a) m ()-menuC (MenuConfig items handle render promptConfig maxItems) = do-  (backchannel, source) <- lift $ promptC promptConfig-  mergeSources 64 [source .| mapC Left, items .| mapC Right] .| consumer backchannel-  where-    consumer backchannel =-      evalStateC initial (menuHandler backchannel) .| iterM render .| menuTerminator-    initial =-      set Menu.maxItems maxItems def-    menuHandler backchannel =-      awaitForever . updateMenu backchannel $ handle--isFloat ::-  NvimE e m =>-  Window ->-  m Bool-isFloat =-  fmap (check . fromMsgpack . toMsgpack) . nvimWinGetConfig-  where-    check (Right (WindowConfig relative _ _)) =-      not (Text.null relative)-    check _ =-      False--closeFloats ::-  NvimE e m =>-  m ()-closeFloats = do-  traverse_ closeWindow =<< filterM isFloat =<< vimGetWindows--runMenu ::-  MonadRibo m =>-  MonadResource m =>-  MonadBaseControl IO m =>-  MenuConfig m a i ->-  m (MenuResult a)-runMenu config =-  bracketPrompt (view (MenuConfig.prompt . PromptConfig.render) config)-  where-    bracketPrompt (PromptRenderer acquire release _) =-      bracket acquire release (const runForResult)-    runForResult =-      menuResult =<< quitReason <$> run-    run =-      runConduit (menuC config .| Conduit.last)-    quitReason =-      fromMaybe QuitReason.NoOutput--nvimMenu ::-  NvimE e m =>-  MonadRibo m =>-  MonadResource m =>-  MonadBaseControl IO m =>-  MonadDeepError e DecodeError m =>-  ScratchOptions ->-  ConduitT () [MenuItem i] m () ->-  (MenuUpdate m a i -> m (MenuAction m a, Menu i)) ->-  PromptConfig m ->-  Maybe Int ->-  m (MenuResult a)-nvimMenu options items handle promptConfig maxItems = do-  _ :: Int <- vimCallFunction "inputsave" []-  whenM (settingOr True Settings.menuCloseFloats) closeFloats-  run =<< showInScratch @[] [] (withSyntax (ensureSize options))-  where-    run scratch = do-      windowSetOption (scratchWindow scratch) "cursorline" (toMsgpack True)-      runMenu $ MenuConfig items (MenuConsumer handle) (render scratch) promptConfig maxItems-    render =-      renderNvimMenu options-    ensureSize =-      over ScratchOptions.size (<|> Just 1)-    withSyntax =-      over ScratchOptions.syntax (++ [menuSyntax])--strictNvimMenu ::-  NvimE e m =>-  MonadRibo m =>-  MonadResource m =>-  MonadBaseControl IO m =>-  MonadDeepError e DecodeError m =>-  ScratchOptions ->-  [MenuItem i] ->-  (MenuUpdate m a i -> m (MenuAction m a, Menu i)) ->-  PromptConfig m ->-  Maybe Int ->-  m (MenuResult a)-strictNvimMenu options items =-  nvimMenu (ensureSize options) (yield items)-  where-    ensureSize =-      over ScratchOptions.size (<|> Just (length items))
− lib/Ribosome/Menu/Simple.hs 
@@ -1,325 +0,0 @@-module Ribosome.Menu.Simple where--import Control.Lens (_2, element, ifolded, over, set, toListOf, view, withIndex, (^..), (^?))-import qualified Control.Lens as Lens (filtered)-import Data.Composition ((.:))-import Data.Map.Strict ((!?))-import qualified Data.Map.Strict as Map (fromList, union)-import qualified Data.Ord as Ord (Down(Down))-import qualified Data.Text as Text (breakOn, null)-import qualified Text.Fuzzy as Fuzzy (Fuzzy(score, original), filter)--import Ribosome.Data.List (indexesComplement)-import Ribosome.Menu.Action (menuContinue, menuCycle, menuQuitWith, menuToggle, menuToggleAll)-import Ribosome.Menu.Data.BasicMenuAction (BasicMenuAction, BasicMenuChange)-import qualified Ribosome.Menu.Data.BasicMenuAction as BasicMenuAction (BasicMenuAction(..))-import qualified Ribosome.Menu.Data.BasicMenuAction as BasicMenuChange (BasicMenuChange(..))-import Ribosome.Menu.Data.FilteredMenuItem (FilteredMenuItem(FilteredMenuItem))-import qualified Ribosome.Menu.Data.FilteredMenuItem as FilteredMenuItem (index, item)-import Ribosome.Menu.Data.Menu (Menu(Menu), MenuFilter(MenuFilter))-import qualified Ribosome.Menu.Data.Menu as Menu (currentFilter, filtered, items, marked, selected)-import Ribosome.Menu.Data.MenuAction (MenuAction)-import qualified Ribosome.Menu.Data.MenuAction as MenuAction (MenuAction(..))-import Ribosome.Menu.Data.MenuConsumerAction (MenuConsumerAction)-import qualified Ribosome.Menu.Data.MenuConsumerAction as MenuConsumerAction (MenuConsumerAction(..))-import Ribosome.Menu.Data.MenuEvent (MenuEvent)-import qualified Ribosome.Menu.Data.MenuEvent as MenuEvent (MenuEvent(..))-import qualified Ribosome.Menu.Data.MenuEvent as QuitReason (QuitReason(..))-import Ribosome.Menu.Data.MenuItem (MenuItem)-import qualified Ribosome.Menu.Data.MenuItem as MenuItem (text)-import Ribosome.Menu.Data.MenuItemFilter (MenuItemFilter(MenuItemFilter))-import Ribosome.Menu.Data.MenuUpdate (MenuUpdate(MenuUpdate))-import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))--type MappingHandler m a i = Menu i -> Prompt -> m (MenuConsumerAction m a, Menu i)-type Mappings m a i = Map Text (MappingHandler m a i)--zipWithIndex :: [a] -> [(Int, a)]-zipWithIndex =-  toListOf $ ifolded . withIndex--textContains :: Text -> Text -> Bool-textContains needle haystack =-  Text.null needle || (not (Text.null haystack) && search needle haystack)-  where-    search =-      not . Text.null . snd .: Text.breakOn--substringMenuItemMatcher :: MenuItemFilter a-substringMenuItemMatcher =-  MenuItemFilter filt-  where-    filt text =-      uncurry FilteredMenuItem <$$> matcher text-    matcher text =-      toListOf $ ifolded . Lens.filtered (textContains text . view MenuItem.text) . withIndex--fuzzyMenuItemMatcher :: MenuItemFilter a-fuzzyMenuItemMatcher =-  MenuItemFilter matcher-  where-    matcher =-      fmap (uncurry FilteredMenuItem . Fuzzy.original) . sortOn (Ord.Down . Fuzzy.score) .: filtered-    filtered text items =-      Fuzzy.filter text (items ^.. ifolded . withIndex) "" "" (view (_2 . MenuItem.text)) False--menuItemsNonequal :: [FilteredMenuItem i] -> [FilteredMenuItem i] -> Bool-menuItemsNonequal a b =-  (view FilteredMenuItem.index <$> a) /= (view FilteredMenuItem.index <$> b)--updateFilter :: MenuItemFilter i -> Text -> Menu i -> (BasicMenuChange, Menu i)-updateFilter (MenuItemFilter itemFilter) text menu@(Menu items oldFiltered _ _ _ _) =-  (change, update menu)-  where-    change =-      if menuItemsNonequal filtered oldFiltered-      then BasicMenuChange.Change-      else BasicMenuChange.NoChange-    update =-      set Menu.filtered filtered . set Menu.currentFilter (MenuFilter text)-    filtered =-      itemFilter text items--reapplyFilter :: MenuItemFilter i -> Menu i -> (BasicMenuChange, Menu i)-reapplyFilter itemFilter menu@(Menu _ _ _ _ (MenuFilter currentFilter) _) =-  updateFilter itemFilter currentFilter menu--basicMenuTransform :: MenuItemFilter i -> MenuEvent m a i -> Menu i -> BasicMenuAction m a i-basicMenuTransform matcher (MenuEvent.PromptChange (Prompt _ _ text)) =-  BasicMenuAction.Continue BasicMenuChange.Reset . snd . updateFilter matcher text-basicMenuTransform _ (MenuEvent.Mapping _ _) =-  BasicMenuAction.Continue BasicMenuChange.NoChange-basicMenuTransform matcher (MenuEvent.NewItems items) =-  uncurry BasicMenuAction.Continue . reapplyFilter matcher . over Menu.items (++ items)-basicMenuTransform _ (MenuEvent.Init _) =-  BasicMenuAction.Continue BasicMenuChange.Change-basicMenuTransform _ (MenuEvent.Quit reason) =-  const $ BasicMenuAction.Quit reason--resetSelection :: BasicMenuChange -> Menu i -> Menu i-resetSelection BasicMenuChange.Reset (Menu i f _ _ filt mi) =-  Menu i f 0 [] filt mi-resetSelection _ m =-  m--menuAction ::-  MenuItemFilter i ->-  Bool ->-  MenuConsumerAction m a ->-  Menu i ->-  (MenuAction m a, Menu i)-menuAction itemFilter _ MenuConsumerAction.Filter menu =-  (MenuAction.Render True, uncurry resetSelection $ reapplyFilter itemFilter menu)-menuAction _ True MenuConsumerAction.Continue menu =-  (MenuAction.Render True, menu)-menuAction _ False MenuConsumerAction.Continue menu =-  (MenuAction.Continue, menu)-menuAction _ _ (MenuConsumerAction.Execute thunk) menu =-  (MenuAction.Execute thunk, menu)-menuAction _ basicChanged (MenuConsumerAction.Render consumerChanged) menu =-  (MenuAction.Render (basicChanged || consumerChanged), menu)-menuAction _ _ (MenuConsumerAction.QuitWith ma) menu =-  (MenuAction.Quit (QuitReason.Execute ma), menu)-menuAction _ _ MenuConsumerAction.Quit menu =-  (MenuAction.Quit QuitReason.Aborted, menu)-menuAction _ _ (MenuConsumerAction.Return a) menu =-  (MenuAction.Quit (QuitReason.Return a), menu)-menuAction _ _ (MenuConsumerAction.UpdatePrompt prompt) menu =-  (MenuAction.UpdatePrompt prompt, menu)--basicMenuAction ::-  Monad m =>-  MenuItemFilter i ->-  (MenuUpdate m a i -> m (MenuConsumerAction m a, Menu i)) ->-  MenuUpdate m a i ->-  BasicMenuAction m a i ->-  m (MenuAction m a, Menu i)-basicMenuAction itemFilter consumer (MenuUpdate event menu) =-  act-  where-    act (BasicMenuAction.Quit reason) =-      pure (MenuAction.Quit reason, menu)-    act (BasicMenuAction.Continue change m) = do-      (action, updatedMenu) <- consumerTransform (resetSelection change m)-      return $ menuAction itemFilter (change /= BasicMenuChange.NoChange) action updatedMenu-    consumerTransform newMenu =-      consumer (MenuUpdate event newMenu)--basicMenu ::-  Monad m =>-  MenuItemFilter i ->-  (MenuUpdate m a i -> m (MenuConsumerAction m a, Menu i)) ->-  MenuUpdate m a i ->-  m (MenuAction m a, Menu i)-basicMenu itemFilter consumer update@(MenuUpdate event menu) =-  basicMenuAction itemFilter consumer update basicTransform-  where-    basicTransform =-      basicMenuTransform itemFilter event menu--mappingConsumer ::-  Monad m =>-  Mappings m a i ->-  MenuUpdate m a i ->-  m (MenuConsumerAction m a, Menu i)-mappingConsumer mappings (MenuUpdate (MenuEvent.Mapping char prompt) menu) =-  handler menu prompt-  where-    handler =-      fromMaybe (const . menuContinue) (mappings !? char)-mappingConsumer _ (MenuUpdate _ menu) =-  menuContinue menu--simpleMenu ::-  Monad m =>-  Mappings m a i ->-  MenuUpdate m a i ->-  m (MenuAction m a, Menu i)-simpleMenu =-  basicMenu fuzzyMenuItemMatcher . mappingConsumer--defaultMappings ::-  Monad m =>-  Mappings m a i-defaultMappings =-  Map.fromList [-    ("k", menuCycle 1),-    ("c-k", menuCycle 1),-    ("j", menuCycle (-1)),-    ("c-j", menuCycle (-1)),-    ("space", menuToggle),-    ("*", menuToggleAll)-    ]--defaultMenu ::-  Monad m =>-  Mappings m a i ->-  MenuUpdate m a i ->-  m (MenuAction m a, Menu i)-defaultMenu =-  simpleMenu . (`Map.union` defaultMappings)--selectedMenuItem :: Menu i -> Maybe (MenuItem i)-selectedMenuItem (Menu _ filtered selected _ _ _) =-  filtered ^? element selected . FilteredMenuItem.item--withSelectedMenuItem ::-  Monad m =>-  (MenuItem i -> m (MenuConsumerAction m a, Menu i)) ->-  Menu i ->-  m (MenuConsumerAction m a, Menu i)-withSelectedMenuItem f m =-  maybe (menuContinue m) pure =<< traverse f (selectedMenuItem m)--filterIndexes :: [Int] -> [a] -> [a]-filterIndexes indexes =-  reverse . go 0 (sort indexes) []-  where-    go current (i : is) result (a : asTail) | i == current =-      go (current + 1) is (a : result) asTail-    go current is result (_ : asTail) =-      go (current + 1) is result asTail-    go _ _ result _ =-      result--markedIndexes :: Menu i -> [Int]-markedIndexes (Menu _ _ selected [] _ _) =-  [selected]-markedIndexes (Menu _ _ _ marked _ _) =-  marked--menuItemsByIndexes :: [Int] -> Menu i -> [MenuItem i]-menuItemsByIndexes indexes (Menu _ filtered _ _ _ _) =-  view FilteredMenuItem.item <$> filterIndexes indexes filtered--markedMenuItemsOnly :: Menu i -> Maybe (NonEmpty (MenuItem i))-markedMenuItemsOnly (Menu _ _ _ [] _ _) =-  Nothing-markedMenuItemsOnly (Menu _ filtered _ marked _ _) =-  nonEmpty $ view FilteredMenuItem.item <$> filterIndexes marked filtered--markedMenuItems :: Menu i -> Maybe (NonEmpty (MenuItem i))-markedMenuItems m =-  markedMenuItemsOnly m <|> (pure <$> selectedMenuItem m)--unmarkedMenuItems :: Menu i -> [MenuItem i]-unmarkedMenuItems menu =-  menuItemsByIndexes (indexesComplement (length (view Menu.filtered menu)) (indexes menu)) menu-  where-    indexes (Menu _ _ selected [] _ _) =-      [selected]-    indexes (Menu _ _ _ marked _ _) =-      marked--withMarkedMenuItems ::-  Monad m =>-  (NonEmpty (MenuItem i) -> m a) ->-  Menu i ->-  m (Maybe a)-withMarkedMenuItems f m =-  traverse f (markedMenuItems m)--withMarkedMenuItems_ ::-  Monad m =>-  (NonEmpty (MenuItem i) -> m ()) ->-  Menu i ->-  m ()-withMarkedMenuItems_ f m =-  traverse_ f (markedMenuItems m)--actionWithMarkedMenuItems ::-  Monad m =>-  (m (NonEmpty b) -> Menu i -> m (MenuConsumerAction m a, Menu i)) ->-  (MenuItem i -> m b) ->-  Menu i ->-  m (MenuConsumerAction m a, Menu i)-actionWithMarkedMenuItems next f m =-  fromMaybe (MenuConsumerAction.Continue, m) <$> withMarkedMenuItems run m-  where-    run items =-      next (traverse f items) m--traverseMarkedMenuItems ::-  Monad m =>-  (MenuItem i -> m a) ->-  Menu i ->-  m (Maybe (NonEmpty a))-traverseMarkedMenuItems =-  withMarkedMenuItems . traverse--traverseMarkedMenuItems_ ::-  Monad m =>-  (MenuItem i -> m ()) ->-  Menu i ->-  m ()-traverseMarkedMenuItems_ =-  withMarkedMenuItems_ . traverse_--traverseMarkedMenuItemsAndQuit ::-  Monad m =>-  (MenuItem i -> m a) ->-  Menu i ->-  m (MenuConsumerAction m (NonEmpty a), Menu i)-traverseMarkedMenuItemsAndQuit =-  actionWithMarkedMenuItems menuQuitWith--traverseMarkedMenuItemsAndQuit_ ::-  Monad m =>-  (MenuItem i -> m ()) ->-  Menu i ->-  m (MenuConsumerAction m (), Menu i)-traverseMarkedMenuItemsAndQuit_ f =-  first void <$$> actionWithMarkedMenuItems menuQuitWith f--deleteByFilteredIndex :: [Int] -> Menu i -> Menu i-deleteByFilteredIndex indexes menu@(Menu items filtered _ _ _ _) =-  set Menu.items newItems . set Menu.filtered [] $ menu-  where-    newItems =-      filterIndexes (indexesComplement (length items) unfilteredIndexes) items-    unfilteredIndexes =-      view FilteredMenuItem.index <$> filterIndexes indexes filtered--deleteMarked :: Menu i -> Menu i-deleteMarked menu =-  set Menu.selected 0 . set Menu.marked [] . deleteByFilteredIndex (markedIndexes menu) $ menu
− lib/Ribosome/Msgpack/Decode.hs 
@@ -1,270 +0,0 @@-module Ribosome.Msgpack.Decode where--import qualified Data.ByteString.UTF8 as ByteString (toString)-import qualified Data.Map.Strict as Map (empty, fromList, toList)-import Data.MessagePack (Object(..))-import Data.Text.Prettyprint.Doc (pretty, viaShow)-import GHC.Float (double2Float, float2Double)-import GHC.Generics (-  C1,-  Constructor,-  D1,-  K1(..),-  M1(..),-  Rep,-  S1,-  Selector,-  conIsRecord,-  selName,-  to,-  (:*:)(..),-  (:+:)(..),-  )-import Neovim (CommandArguments)-import Path (Abs, Dir, File, Path, Rel, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile)--import Ribosome.Msgpack.Error (DecodeError)-import qualified Ribosome.Msgpack.Error as DecodeError (DecodeError(Failed))-import Ribosome.Msgpack.Util (Err)-import qualified Ribosome.Msgpack.Util as Util (illegalType, invalid, lookupObjectMap, missingRecordKey)--class MsgpackDecode a where-  fromMsgpack :: Object -> Either Err a-  default fromMsgpack :: (Generic a, GMsgpackDecode (Rep a)) => Object -> Either Err a-  fromMsgpack = fmap to . gMsgpackDecode--  missingKey :: String -> Object -> Either Err a-  missingKey = Util.missingRecordKey--class GMsgpackDecode f where-  gMsgpackDecode :: Object -> Either Err (f a)--  gMissingKey :: String -> Object -> Either Err (f a)-  gMissingKey = Util.missingRecordKey--class MsgpackDecodeProd f where-  msgpackDecodeRecord :: Map Object Object -> Either Err (f a)-  msgpackDecodeProd :: [Object] -> Either Err ([Object], f a)--instance (GMsgpackDecode f) => GMsgpackDecode (D1 c f) where-  gMsgpackDecode =-    fmap M1 . gMsgpackDecode @f--instance (Constructor c, MsgpackDecodeProd f) => GMsgpackDecode (C1 c f) where-  gMsgpackDecode =-    fmap M1 . decode-    where-      isRec = conIsRecord (undefined :: t c f p)-      decode o@(ObjectMap om) =-        if isRec then msgpackDecodeRecord om else Util.invalid "illegal ObjectMap for product" o-      decode o | isRec =-        Util.invalid "illegal non-ObjectMap for record" o-      decode o =-        msgpackDecodeProd (prod o) >>= check-        where-          check ([], a) = Right a-          check _ = Util.invalid "too many values for product" o-          prod (ObjectArray oa) = oa-          prod ob = [ob]--instance (MsgpackDecodeProd f, MsgpackDecodeProd g) => MsgpackDecodeProd (f :*: g) where-  msgpackDecodeRecord o = do-    left <- msgpackDecodeRecord o-    right <- msgpackDecodeRecord o-    return $ left :*: right-  msgpackDecodeProd o = do-    (rest, left) <- msgpackDecodeProd o-    (rest1, right) <- msgpackDecodeProd rest-    return (rest1, left :*: right)--instance (GMsgpackDecode f, GMsgpackDecode g) => GMsgpackDecode (f :+: g) where-  gMsgpackDecode o = fromRight (L1 <$> gMsgpackDecode @f o) (Right . R1 <$> gMsgpackDecode @g o)---- TODO use Proxy instead of undefined-instance (Selector s, GMsgpackDecode f) => MsgpackDecodeProd (S1 s f) where-  msgpackDecodeRecord o =-    M1 <$> maybe (gMissingKey key (ObjectMap o)) gMsgpackDecode lookup-    where-      lookup =-        Util.lookupObjectMap key o <|> lookupUnderscore-      lookupUnderscore =-        if hasUnderscore-        then Util.lookupObjectMap (dropWhile ('_' ==) key) o-        else Nothing-      hasUnderscore =-        take 1 key == "_"-      key =-        selName (undefined :: t s f p)-  msgpackDecodeProd (cur:rest) = do-    a <- gMsgpackDecode cur-    return (rest, M1 a)-  msgpackDecodeProd [] = Util.invalid "too few values for product" ObjectNil--instance MsgpackDecode a => GMsgpackDecode (K1 i a) where-  gMsgpackDecode = fmap K1 . fromMsgpack--  gMissingKey key =-    fmap K1 . missingKey key--instance (Ord k, MsgpackDecode k, MsgpackDecode v) => MsgpackDecode (Map k v) where-  fromMsgpack (ObjectMap om) = do-    m <- traverse decodePair $ Map.toList om-    Right $ Map.fromList m-    where-      decodePair (k, v) = do-        k1 <- fromMsgpack k-        v1 <- fromMsgpack v-        return (k1, v1)-  fromMsgpack o = Util.illegalType "Map" o-  missingKey _ _ = Right Map.empty--integralFromString ::-  Read a =>-  ByteString ->-  Either Err a-integralFromString =-  mapLeft pretty . readEither . ByteString.toString--msgpackIntegral ::-  Integral a =>-  Read a =>-  Object ->-  Either Err a-msgpackIntegral (ObjectInt i) = Right $ fromIntegral i-msgpackIntegral (ObjectUInt i) = Right $ fromIntegral i-msgpackIntegral (ObjectString s) = integralFromString s-msgpackIntegral (ObjectBinary s) = integralFromString s-msgpackIntegral o = Util.illegalType "Integral" o--msgpackText :: ConvertUtf8 t ByteString => Text -> (t -> Either Err a) -> Object -> Either Err a-msgpackText typeName decode =-  run-  where-    run (ObjectString os) = decode $ decodeUtf8 os-    run (ObjectBinary os) = decode $ decodeUtf8 os-    run o = Util.illegalType typeName o--instance MsgpackDecode Int where-  fromMsgpack = msgpackIntegral--instance MsgpackDecode Int64 where-  fromMsgpack = msgpackIntegral--instance MsgpackDecode Float where-  fromMsgpack (ObjectFloat a) = Right a-  fromMsgpack (ObjectDouble a) = Right (double2Float a)-  fromMsgpack (ObjectInt a) = Right (fromIntegral a)-  fromMsgpack (ObjectUInt a) = Right (fromIntegral a)-  fromMsgpack o = Util.illegalType "Float" o--instance MsgpackDecode Double where-  fromMsgpack (ObjectFloat a) = Right (float2Double a)-  fromMsgpack (ObjectDouble a) = Right a-  fromMsgpack (ObjectInt a) = Right (fromIntegral a)-  fromMsgpack (ObjectUInt a) = Right (fromIntegral a)-  fromMsgpack o = Util.illegalType "Double" o--instance {-# OVERLAPPING #-} MsgpackDecode String where-  fromMsgpack = msgpackText "String" Right--instance {-# OVERLAPPABLE #-} MsgpackDecode a => MsgpackDecode [a] where-  fromMsgpack (ObjectArray oa) = traverse fromMsgpack oa-  fromMsgpack o = Util.illegalType "List" o-  missingKey _ _ = Right []--instance MsgpackDecode Text where-  fromMsgpack =-    msgpackText "Text" Right--instance MsgpackDecode ByteString where-  fromMsgpack (ObjectString os) = Right os-  fromMsgpack (ObjectBinary os) = Right os-  fromMsgpack o = Util.illegalType "ByteString" o--instance MsgpackDecode Char where-  fromMsgpack o =-    msgpackText "Char" check o-    where-      check :: [Char] -> Either Err Char-      check [c] = Right c-      check _ = Util.invalid "multiple characters when decoding Char" o--instance MsgpackDecode a => MsgpackDecode (Maybe a) where-  fromMsgpack ObjectNil = Right Nothing-  fromMsgpack o = Just <$> fromMsgpack o-  missingKey _ _ = Right Nothing--instance (MsgpackDecode a, MsgpackDecode b) => MsgpackDecode (Either a b) where-  fromMsgpack o =-    fromRight (Left <$> fromMsgpack o) (Right . Right <$> fromMsgpack o)--instance MsgpackDecode Bool where-  fromMsgpack (ObjectBool a) = Right a-  fromMsgpack (ObjectInt 0) = Right False-  fromMsgpack (ObjectInt 1) = Right True-  fromMsgpack o = Util.illegalType "Bool" o--instance MsgpackDecode () where-  fromMsgpack _ = Right ()--instance MsgpackDecode Object where-  fromMsgpack = Right--instance (MsgpackDecode a, MsgpackDecode b) => MsgpackDecode (a, b) where-  fromMsgpack (ObjectArray [a, b]) =-    (,) <$> fromMsgpack a <*> fromMsgpack b-  fromMsgpack o@(ObjectArray _) =-    Util.invalid "invalid array length for pair" o-  fromMsgpack o =-    Util.illegalType "pair" o--instance MsgpackDecode CommandArguments where--class DecodePath b t where-  decodePath :: FilePath -> Either SomeException (Path b t)--instance DecodePath Abs File where-  decodePath =-    parseAbsFile--instance DecodePath Abs Dir where-  decodePath =-    parseAbsDir--instance DecodePath Rel File where-  decodePath =-    parseRelFile--instance DecodePath Rel Dir where-  decodePath =-    parseRelDir--decodePathE ::-  ∀ b t .-  DecodePath b t =>-  Text ->-  Either Err (Path b t)-decodePathE =-  first viaShow . decodePath . toString--instance DecodePath b t => MsgpackDecode (Path b t) where-  fromMsgpack =-    msgpackText "Path" decodePathE--fromMsgpack' ::-  ∀ a e m.-  MonadDeepError e DecodeError m =>-  MsgpackDecode a =>-  Object ->-  m a-fromMsgpack' =-  hoistEitherWith DecodeError.Failed . fromMsgpack--msgpackFromString :: IsString a => Text -> Object -> Either Err a-msgpackFromString name o =-  adapt $ fromMsgpack o-  where-    adapt (Right a) =-      Right $ fromString a-    adapt (Left _) =-      Util.illegalType name o
− lib/Ribosome/Msgpack/Encode.hs 
@@ -1,122 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Ribosome.Msgpack.Encode where--import qualified Data.List.NonEmpty as NonEmpty (toList)-import qualified Data.Map.Strict as Map (fromList, toList)-import Data.MessagePack (Object(..))-import GHC.Generics (-  C1,-  Constructor,-  D1,-  K1(..),-  M1(..),-  Rep,-  S1,-  Selector,-  conIsRecord,-  from,-  selName,-  (:*:)(..),-  (:+:)(..),-  )-import Path (Path, toFilePath)-import qualified Ribosome.Msgpack.Util as Util (assembleMap, string, text)--class MsgpackEncode a where-  toMsgpack :: a -> Object-  default toMsgpack :: (Generic a, GMsgpackEncode (Rep a)) => a -> Object-  toMsgpack = gMsgpackEncode . from--class GMsgpackEncode f where-  gMsgpackEncode :: f a -> Object--class MsgpackEncodeProd f where-  msgpackEncodeRecord :: f a -> [(String, Object)]-  msgpackEncodeProd :: f a -> [Object]--instance GMsgpackEncode f => GMsgpackEncode (D1 c f) where-  gMsgpackEncode = gMsgpackEncode . unM1--prodOrNewtype :: MsgpackEncodeProd f => f a -> Object-prodOrNewtype =-  wrap . msgpackEncodeProd-  where-    wrap [a] = a-    wrap as = ObjectArray as--instance (Constructor c, MsgpackEncodeProd f) => GMsgpackEncode (C1 c f) where-  gMsgpackEncode c =-    f $ unM1 c-    where-      f = if conIsRecord c then Util.assembleMap . msgpackEncodeRecord else prodOrNewtype--instance (MsgpackEncodeProd f, MsgpackEncodeProd g) => MsgpackEncodeProd (f :*: g) where-  msgpackEncodeRecord (f :*: g) = msgpackEncodeRecord f <> msgpackEncodeRecord g-  msgpackEncodeProd (f :*: g) = msgpackEncodeProd f <> msgpackEncodeProd g--instance (GMsgpackEncode f, GMsgpackEncode g) => GMsgpackEncode (f :+: g) where-  gMsgpackEncode (L1 a) = gMsgpackEncode a-  gMsgpackEncode (R1 a) = gMsgpackEncode a--instance (Selector s, GMsgpackEncode f) => MsgpackEncodeProd (S1 s f) where-  msgpackEncodeRecord s@(M1 f) =-    [(dropWhile ('_' ==) (selName s), gMsgpackEncode f), (selName s, gMsgpackEncode f)]-  msgpackEncodeProd (M1 f) = [gMsgpackEncode f]--instance MsgpackEncode a => GMsgpackEncode (K1 i a) where-  gMsgpackEncode = toMsgpack . unK1--instance (-    MsgpackEncode k,-    MsgpackEncode v-  ) => MsgpackEncode (Map k v) where-  toMsgpack = ObjectMap . Map.fromList . fmap (bimap toMsgpack toMsgpack) . Map.toList--instance MsgpackEncode Int where-  toMsgpack = ObjectInt . fromIntegral--instance MsgpackEncode Int64 where-  toMsgpack = ObjectInt--instance MsgpackEncode Float where-  toMsgpack = ObjectFloat--instance MsgpackEncode Double where-  toMsgpack = ObjectDouble--instance {-# OVERLAPPING #-} MsgpackEncode String where-  toMsgpack = Util.string--instance {-# OVERLAPPABLE #-} MsgpackEncode a => MsgpackEncode [a] where-  toMsgpack = ObjectArray . fmap toMsgpack--instance MsgpackEncode a => MsgpackEncode (NonEmpty a) where-  toMsgpack = toMsgpack . NonEmpty.toList--instance MsgpackEncode Text where-  toMsgpack = Util.text--instance MsgpackEncode a => MsgpackEncode (Maybe a) where-  toMsgpack = maybe ObjectNil toMsgpack--instance MsgpackEncode Bool where-  toMsgpack = ObjectBool--instance MsgpackEncode () where-  toMsgpack _ = ObjectNil--instance MsgpackEncode Object where-  toMsgpack = id--instance MsgpackEncode ByteString where-  toMsgpack = ObjectString--instance (MsgpackEncode a, MsgpackEncode b) => MsgpackEncode (a, b) where-  toMsgpack (a, b) = ObjectArray [toMsgpack a, toMsgpack b]--instance MsgpackEncode (Path b t) where-  toMsgpack = ObjectString . encodeUtf8 . toFilePath--instance IsString Object where-  fromString = ObjectString . encodeUtf8
− lib/Ribosome/Msgpack/Error.hs 
@@ -1,21 +0,0 @@-module Ribosome.Msgpack.Error where--import System.Log.Logger (Priority(ERROR))--import Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty)-import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)-import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))-import Ribosome.Error.Report.Class (ReportError(..))-import Ribosome.Msgpack.Util (Err)--newtype DecodeError =-  Failed Err-  deriving Show--deepPrisms ''DecodeError--instance ReportError DecodeError where-  errorReport (Failed err) =-    ErrorReport "error decoding response from neovim" ["DecodeError:", rendered] ERROR-    where-      rendered = renderStrict $ layoutPretty defaultLayoutOptions err
− lib/Ribosome/Msgpack/NvimObject.hs 
@@ -1,17 +0,0 @@-module Ribosome.Msgpack.NvimObject where--import Neovim (NvimObject(..))-import Ribosome.Msgpack.Decode (MsgpackDecode(..))-import Ribosome.Msgpack.Encode (MsgpackEncode(..))--newtype NO a =-  NO { unNO :: a }-  deriving (Eq, Show, Generic)-  deriving newtype (NFData)--instance (MsgpackEncode a, MsgpackDecode a, NFData a) => NvimObject (NO a) where-  toObject (NO a) = toMsgpack a-  fromObject a = NO <$> fromMsgpack a--(-$) :: (NO a -> b) -> a -> b-(-$) f a = f (NO a)
− lib/Ribosome/Msgpack/Util.hs 
@@ -1,42 +0,0 @@-module Ribosome.Msgpack.Util where--import Data.Map.Strict ((!?))-import qualified Data.Map.Strict as Map (fromList)-import Data.MessagePack (Object(..))-import Data.Text.Prettyprint.Doc (Doc, pretty, viaShow, (<+>))-import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)--type Err = Doc AnsiStyle--string :: ConvertUtf8 a ByteString => a -> Object-string = ObjectString . encodeUtf8--binary :: ConvertUtf8 a ByteString => a -> Object-binary = ObjectBinary . encodeUtf8--text :: Text -> Object-text = ObjectString . encodeUtf8--assembleMap :: [(String, Object)] -> Object-assembleMap =-  ObjectMap . Map.fromList . (fmap . first) string--invalid :: Text -> Object -> Either Err a-invalid msg obj =-  Left $ pretty (msg <> ": ") <+> viaShow obj--missingRecordKey :: String -> Object -> Either Err a-missingRecordKey key =-  invalid $ "missing record key " <> toText key <> " in ObjectMap"--illegalType :: Text -> Object -> Either Err a-illegalType tpe =-  invalid $ "illegal type for " <> tpe--lookupObjectMap ::-  ConvertUtf8 a ByteString =>-  a ->-  Map Object Object ->-  Maybe Object-lookupObjectMap key o =-  (o !? string key) <|> (o !? binary key)
− lib/Ribosome/Nvim/Api/Data.hs 
@@ -1,10 +0,0 @@-module Ribosome.Nvim.Api.Data where--import Data.MessagePack (Object(ObjectExt))-import Prelude-import Ribosome.Msgpack.Decode (MsgpackDecode(..))-import Ribosome.Msgpack.Encode (MsgpackEncode(..))--import Ribosome.Nvim.Api.GenerateData (generateData)--generateData
− lib/Ribosome/Nvim/Api/Generate.hs 
@@ -1,73 +0,0 @@-module Ribosome.Nvim.Api.Generate where--import Data.Char (toUpper)-import qualified Data.Map.Strict as Map (fromList, lookup)-import Data.MessagePack (Object)-import Language.Haskell.TH-import Neovim.API.Parser (-  NeovimAPI(functions),-  NeovimFunction(NeovimFunction),-  NeovimType(NestedType, SimpleType, Void),-  customTypes,-  parseAPI,-  )--camelcase :: String -> String-camelcase =-  snd . foldr folder (False, "")-  where-    folder '_' (_, z) = (True, z)-    folder a (True, h : t) = (False, a : toUpper h : t)-    folder a (True, []) = (False, [a])-    folder a (False, z) = (False, a : z)--haskellTypes :: Map String TypeQ-haskellTypes =-  Map.fromList [-    ("Boolean", [t|Bool|]),-    ("Integer", [t|Int|]),-    ("Float", [t|Double|]),-    ("String", [t|Text|]),-    ("Array", [t|[Object]|]),-    ("Dictionary", [t|Map Text Object|]),-    ("void", [t|()|])-    ]--haskellType :: NeovimType -> Q Type-haskellType at =-  case at of-    Void -> [t|()|]-    NestedType t Nothing ->-      appT listT $ haskellType t-    NestedType t (Just n) ->-      foldl appT (tupleT n) . replicate n $ haskellType t-    SimpleType t ->-      fromMaybe (conT . mkName $ t) $ Map.lookup t haskellTypes--data FunctionData =-  FunctionData {-    apiName :: String,-    ccName :: Name,-    async :: Bool,-    names :: [Name],-    types :: [Type],-    returnType :: NeovimType-    }-  deriving (Eq, Show)--functionData :: NeovimFunction -> Q FunctionData-functionData (NeovimFunction name parameters _ async returnType) = do-  names <- traverse newName prefixedNames-  types <- traverse haskellType (fst <$> parameters)-  return (FunctionData name (mkName . camelcase $ name) async names types returnType)-  where-    prefix i n = "arg" <> show i <> "_" <> n-    prefixedNames = zipWith prefix [0 :: Int ..] (snd <$> parameters)--generateFromApi :: (FunctionData -> Q [Dec]) -> (Name -> Int64 -> DecsQ) -> Q [Dec]-generateFromApi handleFunction handleExtType = do-  api <- either (fail . show) return =<< runIO parseAPI-  funcs <- traverse functionData (functions api)-  funcDecs <- traverse handleFunction funcs-  tpeDecs <- traverse (uncurry handleExtType) $ first mkName <$> customTypes api-  return $ join (funcDecs <> tpeDecs)
− lib/Ribosome/Nvim/Api/GenerateData.hs 
@@ -1,81 +0,0 @@-module Ribosome.Nvim.Api.GenerateData where--import Data.MessagePack (Object(ObjectExt))-import Language.Haskell.TH-import Neovim.Plugin.Classes (FunctionName(F))--import Ribosome.Msgpack.Decode (MsgpackDecode)-import Ribosome.Msgpack.Encode (MsgpackEncode)-import Ribosome.Msgpack.Util (illegalType)-import Ribosome.Nvim.Api.Generate (FunctionData(FunctionData), generateFromApi)-import Ribosome.Nvim.Api.RpcCall (AsyncRpcCall(..), RpcCall(..), SyncRpcCall(..))--dataSig :: [Type] -> Name -> Bool -> DecQ-dataSig types name async = do-  returnType <- if async then [t|AsyncRpcCall|] else [t|SyncRpcCall|]-  sigD name . return . foldr (AppT . AppT ArrowT) returnType $ types--dataBody :: String -> Name -> Bool -> [Name] -> DecQ-dataBody apiName name async params =-  funD name [clause (varP <$> params) (normalB $ appE syncCtor rpcCall) []]-  where-    rpcCall = [|RpcCall|] `appE` funcName `appE` listE (toObjVar <$> params)-    funcName = [|F . fromString|] `appE` (litE . stringL $ apiName)-    toObjVar v = [|toMsgpack $(varE v)|]-    syncCtor = if async then [|AsyncRpcCall|] else [|SyncRpcCall|]--genCallData :: FunctionData -> DecsQ-genCallData (FunctionData apiName name async names types _) = do-  sig <- dataSig types name async-  body <- dataBody apiName name async names-  return [sig, body]--extData :: Name -> DecQ-extData name =-  dataD (return []) name [] Nothing [ctor] (deriv ["Eq", "Show"])-  where-    ctor = normalC name [(Bang NoSourceUnpackedness SourceStrict,) <$> [t|ByteString|]]-    deriv = return . return . DerivClause Nothing . (ConT . mkName <$>)--decClause :: Name -> Int64 -> ClauseQ-decClause name number = do-  bytesVar <- newName "bytes"-  clause [pat bytesVar] (decBody bytesVar) []-  where-    pat bytesVar = conP (mkName "ObjectExt") [(litP . integerL . fromIntegral) number, varP bytesVar]-    decBody bytesVar = (normalB [|return $ $(conE name) $(varE bytesVar)|])--decErrorClause :: Name -> ClauseQ-decErrorClause name = do-  objectVar <- newName "object"-  clause [varP objectVar] (decBody objectVar) []-  where-    nameString = nameBase name-    decBody objectVar = normalB [|illegalType nameString $(varE objectVar)|]--encClause :: Name -> Int64 -> ClauseQ-encClause name number = do-  bytesVar <- newName "bytes"-  clause [conP name [varP bytesVar]] (encBody bytesVar) []-  where-    encBody bytesVar = normalB [|ObjectExt $((litE . integerL . fromIntegral) number) $(varE bytesVar)|]--extDataCodec :: Name -> Int64 -> DecsQ-extDataCodec name number = do-  dec <- inst [t|MsgpackDecode|] [method "fromMsgpack" [decClause name number, decErrorClause name]]-  enc <- inst [t|MsgpackEncode|] [method "toMsgpack" [encClause name number]]-  return [dec, enc]-  where-    inst t = instanceD (return []) (tpe t)-    tpe = (`appT` conT name)-    method methodName clauses = funD (mkName methodName) clauses--genExtTypes :: Name -> Int64 -> DecsQ-genExtTypes name number = do-  dat <- extData name-  codec <- extDataCodec name number-  return (dat : codec)--generateData :: DecsQ-generateData =-  generateFromApi genCallData genExtTypes
− lib/Ribosome/Nvim/Api/GenerateIO.hs 
@@ -1,68 +0,0 @@-module Ribosome.Nvim.Api.GenerateIO where--import Language.Haskell.TH-import Language.Haskell.TH.Syntax-import Neovim.API.Parser (NeovimType(SimpleType))--import Ribosome.Control.Monad.Ribo (Nvim(call))-import Ribosome.Msgpack.Decode (MsgpackDecode)-import Ribosome.Nvim.Api.Generate (FunctionData(FunctionData), generateFromApi, haskellType)-import Ribosome.Nvim.Api.RpcCall (RpcError)--rpcModule :: Module-rpcModule =-  Module (mkPkgName "Ribosome.Nvim.Api") (mkModName "Data")--msgpackDecodeConstraint :: NeovimType -> Q (Maybe Type)-msgpackDecodeConstraint (SimpleType "Object") =-  Just <$> [t|MsgpackDecode $(varT $ mkName "a")|]-msgpackDecodeConstraint _ =-  return Nothing--newT :: String -> TypeQ-newT =-  varT <=< newName--ioReturnType :: NeovimType -> Q Type-ioReturnType (SimpleType "Object") =-  return (VarT $ mkName "a")-ioReturnType a =-  haskellType a--analyzeReturnType :: NeovimType -> Q (Type, Maybe Type)-analyzeReturnType tpe = do-  rt <- ioReturnType tpe-  constraint <- msgpackDecodeConstraint tpe-  return (rt, constraint)--ioSig :: Name -> [Type] -> NeovimType -> DecQ-ioSig name types returnType = do-  mType <- newT "m"-  nvimConstraint <- [t|Nvim $(pure mType)|]-  (retType, decodeConstraint) <- analyzeReturnType returnType-  monadErrorConstraint <- [t|MonadDeepError $(newT "e") RpcError $(pure mType)|]-  let-    params = foldr (AppT . AppT ArrowT) (AppT mType retType) types-    constraints = [nvimConstraint, monadErrorConstraint] <> maybeToList decodeConstraint-  sigD name $ return (ForallT [] constraints params)--ioBody :: Name -> Bool -> [Name] -> DecQ-ioBody name _ names =-  funD name [clause (varP <$> names) (normalB body) []]-  where-    responseName = mkName "response"-    callPat = varP responseName-    callExp = appE [|call|] args-    checkExp = appE [|hoistEither|] (varE responseName)-    args = foldl appE (varE $ mkName $ "RpcData." <> show name) (varE <$> names)-    body = doE [bindS callPat callExp, noBindS checkExp]--genIO :: FunctionData -> Q [Dec]-genIO (FunctionData _ name async names types returnType) = do-  sig <- ioSig name types returnType-  body <- ioBody name async names-  return [sig, body]--generateIO :: Q [Dec]-generateIO =-  generateFromApi genIO (const . const . return $ [])
− lib/Ribosome/Nvim/Api/IO.hs 
@@ -1,9 +0,0 @@-module Ribosome.Nvim.Api.IO where--import Data.MessagePack (Object)--import Ribosome.Nvim.Api.Data (Buffer, Tabpage, Window)-import qualified Ribosome.Nvim.Api.Data as RpcData-import Ribosome.Nvim.Api.GenerateIO (generateIO)--generateIO
− lib/Ribosome/Nvim/Api/RpcCall.hs 
@@ -1,61 +0,0 @@-module Ribosome.Nvim.Api.RpcCall where--import Data.MessagePack (Object)-import Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty)-import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)-import Neovim (Neovim)-import Neovim.Exceptions (NeovimException)-import Neovim.Plugin.Classes (FunctionName)-import Neovim.RPC.FunctionCall (scall)-import System.Log.Logger (Priority(ERROR))--import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))-import Ribosome.Error.Report.Class (ReportError(..))-import Ribosome.Msgpack.Decode (MsgpackDecode(..))-import Ribosome.Msgpack.Util (Err)--data RpcCall =-  RpcCall {-    rpcCallName :: FunctionName,-    rpcCallArgs :: [Object]-  }-  deriving (Eq, Show)--newtype AsyncRpcCall =-  AsyncRpcCall { asyncRpcCall :: RpcCall }-  deriving (Eq, Show)--newtype SyncRpcCall =-  SyncRpcCall { syncRpcCall :: RpcCall }-  deriving (Eq, Show)--data RpcError =-  Decode Err-  |-  Nvim RpcCall NeovimException-  |-  Atomic Text-  deriving Show--deepPrisms ''RpcError--class Rpc c a where-  call :: c -> Neovim e (Either RpcError a)--instance Rpc AsyncRpcCall () where-  call (AsyncRpcCall c@(RpcCall name args)) =-    mapLeft (Nvim c) <$> scall name args--instance MsgpackDecode a => Rpc SyncRpcCall a where-  call (SyncRpcCall c@(RpcCall name args)) =-    either (Left . Nvim c) (mapLeft Decode . fromMsgpack) <$> scall name args--instance ReportError RpcError where-  errorReport (Decode err) =-    ErrorReport "error decoding neovim response" ["RpcError.Decode:", rendered] ERROR-    where-      rendered = renderStrict $ layoutPretty defaultLayoutOptions err-  errorReport (Nvim c exc)  =-    ErrorReport "error in request to neovim" ["RpcError.Nvim:", show c, show exc] ERROR-  errorReport (Atomic msg)  =-    ErrorReport "error in request to neovim" ["RpcError.Atomic:", msg] ERROR
− lib/Ribosome/Orphans.hs 
@@ -1,112 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Ribosome.Orphans where--import Chiasma.Data.Cmd (Cmds(Cmds))-import Chiasma.Data.Ident (Ident, identText)-import Chiasma.Data.RenderError (RenderError)-import qualified Chiasma.Data.RenderError as RenderError (RenderError(..))-import Chiasma.Data.TmuxError (TmuxError)-import qualified Chiasma.Data.TmuxError as TmuxError (TmuxError(..))-import Chiasma.Data.Views (ViewsError(..))-import Chiasma.Ui.Data.TreeModError (TreeModError(..))-import Chiasma.Ui.Data.View (View(View))-import Control.Monad.Catch (MonadCatch(..), MonadMask(..))-import Neovim.Context.Internal (Neovim(..))-import System.Log.Logger (Priority(ERROR, DEBUG, NOTICE))--import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))-import Ribosome.Error.Report.Class (ReportError(..))--deriving newtype instance MonadCatch (Neovim e)-deriving newtype instance MonadMask (Neovim e)--invalidOutput :: Text-invalidOutput = "invalid output from tmux process"--instance ReportError TmuxError where-  errorReport (TmuxError.ProcessFailed (Cmds cmds) reason) =-    ErrorReport "fatal error in tmux process" log' ERROR-    where-      log' = ["tmux process failed:", reason, "commands:"] <> (show <$> cmds)-  errorReport (TmuxError.OutputParsingFailed (Cmds cmds) output parseError) =-    ErrorReport invalidOutput (["tmux output parsing failed:"] <> (show <$> cmds) <> ["output:"] <>-    output <> ["parse error:", show parseError]) ERROR-  errorReport (TmuxError.NoOutput (Cmds cmds)) =-    ErrorReport invalidOutput ("no output from tmux process:" : (show <$> cmds)) ERROR-  errorReport (TmuxError.DecodingFailed (Cmds cmds) output decodeError) =-    ErrorReport invalidOutput ("failed to decode tmux process output:" : (show <$> cmds) <> ["output:", output,-      "decoding error:", show decodeError]) ERROR-  errorReport (TmuxError.InvalidOutput reason cmd) =-    ErrorReport invalidOutput ["invalid output from tmux process:", toText reason, toText cmd] ERROR-  errorReport (TmuxError.CommandFailed _ err) =-    ErrorReport invalidOutput ("tmux command failed:" : err) ERROR--viewExists :: Text -> View a -> ErrorReport-viewExists desc (View ident _ _ _) =-  ErrorReport msg [msg] DEBUG-  where-    msg = "a " <> desc <> " with ident `" <> identText ident <> "` already exists"--viewMissing :: Text -> Ident -> ErrorReport-viewMissing desc ident =-  ErrorReport msg [msg] DEBUG-  where-    msg = "no " <> desc <> " with ident `" <> identText ident <> "`"--ambiguousView :: Text -> Ident -> Int -> ErrorReport-ambiguousView desc ident num =-  ErrorReport msg [logMsg] ERROR-  where-    msg = "there are " <> show num <> " " <> desc <> "s with ident `" <> identText ident <> "`"-    logMsg = "ambiguous " <> desc <> ": " <> identText ident <> "(" <> show num <> ")"--instance ReportError TreeModError where-  errorReport (PaneExists pane) =-    viewExists "pane" pane-  errorReport (LayoutExists layout) =-    viewExists "layout" layout-  errorReport (PaneMissing pane) =-    viewMissing "pane" pane-  errorReport (LayoutMissing layout) =-    viewMissing "layout" layout-  errorReport (AmbiguousPane pane num) =-    ambiguousView "pane" pane num-  errorReport (AmbiguousLayout layout num) =-    ambiguousView "layout" layout num-  errorReport NoTrees =-    ErrorReport msg [msg] DEBUG-    where-      msg = "no UI layouts have been created"--noSuchView :: Text -> Ident -> ErrorReport-noSuchView desc ident =-  ErrorReport msg [msg] NOTICE-  where-    msg = "no tmux " <> desc <> " with ident `" <> identText ident <> "`"--noId :: Text -> Ident -> ErrorReport-noId desc ident =-  ErrorReport msg [msg] ERROR-  where-    msg = "tmux " <> desc <> " with ident `" <> identText ident <> "`" <> " has no id"--instance ReportError ViewsError where-  errorReport (NoSuchSession ident) =-    noSuchView "session" ident-  errorReport (NoSuchWindow ident) =-    noSuchView "window" ident-  errorReport (NoSuchPane ident) =-    noSuchView "pane" ident-  errorReport (NoPaneId ident) =-    noId "pane" ident--instance ReportError RenderError where-  errorReport (RenderError.NoPrincipal ident) =-    ErrorReport "internal render error: no view in layout" ["no principal in " <> identText ident] ERROR-  errorReport (RenderError.Views err) =-    errorReport err-  errorReport (RenderError.Pack message) =-    ErrorReport ("error packing a tmux layout: " <> toText message) ["tmux pack error:", toText message] ERROR-  errorReport (RenderError.Fatal tmuxError) =-    errorReport tmuxError
lib/Ribosome/Persist.hs view
@@ -1,124 +1,12 @@-module Ribosome.Persist where--import Control.Exception (IOException, try)-import Control.Monad.Catch (MonadThrow)-import Data.Aeson (FromJSON, ToJSON, eitherDecodeFileStrict', encodeFile)-import Path (Abs, Dir, File, Path, Rel, addExtension, parent, parseAbsDir, parseRelDir, toFilePath, (</>))-import Path.IO (XdgDirectory(XdgCache), createDirIfMissing, doesFileExist, getXdgDir)--import Ribosome.Config.Setting (setting)-import qualified Ribosome.Config.Settings as S (persistenceDir)-import Ribosome.Control.Monad.Error (recoveryFor)-import Ribosome.Control.Monad.Ribo-import Ribosome.Data.PersistError (PersistError)-import qualified Ribosome.Data.PersistError as PersistError (PersistError(..))-import Ribosome.Data.SettingError (SettingError)--defaultPersistencePath :: MonadIO m => m (Path Abs Dir)-defaultPersistencePath =-  liftIO $ getXdgDir XdgCache Nothing--persistencePath ::-  MonadRibo m =>-  NvimE e m =>-  MonadThrow m =>-  MonadDeepError e SettingError m =>-  Path Rel File ->-  m (Path Abs File)-persistencePath path = do-  base <- defaultPersistencePath `recoveryFor` (parseAbsDir =<< setting S.persistenceDir)-  name <- parseRelDir . toString =<< pluginName-  return $ base </> name </> path--persistenceFile ::-  MonadRibo m =>-  NvimE e m =>-  MonadThrow m =>-  MonadDeepError e SettingError m =>-  Path Rel File ->-  m (Path Abs File)-persistenceFile path = do-  file <- persistencePath path-  createDirIfMissing True (parent file)-  addExtension ".json" file--persistStore ::-  MonadRibo m =>-  NvimE e m =>-  MonadThrow m =>-  MonadDeepError e SettingError m =>-  ToJSON a =>-  Path Rel File ->-  a ->-  m ()-persistStore path a = do-  file <- persistenceFile path-  liftIO $ encodeFile (toFilePath file) a--noSuchFile :: MonadDeepError e PersistError m => Path Abs File -> m a-noSuchFile = throwHoist . PersistError.NoSuchFile . toFilePath--ensureExistence ::-  MonadIO m =>-  MonadDeepError e PersistError m =>-  Path Abs File ->-  m ()-ensureExistence file = do-  exists <- liftIO $ doesFileExist file-  unless exists (noSuchFile file)--decodeError ::-  MonadDeepError e PersistError m =>-  Path Abs File ->-  Text ->-  m a-decodeError file = throwHoist . PersistError.Decode (toFilePath file)--fileNotReadable ::-  MonadDeepError e PersistError m =>-  Path Abs File ->-  IOException ->-  m (Either String a)-fileNotReadable file _ = throwHoist $ PersistError.FileNotReadable (toFilePath file)--safeDecodeFile ::-  MonadIO m =>-  MonadDeepError e PersistError m =>-  FromJSON a =>-  Path Abs File ->-  m a-safeDecodeFile file = do-  result <- either (fileNotReadable file) return =<< (liftIO . try . eitherDecodeFileStrict' . toFilePath $ file)-  either (decodeError file) return . mapLeft toText $ result--persistLoad ::-  MonadIO m =>-  MonadRibo m =>-  NvimE e m =>-  MonadThrow m =>-  MonadDeepError e SettingError m =>-  MonadDeepError e PersistError m =>-  FromJSON a =>-  Path Rel File ->-  m a-persistLoad path = do-  file <- persistenceFile path-  ensureExistence file-  safeDecodeFile file+-- |API for the effect 'Persist'.+module Ribosome.Persist (+  module Ribosome.Effect.Persist,+  module Ribosome.Effect.PersistPath,+  module Ribosome.Data.PersistError,+  module Ribosome.Data.PersistPathError,+) where -mayPersistLoad ::-  MonadRibo m =>-  NvimE e m =>-  MonadDeepError e SettingError m =>-  MonadDeepError e PersistError m =>-  MonadThrow m =>-  FromJSON a =>-  Path Rel File ->-  m (Maybe a)-mayPersistLoad =-  catchAt recover . persistLoad-  where-    recover (PersistError.NoSuchFile _) =-      return Nothing-    recover e =-      throwHoist e+import Ribosome.Data.PersistError+import Ribosome.Data.PersistPathError+import Ribosome.Effect.Persist+import Ribosome.Effect.PersistPath
− lib/Ribosome/Plugin.hs 
@@ -1,152 +0,0 @@-module Ribosome.Plugin (-  module Ribosome.Plugin,-  rpcHandler,-  rpcHandlerDef,-  RpcHandlerConfig(..),-  RpcDef(..),-) where--import qualified Data.Map.Strict as Map ()-import Data.MessagePack (Object(ObjectNil, ObjectBool))-import Neovim.Context (Neovim)-import Neovim.Plugin.Classes (-  AutocmdOptions(acmdPattern),-  CommandOption,-  FunctionName(..),-  FunctionalityDescription(..),-  Synchronous(..),-  )-import Neovim.Plugin.Internal (ExportedFunctionality(..), Plugin(..))--import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)-import Ribosome.Data.Mapping (MappingError)-import Ribosome.Data.Text (capitalize)-import Ribosome.Plugin.TH (rpcHandler, rpcHandlerDef)-import Ribosome.Plugin.Builtin (deleteScratchRpc)-import Ribosome.Plugin.Mapping (MappingHandler, handleMappingRequest)-import Ribosome.Plugin.RpcHandler (RpcHandler(..))-import Ribosome.Plugin.TH.Handler (-  RpcDef(RpcDef),-  RpcDefDetail(..),-  RpcHandlerConfig(..),-  rhcCmd,-  )-import Ribosome.Plugin.Watch (handleWatcherRequestSafe, watchedVariables)--poll ::-  Monad m =>-  [Object] ->-  m Object-poll _ =-  return (ObjectBool True)--pollRpc ::-  MonadDeepError e MappingError m =>-  Text ->-  RpcDef m-pollRpc pluginName =-  RpcDef (RpcFunction Sync) (capitalize pluginName <> "Poll") poll--mappingHandlerRpc ::-  MonadDeepError e MappingError m =>-  Text ->-  [MappingHandler m] ->-  RpcDef m-mappingHandlerRpc pluginName mappings =-  RpcDef (RpcFunction Async) (capitalize pluginName <> "Mapping") (handleMappingRequest mappings)--watcherRpc ::-  MonadBaseControl IO m =>-  MonadRibo m =>-  NvimE e m =>-  Text ->-  Map Text (Object -> m ()) ->-  [RpcDef m]-watcherRpc pluginName variables =-  chromatinInit : (rpcDef <$> ["CmdlineLeave", "BufWinEnter", "VimEnter"])-  where-    chromatinInit = rpcDefFromDetail ((detail "User") { raOptions = def { acmdPattern = toString ciName } }) ciName-    ciName = "ChromatinInitialized"-    rpcDef event =-      rpcDefFromDetail (detail event) event-    rpcDefFromDetail dt event =-      RpcDef dt (name' event) (handleWatcherRequestSafe (watchedVariables variables))-    name' event = capitalize pluginName <> "VariableChanged" <> event-    detail event = RpcAutocmd event Async def--compileRpcDef ::-  RpcHandler e env m =>-  (e -> m ()) ->-  RpcDef m ->-  ExportedFunctionality env-compileRpcDef errorHandler (RpcDef detail name' rpcHandler') =-  EF (wrapDetail detail (F (encodeUtf8 name')), executeRpcHandler errorHandler rpcHandler')-  where-    wrapDetail (RpcFunction sync') n =-      Function n sync'-    wrapDetail (RpcCommand options) n =-      Command n options-    wrapDetail (RpcAutocmd event sync' options) n =-      Autocmd (encodeUtf8 event) n sync' options--nvimPlugin ::-  RpcHandler e env m =>-  env ->-  [[RpcDef m]] ->-  (e -> m ()) ->-  Plugin env-nvimPlugin env rpcDefs errorHandler =-  Plugin env (compileRpcDef errorHandler <$> join rpcDefs)--riboPlugin ::-  MonadBaseControl IO m =>-  MonadDeepError e MappingError m =>-  MonadRibo m =>-  NvimE e m =>-  RpcHandler e env m =>-  Text ->-  env ->-  [[RpcDef m]] ->-  [MappingHandler m] ->-  (e -> m ()) ->-  Map Text (Object -> m ()) ->-  Plugin env-riboPlugin pluginName env rpcDefs mappings errorHandler variables =-  Plugin env ((compileRpcDef errorHandler <$> extra) ++ efs)-  where-    Plugin _ efs = nvimPlugin env rpcDefs errorHandler-    extra = deleteScratchRpc pluginName : pollRpc pluginName : mappingHandlerRpc pluginName mappings : watch-    watch = watcherRpc pluginName variables--executeRpcHandler ::-  ∀ e env m.-  RpcHandler e env m =>-  (e -> m ()) ->-  ([Object] -> m Object) ->-  [Object] ->-  Neovim env Object-executeRpcHandler errorHandler rpcHandler' =-  either handleError return <=< runExceptT . native . rpcHandler'-  where-    handleError e =-      ObjectNil <$ (runExceptT . native @e . errorHandler $ e)--cmd :: [CommandOption] -> RpcHandlerConfig -> RpcHandlerConfig-cmd opts conf =-  conf { rhcCmd = Just opts }--sync :: RpcHandlerConfig -> RpcHandlerConfig-sync conf =-  conf { rhcSync = Sync }--name :: Text -> RpcHandlerConfig -> RpcHandlerConfig-name n conf =-  conf { rhcName = Just n }--autocmd :: Text -> RpcHandlerConfig -> RpcHandlerConfig-autocmd event conf =-  conf { rhcAutocmd = Just event }--autocmdOptions :: AutocmdOptions -> RpcHandlerConfig -> RpcHandlerConfig-autocmdOptions options conf =-  conf { rhcAutocmdOptions = Just options }
lib/Ribosome/Plugin/Builtin.hs view
@@ -1,27 +1,99 @@+-- |Interceptor that adds internal RPC handlers to the host. module Ribosome.Plugin.Builtin where -import Data.MessagePack (Object(ObjectString, ObjectNil))-import Neovim.Plugin.Classes (Synchronous(Async))+import Exon (exon)+import Prelude hiding (group) -import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)-import Ribosome.Data.Text (capitalize)-import Ribosome.Plugin.TH.Handler (RpcDef(RpcDef), RpcDefDetail(RpcFunction))-import Ribosome.Scratch (killScratchByName)+import Ribosome.Data.PluginName (PluginName (PluginName))+import Ribosome.Data.ScratchId (ScratchId)+import qualified Ribosome.Effect.Scratch as Scratch+import Ribosome.Effect.Scratch (Scratch)+import qualified Ribosome.Effect.VariableWatcher as VariableWatcher+import Ribosome.Effect.VariableWatcher (VariableWatcher)+import Ribosome.Host.Data.BootError (BootError)+import Ribosome.Host.Data.Execution (Execution (Async))+import Ribosome.Host.Data.Report (Report, resumeReport)+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Data.RpcHandler (Handler, RpcHandler)+import Ribosome.Host.Data.RpcName (RpcName (RpcName))+import Ribosome.Host.Data.RpcType (AutocmdGroup (AutocmdGroup), AutocmdOptions (target), AutocmdPatterns, group)+import Ribosome.Host.Effect.Handlers (Handlers)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Host.Handler (rpcAutocmd, rpcFunction)+import Ribosome.Host.Interpreter.Handlers (withHandlers)+import Ribosome.Text (capitalize) -deleteScratch ::-  MonadRibo m =>-  NvimE e m =>-  [Object] ->-  m Object-deleteScratch [ObjectString name] = do-  ObjectNil <$ killScratchByName (decodeUtf8 name)-deleteScratch _ =-  return ObjectNil+-- |The set of autocmds that should trigger an update in 'VariableWatcher'.+watcherEvents :: [(Text, AutocmdPatterns)]+watcherEvents =+  [+    ("CmdlineLeave", def),+    ("BufWinEnter", def),+    ("VimEnter", def),+    ("User", "RibosomeUpdateVariables")+  ] -deleteScratchRpc ::-  MonadRibo m =>-  NvimE e m =>+-- |Run 'VariableWatcher.update' and restop errors.+updateVar ::+  Member (VariableWatcher !! Report) r =>+  Handler r ()+updateVar =+  restop VariableWatcher.update++-- |Declare an autocmd that triggers the variable watcher.+watcherRpc ::+  ∀ r .+  Member (VariableWatcher !! Report) r =>+  PluginName ->   Text ->-  RpcDef m-deleteScratchRpc pluginName =-  RpcDef (RpcFunction Async) (capitalize pluginName <> "DeleteScratch") deleteScratch+  AutocmdPatterns ->+  RpcHandler r+watcherRpc (PluginName name) event pat =+  rpcAutocmd (RpcName method) Async (fromText event) def { target = Right pat, group = Just (AutocmdGroup name) } do+    updateVar+  where+    method =+      [exon|#{capitalize name}VariableChanged#{event}|]++-- |Delete a scratch buffer.+deleteScratch ::+  Member (Scratch !! RpcError) r =>+  ScratchId ->+  Handler r ()+deleteScratch =+  resumeReport . Scratch.delete++-- |The name for the handler that is triggered by a scratch buffer being deleted.+deleteName :: PluginName -> RpcName+deleteName (PluginName name) =+  RpcName [exon|#{capitalize name}DeleteScratch|]++-- |A set of 'RpcHandler's for internal tasks.+builtinHandlers ::+  ∀ r .+  Members [Scratch !! RpcError, VariableWatcher !! Report] r =>+  PluginName ->+  [RpcHandler r]+builtinHandlers name =+  rpcFunction (deleteName name) Async deleteScratch : (uncurry (watcherRpc name) <$> watcherEvents)++-- |The dependencies of the builtin handlers.+type BuiltinHandlersDeps =+  [+    VariableWatcher !! Report,+    Handlers !! Report,+    Scratch !! RpcError,+    Rpc !! RpcError,+    Reader PluginName,+    Error BootError,+    Log+  ]++-- |Add builtin handlers to 'Handlers' without removing the effect from the stack.+interceptHandlersBuiltin ::+  Members BuiltinHandlersDeps r =>+  Sem r a ->+  Sem r a+interceptHandlersBuiltin sem = do+  name <- ask+  withHandlers (builtinHandlers name) sem
− lib/Ribosome/Plugin/Mapping.hs 
@@ -1,35 +0,0 @@-module Ribosome.Plugin.Mapping where--import Data.MessagePack (Object(ObjectString, ObjectNil))--import Ribosome.Data.Mapping (MappingError(InvalidArgs, NoSuchMapping), MappingIdent(MappingIdent))--data MappingHandler m =-  MappingHandler {-    mhMapping :: MappingIdent,-    mhHandler :: m ()-  }--mappingHandler :: Text -> m () -> MappingHandler m-mappingHandler ident =-  MappingHandler (MappingIdent ident)--mapping :: MappingIdent -> [MappingHandler m] -> Maybe (MappingHandler m)-mapping ident =-  find ((ident ==) . mhMapping)--noSuchMapping :: MonadDeepError e MappingError m => MappingIdent -> m a-noSuchMapping =-  throwHoist . NoSuchMapping--executeMapping :: MappingHandler m -> m ()-executeMapping (MappingHandler _ f) =-  f--handleMappingRequest :: MonadDeepError e MappingError m => [MappingHandler m] -> [Object] -> m Object-handleMappingRequest mappings [ObjectString s] =-  ObjectNil <$ maybe (noSuchMapping ident) executeMapping (mapping ident mappings)-  where-    ident = MappingIdent (decodeUtf8 s)-handleMappingRequest _ args =-  throwHoist (InvalidArgs args)
− lib/Ribosome/Plugin/RpcHandler.hs 
@@ -1,9 +0,0 @@-module Ribosome.Plugin.RpcHandler where--import Neovim (Neovim)--class RpcHandler e env m | m -> e env where-  native :: m a -> ExceptT e (Neovim env) a--instance RpcHandler e env (ExceptT e (Neovim env)) where-  native = id
− lib/Ribosome/Plugin/TH.hs 
@@ -1,61 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Ribosome.Plugin.TH where--import qualified Data.Text as Text (unpack)-import Language.Haskell.TH (ExpQ, Lit(StringL), Name, listE, litE, nameBase)-import Neovim.Plugin.Classes (-  AutocmdOptions,-  Synchronous(..),-  )--import Ribosome.Data.String (capitalize)-import Ribosome.Plugin.TH.Command (handlerParams, rpcCommand)-import Ribosome.Plugin.TH.Handler (-  RpcDef(RpcDef),-  RpcDefDetail(RpcFunction, RpcAutocmd),-  RpcHandlerConfig(RpcHandlerConfig),-  argsCase,-  defaultRpcHandlerConfig,-  functionParamTypes,-  lambdaNames,-  listParamsPattern,-  rpcLambdaWithErrorCase,-  )--functionImplementation :: Name -> ExpQ-functionImplementation name = do-  paramTypes <- functionParamTypes name-  paramNames <- lambdaNames (length paramTypes)-  rpcLambdaWithErrorCase name (argsCase name (listParamsPattern paramNames) paramNames)--rpcFunction :: String -> Synchronous -> Name -> ExpQ-rpcFunction name sync funcName = do-  fun <- functionImplementation funcName-  [|RpcDef (RpcFunction sync) $((litE (StringL name))) $(return fun)|]--rpcAutocmd :: String -> Name -> Synchronous -> Maybe AutocmdOptions -> String -> ExpQ-rpcAutocmd name funcName sync options event = do-  fun <- functionImplementation funcName-  [|RpcDef (RpcAutocmd event sync (fromMaybe def options)) $((litE (StringL name))) $(return fun)|]--vimName :: Name -> Maybe String -> String-vimName funcName =-  capitalize . fromMaybe (nameBase funcName)--rpcHandler :: (RpcHandlerConfig -> RpcHandlerConfig) -> Name -> ExpQ-rpcHandler confTrans =-  handler (confTrans defaultRpcHandlerConfig)-  where-    handler (RpcHandlerConfig sync name cmd autocmd auOptions) funcName = do-      params <- handlerParams funcName-      rpcFun <- rpcFunction vimName' sync funcName-      rpcCmd <- traverse (rpcCommand vimName' funcName params sync) cmd-      rpcAu <- traverse (rpcAutocmd vimName' funcName sync auOptions) (Text.unpack <$> autocmd)-      listE $ return <$> rpcFun : maybeToList rpcCmd <> maybeToList rpcAu-      where-        vimName' = vimName funcName (Text.unpack <$> name)--rpcHandlerDef :: Name -> ExpQ-rpcHandlerDef =-  rpcHandler id
− lib/Ribosome/Plugin/TH/Command.hs 
@@ -1,394 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Ribosome.Plugin.TH.Command where--import Control.Exception (throw)-import Data.Aeson (FromJSON, eitherDecodeStrict)-import qualified Data.ByteString as ByteString (intercalate)-import Data.MessagePack (Object(ObjectArray))-import Data.Text.Prettyprint.Doc (Pretty(..))-import Language.Haskell.TH-import Neovim.Exceptions (NeovimException(ErrorMessage))-import Neovim.Plugin.Classes (CommandArguments, CommandOption(..), Synchronous, mkCommandOptions)--import Ribosome.Msgpack.Decode (fromMsgpack)-import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))-import Ribosome.Msgpack.Util (Err)-import Ribosome.Plugin.TH.Handler (-  RpcDef(RpcDef),-  RpcDefDetail(RpcCommand),-  argsCase,-  decodedCallSequence,-  functionParamTypes,-  handlerCall,-  lambdaNames,-  listParamsPattern,-  )--data CmdParamType =-  PrimParam-  |-  DataParam-  |-  ListParam-  deriving (Eq, Show)--data CmdParams =-  ZeroParams-  |-  OneParam Bool CmdParamType-  |-  OnlyPrims Int-  |-  DataPlus Int-  deriving (Eq, Show)--data HandlerParams =-  HandlerParams {-    handlerHasArgsParam :: Bool,-    handlerCmdParams :: CmdParams-    }-  deriving (Eq, Show)--colon :: Name-colon =-  mkName ":"--colonE :: ExpQ-colonE =-  varE colon--colonP :: PatQ-colonP =-  varP colon--cmdArgsCase :: Name -> [Name] -> Q Match-cmdArgsCase handlerName paramNames =-  argsCase handlerName (listParamsPattern (mkName "_" : paramNames)) paramNames--decodeJson :: FromJSON a => [Object] -> Either Err a-decodeJson =-  mapLeft pretty . eitherDecodeStrict . ByteString.intercalate " " <=< traverse fromMsgpack--primDispatch ::-  [MatchQ] ->-  String ->-  Name ->-  Name ->-  Name ->-  [Name] ->-  Bool ->-  ExpQ-primDispatch extraCases rpcName argsName handlerName cmdArgsName paramNames hasArgsParam =-  caseE (varE argsName) (extraCases ++ [matching, invalidArgs])-  where-    matching =-      match (primArgPattern paramNames) (normalB $ decodedCallSequence handlerName vars) []-    invalidArgs =-      match wildP (normalB [|invalidArgCount $ $(nameLit) <> "(" <> show $(varE argsName) <> ")"|]) []-    vars =-      varE <$> params-    params =-      if hasArgsParam then cmdArgsName : paramNames else paramNames-    nameLit =-      litE (StringL rpcName)--primDispatchStrict ::-  String ->-  Name ->-  Name ->-  Name ->-  [Name] ->-  Bool ->-  ExpQ-primDispatchStrict =-  primDispatch []--primDispatchMaybe ::-  String ->-  Name ->-  Name ->-  Name ->-  [Name] ->-  Bool ->-  ExpQ-primDispatchMaybe rpcName argsName handlerName  =-  primDispatch [nothingCase] rpcName argsName handlerName-  where-    nothingCase =-      match (listP []) (normalB (appE [|pure|] (appE (varE handlerName) [|Nothing|]))) []--primDispatchList ::-  String ->-  Name ->-  Name ->-  Name ->-  [Name] ->-  Bool ->-  ExpQ-primDispatchList _ argsName handlerName cmdArgsName _ hasArgsParam = do-  listArgName <- newName "as"-  caseE (varE argsName) [listCase listArgName]-  where-    listCase listArgName =-      match (varP listArgName) (normalB $ handlerCall handlerName (params listArgName)) []-    params listArgName =-      if hasArgsParam then [[|fromMsgpack $(varE cmdArgsName)|], decodedList listArgName] else [decodedList listArgName]-    decodedList listArgName =-      [|traverse fromMsgpack $(varE listArgName)|]--jsonDispatch ::-  Name ->-  Name ->-  Name ->-  [Name] ->-  Bool ->-  ExpQ-jsonDispatch restName handlerName cmdArgsName paramNames hasArgsParam =-  infixApp prims [|(<*>)|] decodedRest-  where-    prims = decodedCallSequence handlerName vars-    vars = varE <$> params-    params = if hasArgsParam then cmdArgsName : paramNames else paramNames-    decodedRest = [|decodeJson $(varE restName)|]--primArgPattern :: [Name] -> PatQ-primArgPattern paramNames =-  foldr f (listP []) (varP <$> paramNames)-  where-    f a = infixP a (mkName ":")--jsonArgPattern :: [Name] -> Name -> PatQ-jsonArgPattern paramNames restName =-  foldr f (varP restName) (varP <$> paramNames)-  where-    f a = infixP a (mkName ":")--newtype ArgNormalizer m =-  ArgNormalizer (Text -> [Object] -> m (Object, [Object]))--shapeError :: Text -> m a-shapeError =-  throw . ErrorMessage . pretty . errorMessage-  where-    errorMessage =-      ("Bad argument shape for rpc command: " <>)--normalizeArgsFlat ::-  Monad m =>-  ArgNormalizer m-normalizeArgsFlat =-  ArgNormalizer normalize-  where-    normalize _ (cmdArgs : rest) =-      return (cmdArgs, rest)-    normalize rpcName args =-      shapeError $ rpcName <> " (" <> show args <> ")"--normalizeArgsPlus ::-  Monad m =>-  ArgNormalizer m-normalizeArgsPlus =-  ArgNormalizer normalize-  where-    normalize _ [cmdArgs, first', ObjectArray rest] =-      return (cmdArgs, first' : rest)-    normalize rpcName args =-      shapeError $ rpcName <> " (" <> show args <> ")"--normalizeArgs ::-  CmdParams ->-  ExpQ-normalizeArgs ZeroParams =-  [|normalizeArgsFlat|]-normalizeArgs (OnlyPrims 1) =-  [|normalizeArgsFlat|]-normalizeArgs (OneParam _ PrimParam) =-  [|normalizeArgsFlat|]-normalizeArgs (OneParam _ ListParam) =-  [|normalizeArgsFlat|]-normalizeArgs _ =-  [|normalizeArgsPlus|]--rpc ::-  Monad m =>-  MsgpackEncode a =>-  Text ->-  ArgNormalizer m ->-  (Object -> [Object] -> Either Err (m a)) ->-  [Object] ->-  m Object-rpc rpcName (ArgNormalizer normalize) dispatch =-  toMsgpack <$$> decodeResult . uncurry dispatch <=< normalize rpcName-  where-    decodeResult =-      either (throw . ErrorMessage) id--invalidArgCount :: String -> m a-invalidArgCount =-  throw . ErrorMessage . pretty . (msg <>)-  where-    msg =-      "Wrong number of arguments for rpc handler: "--command ::-  String ->-  Name ->-  [Name] ->-  HandlerParams ->-  PatQ ->-  (Name -> Name -> [Name] -> Bool -> ExpQ) ->-  ExpQ-command rpcName handlerName paramNames (HandlerParams hasCmdArgs cmdParams) argsPattern dispatch = do-  cmdArgsName <- newName "cmdArgs"-  [|rpc $(nameLit) $(normalizeArgs cmdParams) $(handler cmdArgsName)|]-  where-    handler cmdArgsName =-      lamE [firstParam cmdArgsName, argsPattern] (dispatch handlerName cmdArgsName paramNames hasCmdArgs)-    firstParam cmdArgsName =-      if hasCmdArgs then varP cmdArgsName-      else wildP-    nameLit =-      litE (StringL rpcName)--primCommand ::-  String ->-  Name ->-  [Name] ->-  HandlerParams ->-  Bool ->-  Bool ->-  ExpQ-primCommand rpcName handlerName paramNames handlerPar isMaybe isL = do-  argsName <- newName "args"-  command rpcName handlerName paramNames handlerPar (varP argsName) (dispatch rpcName argsName)-  where-    dispatch | isMaybe = primDispatchMaybe-      | isL = primDispatchList-      | otherwise = primDispatchStrict--jsonCommand ::-  String ->-  Name ->-  [Name] ->-  HandlerParams ->-  Bool ->-  ExpQ-jsonCommand rpcName handlerName paramNames handlerPar _ = do-  restName <- newName "rest"-  command rpcName handlerName paramNames handlerPar (jsonArgPattern paramNames restName) (jsonDispatch restName)--commandImplementation :: String -> Name -> HandlerParams -> ExpQ-commandImplementation rpcName handlerName hps@(HandlerParams _ params) =-  forParams params-  where-    forParams ZeroParams =-      primCommand rpcName handlerName [] hps False False-    forParams (OnlyPrims paramCount) = do-      paramNames <- lambdaNames paramCount-      primCommand rpcName handlerName paramNames hps False False-    forParams (DataPlus paramCount) = do-      paramNames <- lambdaNames paramCount-      jsonCommand rpcName handlerName paramNames hps False-    forParams (OneParam isMaybe DataParam) =-      jsonCommand rpcName handlerName [] hps isMaybe-    forParams (OneParam isMaybe PrimParam) = do-      paramNames <- lambdaNames 1-      primCommand rpcName handlerName paramNames hps isMaybe False-    forParams (OneParam isMaybe ListParam) = do-      paramNames <- lambdaNames 1-      primCommand rpcName handlerName paramNames hps isMaybe True--isRecord :: Info -> Bool-isRecord (TyConI (DataD _ _ _ _ [RecC _ _] _)) =-  True-isRecord _ =-  False--isJsonDecodable :: Type -> Q Bool-isJsonDecodable (ConT name) =-  isRecord <$> reify name-isJsonDecodable _ =-  return False--isList :: Type -> Bool-isList (AppT ListT _) =-  True-isList _ =-  False--isMaybeType :: Name -> Q Bool-isMaybeType tpe =-  (ConT tpe ==) <$> [t|Maybe|]--analyzeMaybeCmdParam :: Type -> Q (Bool, Type)-analyzeMaybeCmdParam (AppT (ConT tcon) tpe) =-  (, tpe) <$> isMaybeType tcon-analyzeMaybeCmdParam a =-  return (False, a)--analyzeCmdParams :: [Type] -> Q CmdParams-analyzeCmdParams =-  check . reverse-  where-    check [a] = do-      (isMaybe, tpe) <- analyzeMaybeCmdParam a-      isD <- isJsonDecodable tpe-      return $ OneParam isMaybe (singleParam isD (isList tpe))-    check (a : rest) = do-      isD <- isJsonDecodable a-      return $ if isD then DataPlus (length rest) else OnlyPrims (length rest + 1)-    check [] =-      return ZeroParams-    singleParam _ True =-      ListParam-    singleParam True _ =-      DataParam-    singleParam _ _ =-      PrimParam--cmdNargs :: CmdParams -> CommandOption-cmdNargs ZeroParams =-  CmdNargs "0"-cmdNargs (OnlyPrims 1) =-  CmdNargs "1"-cmdNargs (OneParam False PrimParam) =-  CmdNargs "1"-cmdNargs (OneParam True PrimParam) =-  CmdNargs "?"-cmdNargs (OneParam _ ListParam) =-  CmdNargs "*"-cmdNargs _ =-  CmdNargs "+"--amendSync :: Synchronous -> [CommandOption] -> [CommandOption]-amendSync _ options | any isSync options =-  options-  where-    isSync (CmdSync _) =-      True-    isSync _ =-      False-amendSync sync options =-  CmdSync sync : options--rpcCommand :: String -> Name -> HandlerParams -> Synchronous -> [CommandOption] -> ExpQ-rpcCommand rpcName funcName hps@(HandlerParams _ params) sync opts = do-  fun <- commandImplementation rpcName funcName hps-  [|RpcDef (RpcCommand $ mkCommandOptions (nargs : amendSync sync opts)) $((litE (StringL rpcName))) $(return fun)|]-  where-    nargs = cmdNargs params--removeArgsParam :: [Type] -> Q (Bool, [Type])-removeArgsParam [] =-  return (False, [])-removeArgsParam (p1 : rest) = do-  argsType <- [t|CommandArguments|]-  return $ if p1 == argsType then (True, rest) else (False, p1 : rest)--handlerParams :: Name -> Q HandlerParams-handlerParams name = do-  types <- functionParamTypes name-  (hasArgsParam, userTypes) <- removeArgsParam types-  cp <- analyzeCmdParams userTypes-  return $ HandlerParams hasArgsParam cp
− lib/Ribosome/Plugin/TH/Handler.hs 
@@ -1,150 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Ribosome.Plugin.TH.Handler where--import Control.Exception (throw)-import Data.MessagePack (Object)-import Data.Text.Prettyprint.Doc (Doc, Pretty(..))-import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)-import Language.Haskell.TH-import Language.Haskell.TH.Syntax (Lift(..))-import Neovim.Exceptions (NeovimException(ErrorMessage))-import Neovim.Plugin.Classes (-  AutocmdOptions(AutocmdOptions),-  CommandOption(..),-  CommandOptions,-  RangeSpecification(..),-  Synchronous(..),-  )-import qualified Text.Show as Show (Show(show))--import Ribosome.Msgpack.Decode (fromMsgpack)-import Ribosome.Msgpack.Encode (toMsgpack)--data RpcHandlerConfig =-  RpcHandlerConfig {-    rhcSync :: Synchronous,-    rhcName :: Maybe Text,-    rhcCmd :: Maybe [CommandOption],-    rhcAutocmd :: Maybe Text,-    rhcAutocmdOptions :: Maybe AutocmdOptions-  }-  deriving (Eq, Show)--defaultRpcHandlerConfig :: RpcHandlerConfig-defaultRpcHandlerConfig =-  RpcHandlerConfig Async Nothing Nothing Nothing Nothing--data RpcDefDetail =-  RpcFunction { rfSync :: Synchronous }-  |-  RpcCommand { rcOptions :: CommandOptions }-  |-  RpcAutocmd {-    raEvent :: Text,-    raSync :: Synchronous,-    raOptions :: AutocmdOptions-    }-  deriving Show--data RpcDef m =-  RpcDef {-    rdDetail :: RpcDefDetail,-    rdName :: Text,-    rdHandler :: [Object] -> m Object-  }--instance Show (RpcDef m) where-  show (RpcDef d n _) =-    "RpcDef" <> show (d, n)--deriving instance Lift Synchronous--deriving instance Lift RangeSpecification--deriving instance Lift CommandOption--deriving instance Lift AutocmdOptions--unfoldFunctionParams :: Type -> [Type]-unfoldFunctionParams (ForallT _ _ t) =-  unfoldFunctionParams t-unfoldFunctionParams (AppT (AppT ArrowT t) r) =-  t : unfoldFunctionParams r-unfoldFunctionParams _ = []--functionParamTypes :: Name -> Q [Type]-functionParamTypes name =-  reify name <&> \case-    (VarI _ functionType _) -> unfoldFunctionParams functionType-    _ -> fail $ "rpc handler `" <> show name <> "` is not a function"--errorBody :: Name -> BodyQ-errorBody rpcName =-  normalB [|throw . ErrorMessage . pretty $ ($(errLit) :: String)|]-  where-    errLit =-      litE (StringL errMsg)-    errMsg =-      "Wrong number of arguments for rpc handler: " <> nameBase rpcName--errorCase :: Name -> Q Match-errorCase rpcName =-  match wildP (errorBody rpcName) []--failedEvaluation :: Q Match-failedEvaluation = do-  e <- newName "e"-  match (conP (mkName "Left") [varP e]) (normalB [|throw . ErrorMessage $ ($(varE e) :: Doc AnsiStyle)|]) []--successfulEvaluation :: Q Match-successfulEvaluation = do-  action <- newName "action"-  match (conP (mkName "Right") [varP action]) (normalB [|toMsgpack <$> $(varE action)|]) []--dispatchCase :: PatQ -> ExpQ -> Q Match-dispatchCase params dispatch =-  match params (normalB (caseE dispatch resultCases)) []-  where-    resultCases = [successfulEvaluation, failedEvaluation]--handlerCall :: Name -> [ExpQ] -> ExpQ-handlerCall handlerName =-  foldl decodeSeq [|pure $(varE handlerName)|]-  where-    decodeSeq z = infixApp z [|(<*>)|]--decodedCallSequence :: Name -> [ExpQ] -> ExpQ-decodedCallSequence handlerName vars =-  handlerCall handlerName (decoded <$> vars)-  where-    decoded a =-      [|fromMsgpack $(a)|]--argsCase :: Name -> PatQ -> [Name] -> Q Match-argsCase handlerName params paramNames =-  dispatchCase params dispatch-  where-    dispatch = decodedCallSequence handlerName paramVars-    paramVars = varE <$> paramNames--rpcLambda :: Q Match -> Maybe (Q Match) -> ExpQ-rpcLambda matchingArgsCase errorCase' = do-  args <- newName "args"-  lamE [varP args] [|$(caseE (varE args) (matchingArgsCase : maybeToList errorCase'))|]--rpcLambdaWithErrorCase :: Name -> Q Match -> ExpQ-rpcLambdaWithErrorCase funcName matchingArgsCase =-  rpcLambda matchingArgsCase $ Just (errorCase funcName)--rpcLambdaWithoutErrorCase :: Q Match -> ExpQ-rpcLambdaWithoutErrorCase matchingArgsCase =-  rpcLambda matchingArgsCase Nothing--listParamsPattern :: [Name] -> PatQ-listParamsPattern =-  listP . (varP <$>)--lambdaNames :: Int -> Q [Name]-lambdaNames count =-  replicateM count (newName "a")
− lib/Ribosome/Plugin/Watch.hs 
@@ -1,80 +0,0 @@-module Ribosome.Plugin.Watch where--import Control.Lens (Lens')-import qualified Control.Lens as Lens (at)-import qualified Data.Map.Strict as Map (toList)-import Data.MessagePack (Object(ObjectNil))--import Ribosome.Control.Lock (lockOrSkip)-import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, pluginInternalL, pluginInternalModifyL)-import Ribosome.Control.Ribosome (RibosomeInternal)-import qualified Ribosome.Control.Ribosome as RibosomeInternal (watchedVariables)-import Ribosome.Nvim.Api.IO (vimGetVar)-import Ribosome.Nvim.Api.RpcCall (RpcError)--data WatchedVariable m =-  WatchedVariable {-    wvName :: Text,-    wvHandler :: Object -> m ()-  }--watchedVariables :: Map Text (Object -> m ()) -> [WatchedVariable m]-watchedVariables =-  fmap create . Map.toList-  where-    create (name, handler) = WatchedVariable name handler--storedVarLens :: Text -> Lens' RibosomeInternal (Maybe Object)-storedVarLens name =-  RibosomeInternal.watchedVariables . Lens.at name--runHandler ::-  MonadRibo m =>-  WatchedVariable m ->-  Object ->-  m ()-runHandler (WatchedVariable name handler) new = do-  pluginInternalModifyL (storedVarLens name) (const (Just new))-  handler new--compareVar ::-  MonadRibo m =>-  WatchedVariable m ->-  Maybe Object ->-  Object ->-  m ()-compareVar _ (Just old) new | old == new =-  return ()-compareVar wv _ new =-  runHandler wv new--checkVar ::-  MonadRibo m =>-  NvimE e m =>-  WatchedVariable m ->-  m ()-checkVar wv@(WatchedVariable name _) = do-  old <- pluginInternalL (storedVarLens name)-  new <- catchAt @RpcError recover (Right <$> vimGetVar name)-  traverse_ (compareVar wv old) new-  where-  recover _ = return (Left ())--handleWatcherRequest ::-  MonadRibo m =>-  NvimE e m =>-  [WatchedVariable m] ->-  [Object] ->-  m Object-handleWatcherRequest variables _ =-  ObjectNil <$ traverse_ checkVar variables--handleWatcherRequestSafe ::-  MonadBaseControl IO m =>-  MonadRibo m =>-  NvimE e m =>-  [WatchedVariable m] ->-  [Object] ->-  m Object-handleWatcherRequestSafe variables o =-  ObjectNil <$ lockOrSkip "variable-watcher" (void $ handleWatcherRequest variables o)
+ lib/Ribosome/PluginName.hs view
@@ -0,0 +1,31 @@+-- |Combinators for 'PluginName'.+module Ribosome.PluginName where++import Exon (exon)++import Ribosome.Data.PluginName (PluginName (PluginName))+import Ribosome.Host.Text (pascalCase)++-- |Get the 'PluginName' from a 'Reader'.+pluginName ::+  Member (Reader PluginName) r =>+  Sem r PluginName+pluginName =+  ask++-- |Get the 'PluginName' from a 'Reader' and prefix the given string with it, followed by a colon..+pluginNamePrefixed ::+  Member (Reader PluginName) r =>+  Text ->+  Sem r Text+pluginNamePrefixed msg = do+  PluginName name <- pluginName+  pure [exon|#{name}: #{msg}|]++-- |Get the 'PluginName' from a 'Reader' and convert it to PascalCase.+pluginNamePascalCase ::+  Member (Reader PluginName) r =>+  Sem r PluginName+pluginNamePascalCase = do+  PluginName n <- pluginName+  pure (PluginName (pascalCase n))
− lib/Ribosome/Prelude.hs 
@@ -1,115 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Ribosome.Prelude (-  module Control.Monad.Trans.Control,-  module Cornea,-  module Data.Default,-  module Data.Foldable,-  module Relude,-  dbg,-  dbgs,-  dbgm,-  dbgWith,-  dbgmWith,-  makeClassy,-  mapLeft,-  tuple,-  undefined,-  unit,-  unsafeLogAnd,-  unsafeLogS,-  unsafeLogSAnd,-  throwText,-  (<$$>),-) where--import Control.Lens (makeClassy)-import Control.Monad.Base (MonadBase(..))-import Control.Monad.Trans.Control (MonadBaseControl(..))-import Control.Monad.Trans.Resource.Internal (ResourceT(ResourceT))-import Cornea-import Data.Default (Default(def))-import Data.Either.Combinators (mapLeft)-import Data.Foldable (foldl, traverse_)-import Data.Functor.Syntax ((<$$>))-import GHC.Err (undefined)-import GHC.IO.Unsafe (unsafePerformIO)-import Relude hiding (Type, ask, asks, get, gets, hoistEither, hoistMaybe, local, modify, put, state, undefined)-import System.IO.Error (ioError, userError)--dbg :: Monad m => Text -> m ()-dbg msg = do-  () <- return $ unsafePerformIO (putStrLn (toString msg))-  return ()--dbgs :: Monad m => Show a => a -> m ()-dbgs =-  dbg . show--dbgm :: Monad m => Show a => m a -> m a-dbgm ma = do-  a <- ma-  a <$ dbgs a--dbgWith ::-  Monad m =>-  Show b =>-  (a -> b) ->-  a ->-  m a-dbgWith f a =-  a <$ dbgs (f a)--dbgmWith ::-  Monad m =>-  Show b =>-  (a -> b) ->-  m a ->-  m a-dbgmWith f ma = do-  a <- ma-  a <$ dbgs (f a)--unit ::-  Applicative f =>-  f ()-unit =-  pure ()--tuple ::-  Applicative f =>-  f a ->-  f b ->-  f (a, b)-tuple fa fb =-  (,) <$> fa <*> fb--unsafeLogSAnd :: Show a => a -> b -> b-unsafeLogSAnd a b =-  unsafePerformIO $ print a >> return b--unsafeLogAnd :: Text -> b -> b-unsafeLogAnd a b =-  unsafePerformIO $ putStrLn (toString a) >> return b--unsafeLogS :: Show a => a -> a-unsafeLogS a =-  unsafePerformIO $ print a >> return a--throwText ::-  MonadIO m =>-  Text ->-  m a-throwText =-  liftIO . ioError . userError . toString--instance MonadBase b m => MonadBase b (ResourceT m) where-    liftBase = lift . liftBase--instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where-  type StM (ResourceT m) a = StM m a-  liftBaseWith f = ResourceT $ \reader' ->-      liftBaseWith $ \runInBase ->-          f $ runInBase . (\(ResourceT r) -> r reader'  )-  restoreM = ResourceT . const . restoreM
+ lib/Ribosome/Register.hs view
@@ -0,0 +1,8 @@+-- |API for registers.+module Ribosome.Register (+  module Ribosome.Data.Register,+  module Ribosome.Data.RegisterType,+) where++import Ribosome.Data.Register (Register (..), registerRepr)+import Ribosome.Data.RegisterType (RegisterType (..))
+ lib/Ribosome/Remote.hs view
@@ -0,0 +1,150 @@+-- |Main function combinators for remote plugins.+module Ribosome.Remote where++import Ribosome.Data.PluginConfig (PluginConfig)+import Ribosome.Host.Data.RpcHandler (RpcHandler)+import Ribosome.Host.Interpret (HigherOrder)+import Ribosome.Host.Interpreter.Handlers (interpretHandlersNull, withHandlers)+import Ribosome.Host.Interpreter.Host (runHost)+import Ribosome.Host.Interpreter.Process.Stdio (interpretProcessCerealStdio)+import Ribosome.Host.Run (RpcDeps, RpcStack, interpretRpcStack)+import Ribosome.IOStack (BasicPluginStack, runCli)+import Ribosome.Interpreter.Scratch (interpretScratch)+import Ribosome.Interpreter.Settings (interpretSettingsRpc)+import Ribosome.Interpreter.UserError (interpretUserErrorPrefixed)+import Ribosome.Interpreter.VariableWatcher (interpretVariableWatcherNull)+import Ribosome.Plugin.Builtin (interceptHandlersBuiltin)+import Ribosome.Run (PluginEffects)++-- |The stack of plugin internals.+type HandlerStack =+  PluginEffects ++ RpcStack ++ RpcDeps++-- |The complete stack of a Neovim plugin.+type RemoteStack c =+  HandlerStack ++ BasicPluginStack c++-- |Run plugin internals without IO effects.+interpretPluginRemote ::+  Members (BasicPluginStack c) r =>+  InterpretersFor HandlerStack r+interpretPluginRemote =+  interpretUserErrorPrefixed .+  interpretProcessCerealStdio .+  interpretRpcStack .+  interpretHandlersNull .+  interpretVariableWatcherNull .+  interpretSettingsRpc .+  interpretScratch++-- |Run the main loop for a remote plugin.+remotePlugin ::+  ∀ c r .+  Members HandlerStack r =>+  Members (BasicPluginStack c) r =>+  Sem r ()+remotePlugin =+  interceptHandlersBuiltin runHost++-- |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.+runRemoteStackCli ::+  PluginConfig c ->+  Sem (RemoteStack c) () ->+  IO ()+runRemoteStackCli conf =+  runCli conf . interpretPluginRemote++-- |Run plugin internals and IO effects for a remote plugin, reading options from the CLI.+runRemoteStack ::+  PluginConfig () ->+  Sem (RemoteStack ()) () ->+  IO ()+runRemoteStack conf =+  runCli conf . interpretPluginRemote++-- |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 @'Reader' c@ to the plugin.+--+-- This is separate from 'runNvimPluginIO' because it requires a type hint when using @OverloadedStrings@ or 'def' to+-- construct the config without an option parser.+runNvimPluginCli ::+  HigherOrder r (RemoteStack c) =>+  PluginConfig c ->+  InterpretersFor r (RemoteStack c) ->+  [RpcHandler (r ++ RemoteStack c)] ->+  IO ()+runNvimPluginCli conf effs handlers =+  runRemoteStackCli conf (effs (withHandlers handlers remotePlugin))++-- |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 via @OverloadedStrings@+--+-- - @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]("Ribosome#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 ::+  ∀ r .+  HigherOrder r (RemoteStack ()) =>+  PluginConfig () ->+  InterpretersFor r (RemoteStack ()) ->+  [RpcHandler (r ++ RemoteStack ())] ->+  IO ()+runNvimPluginIO conf effs handlers =+  runRemoteStack conf (effs (withHandlers handlers remotePlugin))++-- |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.+runNvimPluginIO_ ::+  PluginConfig () ->+  [RpcHandler (RemoteStack ())] ->+  IO ()+runNvimPluginIO_ conf handlers =+  runRemoteStack conf (withHandlers handlers remotePlugin)
+ lib/Ribosome/Report.hs view
@@ -0,0 +1,117 @@+-- |Smart constructors for @'DataLog' 'LogReport'@+module Ribosome.Report (+  module Ribosome.Report,+  module Ribosome.Host.Effect.Reports,+  module Ribosome.Host.Interpreter.Reports,+  LogReport (LogReport),+  Report (Report),+  ReportContext (ReportContext),+  Reportable (toReport),+) where++import Log (Severity (Error, Info, Warn), dataLog)+import qualified Polysemy.Log as Log++import Ribosome.Data.SettingError (SettingError)+import Ribosome.Effect.Scratch (Scratch)+import Ribosome.Effect.Settings (Settings)+import qualified Ribosome.Host.Data.Report as Report+import Ribosome.Host.Data.Report (+  LogReport (LogReport),+  Report (Report),+  ReportContext (ReportContext),+  Reportable (toReport),+  resumeReport,+  severity,+  )+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Effect.Reports (Reports (..), storeReport, storedReports)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Host.Interpreter.Reports++-- |Add a segment to the current 'Report' logging context.+context ::+  Member (DataLog LogReport) r =>+  Text ->+  Sem r a ->+  Sem r a+context ctx =+  Log.local (#context %~ \ (ReportContext cur) -> ReportContext (ctx : cur))++-- |Set the current 'Report' logging context.+setContext ::+  Member (DataLog LogReport) r =>+  ReportContext ->+  Sem r a ->+  Sem r a+setContext ctx =+  Log.local (#context .~ ctx)++-- |Convert a value to 'Report' via 'Reportable' and send it to the log.+logReport ::+  Reportable e =>+  Member (DataLog LogReport) r =>+  e ->+  Sem r ()+logReport e =+  dataLog (LogReport r True (severity r >= Warn) mempty)+  where+    r = toReport e++-- |Send a 'Report' to the log given a user and log message, with serverity 'Info'.+info ::+  Member (DataLog LogReport) r =>+  Text ->+  [Text] ->+  Sem r ()+info user log =+  logReport Report {severity = Info, ..}++-- |Send a 'Report' to the log given a user and log message, with serverity 'Warn'.+warn ::+  Member (DataLog LogReport) r =>+  Text ->+  [Text] ->+  Sem r ()+warn user log =+  logReport Report {severity = Warn, ..}++-- |Send a 'Report' to the log given a user and log message, with serverity 'Log.Error'.+error ::+  Member (DataLog LogReport) r =>+  Text ->+  [Text] ->+  Sem r ()+error user log =+  logReport Report {severity = Error, ..}++-- |Eliminate @'Stop' err@ by converting @err@ to a 'Report' and logging it, continuing execution for a unit action.+reportStop ::+  ∀ err r .+  Reportable err =>+  Member (DataLog LogReport) r =>+  Sem (Stop err : r) () ->+  Sem r ()+reportStop sem =+  withFrozenCallStack do+    either logReport pure =<< runStop sem++-- |Resume an effect by converting the error to a 'Report' and logging it, continuing execution for a unit action.+resumeLogReport ::+  ∀ eff e r .+  Reportable e =>+  Members [eff !! e, DataLog LogReport] r =>+  Sem (eff : r) () ->+  Sem r ()+resumeLogReport sem =+  withFrozenCallStack do+    sem !! logReport++-- |Resume all plugin effects.+pluginLogReports ::+  Members [Scratch !! RpcError, Settings !! SettingError, Rpc !! RpcError, Stop Report] r =>+  InterpretersFor [Scratch, Settings, Rpc] r+pluginLogReports =+  resumeReport @Rpc .+  resumeReport @Settings .+  resumeReport @Scratch
+ lib/Ribosome/Run.hs view
@@ -0,0 +1,30 @@+-- |Convenience aliases for plugin effects.+module Ribosome.Run where++import Ribosome.Data.PluginName (PluginName)+import Ribosome.Data.SettingError (SettingError)+import Ribosome.Effect.Scratch (Scratch)+import Ribosome.Effect.Settings (Settings)+import Ribosome.Effect.VariableWatcher (VariableWatcher)+import Ribosome.Host.Data.Report (Report)+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Effect.Handlers (Handlers)+import Ribosome.Host.Effect.Rpc (Rpc)++-- |The set of core effects that are intepreted by the main logic, minus what's in "Ribosome.Host".+type PluginEffects =+  [+    Scratch !! RpcError,+    Settings !! SettingError,+    VariableWatcher !! Report,+    Handlers !! Report+  ]++-- |The set of core effects that handlers and API functions commonly use.+type NvimPlugin =+  [+    Scratch !! RpcError,+    Settings !! SettingError,+    Rpc !! RpcError,+    Reader PluginName+  ]
lib/Ribosome/Scratch.hs view
@@ -1,347 +1,20 @@-module Ribosome.Scratch where--import Control.Lens (Lens', set, view)-import qualified Control.Lens as Lens (at)-import qualified Data.Map.Strict as Map (empty)-import Data.MessagePack (Object)--import Ribosome.Api.Autocmd (bufferAutocmd, eventignore)-import Ribosome.Api.Buffer (setBufferContent, wipeBuffer)-import Ribosome.Api.Syntax (executeCurrentWindowSyntax)-import Ribosome.Api.Tabpage (closeTabpage)-import Ribosome.Api.Window (closeWindow)-import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, pluginInternalL, pluginInternalModify, pluginName)-import Ribosome.Control.Ribosome (RibosomeInternal)-import qualified Ribosome.Control.Ribosome as Ribosome (scratch)-import Ribosome.Data.FloatOptions (FloatOptions)-import Ribosome.Data.Scratch (Scratch(Scratch))-import qualified Ribosome.Data.Scratch as Scratch (Scratch(scratchPrevious, scratchWindow, scratchBuffer))-import Ribosome.Data.ScratchOptions (ScratchOptions(ScratchOptions))-import qualified Ribosome.Data.ScratchOptions as ScratchOptions (maxSize, modify, name, resize, vertical)-import Ribosome.Data.Text (capitalize)-import Ribosome.Log (logDebug)-import Ribosome.Mapping (activateBufferMapping)-import Ribosome.Msgpack.Decode (fromMsgpack)-import Ribosome.Msgpack.Encode (toMsgpack)-import Ribosome.Msgpack.Error (DecodeError)-import Ribosome.Nvim.Api.Data (Buffer, Tabpage, Window)-import Ribosome.Nvim.Api.IO (-  bufferGetName,-  bufferGetNumber,-  bufferSetName,-  bufferSetOption,-  nvimBufIsLoaded,-  nvimCreateBuf,-  nvimOpenWin,-  vimCommand,-  vimGetCurrentBuffer,-  vimGetCurrentTabpage,-  vimGetCurrentWindow,-  vimSetCurrentWindow,-  windowGetBuffer,-  windowIsValid,-  windowSetHeight,-  windowSetOption,-  windowSetWidth,-  )-import Ribosome.Nvim.Api.RpcCall (RpcError)--createScratchTab :: NvimE e m => m Tabpage-createScratchTab = do-  vimCommand "tabnew"-  vimGetCurrentTabpage--createRegularWindow ::-  NvimE e m =>-  Bool ->-  Bool ->-  Maybe Int ->-  m (Buffer, Window)-createRegularWindow vertical bottom size = do-  vimCommand prefixedCmd-  buf <- vimGetCurrentBuffer-  win <- vimGetCurrentWindow-  return (buf, win)-  where-    prefixedCmd = locationPrefix <> " " <> sizePrefix <> cmd-    cmd = if vertical then "vnew" else "new"-    sizePrefix = maybe "" show size-    locationPrefix = if bottom then "belowright" else "aboveleft"--floatConfig ::-  FloatOptions ->-  Map Text Object-floatConfig =-  fromRight Map.empty . fromMsgpack . toMsgpack--createFloat ::-  NvimE e m =>-  FloatOptions ->-  m (Buffer, Window)-createFloat options = do-  buffer <- nvimCreateBuf True True-  window <- nvimOpenWin buffer True (floatConfig options)-  return (buffer, window)--createScratchWindow ::-  NvimE e m =>-  Bool ->-  Bool ->-  Bool ->-  Maybe FloatOptions ->-  Maybe Int ->-  m (Buffer, Window)-createScratchWindow vertical wrap bottom float size = do-  (buffer, win) <- createWindow-  windowSetOption win "wrap" (toMsgpack wrap)-  windowSetOption win "number" (toMsgpack False)-  windowSetOption win "cursorline" (toMsgpack True)-  windowSetOption win "colorcolumn" (toMsgpack ("" :: Text))-  windowSetOption win "foldmethod" (toMsgpack ("manual" :: Text))-  windowSetOption win "conceallevel" (toMsgpack (2 :: Int))-  return (buffer, win)-  where-    createWindow =-      maybe regular createFloat float-    regular =-      createRegularWindow vertical bottom size--createScratchUiInTab :: NvimE e m => m (Buffer, Window, Maybe Tabpage)-createScratchUiInTab = do-  tab <- createScratchTab-  win <- vimGetCurrentWindow-  buffer <- windowGetBuffer win-  return (buffer, win, Just tab)--createScratchUi ::-  NvimE e m =>-  ScratchOptions ->-  m (Buffer, Window, Maybe Tabpage)-createScratchUi (ScratchOptions False vertical wrap _ _ bottom _ float size _ _ _ _) =-  uncurry (,,Nothing) <$> createScratchWindow vertical wrap bottom float size-createScratchUi _ =-  createScratchUiInTab--configureScratchBuffer :: NvimE e m => Buffer -> Text -> m ()-configureScratchBuffer buffer name = do-  bufferSetOption buffer "bufhidden" (toMsgpack ("wipe" :: Text))-  bufferSetOption buffer "buftype" (toMsgpack ("nofile" :: Text))-  bufferSetOption buffer "swapfile" (toMsgpack False)-  bufferSetName buffer name--setupScratchBuffer ::-  NvimE e m =>-  MonadRibo m =>-  Window ->-  Buffer ->-  Text ->-  m Buffer-setupScratchBuffer window buffer name = do-  valid <- nvimBufIsLoaded buffer-  logDebug @Text $ (if valid then "" else "in") <> "valid scratch buffer"-  validBuffer <- if valid then return buffer else windowGetBuffer window-  configureScratchBuffer validBuffer name-  return validBuffer--scratchLens :: Text -> Lens' RibosomeInternal (Maybe Scratch)-scratchLens name =-  Ribosome.scratch . Lens.at name--setupDeleteAutocmd ::-  MonadRibo m =>-  NvimE e m =>-  Scratch ->-  m ()-setupDeleteAutocmd (Scratch name buffer _ _ _) = do-  pname <- capitalize <$> pluginName-  bufferAutocmd buffer "RibosomeScratch" "BufDelete" (deleteCall pname)-  where-    deleteCall pname =-      "silent! call " <> pname <> "DeleteScratch('" <> name <> "')"--setupScratchIn ::-  MonadDeepError e DecodeError m =>-  MonadRibo m =>-  NvimE e m =>-  Buffer ->-  Window ->-  Window ->-  Maybe Tabpage ->-  ScratchOptions ->-  m Scratch-setupScratchIn buffer previous window tab (ScratchOptions _ _ _ focus _ _ _ _ _ _ syntax mappings name) = do-  validBuffer <- setupScratchBuffer window buffer name-  traverse_ executeCurrentWindowSyntax syntax-  traverse_ (activateBufferMapping validBuffer) mappings-  unless focus $ vimSetCurrentWindow previous-  let scratch = Scratch name validBuffer window previous tab-  pluginInternalModify $ set (scratchLens name) (Just scratch)-  setupDeleteAutocmd scratch-  return scratch--createScratch ::-  NvimE e m =>-  MonadRibo m =>-  MonadBaseControl IO m =>-  MonadDeepError e DecodeError m =>-  ScratchOptions ->-  m Scratch-createScratch options = do-  logDebug @Text $ "creating new scratch `" <> show options <> "`"-  previous <- vimGetCurrentWindow-  (buffer, window, tab) <- eventignore $ createScratchUi options-  eventignore $ setupScratchIn buffer previous window tab options--bufferStillLoaded ::-  NvimE e m =>-  Text ->-  Buffer ->-  m Bool-bufferStillLoaded name buffer =-  (&&) <$> loaded <*> loadedName-  where-    loaded = nvimBufIsLoaded buffer-    loadedName = catchAs @RpcError False ((name ==) <$> bufferGetName buffer)--updateScratch ::-  NvimE e m =>-  MonadRibo m =>-  MonadBaseControl IO m =>-  MonadDeepError e DecodeError m =>-  Scratch ->-  ScratchOptions ->-  m Scratch-updateScratch oldScratch@(Scratch name oldBuffer oldWindow _ _) options = do-  logDebug $ "updating existing scratch `" <> name <> "`"-  ifM (windowIsValid oldWindow) attemptReuseWindow reset-  where-    attemptReuseWindow =-      ifM (bufferStillLoaded name oldBuffer) (return oldScratch) closeAndReset-    closeAndReset =-      closeWindow oldWindow *> reset-    reset =-      createScratch options--lookupScratch ::-  MonadRibo m =>-  Text ->-  m (Maybe Scratch)-lookupScratch name =-  pluginInternalL (scratchLens name)--ensureScratch ::-  NvimE e m =>-  MonadRibo m =>-  MonadBaseControl IO m =>-  MonadDeepError e DecodeError m =>-  ScratchOptions ->-  m Scratch-ensureScratch options = do-  f <- maybe createScratch updateScratch <$> lookupScratch (view ScratchOptions.name options)-  f options--withModifiable ::-  NvimE e m =>-  Buffer ->-  ScratchOptions ->-  m a ->-  m a-withModifiable buffer options thunk =-  if isWrite then thunk else wrap-  where-    isWrite =-      view ScratchOptions.modify options-    wrap =-      update True *> thunk <* update False-    update value =-      bufferSetOption buffer "modifiable" (toMsgpack value)--setScratchContent ::-  Foldable t =>-  NvimE e m =>-  ScratchOptions ->-  Scratch ->-  t Text ->-  m ()-setScratchContent options (Scratch _ buffer win _ _) lines' = do-  withModifiable buffer options $ setBufferContent buffer (toList lines')-  when (view ScratchOptions.resize options) (ignoreError @RpcError $ setSize win size)-  where-    size =-      max 1 calculateSize-    calculateSize =-      if vertical then fromMaybe 50 maxSize else min (length lines') (fromMaybe 30 maxSize)-    maxSize =-      view ScratchOptions.maxSize options-    vertical =-      view ScratchOptions.vertical options-    setSize =-      if vertical then windowSetWidth else windowSetHeight--showInScratch ::-  Foldable t =>-  NvimE e m =>-  MonadRibo m =>-  MonadBaseControl IO m =>-  MonadDeepError e DecodeError m =>-  t Text ->-  ScratchOptions ->-  m Scratch-showInScratch lines' options = do-  scratch <- ensureScratch options-  setScratchContent options scratch lines'-  return scratch--showInScratchDef ::-  Foldable t =>-  NvimE e m =>-  MonadRibo m =>-  MonadBaseControl IO m =>-  MonadDeepError e DecodeError m =>-  t Text ->-  m Scratch-showInScratchDef lines' =-  showInScratch lines' def--killScratch ::-  MonadRibo m =>-  NvimE e m =>-  Scratch ->-  m ()-killScratch (Scratch name buffer window _ tab) = do-  catchAs @RpcError () removeAutocmd-  traverse_ closeTabpage tab *> closeWindow window *> wipeBuffer buffer-  pluginInternalModify $ set (scratchLens name) Nothing-  where-    removeAutocmd = do-      number <- bufferGetNumber buffer-      vimCommand $ "autocmd! RibosomeScratch BufDelete <buffer=" <> show number <> ">"--killScratchByName ::-  MonadRibo m =>-  NvimE e m =>-  Text ->-  m ()-killScratchByName =-  traverse_ killScratch <=< lookupScratch--scratchPreviousWindow ::-  MonadRibo m =>-  Text ->-  m (Maybe Window)-scratchPreviousWindow =-  fmap Scratch.scratchPrevious <$$> lookupScratch--scratchWindow ::-  MonadRibo m =>-  Text ->-  m (Maybe Window)-scratchWindow =-  fmap Scratch.scratchWindow <$$> lookupScratch+-- |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.+module Ribosome.Scratch (+  module Ribosome.Effect.Scratch,+  module Ribosome.Data.ScratchOptions,+  module Ribosome.Data.ScratchId,+  module Ribosome.Data.ScratchState,+  module Ribosome.Data.FloatOptions,+  module Ribosome.Interpreter.Scratch,+) where -scratchBuffer ::-  MonadRibo m =>-  Text ->-  m (Maybe Buffer)-scratchBuffer =-  fmap Scratch.scratchBuffer <$$> lookupScratch+import Ribosome.Data.FloatOptions+import Ribosome.Data.ScratchId+import Ribosome.Data.ScratchOptions+import Ribosome.Data.ScratchState+import Ribosome.Effect.Scratch+import Ribosome.Interpreter.Scratch
+ lib/Ribosome/Settings.hs view
@@ -0,0 +1,21 @@+-- |The 'Settings' API, an effect for accessing Neovim variables with defaults.+module Ribosome.Settings (+  module Ribosome.Data.Setting,+  module Ribosome.Data.SettingError,+  module Ribosome.Settings,+  module Ribosome.Effect.Settings,+) where++import Ribosome.Data.Setting (Setting (..))+import Ribosome.Data.SettingError (SettingError (..))+import Ribosome.Effect.Settings (Settings, get, maybe, or, update)++-- |The vertical margin for floating windows used by @ribosome-menu@.+menuMarginVertical :: Setting Float+menuMarginVertical =+  Setting "ribosome_menu_margin_vertical" False (Just 0.2)++-- |The horizontal margin for floating windows used by @ribosome-menu@.+menuMarginHorizontal :: Setting Float+menuMarginHorizontal =+  Setting "ribosome_menu_margin_horizontal" False (Just 0.1)
+ lib/Ribosome/Socket.hs view
@@ -0,0 +1,38 @@+-- |Main function combinators for connecting to Neovim over a socket.+module Ribosome.Socket where++import Ribosome.Host.Data.BootError (BootError (BootError))+import Ribosome.Host.Data.NvimSocket (NvimSocket)+import Ribosome.Host.Interpreter.Handlers (interpretHandlersNull)+import Ribosome.Host.Interpreter.Process.Socket (interpretProcessCerealSocket)+import Ribosome.Host.Run (RpcDeps, RpcStack, interpretRpcStack)+import Ribosome.IOStack (BasicPluginStack)+import Ribosome.Interpreter.Scratch (interpretScratch)+import Ribosome.Interpreter.Settings (interpretSettingsRpc)+import Ribosome.Interpreter.UserError (interpretUserErrorPrefixed)+import Ribosome.Interpreter.VariableWatcher (interpretVariableWatcherNull)+import Ribosome.Run (PluginEffects)++-- |The stack of plugin internals.+type SocketHandlerEffects =+  PluginEffects ++ RpcStack ++ RpcDeps++-- |The complete stack of a Neovim plugin.+type PluginSocketStack c =+  SocketHandlerEffects ++ Reader NvimSocket : BasicPluginStack c++-- |Run plugin internals without IO effects.+interpretPluginSocket ::+  Members (BasicPluginStack c) r =>+  Member (Reader NvimSocket) r =>+  InterpretersFor SocketHandlerEffects r+interpretPluginSocket =+  interpretUserErrorPrefixed .+  interpretProcessCerealSocket def .+  resumeHoistError (BootError . show @Text) .+  raiseUnder .+  interpretRpcStack .+  interpretHandlersNull .+  interpretVariableWatcherNull .+  interpretSettingsRpc .+  interpretScratch
+ lib/Ribosome/Syntax.hs view
@@ -0,0 +1,50 @@+-- |Data types and combinators for [Ribosome.Api.Syntax]("Ribosome.Api.Syntax").+module Ribosome.Syntax (+  module Ribosome.Data.Syntax,+  module Ribosome.Syntax,+) where++import qualified Data.Map.Strict as Map++import Ribosome.Data.Syntax (+  HiLink (..),+  Highlight (..),+  Syntax (..),+  SyntaxItem (..),+  SyntaxItemDetail (..),+  )++-- |Construct a default 'SyntaxItem' from a 'SyntaxItemDetail'.+syntaxItem :: SyntaxItemDetail -> SyntaxItem+syntaxItem detail =+  SyntaxItem detail def def++-- |Construct a simple keyword syntax item.+syntaxKeyword :: Text -> Text -> SyntaxItem+syntaxKeyword group' keyword =+  syntaxItem $ Keyword group' keyword def++-- |Construct a simple match syntax item.+syntaxMatch :: Text -> Text -> SyntaxItem+syntaxMatch group' pat =+  syntaxItem $ Match group' pat++-- |Construct a region syntax item with offsets.+syntaxRegionOffset :: Text -> Text -> Text -> Maybe Text -> Text -> Text -> SyntaxItem+syntaxRegionOffset group' start end skip ms me =+  syntaxItem $ Region group' start end skip ms me++-- |Construct a simple region syntax item.+syntaxRegion :: Text -> Text -> Text -> Maybe Text -> SyntaxItem+syntaxRegion group' start end skip =+  syntaxRegionOffset group' start end skip "" ""++-- |Construct a simple verbatim syntax item.+syntaxVerbatim :: Text -> SyntaxItem+syntaxVerbatim =+  syntaxItem . Verbatim++-- |Construct a syntax highlight.+syntaxHighlight :: Text -> [(Text, Text)] -> Highlight+syntaxHighlight group' =+  Highlight group' . Map.fromList
− lib/Ribosome/System/Time.hs 
@@ -1,27 +0,0 @@-module Ribosome.System.Time where--import Control.Concurrent (threadDelay)-import Data.Hourglass (Elapsed(Elapsed), ElapsedP(ElapsedP), NanoSeconds(NanoSeconds), Seconds(Seconds))-import Data.Time.Clock.POSIX (getPOSIXTime)-import GHC.Float (word2Double)--epochSeconds :: MonadIO m => m Int-epochSeconds = liftIO $ round <$> getPOSIXTime--usleep :: MonadIO m => Double -> m ()-usleep =-  liftIO . threadDelay . round--sleep :: MonadIO m => Double -> m ()-sleep seconds =-  usleep $ seconds * 1e6--sleepW :: MonadIO m => Word -> m ()-sleepW = sleep . word2Double--secondsP :: Double -> ElapsedP-secondsP s =-  ElapsedP (Elapsed (Seconds $ floor s)) (NanoSeconds nano)-  where-    nano =-      round (s * 1000000000) `mod` 1000000000
+ lib/Ribosome/Text.hs view
@@ -0,0 +1,26 @@+-- |Combinators for 'Text'.+module Ribosome.Text where++import Data.Char (toUpper)+import qualified Data.Text as Text++-- |Escape a single quote Neovim-style by replacing it with two single quotes.+escapeQuote :: Char -> Text+escapeQuote = \case+  '\'' ->+    "''"+  a ->+    Text.singleton a++-- |Escape all single quotes Neovim-style by replacing them with two single quotes.+escapeQuotes :: Text -> Text+escapeQuotes =+  Text.concatMap escapeQuote++-- |Upcase the first letter of a 'Text', if any.+capitalize :: Text -> Text+capitalize a =+  maybe "" run (Text.uncons a)+  where+    run (h, t) =+      Text.cons (toUpper h) t
− lib/Ribosome/Tmux/Run.hs 
@@ -1,42 +0,0 @@-module Ribosome.Tmux.Run where--import Chiasma.Data.TmuxError (TmuxError)-import Chiasma.Monad.Stream (TmuxProg)-import qualified Chiasma.Monad.Stream as Chiasma (runTmux)-import Chiasma.Native.Api (TmuxNative(TmuxNative))-import Control.Monad.Catch (MonadMask)-import Data.DeepPrisms (DeepPrisms)--import Ribosome.Config.Setting (settingMaybe)-import Ribosome.Config.Settings (tmuxSocket)-import Ribosome.Control.Monad.Ribo (MonadRibo, Nvim, Ribo)--runTmux ::-  MonadIO m =>-  MonadRibo m =>-  MonadBaseControl IO m =>-  MonadDeepError e TmuxError m =>-  MonadMask m =>-  Nvim m =>-  TmuxProg m a ->-  m a-runTmux prog = do-  socket <- settingMaybe tmuxSocket-  Chiasma.runTmux (TmuxNative socket) prog--runTmuxE ::-  MonadIO m =>-  MonadRibo m =>-  MonadBaseControl IO m =>-  MonadMask m =>-  Nvim m =>-  TmuxProg (ExceptT TmuxError m) a ->-  m (Either TmuxError a)-runTmuxE =-  runExceptT . runTmux--class RunTmux m where-  runRiboTmux :: TmuxProg m b -> m b--instance DeepPrisms e TmuxError => RunTmux (Ribo s e) where-    runRiboTmux = runTmux
− readme.md 
@@ -1,91 +0,0 @@-# About--*ribosome* is an extension framework for [nvim-hs], a [Haskell] library that-provides a [Neovim] plugin engine.--*ribosome*'s structure is similar to that of vanilla [nvim-hs] plugins and is-intended to provide a more comfortable API on top of it.--# Basic Plugin--*ribosome* comes with a companion plugin manager, [chromatin], but you can-start plugins regularly with `jobstart()`.--First, add `ribosome` to your `myplugin.cabal`'s dependencies.--Your project should have an executable that looks like this:--```haskell-import Neovim (neovim, plugins, defaultConfig)-import MyPlugin.Plugin (plugin)--main :: IO ()-main =-  neovim defaultConfig {plugins = [plugin]}-```--In `MyPlugin.Plugin`, you should write a plugin definition like this:--```haskell-module MyPlugin.Plugin where--import Data.Default.Class (Default(def))-import Neovim (Neovim, NeovimPlugin, Plugin, wrapPlugin)-import Neovim.Context.Internal (Config(customConfig), asks')-import Ribosome.Api.Echo (echom)-import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, Ribo)-import Ribosome.Control.Ribosome (Ribosome, newRibosome)-import Ribosome.Error.Report (reportError)-import Ribosome.Internal.IO (retypeNeovim)-import Ribosome.Plugin (RpcDef, autocmd, cmd, riboPlugin, rpcHandler)-import System.Log.Logger (Priority(ERROR), setLevel, updateGlobalLogger)--handleError :: Text -> Ribo () Text ()-handleError err =-  echom err--hello :: NvimE e m => MonadRibo m => m ()-hello ::-  echom "hello"--bufEnter :: NvimE e m => MonadRibo m => m ()-bufEnter ::-  echom "BufEnter"--rpcHandlers :: [[RpcDef (Ribo () Error)]]-rpcHandlers =-  [-    $(rpcHandler (cmd []) 'hello),-    $(rpcHandler (autocmd "BufEnter") 'bufEnter)-  ]--plugin' :: Ribosome () -> Plugin (Ribosome ())-plugin' env =-  riboPlugin "myplugin" env rpcHandlers def handleError def--initialize :: Neovim e (Ribosome Env)-initialize = do-  liftIO $ updateGlobalLogger "Neovim.Plugin" (setLevel ERROR)-  ribo <- newRibosome "myplugin" def-  retypeNeovim (const ribo) (asks' customConfig)--plugin :: Neovim e NeovimPlugin-plugin =-  wrapPlugin . plugin' =<< initialize-```--Follow the instructions for the bootstrapping vim config in the documentation-for [chromatin].-Now you can execute the command `:Hello`.--For more inspiration, check out some example projects: [proteome], [myo],-[uracil].--[nvim-hs]: https://github.com/neovimhaskell/nvim-hs-[Haskell]: https://www.haskell.org-[proteome]: https://github.com/tek/proteome-[myo]: https://github.com/tek/myo-[uracil]: https://github.com/tek/uracil-[chromatin]: https://github.com/tek/chromatin-[nvim-hs]: https://github.com/neovimhaskell/nvim-hs-[Neovim]: https://github.com/neovim/neovim
ribosome.cabal view
@@ -1,152 +1,100 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack------ hash: 5149fd2775468552936c7de98962a22d9d92a598322a9cd7ace739c9f8bdb2c7  name:           ribosome-version:        0.4.0.0-synopsis:       api extensions for nvim-hs-description:    Please see the README on GitHub at <https://github.com/tek/ribosome>+version:        0.9.9.9+synopsis:       Neovim plugin framework for Polysemy+description:    See https://hackage.haskell.org/package/ribosome/docs/Ribosome.html category:       Neovim-homepage:       https://github.com/tek/ribosome#readme-bug-reports:    https://github.com/tek/ribosome/issues author:         Torsten Schmits-maintainer:     tek@tryp.io-copyright:      2021 Torsten Schmits+maintainer:     hackage@tryp.io+copyright:      2022 Torsten Schmits license:        BSD-2-Clause-Patent license-file:   LICENSE build-type:     Simple-extra-source-files:-    readme.md -source-repository head-  type: git-  location: https://github.com/tek/ribosome- library   exposed-modules:-      Ribosome.Api.Atomic+      Ribosome+      Ribosome.Api       Ribosome.Api.Autocmd       Ribosome.Api.Buffer+      Ribosome.Api.Data       Ribosome.Api.Echo-      Ribosome.Api.Exists       Ribosome.Api.Function       Ribosome.Api.Input       Ribosome.Api.Mode       Ribosome.Api.Normal       Ribosome.Api.Option       Ribosome.Api.Path+      Ribosome.Api.Position       Ribosome.Api.Process       Ribosome.Api.Register-      Ribosome.Api.Response       Ribosome.Api.Sleep       Ribosome.Api.Syntax       Ribosome.Api.Tabpage       Ribosome.Api.Undo-      Ribosome.Api.Variable       Ribosome.Api.Window-      Ribosome.Config.Setting-      Ribosome.Config.Settings-      Ribosome.Control.Concurrent.Wait-      Ribosome.Control.Exception-      Ribosome.Control.Lock-      Ribosome.Control.Monad.Error-      Ribosome.Control.Monad.Ribo-      Ribosome.Control.Ribosome-      Ribosome.Control.StrictRibosome-      Ribosome.Data.Conduit-      Ribosome.Data.Conduit.Composition-      Ribosome.Data.ErrorReport-      Ribosome.Data.Errors+      Ribosome.Cli+      Ribosome.Data.CliConfig+      Ribosome.Data.CustomConfig+      Ribosome.Data.FileBuffer       Ribosome.Data.FloatOptions-      Ribosome.Data.Foldable-      Ribosome.Data.List       Ribosome.Data.Mapping+      Ribosome.Data.Mode       Ribosome.Data.PersistError+      Ribosome.Data.PersistPathError+      Ribosome.Data.PluginConfig+      Ribosome.Data.PluginName       Ribosome.Data.Register       Ribosome.Data.RegisterType-      Ribosome.Data.RiboError-      Ribosome.Data.Scratch+      Ribosome.Data.ScratchId       Ribosome.Data.ScratchOptions+      Ribosome.Data.ScratchState       Ribosome.Data.Setting       Ribosome.Data.SettingError-      Ribosome.Data.String       Ribosome.Data.Syntax-      Ribosome.Data.Text       Ribosome.Data.WindowConfig-      Ribosome.Error.Report-      Ribosome.Error.Report.Class-      Ribosome.File-      Ribosome.Internal.IO-      Ribosome.Internal.NvimObject-      Ribosome.Log+      Ribosome.Data.WindowView+      Ribosome.Effect.Persist+      Ribosome.Effect.PersistPath+      Ribosome.Effect.Scratch+      Ribosome.Effect.Settings+      Ribosome.Effect.VariableWatcher+      Ribosome.Embed+      Ribosome.Examples.Example1+      Ribosome.Examples.Example2+      Ribosome.Examples.Example3+      Ribosome.Final+      Ribosome.Float+      Ribosome.Internal.Path+      Ribosome.Internal.Scratch+      Ribosome.Internal.Syntax+      Ribosome.Interpreter.Persist+      Ribosome.Interpreter.PersistPath+      Ribosome.Interpreter.PluginName+      Ribosome.Interpreter.Scratch+      Ribosome.Interpreter.Settings+      Ribosome.Interpreter.UserError+      Ribosome.Interpreter.VariableWatcher+      Ribosome.IOStack+      Ribosome.Lens       Ribosome.Mapping-      Ribosome.Menu.Action-      Ribosome.Menu.Data.BasicMenuAction-      Ribosome.Menu.Data.FilteredMenuItem-      Ribosome.Menu.Data.Menu-      Ribosome.Menu.Data.MenuAction-      Ribosome.Menu.Data.MenuConfig-      Ribosome.Menu.Data.MenuConsumer-      Ribosome.Menu.Data.MenuConsumerAction-      Ribosome.Menu.Data.MenuConsumerUpdate-      Ribosome.Menu.Data.MenuEvent-      Ribosome.Menu.Data.MenuItem-      Ribosome.Menu.Data.MenuItemFilter-      Ribosome.Menu.Data.MenuRenderEvent-      Ribosome.Menu.Data.MenuResult-      Ribosome.Menu.Data.MenuUpdate-      Ribosome.Menu.Nvim-      Ribosome.Menu.Prompt-      Ribosome.Menu.Prompt.Data.Codes-      Ribosome.Menu.Prompt.Data.CursorUpdate-      Ribosome.Menu.Prompt.Data.InputEvent-      Ribosome.Menu.Prompt.Data.Prompt-      Ribosome.Menu.Prompt.Data.PromptConfig-      Ribosome.Menu.Prompt.Data.PromptConsumed-      Ribosome.Menu.Prompt.Data.PromptConsumerUpdate-      Ribosome.Menu.Prompt.Data.PromptEvent-      Ribosome.Menu.Prompt.Data.PromptRenderer-      Ribosome.Menu.Prompt.Data.PromptState-      Ribosome.Menu.Prompt.Data.PromptUpdate-      Ribosome.Menu.Prompt.Data.TextUpdate-      Ribosome.Menu.Prompt.Nvim-      Ribosome.Menu.Prompt.Run-      Ribosome.Menu.Run-      Ribosome.Menu.Simple-      Ribosome.Msgpack.Decode-      Ribosome.Msgpack.Encode-      Ribosome.Msgpack.Error-      Ribosome.Msgpack.NvimObject-      Ribosome.Msgpack.Util-      Ribosome.Nvim.Api.Data-      Ribosome.Nvim.Api.Generate-      Ribosome.Nvim.Api.GenerateData-      Ribosome.Nvim.Api.GenerateIO-      Ribosome.Nvim.Api.IO-      Ribosome.Nvim.Api.RpcCall-      Ribosome.Orphans       Ribosome.Persist-      Ribosome.Plugin       Ribosome.Plugin.Builtin-      Ribosome.Plugin.Mapping-      Ribosome.Plugin.RpcHandler-      Ribosome.Plugin.TH-      Ribosome.Plugin.TH.Command-      Ribosome.Plugin.TH.Handler-      Ribosome.Plugin.Watch-      Ribosome.Prelude+      Ribosome.PluginName+      Ribosome.Register+      Ribosome.Remote+      Ribosome.Report+      Ribosome.Run       Ribosome.Scratch-      Ribosome.System.Time-      Ribosome.Tmux.Run-  other-modules:-      Prelude-      Paths_ribosome-  autogen-modules:-      Paths_ribosome+      Ribosome.Settings+      Ribosome.Socket+      Ribosome.Syntax+      Ribosome.Text   hs-source-dirs:       lib   default-extensions:@@ -166,9 +114,11 @@       DeriveLift       DeriveTraversable       DerivingStrategies+      DerivingVia       DisambiguateRecordFields       DoAndIfThenElse       DuplicateRecordFields+      EmptyCase       EmptyDataDecls       ExistentialQuantification       FlexibleContexts@@ -183,8 +133,9 @@       MultiParamTypeClasses       MultiWayIf       NamedFieldPuns-      OverloadedStrings+      OverloadedLabels       OverloadedLists+      OverloadedStrings       PackageImports       PartialTypeSignatures       PatternGuards@@ -195,6 +146,7 @@       RankNTypes       RecordWildCards       RecursiveDo+      RoleAnnotations       ScopedTypeVariables       StandaloneDeriving       TemplateHaskell@@ -207,63 +159,128 @@       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -Wall -Wredundant-constraints -Wsimplifiable-class-constraints+      StandaloneKindSignatures+      OverloadedLabels+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin   build-depends:       aeson-    , ansi-terminal-    , base ==4.*-    , bytestring-    , cereal-    , cereal-conduit-    , chiasma-    , composition-    , composition-extra-    , conduit-    , conduit-extra-    , containers-    , cornea-    , data-default-    , deepseq-    , directory-    , either-    , exceptions-    , filepath-    , free-    , fuzzy-    , hourglass-    , hslogger-    , lens-    , lifted-async-    , lifted-base+    , base >=4.12 && <5+    , exon     , messagepack-    , monad-control-    , monad-loops-    , mtl-    , nvim-hs+    , optparse-applicative     , path     , path-io-    , pretty-terminal+    , polysemy+    , polysemy-plugin+    , prelate >=0.1     , prettyprinter-    , prettyprinter-ansi-terminal-    , process-    , relude >=0.7 && <1.2-    , resourcet-    , safe-    , split-    , stm-    , stm-chans-    , stm-conduit-    , template-haskell-    , text-    , th-abstraction-    , time-    , transformers-    , transformers-base-    , typed-process-    , unix-    , unliftio-    , unliftio-core-    , utf8-string+    , ribosome-host   mixins:       base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: Haskell2010++test-suite ribosome-unit+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Ribosome.Test.BufferTest+      Ribosome.Test.Error+      Ribosome.Test.MappingTest+      Ribosome.Test.PathTest+      Ribosome.Test.PersistTest+      Ribosome.Test.ScratchTest+      Ribosome.Test.SettingTest+      Ribosome.Test.UndoTest+      Ribosome.Test.Wait+      Ribosome.Test.WatcherTest+      Ribosome.Test.WindowTest+      Ribosome.Unit.Run+  hs-source-dirs:+      test+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+      StandaloneKindSignatures+      OverloadedLabels+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.12 && <5+    , exon+    , hedgehog+    , messagepack+    , path+    , polysemy+    , polysemy-conc+    , polysemy-plugin+    , polysemy-test+    , prelate >=0.1+    , ribosome+    , ribosome-host+    , ribosome-host-test+    , tasty+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)   default-language: Haskell2010
+ test/Main.hs view
@@ -0,0 +1,29 @@+module Main where++import Polysemy.Test (unitTest)+import Ribosome.Test.BufferTest (test_bufferForFile)+import Ribosome.Test.MappingTest (test_mapping)+import Ribosome.Test.PersistTest (test_persist)+import Ribosome.Test.ScratchTest (test_scratch)+import Ribosome.Test.SettingTest (test_settings)+import Ribosome.Test.UndoTest (test_undo)+import Ribosome.Test.WatcherTest (test_varWatcher)+import Ribosome.Test.WindowTest (test_window)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+  testGroup "ribosome" [+    unitTest "buffer for file" test_bufferForFile,+    test_scratch,+    unitTest "mapping" test_mapping,+    unitTest "variable watcher" test_varWatcher,+    unitTest "persist" test_persist,+    test_window,+    test_settings,+    unitTest "undo" test_undo+  ]++main :: IO ()+main =+  defaultMain tests
+ test/Ribosome/Test/BufferTest.hs view
@@ -0,0 +1,24 @@+module Ribosome.Test.BufferTest where++import Path (relfile)+import qualified Polysemy.Test as Test+import Polysemy.Test (UnitTest, assert, assertEq, evalMaybe, (/==), (===))++import Ribosome.Api.Buffer (bufferCount, bufferForFile, bufferIsFile, edit)+import Ribosome.Data.FileBuffer (FileBuffer (FileBuffer))+import Ribosome.Host.Api.Effect (nvimGetCurrentBuf)+import Ribosome.Host.Test.Run (embedTest_)++test_bufferForFile :: UnitTest+test_bufferForFile =+  embedTest_ do+    file1 <- Test.tempFile [] [relfile|file.x|]+    file2 <- Test.tempFile [] [relfile|file.y|]+    edit file1+    edit file2+    assertEq 2 =<< bufferCount+    cb <- nvimGetCurrentBuf+    assert =<< bufferIsFile cb+    FileBuffer buf path <- evalMaybe =<< bufferForFile file1+    cb /== buf+    path === file1
+ test/Ribosome/Test/Error.hs view
@@ -0,0 +1,34 @@+-- |Combinators for aborting tests on Ribosome errors+module Ribosome.Test.Error where++import Polysemy.Test (TestError (TestError))++import Ribosome.Host.Data.Report (Reportable, mapReport, reportMessages)+import Ribosome.Host.Data.RpcHandler (Handler)++-- |Convert the effect @eff@ to @eff '!!' err@ and @'Error' 'TestError'@, failing the test when 'Stop' is used.+resumeTestError ::+  ∀ eff e r .+  Show e =>+  Members [eff !! e, Error TestError] r =>+  InterpreterFor eff r+resumeTestError =+  resumeHoistError (TestError . show)++-- |Convert a 'LogReport' from a 'Handler' to an @'Error' 'TestError'@, failing the test when 'Stop' is used.+testHandler ::+  Member (Error TestError) r =>+  Handler r a ->+  Sem r a+testHandler =+  stopToError . mapStop (TestError . reportMessages) . raiseUnder++-- |Reinterpret @'Stop' err@ to @'Error' 'TestError'@ if @err@ is an instance of 'Reportable'.+testError ::+  ∀ e r a .+  Reportable e =>+  Member (Error TestError) r =>+  Sem (Stop e : r) a ->+  Sem r a+testError =+  testHandler . mapReport . raiseUnder
+ test/Ribosome/Test/MappingTest.hs view
@@ -0,0 +1,65 @@+module Ribosome.Test.MappingTest where++import Conc (interpretSync)+import qualified Polysemy.Conc.Sync as Sync+import Polysemy.Test (UnitTest, assertJust, (===))+import Polysemy.Time (Seconds (Seconds))++import Ribosome.Api.Buffer (currentBufferContent)+import Ribosome.Data.Mapping (MapMode (MapNormal), Mapping)+import Ribosome.Data.ScratchOptions (ScratchOptions (ScratchOptions))+import qualified Ribosome.Effect.Scratch as Scratch+import Ribosome.Effect.Scratch (Scratch)+import Ribosome.Host.Api.Data (nvimFeedkeys, vimCallFunction)+import Ribosome.Host.Data.Execution (Execution (Sync))+import Ribosome.Host.Data.Report (resumeReport)+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Data.RpcHandler (Handler, RpcHandler)+import qualified Ribosome.Host.Effect.Rpc as Rpc+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Host.Handler (rpcCommand, rpcFunction)+import Ribosome.Mapping (mappingFor)+import Ribosome.Test.Wait (assertWait)+import Ribosome.Unit.Run (runTest, testHandlers)++target :: [Text]+target = ["line 1", "line 2"]++mappingHandler ::+  Members [Sync Int, Rpc !! RpcError] r =>+  Handler r ()+mappingHandler =+  void (Sync.putWait (Seconds 5) 13)++setupMappingScratch ::+  Member (Scratch !! RpcError) r =>+  Mapping ->+  Handler r ()+setupMappingScratch mapping = do+  resumeReport (void (Scratch.show target options))+  where+    options =+      ScratchOptions False True False True True True False Nothing Nothing Nothing [] [mapping] Nothing "mappo"++handlers ::+  ∀ r .+  Members [Sync Int, Scratch !! RpcError, Rpc !! RpcError] r =>+  [RpcHandler r]+handlers =+  [+    rpcFunction "Setup" Sync (setupMappingScratch m),+    mapRpc+  ]+  where+    m =+      mappingFor mapRpc "a" [MapNormal] Nothing mempty+    mapRpc =+      rpcCommand "Map" Sync mappingHandler++test_mapping :: UnitTest+test_mapping =+  runTest $ interpretSync $ testHandlers handlers mempty do+    () <- Rpc.sync (vimCallFunction @() "Setup" [])+    assertWait currentBufferContent (target ===)+    Rpc.notify (nvimFeedkeys "a" "x" False)+    assertJust (13 :: Int) =<< Sync.wait (Seconds 5)
+ test/Ribosome/Test/PathTest.hs view
@@ -0,0 +1,16 @@+module Ribosome.Test.PathTest where++import Path (reldir)+import qualified Polysemy.Test as Test+import Polysemy.Test (UnitTest, assertEq)++import Ribosome.Api.Path (nvimDir, nvimSetCwd)+import Ribosome.Host.Test.Run (embedTest_)+import Ribosome.Test.Error (testHandler)++test_nvimPath :: UnitTest+test_nvimPath =+  embedTest_ $ testHandler do+    dir <- Test.tempDir [reldir|path|]+    nvimSetCwd dir+    assertEq dir =<< nvimDir ""
+ test/Ribosome/Test/PersistTest.hs view
@@ -0,0 +1,31 @@+module Ribosome.Test.PersistTest where++import Path (reldir)+import qualified Polysemy.Test as Test+import Polysemy.Test (UnitTest, assertJust)++import qualified Ribosome.Effect.Persist as Persist+import Ribosome.Host.Test.Run (embedTest_)+import Ribosome.Interpreter.Persist (interpretPersist)+import Ribosome.Interpreter.PersistPath (interpretPersistPathAt)+import Ribosome.Test.Error (resumeTestError)++data Thing =+  Thing {+    number :: Int,+    name :: Text+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (FromJSON, ToJSON)++thing :: Thing+thing =+  Thing 13 "thingo"++test_persist :: UnitTest+test_persist =+  embedTest_ do+    dir <- Test.tempDir [reldir|persist|]+    interpretPersistPathAt False dir $ interpretPersist "thing" $ resumeTestError do+      Persist.store Nothing thing+      assertJust thing =<< Persist.load Nothing
+ test/Ribosome/Test/ScratchTest.hs view
@@ -0,0 +1,90 @@+module Ribosome.Test.ScratchTest where++import Polysemy.Test (UnitTest, assertEq, unitTest)+import Test.Tasty (TestTree, testGroup)++import Ribosome.Api.Buffer (currentBufferContent)+import Ribosome.Data.FloatOptions (FloatOptions (FloatOptions), FloatRelative (Cursor))+import Ribosome.Data.ScratchId (ScratchId)+import Ribosome.Data.ScratchOptions (ScratchOptions (ScratchOptions))+import qualified Ribosome.Effect.Scratch as Scratch+import Ribosome.Effect.Scratch (Scratch)+import Ribosome.Host.Api.Data (nvimCommand)+import Ribosome.Host.Api.Effect (vimCallFunction)+import Ribosome.Host.Data.Execution (Execution (Sync))+import Ribosome.Host.Data.Report (resumeReport)+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Data.RpcHandler (Handler, RpcHandler)+import qualified Ribosome.Host.Effect.Rpc as Rpc+import Ribosome.Host.Handler (rpcFunction)+import Ribosome.Test.Wait (assertWait)+import Ribosome.Unit.Run (runTestHandlers)++target :: [Text]+target = ["line 1", "line 2"]++name :: ScratchId+name =+  "buffi"++makeScratch ::+  Member (Scratch !! RpcError) r =>+  Handler r ()+makeScratch =+  resumeReport (void (Scratch.show target options))+  where+    options =+      ScratchOptions False True False True True True False Nothing Nothing Nothing [] [] Nothing name++floatOptions :: FloatOptions+floatOptions =+  FloatOptions Cursor 30 2 1 1 True def Nothing def False True (Just def) Nothing++makeFloatScratch ::+  Member (Scratch !! RpcError) r =>+  Handler r ()+makeFloatScratch =+  resumeReport (void (Scratch.show target options))+  where+    options =+      ScratchOptions False True False True True True False (Just floatOptions) Nothing (Just 0) [] [] Nothing name++scratchCount ::+  Member (Scratch !! RpcError) r =>+  Sem r Int+scratchCount =+  (-1) <! (length <$> Scratch.get)++handlers ::+  ∀ r .+  Member (Scratch !! RpcError) r =>+  [RpcHandler r]+handlers =+  [+    rpcFunction "MakeFloatScratch" Sync makeFloatScratch,+    rpcFunction "MakeScratch" Sync makeScratch+  ]++scratchTest :: Text -> UnitTest+scratchTest fun = do+  runTestHandlers handlers mempty do+    () <- vimCallFunction fun []+    assertWait scratchCount (assertEq (1 :: Int))+    assertWait currentBufferContent (assertEq target)+    Rpc.notify (nvimCommand "bdelete")+    assertWait scratchCount (assertEq 0)++test_regularScratch :: UnitTest+test_regularScratch = do+  scratchTest "MakeScratch"++test_floatScratch :: UnitTest+test_floatScratch = do+  scratchTest "MakeFloatScratch"++test_scratch :: TestTree+test_scratch =+  testGroup "scratch" [+    unitTest "regular window" test_regularScratch,+    unitTest "float window" test_floatScratch+  ]
+ test/Ribosome/Test/SettingTest.hs view
@@ -0,0 +1,56 @@+module Ribosome.Test.SettingTest where++import Exon (exon)+import Polysemy.Test (TestError (TestError), UnitTest, assertEq, unitTest, (===))+import Test.Tasty (TestTree, testGroup)++import Ribosome.Data.Setting (Setting (Setting))+import qualified Ribosome.Data.SettingError as SettingError+import Ribosome.Data.SettingError (SettingError)+import qualified Ribosome.Effect.Settings as Settings+import Ribosome.Effect.Settings (Settings)+import Ribosome.Host.Api.Effect (nvimSetVar)+import Ribosome.Test.Error (resumeTestError)+import Ribosome.Unit.Run (runTestRibosome)++setting :: Setting Int+setting =+  Setting "name" True Nothing++settingDefault :: Setting Int+settingDefault =+  Setting "name" True (Just 13)++test_settingUpdate :: UnitTest+test_settingUpdate =+  runTestRibosome do+    resumeTestError @Settings do+      Settings.update setting 5+      r <- Settings.get setting+      5 === r++test_settingUnset :: UnitTest+test_settingUnset =+  runTestRibosome do+    resumeEither @SettingError (Settings.get setting) >>= \case+      Left (SettingError.Unset _) -> unit+      Right _ -> throw "Unset setting didn't produce error"+      e -> throw (TestError [exon|Invalid setting error for unset: #{show e}|])+    assertEq 13 =<< resumeTestError @Settings (Settings.get settingDefault)++test_settingDecodeError :: UnitTest+test_settingDecodeError =+  runTestRibosome do+    nvimSetVar "test_name" (["text"] :: [Text])+    resumeEither @SettingError (Settings.get setting) >>= \case+      Left (SettingError.Decode _ _) -> unit+      Right _ -> throw "Invalid setting didn't produce error"+      e -> throw (TestError [exon|Invalid setting error for decode error: #{show e}|])++test_settings :: TestTree+test_settings =+  testGroup "settings" [+    unitTest "update" test_settingUpdate,+    unitTest "unset" test_settingUnset,+    unitTest "decode error" test_settingDecodeError+  ]
+ test/Ribosome/Test/UndoTest.hs view
@@ -0,0 +1,25 @@+module Ribosome.Test.UndoTest where++import Polysemy.Test (UnitTest, assertEq)++import Ribosome.Api.Buffer (currentBufferContent, setCurrentBufferContent)+import Ribosome.Api.Register (setregLine, unnamedRegister)+import Ribosome.Api.Window (setCurrentCursor)+import Ribosome.Host.Api.Effect (nvimCommand)+import Ribosome.Host.Test.Run (embedTest_)++test_undo :: UnitTest+test_undo =+  embedTest_ do+    setCurrentBufferContent orig+    setCurrentCursor 1 0+    setregLine unnamedRegister new+    nvimCommand "normal! p"+    assertEq (orig <> new) =<< currentBufferContent+    nvimCommand "undo"+    assertEq orig =<< currentBufferContent+  where+    orig =+      ["line1", "line2"]+    new =+      ["new1", "new2"]
+ test/Ribosome/Test/Wait.hs view
@@ -0,0 +1,53 @@+-- |Assertions that are made repeatedly until the succeed+module Ribosome.Test.Wait where++import Hedgehog.Internal.Property (Failure, failWith, liftTest, mkTest)+import qualified Conc+import Conc (interpretAtomic)+import Polysemy.Test (Hedgehog, liftH)+import qualified Polysemy.Time as Time+import Polysemy.Time (MilliSeconds (MilliSeconds), Seconds (Seconds))++-- |Run an action and make an assertion about its result.+-- Repeat on failure until the @timeout@ has been exceeded.+--+-- Sleeps for @interval@ between attempts.+assertWaitFor ::+  Monad m =>+  HasCallStack =>+  Members [Hedgehog m, Time t d, Race, Error Failure, Embed IO] r =>+  TimeUnit t1 =>+  TimeUnit t2 =>+  t1 ->+  t2 ->+  Sem r a ->+  (a -> Sem r b) ->+  Sem r b+assertWaitFor timeout interval acquire test =+  withFrozenCallStack do+    interpretAtomic Nothing do+      Conc.timeout_ timeoutError timeout spin+  where+    spin = do+      a <- raise acquire+      catch (raise (test a)) \ e -> do+        atomicPut (Just e)+        Time.sleep interval+        spin+    timeoutError =+      atomicGet >>= liftH . \case+        Just e -> liftTest (mkTest (Left e, mempty))+        Nothing -> failWith Nothing "timed out before an assertion was made"++-- |Run an action and make an assertion about its result.+-- Repeat on failure for three seconds, every 100 milliseconds.+assertWait ::+  Monad m =>+  HasCallStack =>+  Members [Hedgehog m, Time t d, Race, Error Failure, Embed IO] r =>+  Sem r a ->+  (a -> Sem r b) ->+  Sem r b+assertWait acquire test =+  withFrozenCallStack do+    assertWaitFor (Seconds 3) (MilliSeconds 100) acquire test
+ test/Ribosome/Test/WatcherTest.hs view
@@ -0,0 +1,35 @@+module Ribosome.Test.WatcherTest where++import Conc (interpretAtomic)+import Data.MessagePack (Object)+import Polysemy.Test (UnitTest, (===))++import Ribosome.Api.Autocmd (doautocmd)+import Ribosome.Host.Api.Effect (nvimSetVar)+import Ribosome.Host.Data.Report (Report)+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Test.Wait (assertWait)+import Ribosome.Unit.Run (runTest, testHandlers)++changed ::+  Members [AtomicState Int, Rpc !! RpcError, Stop Report] r =>+  Object ->+  Sem r ()+changed _ =+  atomicModify' (+ 1)++test_varWatcher :: UnitTest+test_varWatcher =+  runTest $ interpretAtomic 0 $ testHandlers mempty [("trigger", changed)] do+    nvimSetVar "trigger" (4 :: Int)+    doautocmd "CmdlineLeave"+    assertWait atomicGet ((1 :: Int) ===)+    nvimSetVar "trigger" (5 :: Int)+    doautocmd "CmdlineLeave"+    doautocmd "CmdlineLeave"+    doautocmd "CmdlineLeave"+    assertWait atomicGet ((2 :: Int) ===)+    nvimSetVar "trigger" (6 :: Int)+    doautocmd "CmdlineLeave"+    assertWait atomicGet ((3 :: Int) ===)
+ test/Ribosome/Test/WindowTest.hs view
@@ -0,0 +1,48 @@+module Ribosome.Test.WindowTest where++import Polysemy.Test (UnitTest, assertEq, unitTest, (===))+import Test.Tasty (TestTree, testGroup)++import Ribosome.Api.Window (ensureMainWindow)+import Ribosome.Host.Api.Data (Window)+import Ribosome.Host.Api.Effect (bufferSetOption, nvimCommand, vimGetCurrentBuffer, vimGetCurrentWindow, vimGetWindows)+import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Host.Test.Run (embedTest_)++setCurrentNofile ::+  Member Rpc r =>+  Sem r ()+setCurrentNofile = do+  buf <- vimGetCurrentBuffer+  bufferSetOption buf "buftype" (toMsgpack ("nofile" :: Text))++createNofile ::+  Member Rpc r =>+  Sem r Window+createNofile = do+  initialWindow <- vimGetCurrentWindow+  nvimCommand "new"+  setCurrentNofile+  pure initialWindow++test_findMainWindowExisting :: UnitTest+test_findMainWindowExisting =+  embedTest_ do+    initialWindow <- createNofile+    (initialWindow ===) =<< ensureMainWindow++test_findMainWindowCreate :: UnitTest+test_findMainWindowCreate =+  embedTest_ do+    setCurrentNofile+    void createNofile+    void ensureMainWindow+    assertEq 3 . length =<< vimGetWindows++test_window :: TestTree+test_window =+  testGroup "window" [+    unitTest "find existing" test_findMainWindowExisting,+    unitTest "find create" test_findMainWindowCreate+  ]
+ test/Ribosome/Unit/Run.hs view
@@ -0,0 +1,87 @@+module Ribosome.Unit.Run where++import Data.MessagePack (Object)+import Log (Severity (Trace))+import Polysemy.Test (TestError (TestError), UnitTest)++import Ribosome.Data.PluginName (PluginName)+import Ribosome.Effect.VariableWatcher (WatchedVariable)+import Ribosome.Effect.Scratch (Scratch)+import Ribosome.Effect.Settings (Settings)+import Ribosome.Embed (HandlerEffects, embedPlugin, interpretPluginEmbed)+import Ribosome.Host.Data.HostConfig (setStderr)+import Ribosome.Host.Data.Report (Report, reportMessages)+import Ribosome.Host.Data.RpcHandler (Handler, RpcHandler)+import Ribosome.Host.Effect.Handlers (Handlers)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Host.Error (resumeBootError)+import Ribosome.Host.Interpret (type (|>))+import Ribosome.Host.Interpreter.Handlers (interpretHandlers)+import Ribosome.Host.Test.Data.TestConfig (host)+import qualified Ribosome.Host.Test.Run as Host+import Ribosome.Host.Test.Run (TestStack)+import Ribosome.Interpreter.VariableWatcher (watchVariables)++type HandlerTestStack =+  HandlerEffects ++ Reader PluginName : TestStack++type EmbedEffects =+  [+    Stop Report,+    Scratch,+    Settings,+    Rpc+  ] |> Handlers !! Report++type PluginTestStack =+  EmbedEffects ++ HandlerTestStack++runTest ::+  HasCallStack =>+  Sem HandlerTestStack () ->+  UnitTest+runTest =+  Host.runTest .+  runReader "test" .+  interpretPluginEmbed++runTestTrace ::+  HasCallStack =>+  Sem HandlerTestStack () ->+  UnitTest+runTestTrace =+  Host.runTestConf def { host = setStderr Trace def } .+  runReader "test" .+  interpretPluginEmbed++testHandlers ::+  Members HandlerTestStack r =>+  [RpcHandler r] ->+  Map WatchedVariable (Object -> Handler r ()) ->+  InterpretersFor EmbedEffects r+testHandlers handlers vars =+  watchVariables vars .+  interpretHandlers handlers .+  embedPlugin .+  resumeBootError @Rpc .+  resumeBootError @Settings .+  resumeBootError @Scratch .+  stopToErrorWith (TestError . reportMessages) .+  insertAt @4++runTestHandlers ::+  HasCallStack =>+  [RpcHandler HandlerTestStack] ->+  Map WatchedVariable (Object -> Handler HandlerTestStack ()) ->+  Sem PluginTestStack () ->+  UnitTest+runTestHandlers handlers vars =+  runTest .+  testHandlers handlers vars++runTestRibosome ::+  HasCallStack =>+  Sem PluginTestStack () ->+  UnitTest+runTestRibosome =+  runTestHandlers mempty mempty