ribosome 0.3.0.1 → 0.4.0.0

raw patch · 102 files changed

+2721/−1072 lines, 102 filesdep +basedep +fuzzydep +hourglassdep −MissingHdep −base-nopreludedep ~aesondep ~ansi-terminaldep ~bytestring

Dependencies added: base, fuzzy, hourglass

Dependencies removed: MissingH, base-noprelude

Dependency ranges changed: aeson, ansi-terminal, bytestring, cereal, cereal-conduit, chiasma, composition, composition-extra, conduit, conduit-extra, containers, cornea, data-default, deepseq, directory, either, exceptions, filepath, free, hslogger, lens, lifted-async, lifted-base, messagepack, monad-control, monad-loops, mtl, nvim-hs, path, path-io, pretty-terminal, prettyprinter, 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

Files

• LICENSE +27/−48
• lib/Ribosome/Api/Atomic.hs +1/−1
• lib/Ribosome/Api/Autocmd.hs +47/−3
• lib/Ribosome/Api/Buffer.hs +78/−17
• lib/Ribosome/Api/Echo.hs +1/−1
• lib/Ribosome/Api/Exists.hs +1/−10
• lib/Ribosome/Api/Mode.hs +38/−0
• lib/Ribosome/Api/Normal.hs +25/−0
• lib/Ribosome/Api/Option.hs +19/−1
• lib/Ribosome/Api/Process.hs +0/−2
• lib/Ribosome/Api/Register.hs +79/−0
• lib/Ribosome/Api/Syntax.hs +23/−5
• lib/Ribosome/Api/Tabpage.hs +0/−2
• lib/Ribosome/Api/Undo.hs +10/−0
• lib/Ribosome/Api/Window.hs +45/−7
• lib/Ribosome/Config/Setting.hs +1/−8
• lib/Ribosome/Config/Settings.hs +4/−0
• lib/Ribosome/Control/Concurrent/Wait.hs +14/−18
• lib/Ribosome/Control/Exception.hs +17/−2
• lib/Ribosome/Control/Lock.hs +19/−10
• lib/Ribosome/Control/Monad/Ribo.hs +52/−22
• lib/Ribosome/Control/Ribosome.hs +2/−11
• lib/Ribosome/Control/StrictRibosome.hs +1/−3
• lib/Ribosome/Data/Conduit.hs +39/−4
• lib/Ribosome/Data/Conduit/Composition.hs +9/−11
• lib/Ribosome/Data/ErrorReport.hs +0/−3
• lib/Ribosome/Data/Errors.hs +4/−8
• lib/Ribosome/Data/FloatOptions.hs +73/−0
• lib/Ribosome/Data/List.hs +21/−0
• lib/Ribosome/Data/Mapping.hs +0/−3
• lib/Ribosome/Data/Maybe.hs +0/−7
• lib/Ribosome/Data/PersistError.hs +0/−2
• lib/Ribosome/Data/Register.hs +61/−0
• lib/Ribosome/Data/RegisterType.hs +50/−0
• lib/Ribosome/Data/RiboError.hs +22/−0
• lib/Ribosome/Data/ScratchOptions.hs +38/−19
• lib/Ribosome/Data/Setting.hs +4/−0
• lib/Ribosome/Data/SettingError.hs +0/−3
• lib/Ribosome/Data/Syntax.hs +1/−5
• lib/Ribosome/Data/WindowConfig.hs +13/−0
• lib/Ribosome/Error/Report.hs +11/−18
• lib/Ribosome/Error/Report/Class.hs +1/−8
• lib/Ribosome/File.hs +4/−8
• lib/Ribosome/Internal/IO.hs +4/−9
• lib/Ribosome/Internal/NvimObject.hs +1/−1
• lib/Ribosome/Log.hs +1/−5
• lib/Ribosome/Mapping.hs +8/−4
• lib/Ribosome/Menu/Action.hs +111/−0
• lib/Ribosome/Menu/Data/BasicMenuAction.hs +18/−0
• lib/Ribosome/Menu/Data/FilteredMenuItem.hs +12/−0
• lib/Ribosome/Menu/Data/Menu.hs +13/−9
• lib/Ribosome/Menu/Data/MenuAction.hs +19/−5
• lib/Ribosome/Menu/Data/MenuConfig.hs +8/−5
• lib/Ribosome/Menu/Data/MenuConsumer.hs +2/−2
• lib/Ribosome/Menu/Data/MenuConsumerAction.hs +11/−0
• lib/Ribosome/Menu/Data/MenuConsumerUpdate.hs +2/−2
• lib/Ribosome/Menu/Data/MenuEvent.hs +3/−3
• lib/Ribosome/Menu/Data/MenuItem.hs +9/−8
• lib/Ribosome/Menu/Data/MenuItemFilter.hs +7/−0
• lib/Ribosome/Menu/Data/MenuRenderEvent.hs +2/−2
• lib/Ribosome/Menu/Data/MenuUpdate.hs +3/−7
• lib/Ribosome/Menu/Nvim.hs +56/−10
• lib/Ribosome/Menu/Prompt.hs +17/−0
• lib/Ribosome/Menu/Prompt/Data/Codes.hs +6/−4
• lib/Ribosome/Menu/Prompt/Data/Prompt.hs +2/−2
• lib/Ribosome/Menu/Prompt/Data/PromptConfig.hs +30/−2
• lib/Ribosome/Menu/Prompt/Data/PromptEvent.hs +4/−0
• lib/Ribosome/Menu/Prompt/Data/PromptState.hs +0/−2
• lib/Ribosome/Menu/Prompt/Data/TextUpdate.hs +2/−0
• lib/Ribosome/Menu/Prompt/Nvim.hs +9/−8
• lib/Ribosome/Menu/Prompt/Run.hs +83/−31
• lib/Ribosome/Menu/Run.hs +114/−48
• lib/Ribosome/Menu/Simple.hs +258/−102
• lib/Ribosome/Msgpack/Decode.hs +92/−24
• lib/Ribosome/Msgpack/Encode.hs +28/−11
• lib/Ribosome/Msgpack/Error.hs +0/−3
• lib/Ribosome/Msgpack/NvimObject.hs +3/−7
• lib/Ribosome/Msgpack/Util.hs +20/−10
• lib/Ribosome/Nvim/Api/Data.hs +0/−2
• lib/Ribosome/Nvim/Api/Generate.hs +1/−8
• lib/Ribosome/Nvim/Api/GenerateData.hs +2/−6
• lib/Ribosome/Nvim/Api/GenerateIO.hs +0/−5
• lib/Ribosome/Nvim/Api/IO.hs +0/−2
• lib/Ribosome/Nvim/Api/RpcCall.hs +0/−4
• lib/Ribosome/Orphans.hs +105/−2
• lib/Ribosome/Persist.hs +2/−10
• lib/Ribosome/Plugin.hs +2/−8
• lib/Ribosome/Plugin/Builtin.hs +1/−3
• lib/Ribosome/Plugin/Mapping.hs +2/−4
• lib/Ribosome/Plugin/RpcHandler.hs +0/−1
• lib/Ribosome/Plugin/TH.hs +2/−5
• lib/Ribosome/Plugin/TH/Command.hs +146/−37
• lib/Ribosome/Plugin/TH/Handler.hs +20/−33
• lib/Ribosome/Plugin/Watch.hs +1/−3
• lib/Ribosome/Prelude.hs +60/−40
• lib/Ribosome/PreludeExport.hs +0/−19
• lib/Ribosome/Scratch.hs +188/−78
• lib/Ribosome/System/Time.hs +9/−2
• lib/Ribosome/Tmux/Run.hs +11/−5
• lib/Ribosome/Unsafe.hs +0/−9
• readme.md +91/−0
• ribosome.cabal +265/−190

@@ -1,55 +1,34 @@-# Blue Oak Model License--Version 1.0.0--## Purpose--This license gives everyone as much permission to work with-this software as possible, while protecting contributors-from liability.--## Acceptance--In order to receive this license, you must agree to its-rules.  The rules of this license are both obligations-under that agreement and conditions to your license.-You must not do anything with this software that triggers-a rule that you cannot or will not follow.--## Copyright--Each contributor licenses you to do everything with this-software that would otherwise infringe that contributor's-copyright in it.--## Notices--You must ensure that everyone who gets a copy of-any part of this software from you, with or without-changes, also gets the text of this license or a link to-<https://blueoakcouncil.org/license/1.0.0>.--## Excuse+Copyright (c) 2020 Torsten Schmits -If anyone notifies you in writing that you have not-complied with [Notices](#notices), you can keep your-license by taking all practical steps to comply within 30-days after the notice.  If you do not do so, your license-ends immediately.+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met: -## Patent+  1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+  disclaimer.+  2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+  disclaimer in the documentation and/or other materials provided with the distribution. -Each contributor licenses you to do everything with this-software that would otherwise infringe any patent claims-they can license or become able to license.+Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by: -## Reliability+  (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+  contributors, in source or binary form) alone; or+  (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+  copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+  be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution. -No contributor can revoke this license.+Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise. -## No Liability+DISCLAIMER -***As far as the law allows, this software comes as is,-without any warranty or condition, and no contributor-will be liable to anyone for any damages related to this-software or this license, under any kind of legal claim.***+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -39,7 +39,7 @@   check results status   where     call (RpcCall (F name) args) =-      toMsgpack [toMsgpack name, toMsgpack args]+      toMsgpack @[Object] [toMsgpack name, toMsgpack args]     unpack [ObjectArray results, status] =       return (results, status)     unpack o =

@@ -1,11 +1,55 @@ module Ribosome.Api.Autocmd where +import Control.Exception.Lifted (bracket)+ import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Nvim.Api.IO (vimCommand)+import Ribosome.Msgpack.Encode (toMsgpack)+import Ribosome.Nvim.Api.Data (Buffer)+import Ribosome.Nvim.Api.IO (bufferGetNumber, vimCommand, vimGetOption, vimSetOption)  doautocmd ::   NvimE e m =>+  Bool ->   Text ->   m ()-doautocmd name =-  vimCommand $ "doautocmd " <> name+doautocmd silent name =+  vimCommand $ pre <> "doautocmd " <> name+  where+    pre =+      if silent then "silent! " else ""++uautocmd ::+  NvimE e m =>+  Bool ->+  Text ->+  m ()+uautocmd silent name =+  doautocmd silent $ "User " <> name++eventignore ::+  NvimE e m =>+  MonadBaseControl IO m =>+  m a ->+  m a+eventignore =+  bracket getAndSet restore . const+  where+    getAndSet = do+      previous <- vimGetOption "eventignore"+      vimSetOption "eventignore" (toMsgpack ("all" :: Text))+      return previous+    restore =+      vimSetOption "eventignore"++bufferAutocmd ::+  NvimE e m =>+  Buffer ->+  Text ->+  Text ->+  Text ->+  m ()+bufferAutocmd buffer grp event cmd = do+  number <- bufferGetNumber buffer+  vimCommand $ "augroup " <> grp+  vimCommand $ "autocmd " <> " " <> event <> " <buffer=" <> show number <> "> " <> cmd+  vimCommand "augroup end"

@@ -1,8 +1,7 @@ module Ribosome.Api.Buffer where -import Control.Monad (when)-import Data.Bifunctor (second) import Data.MessagePack (Object)+import qualified Data.Text as Text (null) import System.FilePath ((</>))  import Ribosome.Api.Atomic (atomicAs)@@ -10,18 +9,23 @@ import Ribosome.Control.Monad.Ribo (NvimE) import Ribosome.Msgpack.Encode (toMsgpack) import Ribosome.Msgpack.Error (DecodeError)-import Ribosome.Nvim.Api.Data (Buffer, bufferGetName)+import Ribosome.Nvim.Api.Data (Buffer)+import qualified Ribosome.Nvim.Api.Data as ApiData (bufferGetName) import Ribosome.Nvim.Api.IO (   bufferGetLines,+  bufferGetName,   bufferGetNumber,+  bufferGetOption,   bufferIsValid,   bufferSetLines,+  nvimWinSetBuf,   vimCallFunction,   vimCommand,   vimGetBuffers,   vimGetCurrentBuffer,+  vimGetCurrentWindow,   )-import Ribosome.Nvim.Api.RpcCall (syncRpcCall)+import Ribosome.Nvim.Api.RpcCall (RpcError, syncRpcCall)  edit :: NvimE e m => FilePath -> m () edit path = vimCommand $ "silent! edit " <> toText path@@ -32,8 +36,9 @@  buflisted :: NvimE e m => Buffer -> m Bool buflisted buf = do-  num <- bufferGetNumber buf-  nvimCallBool "buflisted" [toMsgpack num]+  catchAs @RpcError False do+    num <- bufferGetNumber buf+    nvimCallBool "buflisted" [toMsgpack num]  bufferContent :: NvimE e m => Buffer -> m [Text] bufferContent buffer =@@ -47,6 +52,10 @@ 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]+ setCurrentBufferContent ::   NvimE e m =>   [Text] ->@@ -55,26 +64,51 @@   buffer <- vimGetCurrentBuffer   setBufferContent buffer content +withBufferNumber ::+  NvimE e m =>+  (Int -> m ()) ->+  Buffer ->+  m ()+withBufferNumber run buffer =+  whenM (bufferIsValid buffer) (run =<< bufferGetNumber buffer)+ closeBuffer ::   NvimE e m =>   Buffer ->   m ()-closeBuffer buffer = do-  valid <- bufferIsValid buffer-  when valid $ do-    number <- bufferGetNumber buffer-    vimCommand ("silent! bdelete! " <> show number)+closeBuffer =+  withBufferNumber del+  where+    del number =+      vimCommand ("silent! bdelete! " <> show number)  wipeBuffer ::   NvimE e m =>   Buffer ->   m ()-wipeBuffer buffer = do-  valid <- bufferIsValid buffer-  when valid $ do-    number <- bufferGetNumber buffer-    vimCommand ("silent! bwipeout! " <> show number)+wipeBuffer =+  withBufferNumber wipe+  where+    wipe number =+      vimCommand ("silent! bwipeout! " <> show number) +unloadBuffer ::+  NvimE e m =>+  Buffer ->+  m ()+unloadBuffer =+  withBufferNumber unload+  where+    unload number =+      vimCommand ("silent! bunload! " <> show number)++addBuffer ::+  NvimE e m =>+  Text ->+  m ()+addBuffer path =+  vimCommand ("badd " <> path)+ buffersAndNames ::   MonadIO m =>   MonadDeepError e DecodeError m =>@@ -82,7 +116,7 @@   m [(Buffer, Text)] buffersAndNames = do   buffers <- vimGetBuffers-  names <- atomicAs (syncRpcCall . bufferGetName <$> buffers)+  names <- atomicAs (syncRpcCall . ApiData.bufferGetName <$> buffers)   return (zip buffers names)  bufferForFile ::@@ -102,3 +136,30 @@       p     absolute dir path =       dir </> path++currentBufferName ::+  NvimE e m =>+  m Text+currentBufferName =+  bufferGetName =<< vimGetCurrentBuffer++setCurrentBuffer ::+  NvimE e m =>+  Buffer ->+  m ()+setCurrentBuffer buf = do+  win <- vimGetCurrentWindow+  nvimWinSetBuf win buf++bufferIsFile ::+  NvimE e m =>+  Buffer ->+  m Bool+bufferIsFile buf =+  Text.null <$> bufferGetOption buf "buftype"++bufferCount ::+  NvimE e m =>+  m Natural+bufferCount =+  fromIntegral . length <$> vimGetBuffers

@@ -41,6 +41,6 @@ echon =   echoWithName "echom" -echohl :: MonadRibo m => NvimE e m => Text -> m ()+echohl :: NvimE e m => Text -> m () echohl =   vimCommand . ("echohl " <>)

@@ -1,15 +1,7 @@ module Ribosome.Api.Exists where -import Control.Monad.IO.Class (MonadIO)-import Data.Default (Default(def))-import Data.Either (isRight) import Data.Text.Prettyprint.Doc (viaShow, (<+>))-import Neovim (-  AnsiStyle,-  Doc,-  NvimObject,-  Object(ObjectInt),-  )+import Neovim (AnsiStyle, Doc, Object(ObjectInt))  import Ribosome.Control.Monad.Ribo (NvimE) import Ribosome.Msgpack.Decode (MsgpackDecode, fromMsgpack)@@ -50,7 +42,6 @@ waitFor ::   NvimE e m =>   MonadIO m =>-  NvimObject b =>   m Object ->   (Object -> m (Either (Doc AnsiStyle) b)) ->   Retry ->

@@ -0,0 +1,38 @@+module Ribosome.Api.Mode where++import Ribosome.Control.Monad.Ribo (NvimE)+import Ribosome.Msgpack.Decode (MsgpackDecode(..), msgpackFromString)+import Ribosome.Nvim.Api.IO (vimCallFunction)++data NvimMode =+  Normal+  |+  Visual+  |+  Insert+  |+  Other Text+  deriving (Eq, Show)++instance IsString NvimMode where+  fromString "n" = Normal+  fromString "v" = Visual+  fromString "V" = Visual+  fromString "CTRL-V" = Visual+  fromString "i" = Insert+  fromString a = Other (toText a)++instance MsgpackDecode NvimMode where+  fromMsgpack = msgpackFromString "NvimMode"++mode ::+  NvimE e m =>+  m NvimMode+mode =+  vimCallFunction "mode" []++visualModeActive ::+  NvimE e m =>+  m Bool+visualModeActive =+  (== Visual) <$> mode

@@ -0,0 +1,25 @@+module Ribosome.Api.Normal where++import Ribosome.Control.Monad.Ribo (NvimE)+import Ribosome.Nvim.Api.IO (vimCommand)++normalm ::+  NvimE e m =>+  Text ->+  m ()+normalm cmd =+  vimCommand $ "normal " <> cmd++normal ::+  NvimE e m =>+  Text ->+  m ()+normal cmd =+  vimCommand $ "normal! " <> cmd++noautocmdNormal ::+  NvimE e m =>+  Text ->+  m ()+noautocmdNormal cmd =+  vimCommand $ "noautocmd normal! " <> cmd

@@ -1,8 +1,10 @@ module Ribosome.Api.Option where +import Control.Exception.Lifted (bracket) import Data.Text (splitOn)+ import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Msgpack.Encode (toMsgpack)+import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack)) import Ribosome.Nvim.Api.IO (vimGetOption, vimSetOption)  optionCat :: NvimE e m => Text -> Text -> m ()@@ -20,3 +22,19 @@ optionList name = do   s <- vimGetOption name   return $ splitOn "," s++withOption ::+  NvimE e m =>+  MsgpackEncode a =>+  MonadBaseControl IO m =>+  Text ->+  a ->+  m b ->+  m b+withOption name value =+  bracket set reset . const+  where+    set =+      vimGetOption name <* vimSetOption name (toMsgpack value)+    reset =+      vimSetOption name

@@ -1,7 +1,5 @@ module Ribosome.Api.Process where -import Control.Monad.DeepError (MonadDeepError)- import Ribosome.Control.Monad.Ribo (Nvim) import Ribosome.Nvim.Api.IO (vimCallFunction) import Ribosome.Nvim.Api.RpcCall (RpcError)

@@ -0,0 +1,79 @@+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 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)++starRegister :: Register+starRegister =+  Register.Special "*"++unnamedRegister :: Register+unnamedRegister =+  Register.Special "\""++setregAs ::+  NvimE e m =>+  MsgpackEncode a =>+  RegisterType ->+  Register ->+  a ->+  m ()+setregAs regType register text =+  vimCallFunction "setreg" [toMsgpack register, toMsgpack text, toMsgpack regType]++setreg ::+  NvimE e m =>+  Register ->+  Text ->+  m ()+setreg =+  setregAs RegisterType.Character++setregLine ::+  NvimE e m =>+  Register ->+  [Text] ->+  m ()+setregLine =+  setregAs RegisterType.Line++getregtype ::+  NvimE e m =>+  Register ->+  m RegisterType+getregtype register =+  vimCallFunction "getregtype" [toMsgpack register]++getregAs ::+  NvimE e m =>+  MsgpackDecode a =>+  Bool ->+  Register ->+  m a+getregAs list register =+  vimCallFunction "getreg" [toMsgpack register, toMsgpack (0 :: Int), toMsgpack list]++getreg ::+  NvimE e m =>+  Register ->+  m (Either [Text] Text)+getreg register =+  withType =<< getregtype register+  where+    withType RegisterType.Line =+      Left <$> getregAs True register+    withType _ =+      Right <$> getregAs False register++getregList ::+  NvimE e m =>+  Register ->+  m [Text]+getregList =+  getregAs True

@@ -1,8 +1,6 @@ module Ribosome.Api.Syntax where -import Data.Functor.Syntax ((<$$>))-import Data.Map (Map)-import qualified Data.Map as Map (toList)+import qualified Data.Map.Strict as Map (toList) import Data.MessagePack (Object) import Neovim.Plugin.Classes (FunctionName(F)) @@ -18,7 +16,7 @@ import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack)) import Ribosome.Msgpack.Error (DecodeError) import Ribosome.Nvim.Api.Data (Window)-import Ribosome.Nvim.Api.IO (nvimWinGetNumber)+import Ribosome.Nvim.Api.IO (nvimWinGetNumber, vimCallFunction, vimGetCurrentWindow, vimSetCurrentWindow) import Ribosome.Nvim.Api.RpcCall (RpcCall(RpcCall))  joinEquals :: Map Text Text -> Text@@ -75,6 +73,14 @@ executeSyntax =   atomic . (rpcCommand <$$> syntaxCmds) +executeCurrentWindowSyntax ::+  MonadDeepError e DecodeError m =>+  NvimE e m =>+  Syntax ->+  m [Object]+executeCurrentWindowSyntax syntax =+  atomic $ rpcCommand <$> syntaxCmds syntax+ executeWindowSyntax ::   MonadDeepError e DecodeError m =>   NvimE e m =>@@ -82,8 +88,20 @@   Syntax ->   m [Object] executeWindowSyntax win syntax = do+  previous <- vimGetCurrentWindow   number <- nvimWinGetNumber win-  atomic $ wrapCmd (show number <> "windo") <$> syntaxCmds syntax+  exec number <* vimSetCurrentWindow previous   where+    exec number =+      atomic $ wrapCmd (show number <> "windo") <$> syntaxCmds syntax     wrapCmd wrap cmd =       rpcCommand (wrap : cmd)++syntaxName ::+  NvimE e m =>+  Int ->+  Int ->+  m (Text, Text)+syntaxName l c = do+  synId <- vimCallFunction "synID" (toMsgpack <$> [l, c, 0])+  tuple (vimCallFunction "getline" [toMsgpack l]) (vimCallFunction "synIDattr" [synId, toMsgpack ("name" :: Text)])

@@ -1,7 +1,5 @@ module Ribosome.Api.Tabpage where -import Control.Monad (when)- import Ribosome.Control.Monad.Ribo (NvimE) import Ribosome.Nvim.Api.Data (Tabpage) import Ribosome.Nvim.Api.IO (nvimTabpageGetNumber, tabpageIsValid, vimCommand)

@@ -0,0 +1,10 @@+module Ribosome.Api.Undo where++import Ribosome.Control.Monad.Ribo (NvimE)+import Ribosome.Nvim.Api.IO (vimCommand)++undo ::+  NvimE e m =>+  m ()+undo =+  vimCommand "undo"

@@ -1,15 +1,17 @@ module Ribosome.Api.Window where -import Control.Monad (when)- import Ribosome.Control.Monad.Ribo (NvimE) import Ribosome.Nvim.Api.Data (Window) import Ribosome.Nvim.Api.IO (+  nvimBufGetOption,   nvimGetCurrentWin,   nvimWinClose,+  nvimWinGetBuf,   nvimWinGetCursor,   nvimWinSetCursor,   vimCommand,+  vimGetWindows,+  vimSetCurrentWindow,   windowIsValid,   ) @@ -19,7 +21,8 @@   m () closeWindow window = do   valid <- windowIsValid window-  when valid $ nvimWinClose window True+  last' <- (1 ==) . length <$> vimGetWindows+  when (valid && not last') $ nvimWinClose window True  cursor ::   NvimE e m =>@@ -27,7 +30,7 @@   m (Int, Int) cursor window = do   (line, col) <- nvimWinGetCursor window-  return (fromIntegral line - 1, fromIntegral col)+  return (line - 1, col)  currentCursor ::   NvimE e m =>@@ -57,6 +60,15 @@ setCursor window line col =   nvimWinSetCursor window (line + 1, col) +setCurrentCursor ::+  NvimE e m =>+  Int ->+  Int ->+  m ()+setCurrentCursor line col = do+  window <- nvimGetCurrentWin+  setCursor window line col+ setLine ::   NvimE e m =>   Window ->@@ -69,12 +81,38 @@   NvimE e m =>   Int ->   m ()-setCurrentLine line = do-  window <- nvimGetCurrentWin-  setLine window line+setCurrentLine line =+  setCurrentCursor line 0  redraw ::   NvimE e m =>   m () redraw =   vimCommand "silent! redraw!"++-- |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)+findMainWindow =+  listToMaybe <$> (filterM isFile =<< vimGetWindows)+  where+    isFile w = do+      buf <- nvimWinGetBuf w+      (("" :: Text) ==) <$> nvimBufGetOption buf "buftype"++-- |Create a new window at the top if no existing window has empty 'buftype'.+-- Focuses the window.+ensureMainWindow ::+  NvimE e m =>+  m Window+ensureMainWindow =+  maybe create focus =<< findMainWindow+  where+    create = do+      vimCommand "aboveleft new"+      win <- nvimGetCurrentWin+      vimCommand "wincmd K"+      return win+    focus w =+      w <$ vimSetCurrentWindow w

@@ -1,12 +1,5 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Config.Setting where -import Control.Monad.DeepError (MonadDeepError(throwHoist), catchAt)-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Trans.Except (runExceptT)-import Data.DeepPrisms (deepPrisms)- import Ribosome.Control.Monad.Ribo (MonadRibo, Nvim, NvimE, pluginName) import Ribosome.Data.Setting (Setting(Setting)) import Ribosome.Data.SettingError (SettingError)@@ -72,7 +65,7 @@   (rightToMaybe <$>) . runExceptT . setting @SettingOrError  updateSetting ::-  (MonadRibo m, MonadIO m, Nvim m, MonadDeepError e RpcError m, MsgpackEncode a) =>+  (MonadRibo m, Nvim m, MonadDeepError e RpcError m, MsgpackEncode a) =>   Setting a ->   a ->   m ()

@@ -7,3 +7,7 @@  tmuxSocket :: Setting FilePath tmuxSocket = Setting "tmux_socket" True Nothing++menuCloseFloats :: Setting Bool+menuCloseFloats =+  Setting "ribosome_menu_close_floats" False (Just True)

@@ -1,10 +1,6 @@ module Ribosome.Control.Concurrent.Wait where -import Control.Exception.Lifted (Exception, SomeException(..), try)-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Trans.Control (MonadBaseControl)-import Data.Default (Default(def))-import Data.Functor ((<&>))+import Control.Exception.Lifted (try) import qualified Text.Show  import Ribosome.System.Time (sleep)@@ -15,21 +11,21 @@   deriving Show  instance Default Retry where-  def = Retry 30 0.1+  def = Retry 20 0.25  -- |Error description for 'waitIO'-data WaitError =+data WaitError e =   NotStarted   |-  ConditionUnmet Text+  ConditionUnmet e   |-  ∀ e. Exception e => Thrown e+  ∀ excp. Exception excp => Thrown excp -instance Text.Show.Show WaitError where+instance Show e => Show (WaitError e) where   show NotStarted =     "NotStarted"   show (ConditionUnmet reason) =-    toString $ "ConditionUnmet(" <> reason <> ")"+    "ConditionUnmet(" <> show reason <> ")"   show (Thrown _) =     "Thrown" @@ -41,8 +37,8 @@   MonadBaseControl IO m =>   Retry ->   m a ->-  (a -> m (Either Text b)) ->-  m (Either WaitError b)+  (a -> m (Either e b)) ->+  m (Either (WaitError e) b) waitIO (Retry maxRetry interval) thunk cond =   wait maxRetry (Left NotStarted)   where@@ -72,8 +68,8 @@   MonadIO m =>   MonadBaseControl IO m =>   m a ->-  (a -> m (Either Text b)) ->-  m (Either WaitError b)+  (a -> m (Either e b)) ->+  m (Either (WaitError e) b) waitIODef =   waitIO def @@ -84,13 +80,13 @@   Retry ->   m a ->   (a -> m Bool) ->-  m (Either WaitError a)+  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"+      False -> Left ("predicate returned False" :: Text)  -- |Calls 'waitIOPred' with the default configuration of 30 retries every 100ms. waitIOPredDef ::@@ -98,6 +94,6 @@   MonadBaseControl IO m =>   m a ->   (a -> m Bool) ->-  m (Either WaitError a)+  m (Either (WaitError Text) a) waitIOPredDef =   waitIOPred def

@@ -1,7 +1,6 @@ module Ribosome.Control.Exception where -import Control.Exception.Lifted (IOException, try)-import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Exception.Lifted (IOException, catch, try)  tryIO ::   MonadBaseControl IO m =>@@ -16,3 +15,19 @@   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

@@ -2,28 +2,25 @@  import Control.Exception.Lifted (finally) import qualified Control.Lens as Lens (at, view)-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Trans.Control (MonadBaseControl)-import qualified Data.Map as Map (insert)-import UnliftIO.STM (TMVar, newTMVarIO, tryPutTMVar, tryTakeTMVar)+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, MonadIO m) => m Locks+getLocks :: MonadRibo m => m Locks getLocks =   pluginInternalL Ribosome.locks -inspectLocks :: (MonadRibo m, MonadIO m) => (Locks -> a) -> m a+inspectLocks :: MonadRibo m => (Locks -> a) -> m a inspectLocks = (<$> getLocks)  modifyLocks :: MonadRibo m => (Locks -> Locks) -> m () modifyLocks =   pluginInternalModifyL Ribosome.locks -getOrCreateLock :: (MonadRibo m, MonadIO m) => Text -> m (TMVar ())+getOrCreateLock :: MonadRibo m => Text -> m (TMVar ()) getOrCreateLock key = do   currentLock <- inspectLocks $ Lens.view $ Lens.at key   case currentLock of@@ -35,7 +32,6 @@  lockOrSkip ::   MonadRibo m =>-  MonadIO m =>   MonadBaseControl IO m =>   Text ->   m () ->@@ -45,7 +41,20 @@   currentState <- atomically $ tryTakeTMVar currentLock   case currentState of     Just _ -> do-      Log.debug $ "locking MVar `" <> key <> "`"+      Log.debug $ "locking TMVar `" <> key <> "`"       finally thunk $ atomically $ tryPutTMVar currentLock ()-      Log.debug $ "unlocking MVar `" <> key <> "`"+      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 <> "`"

@@ -1,29 +1,20 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE UndecidableInstances #-}  module Ribosome.Control.Monad.Ribo where -import Control.Concurrent.STM.TMVar (putTMVar, readTMVar, takeTMVar) 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 Control.Monad.Fail (MonadFail)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Reader.Class (MonadReader, asks)-import Control.Monad.Trans.Control (MonadBaseControl(..))-import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)+import qualified Control.Monad.Reader as ReaderT import Control.Monad.Trans.Free (FreeT)-import Control.Monad.Trans.Reader (ReaderT(ReaderT), runReaderT)-import Control.Monad.Trans.Resource (runResourceT)+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.Plugin.RpcHandler (RpcHandler(..))-import UnliftIO.STM (TMVar)  import Ribosome.Control.Ribosome (Ribosome, RibosomeInternal, RibosomeState) import qualified Ribosome.Control.Ribosome as Ribosome (_errors, errors, name, state)@@ -34,6 +25,7 @@ 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) @@ -51,13 +43,12 @@  newtype Ribo s e a =   Ribo { unRibo :: ExceptT e (RNeovim s) a }-  deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask, MonadFail, MonadBase IO)+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask, MonadFail, MonadBase IO) -deriving instance MonadError e (Ribo s e)+deriving newtype instance MonadError e (Ribo s e)  modifyTMVar ::   MonadIO m =>-  MonadBaseControl IO m =>   (a -> a) ->   TMVar a ->   m a@@ -80,13 +71,13 @@     restore a =       a <$ (atomically . putTMVar tmvar $ a) -deriving instance MonadReader (Ribosome s) (Ribo s e)+deriving newtype instance MonadReader (Ribosome s) (Ribo s e)  riboStateVar ::   MonadReader (Ribosome s) m =>   m (TMVar (RibosomeState s)) riboStateVar =-  asks (Lens.view Ribosome.state)+  ReaderT.asks (Lens.view Ribosome.state)  public ::   DeepLenses s s' =>@@ -128,16 +119,16 @@  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 liftBaseWith #-}     {-# INLINABLE restoreM #-} +instance MonadResource (Ribo s e) where+    liftResourceT = Ribo . liftResourceT+ instance RpcHandler e (Ribosome s) (Ribo s e) where   native = runRiboE @@ -155,6 +146,16 @@ 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@@ -176,10 +177,10 @@  instance MonadRibo (RNeovim s) where   pluginName =-    asks (Lens.view Ribosome.name)+    ReaderT.asks (Lens.view Ribosome.name)    pluginInternal =-    Lens.view RibosomeState.internal <$$> atomically . readTMVar =<< asks (Lens.view Ribosome.state)+    Lens.view RibosomeState.internal <$$> atomically . readTMVar =<< ReaderT.asks (Lens.view Ribosome.state)    pluginInternalModify f =     void . modifyTMVar (Lens.over RibosomeState.internal f) =<< riboStateVar@@ -216,6 +217,35 @@ 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 .

@@ -1,16 +1,7 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveAnyClass #-}- module Ribosome.Control.Ribosome where -import Control.Lens (makeClassy)-import Control.Monad.IO.Class (MonadIO)-import Data.Default (Default(def))-import Data.Functor.Syntax ((<$$>))-import Data.Map (Map) import Data.MessagePack (Object)-import GHC.Generics (Generic)-import UnliftIO.STM (TMVar, TMVar, newTMVarIO)+import Prelude hiding (state)  import Path (Abs, Dir, Path) import Ribosome.Data.Errors (Errors)@@ -49,7 +40,7 @@  newRibosomeTMVar :: MonadIO m => s -> m (TMVar (RibosomeState s)) newRibosomeTMVar s =-  newTMVarIO (RibosomeState def s)+  liftIO $ newTMVarIO (RibosomeState def s)  newRibosome :: MonadIO m => Text -> s -> m (Ribosome s) newRibosome name' =

@@ -1,8 +1,6 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Control.StrictRibosome where -import Control.Lens (makeClassy)+import Prelude hiding (state)  import Ribosome.Control.Ribosome (RibosomeState) 

@@ -1,11 +1,11 @@ module Ribosome.Data.Conduit where -import Conduit (ConduitT, runConduit, yield, (.|))+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.Concurrent.STM.TMVar (TMVar, newTMVar) import Control.Exception.Lifted (bracket, finally)-import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Control (embed) import qualified Data.Conduit.Combinators as Conduit (mapM_)  import Ribosome.Control.Monad.Ribo (modifyTMVar)@@ -38,13 +38,48 @@  sourceTerminated ::   MonadIO m =>-  MonadBaseControl IO 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 =>

@@ -14,9 +14,7 @@ import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.Cereal as C import qualified Data.Conduit.List as CL-import Data.Foldable (forM_) import Data.Serialize-import GHC.Exts (Constraint) import Prelude hiding (get, put) import System.Directory (removeFile) import System.IO@@ -41,7 +39,7 @@ -- >>> buffer 1 (CL.sourceList [1,2,3]) CL.consume -- [1,2,3] buffer :: (CCatable c1 c2 c3, CRunnable c3, RunConstraints c3 m)-          => Int -- ^ Size of the bounded queue in memory.+          => Natural -- ^ Size of the bounded queue in memory.           -> c1 () x m ()           -> c2 x Void m r           -> m r@@ -116,7 +114,7 @@   --   -- >>> runCConduit $ buffer' 1 (CL.sourceList [1,2,3]) CL.consume   -- [1,2,3]-  buffer' :: Int -- ^ Size of the bounded queue in memory+  buffer' :: Natural -- ^ Size of the bounded queue in memory              -> c1 i x m ()              -> c2 x o m r              -> c3 i o m r@@ -134,8 +132,8 @@ -- -- >>> 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, MonadIO m, MonadResource m, MonadThrow m)-                => Int -- ^ Size of the bounded queue in memory+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 ()@@ -166,7 +164,7 @@ -- :} -- "012" bufferToFile' :: (CFConduitLike c1, CFConduitLike c2, Serialize x)-                 => Int -- ^ Size of the bounded queue in memory+                 => 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 ()@@ -251,7 +249,7 @@ -- a buffering queue between them. data CConduit i o m r where   Single :: ConduitT i o m r -> CConduit i o m r-  Multiple :: Int -> ConduitT i x m () -> CConduit x 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 ()@@ -294,8 +292,8 @@ -- 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 :: Int -> ConduitT i x m () -> CFConduit x o m r -> CFConduit i o m r-  FMultipleF :: (Serialize x) => Int -> Maybe Int -> FilePath -> ConduitT i x m () -> CFConduit x 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@@ -333,7 +331,7 @@  -- 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, MonadIO m, MonadResource m, MonadThrow m) => ConduitT () i m () -> Async x -> CFConduit i Void m r -> m r+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.

@@ -1,5 +1,3 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Data.ErrorReport(   ErrorReport(..),   user,@@ -7,7 +5,6 @@   priority, ) where -import Control.Lens (makeClassy) import System.Log (Priority)  data ErrorReport =

@@ -1,5 +1,3 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Data.Errors(   ComponentName(..),   Errors(..),@@ -9,11 +7,8 @@   report, ) where -import Control.Lens (makeClassy)-import Data.Default (Default)-import Data.Map (Map)-import qualified Data.Map as Map (toList)-import Data.Text.Prettyprint.Doc (Doc, Pretty(..), align, line, vsep, (<+>), (<>))+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))@@ -39,7 +34,8 @@   Errors {     _componentErrors :: Map ComponentName [Error]     }-  deriving (Eq, Show, Default)+  deriving (Eq, Show)+  deriving newtype Default  makeClassy ''Errors 

@@ -0,0 +1,73 @@+module Ribosome.Data.FloatOptions where++import qualified Data.Map as Map++import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))++data FloatRelative =+  Editor+  |+  Win+  |+  Cursor+  deriving (Eq, Show)++instance MsgpackEncode FloatRelative where+  toMsgpack Editor = toMsgpack ("editor" :: Text)+  toMsgpack Win = toMsgpack ("win" :: Text)+  toMsgpack Cursor = toMsgpack ("cursor" :: Text)++instance Default FloatRelative where+  def = Cursor++data FloatAnchor =+  NW+  |+  NE+  |+  SW+  |+  SE+  deriving (Eq, Show)++instance MsgpackEncode FloatAnchor where+  toMsgpack NW = toMsgpack ("NW" :: Text)+  toMsgpack NE = toMsgpack ("NE" :: Text)+  toMsgpack SW = toMsgpack ("SW" :: Text)+  toMsgpack SE = toMsgpack ("SE" :: Text)++instance Default FloatAnchor where+  def = NW++data FloatOptions =+  FloatOptions {+    relative :: FloatRelative,+    width :: Int,+    height :: Int,+    row :: Int,+    col :: Int,+    focusable :: Bool,+    anchor :: FloatAnchor,+    bufpos :: Maybe (Int, Int)+  }+  deriving (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)+        ]++instance Default FloatOptions where+  def =+    FloatOptions def 30 10 1 1 False def def

@@ -0,0 +1,21 @@+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]

@@ -1,8 +1,5 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Data.Mapping where -import Data.DeepPrisms (deepPrisms) import Data.MessagePack (Object) import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport)) import Ribosome.Error.Report.Class (ReportError(..))

@@ -1,7 +0,0 @@-module Ribosome.Data.Maybe(-  orElse,-) where--orElse :: Maybe a -> Maybe a -> Maybe a-orElse fallback Nothing = fallback-orElse _ a = a

@@ -1,5 +1,3 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Data.PersistError where  import System.Log (Priority(INFO, NOTICE, ERROR))

@@ -0,0 +1,61 @@+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 Ribosome.Msgpack.Decode (MsgpackDecode(..), msgpackFromString)+import Ribosome.Msgpack.Encode (MsgpackEncode(..))++data Register =+  Named Text+  |+  Numbered Text+  |+  Special Text+  |+  Empty+  deriving (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++instance MsgpackDecode Register where+  fromMsgpack = msgpackFromString "Register"++instance MsgpackEncode Register where+  toMsgpack (Named a) =+    toMsgpack a+  toMsgpack (Numbered a) =+    toMsgpack a+  toMsgpack (Special a) =+    toMsgpack a+  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"++registerRepr :: Register -> Text+registerRepr (Named a) =+  "\"" <> a+registerRepr (Numbered a) =+  "\"" <> a+registerRepr (Special a) =+  "\"" <> a+registerRepr Empty =+  ""

@@ -0,0 +1,50 @@+module Ribosome.Data.RegisterType where++import Data.Text.Prettyprint.Doc (Pretty(..))++import Ribosome.Msgpack.Decode (MsgpackDecode(..), msgpackFromString)+import Ribosome.Msgpack.Encode (MsgpackEncode(..))++data RegisterType =+  Character+  |+  Line+  |+  Block+  |+  BlockWidth Int+  |+  Unknown Text+  deriving (Eq, Show)++instance IsString RegisterType where+  fromString "v" =+    Character+  fromString "V" =+    Line+  fromString a@('c' : 'v' : _) =+    Unknown (toText a)+  fromString a =+    Unknown (toText a)++instance MsgpackDecode RegisterType where+  fromMsgpack = msgpackFromString "RegisterType"++instance MsgpackEncode RegisterType where+  toMsgpack Character =+    toMsgpack ("v" :: Text)+  toMsgpack Line =+    toMsgpack ("V" :: Text)+  toMsgpack Block =+    toMsgpack ("b" :: Text)+  toMsgpack (BlockWidth width) =+    toMsgpack ("b" <> show width :: Text)+  toMsgpack (Unknown _) =+    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

@@ -0,0 +1,22 @@+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

@@ -1,39 +1,58 @@ module Ribosome.Data.ScratchOptions where -import Data.Default (Default(def))+import Control.Lens (set)+import Prelude hiding (modify) +import Ribosome.Data.FloatOptions (FloatOptions) import Ribosome.Data.Mapping (Mapping) import Ribosome.Data.Syntax (Syntax)  data ScratchOptions =   ScratchOptions {-    tab :: Bool,-    vertical :: Bool,-    wrap :: Bool,-    focus :: Bool,-    resize :: Bool,-    bottom :: Bool,-    size :: Maybe Int,-    maxSize :: Maybe Int,-    syntax :: [Syntax],-    mappings :: [Mapping],-    name :: Text+    _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   }+  deriving (Eq, Show) +makeClassy ''ScratchOptions+ defaultScratchOptions :: Text -> ScratchOptions-defaultScratchOptions = ScratchOptions False False False False True True Nothing Nothing [] []+defaultScratchOptions = ScratchOptions False False False False True True False Nothing Nothing Nothing [] []  instance Default ScratchOptions where   def = defaultScratchOptions "scratch"  scratchFocus :: ScratchOptions -> ScratchOptions-scratchFocus so =-  so { focus = True }+scratchFocus =+  set focus True  scratchSyntax :: [Syntax] -> ScratchOptions -> ScratchOptions-scratchSyntax syn so =-  so { syntax = syn }+scratchSyntax =+  set syntax  scratchMappings :: [Mapping] -> ScratchOptions -> ScratchOptions-scratchMappings maps so =-  so { mappings = maps }+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

@@ -6,3 +6,7 @@     prefix :: Bool,     fallback :: Maybe a   }++data GSetting a where+  SettingWithoutDefault :: Text -> Bool -> GSetting a+  SettingWithDefault :: Text -> Bool -> a -> GSetting a

@@ -1,8 +1,5 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Data.SettingError where -import Data.DeepPrisms (deepPrisms) import Data.Text.Prettyprint.Doc (Doc) import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle) import System.Log (Priority(NOTICE))

@@ -1,10 +1,6 @@-{-# LANGUAGE DeriveAnyClass #-}- module Ribosome.Data.Syntax where -import Data.Default (Default(def))-import Data.Map (Map)-import qualified Data.Map as Map (fromList)+import qualified Data.Map.Strict as Map (fromList)  data SyntaxItemDetail =   Keyword {

@@ -0,0 +1,13 @@+module Ribosome.Data.WindowConfig where++import Ribosome.Msgpack.Decode (MsgpackDecode)+import Ribosome.Msgpack.Encode (MsgpackEncode)++data WindowConfig =+  WindowConfig {+     relative :: Text,+     focusable :: Bool,+     external :: Bool+  }+  deriving (Eq, Show, Generic)+  deriving anyclass (MsgpackEncode, MsgpackDecode)

@@ -1,13 +1,7 @@ module Ribosome.Error.Report where -import Control.Monad ((<=<))-import Control.Monad.Error.Class (MonadError)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Except (runExceptT)-import Data.Foldable (traverse_)-import Data.Functor (void)-import qualified Data.Map as Map (alter)-import Data.Text.Prettyprint.Doc (line, pretty, (<>))+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)) @@ -29,13 +23,13 @@     alter Nothing = Just [err]     alter (Just current) = Just (err:current) -storeError :: (MonadRibo m, MonadIO m) => Text -> ErrorReport -> m ()+storeError :: MonadRibo m => Text -> ErrorReport -> m () storeError name e = do   time <- epochSeconds   Ribo.modifyErrors $ storeError' time name e  logErrorReport ::-  (MonadRibo m, NvimE e m, MonadIO m) =>+  (MonadRibo m, NvimE e m) =>   ErrorReport ->   m () logErrorReport (ErrorReport user logMsgs prio) = do@@ -44,7 +38,7 @@   when (prio >= NOTICE) (echom user)  processErrorReport ::-  (MonadRibo m, NvimE e m, MonadIO m) =>+  (MonadRibo m, NvimE e m) =>   Text ->   ErrorReport ->   m ()@@ -53,7 +47,7 @@   logErrorReport report  processErrorReport' ::-  (MonadRibo m, Nvim m, MonadIO m) =>+  (MonadRibo m, Nvim m) =>   Text ->   ErrorReport ->   m ()@@ -61,7 +55,7 @@   void . runExceptT @RpcError . processErrorReport name  reportErrorWith ::-  (MonadRibo m, NvimE e m, MonadIO m) =>+  (MonadRibo m, NvimE e m) =>   Text ->   (a -> ErrorReport) ->   a ->@@ -72,7 +66,6 @@ reportError ::   MonadRibo m =>   NvimE e m =>-  MonadIO m =>   ReportError a =>   Text ->   a ->@@ -81,7 +74,7 @@   reportErrorWith name errorReport  reportErrorOr ::-  (MonadRibo m, NvimE e m, MonadIO m, ReportError e) =>+  (MonadRibo m, NvimE e m, ReportError e) =>   Text ->   (a -> m ()) ->   Either e a ->@@ -90,7 +83,7 @@   either $ reportError name  reportErrorOr_ ::-  (MonadError RpcError m, MonadRibo m, NvimE e m, MonadIO m, ReportError e) =>+  (MonadRibo m, NvimE e m, ReportError e) =>   Text ->   m () ->   Either e a ->@@ -100,7 +93,7 @@  reportError' ::   ∀ e m a .-  (MonadRibo m, Nvim m, MonadIO m, ReportError e) =>+  (MonadRibo m, Nvim m, ReportError e) =>   Text ->   Either e a ->   m ()@@ -109,7 +102,7 @@ reportError' componentName (Left e) =   void $ runExceptT @RpcError $ reportError componentName e -printAllErrors :: (MonadRibo m, NvimE e m, MonadIO m) => m ()+printAllErrors :: MonadRibo m => m () printAllErrors = do   errors <- Ribo.getErrors   liftIO $ putDoc (pretty errors <> line)

@@ -1,14 +1,7 @@ module Ribosome.Error.Report.Class where  import qualified Data.Text as Text (pack)-import GHC.Generics (-  Generic,-  K1(..),-  M1(..),-  Rep,-  from,-  (:+:)(..),-  )+import GHC.Generics (K1(..), M1(..), Rep, from, (:+:)(..)) import System.Log.Logger (Priority(NOTICE, DEBUG))  import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))

@@ -1,15 +1,11 @@-module Ribosome.File(-  canonicalPathWithHome,-  canonicalPath,-  canonicalPaths,-) where+module Ribosome.File where -import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.String.Utils (replace)+import qualified Data.Text as Text import System.Directory (canonicalizePath, getHomeDirectory)  canonicalPathWithHome :: FilePath -> FilePath -> FilePath-canonicalPathWithHome = replace "~"+canonicalPathWithHome home path =+  toString (Text.replace "~" (toText home) (toText path))  canonicalPath :: MonadIO m => FilePath -> m FilePath canonicalPath path = do

@@ -1,24 +1,19 @@-module Ribosome.Internal.IO(-  retypeNeovim,-  forkNeovim,-) where+module Ribosome.Internal.IO where  import Control.Concurrent (forkIO)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Reader (ask, runReaderT, withReaderT) import Control.Monad.Trans.Resource (runResourceT)-import Data.Functor (void) 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 ask+  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 ask+  env <- Neovim ReaderT.ask   _ <- liftIO $ forkIO $ void $ runNeovim env thunk   return ()

@@ -1,6 +1,6 @@ module Ribosome.Internal.NvimObject where -import Data.Map (Map, (!?))+import Data.Map.Strict ((!?)) import Data.Text.Prettyprint.Doc (pretty, (<+>)) import Neovim (AnsiStyle, Doc, NvimObject, Object(ObjectString), fromObject) 

@@ -1,10 +1,6 @@ module Ribosome.Log where -import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.ByteString (ByteString) import qualified Data.ByteString.UTF8 as ByteString (toString)-import Data.Foldable (traverse_)-import Data.Text (Text) import qualified Data.Text as Text (unpack) import System.Log.Logger (Priority(DEBUG, ERROR, INFO), logM) @@ -63,7 +59,7 @@   logAs ERROR  prefixed :: (MonadIO m, Show a) => Text -> a -> m ()-prefixed prefix a = liftIO $ putStrLn $ prefix <> ": " <> show a+prefixed prefix a = liftIO . putStrLn . toString $ prefix <> ": " <> show a  logR ::   Loggable a =>

@@ -4,7 +4,7 @@ import Ribosome.Data.Mapping (Mapping(Mapping), MappingIdent(MappingIdent)) import Ribosome.Data.Text (capitalize) import Ribosome.Nvim.Api.Data (Buffer)-import Ribosome.Nvim.Api.IO (vimCommand)+import Ribosome.Nvim.Api.IO (bufferGetNumber, vimCommand, vimGetCurrentBuffer, vimSetCurrentBuffer)  activateMapping :: Mapping -> m () activateMapping _ =@@ -20,10 +20,14 @@   Buffer ->   Mapping ->   m ()-activateBufferMapping _ (Mapping (MappingIdent ident) lhs mode remap _) = do+activateBufferMapping buffer (Mapping (MappingIdent ident) lhs mode remap _) = do+  previous <- vimGetCurrentBuffer   name <- pluginName-  vimCommand (unwords (cmdline name))+  number <- bufferGetNumber buffer+  vimCommand (unwords (cmdline name number))+  when (buffer /= previous) (vimSetCurrentBuffer previous)   where-    cmdline name = [cmd, "<buffer>", lhs, ":call", func name <> "('" <> ident <> "')<cr>"]+    cmdline name number =+      [show number, "bufdo ", cmd, "<buffer>", lhs, ":silent call", func name <> "('" <> ident <> "')<cr>"]     cmd = mapCommand mode remap     func name = capitalize name <> "Mapping"

@@ -0,0 +1,111 @@+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,)

@@ -0,0 +1,18 @@+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)

@@ -0,0 +1,12 @@+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

@@ -1,8 +1,8 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Menu.Data.Menu where +import Data.DeepLenses (DeepLenses(..))++import Ribosome.Menu.Data.FilteredMenuItem (FilteredMenuItem) import Ribosome.Menu.Data.MenuItem (MenuItem)  newtype MenuFilter =@@ -12,14 +12,18 @@ instance Default MenuFilter where   def = MenuFilter "" -data Menu =+data Menu a =   Menu {-    _items :: [MenuItem],-    _filtered :: [MenuItem],-    _stack :: [(Text, [MenuItem])],+    _items :: [MenuItem a],+    _filtered :: [FilteredMenuItem a],     _selected :: Int,-    _currentFilter :: MenuFilter+    _marked :: [Int],+    _currentFilter :: MenuFilter,+    _maxItems :: Maybe Int   }   deriving (Eq, Show, Generic, Default) -deepLenses ''Menu+makeClassy ''Menu++instance DeepLenses (Menu a) (Menu a) where+  deepLens = id

@@ -1,15 +1,29 @@ 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-  -- |-  -- Cursor Int   |+  Execute (m ())+  |   Render Bool-  -- |-  -- Submenu Text-  deriving Show+  |+  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 <> ")"

@@ -7,10 +7,13 @@ import Ribosome.Menu.Data.MenuRenderEvent (MenuRenderEvent) import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig) -data MenuConfig m a =+data MenuConfig m a i =   MenuConfig {-    _items :: ConduitT () MenuItem m (),-    _handle :: MenuConsumer m a,-    _render :: MenuRenderEvent m a -> m (),-    _prompt :: PromptConfig m+    _items :: ConduitT () [MenuItem i] m (),+    _handle :: MenuConsumer m a i,+    _render :: MenuRenderEvent m a i -> m (),+    _prompt :: PromptConfig m,+    _maxItems :: Maybe Int   }++makeClassy ''MenuConfig

@@ -4,5 +4,5 @@ import Ribosome.Menu.Data.MenuAction (MenuAction) import Ribosome.Menu.Data.MenuUpdate (MenuUpdate) -newtype MenuConsumer m a =-  MenuConsumer { unMenuConsumer :: MenuUpdate m a -> m (MenuAction m a, Menu) }+newtype MenuConsumer m a i =+  MenuConsumer { unMenuConsumer :: MenuUpdate m a i -> m (MenuAction m a, Menu i) }

@@ -1,5 +1,7 @@ module Ribosome.Menu.Data.MenuConsumerAction where +import Ribosome.Menu.Prompt.Data.Prompt (Prompt)+ data MenuConsumerAction m a =   Quit   |@@ -7,6 +9,15 @@   |   Continue   |+  Execute (m ())+  |+  Filter+  |   Render Bool   |   Return a+  |+  UpdatePrompt Prompt+  -- |+  -- Error Text+  deriving (Functor)

@@ -2,8 +2,8 @@  import Ribosome.Menu.Data.MenuUpdate (MenuUpdate) -data MenuConsumerUpdate m a =+data MenuConsumerUpdate m a i =   MenuConsumerUpdate {     _changed :: Bool,-    _menu :: MenuUpdate m a+    _menu :: MenuUpdate m a i   }

@@ -28,14 +28,14 @@   show (Execute _) =     "Execute" -data MenuEvent m a =+data MenuEvent m a i =   Init Prompt   |-  PromptChange Text Prompt+  PromptChange Prompt   |   Mapping Text Prompt   |-  NewItems MenuItem+  NewItems [MenuItem i]   |   Quit (QuitReason m a)   deriving Show

@@ -1,14 +1,15 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Menu.Data.MenuItem where -import Control.Lens (makeClassy)--data MenuItem =+data MenuItem a =   MenuItem {-    _ident :: Text,-    _text :: Text+    _meta :: a,+    _text :: Text,+    _abbreviated :: Text   }-  deriving (Eq, Show)+  deriving (Eq, Show, Ord, Functor)  makeClassy ''MenuItem++simpleMenuItem :: a -> Text -> MenuItem a+simpleMenuItem a t =+  MenuItem a t t

@@ -0,0 +1,7 @@+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])

@@ -3,8 +3,8 @@ import Ribosome.Menu.Data.Menu (Menu) import Ribosome.Menu.Data.MenuEvent (QuitReason) -data MenuRenderEvent m a =-  Render Bool Menu+data MenuRenderEvent m a i =+  Render Bool (Menu i)   |   Quit (QuitReason m a)   deriving Show

@@ -1,16 +1,12 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Menu.Data.MenuUpdate where -import Control.Lens (makeClassy)- import Ribosome.Menu.Data.Menu (Menu) import Ribosome.Menu.Data.MenuEvent (MenuEvent) -data MenuUpdate m a =+data MenuUpdate m a i =   MenuUpdate {-    _event :: MenuEvent m a,-    _menu :: Menu+    _event :: MenuEvent m a i,+    _menu :: Menu i   }  makeClassy ''MenuUpdate

@@ -1,37 +1,83 @@ 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 (MenuItem(_text))+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 ->+  MenuRenderEvent m a i ->   m () renderNvimMenu _ scratch (MenuRenderEvent.Quit _) =   killScratch scratch-renderNvimMenu options scratch (MenuRenderEvent.Render changed (Menu _ allItems _ selected _)) = do-  when changed $ setScratchContent options scratch (reverse text)-  updateCursor+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 = MenuItem._text <$> items-    items = take maxItems (reverse allItems)-    maxItems = 100-    updateCursor = do-      logDebug @Text logMsg+    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)

@@ -0,0 +1,17 @@+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

@@ -1,8 +1,8 @@ module Ribosome.Menu.Prompt.Data.Codes where  import Control.Exception.Lifted (try)-import Data.Map (Map, (!?))-import qualified Data.Map as Map (fromList)+import Data.Map.Strict ((!?))+import qualified Data.Map.Strict as Map (fromList) import qualified Data.Text as Text (singleton)  specialCodes :: Map Text Text@@ -10,7 +10,7 @@   Map.fromList [     ("\x80\xffX", "c-@"),     ("\65533kb", "bs"),-    ("\x80kB", "s-ta"),+    ("\x80kB", "s-tab"),     ("\x0", "c-k"),     ("\x80kD", "del"),     ("\x9B", "csi"),@@ -81,11 +81,13 @@ specialNumCodes :: Map Int Text specialNumCodes =   Map.fromList [-    (9, "ta"),+    (9, "tab"),     (10, "c-j"),     (11, "c-k"),     (12, "fe"),     (13, "cr"),+    (14, "c-n"),+    (25, "c-y"),     (27, "esc"),     (32, "space"),     (60, "lt"),

@@ -1,6 +1,6 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Menu.Prompt.Data.Prompt where++import Prelude hiding (state)  import Ribosome.Menu.Prompt.Data.PromptState (PromptState) 

@@ -1,16 +1,44 @@ 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 :: PromptEvent -> PromptState -> m PromptUpdate,+    _modes :: [PromptFlag] -> PromptEvent -> PromptState -> m PromptUpdate,     _render :: PromptRenderer m,-    _insert :: Bool+    _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

@@ -1,5 +1,7 @@ module Ribosome.Menu.Prompt.Data.PromptEvent where +import Ribosome.Menu.Prompt.Data.Prompt (Prompt)+ data PromptEvent =   Init   |@@ -12,4 +14,6 @@   Interrupt   |   Error Text+  |+  Set Prompt   deriving (Eq, Show)

@@ -1,5 +1,3 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Menu.Prompt.Data.PromptState where  data PromptState =

@@ -8,4 +8,6 @@   DeleteLeft   |   DeleteRight+  |+  Set Text   deriving (Eq, Show)

@@ -2,7 +2,6 @@  import Conduit (ConduitT, yield) import Control.Exception.Lifted (bracket_)-import Control.Monad.DeepError (ignoreError) import qualified Data.Text as Text (singleton, splitAt, uncons)  import Ribosome.Api.Atomic (atomic)@@ -35,14 +34,19 @@  getChar ::   NvimE e m =>-  MonadRibo m =>   MonadBaseControl IO m =>   m InputEvent getChar =   catchAs @RpcError InputEvent.Interrupt request   where     request =-      event =<< vimCallFunction "getchar" [toMsgpack False]+      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) =@@ -53,10 +57,9 @@       maybe (InputEvent.Unexpected num) InputEvent.Character <$> decodeInputNum num  getCharC ::-  MonadIO m =>-  MonadBaseControl IO m =>   NvimE e m =>   MonadRibo m =>+  MonadBaseControl IO m =>   Double ->   ConduitT () PromptEvent m () getCharC interval =@@ -166,14 +169,13 @@   highlightSet <- catchAs @RpcError False $ True <$ vimCommandOutput "highlight RibosomePromptCaret"   unless highlightSet $ vimCommand "highlight link RibosomePromptCaret TermCursor"   res <- NvimPromptResources <$> vimGetOption "guicursor"-  vimSetOption "guicursor" (toMsgpack ("a:None" :: Text))+  vimSetOption "guicursor" (toMsgpack ("a:hor20" :: Text))   () <- vimCallFunction "inputsave" []   startLoop   return res  nvimRelease ::   NvimE e m =>-  MonadRibo m =>   NvimPromptResources ->   m () nvimRelease (NvimPromptResources gc) = do@@ -185,7 +187,6 @@  nvimPromptRenderer ::   NvimE e m =>-  MonadRibo m =>   MonadDeepError e DecodeError m =>   PromptRenderer m nvimPromptRenderer =

@@ -1,15 +1,18 @@ module Ribosome.Menu.Prompt.Run where -import Conduit (ConduitT, await, awaitForever, evalStateC, yield, (.|))+import Conduit (ConduitT, MonadResource, await, awaitForever, bracketP, evalStateC, yield, (.|)) import Data.Conduit.Combinators (peek)-import qualified Data.Text as Text (drop, dropEnd, length, splitAt)+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))+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))@@ -28,14 +31,22 @@   where     update CursorUpdate.OneLeft | current > 0 =       current - 1-    update CursorUpdate.OneRight | current <= Text.length text =+    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 _ =+    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 =@@ -49,6 +60,8 @@       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 ::@@ -60,8 +73,10 @@ 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 text cursorUpdate) newState (updateText cursor text textUpdate)+      Prompt (updateCursor cursor updatedText cursorUpdate) newState updatedText   return (consumed, newPrompt)  processPromptEvent ::@@ -70,9 +85,9 @@   PromptConfig m ->   PromptEvent ->   ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()-processPromptEvent (PromptConfig _ modes (PromptRenderer _ _ render) _) event = do+processPromptEvent (PromptConfig _ modes (PromptRenderer _ _ render) flags) event = do   logDebug @Text $ "prompt event: " <> show event-  consumed <- lift . stateM $ lift . updatePrompt modes event+  consumed <- lift . stateM $ lift . updatePrompt (modes flags) event   newPrompt <- get   yield (PromptConsumerUpdate event newPrompt consumed)   lift . lift . render $ newPrompt@@ -97,25 +112,45 @@     renderIfIdle prompt Nothing =       lift (render prompt) -promptC ::-  MonadIO m =>+promptWithBackchannel ::   MonadRibo m =>+  MonadResource m =>+  MonadBaseControl IO m =>   PromptConfig m ->+  TMChan PromptEvent ->   ConduitT () PromptConsumerUpdate m ()-promptC config@(PromptConfig source _ (PromptRenderer _ _ render) insert) =-  sourceWithInit .| process .| skippingRenderer render+promptWithBackchannel config@(PromptConfig source _ (PromptRenderer _ _ render) _) chan =+  mergeSources 64 [sourceWithInit, sourceTMChan chan] .| process .| skippingRenderer render   where     sourceWithInit =-      yield PromptEvent.Init *> source+      yield PromptEvent.Init *> source <* atomically (closeTMChan chan)     process =-      evalStateC (pristinePrompt insert) (awaitForever (processPromptEvent config))+      evalStateC (pristinePrompt (startInsert config)) (awaitForever (processPromptEvent config)) -unprocessable :: [Text]-unprocessable =+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"+    "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@@ -145,29 +180,46 @@   PromptUpdate PromptState.Normal CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.No  basicTransitionInsert ::+  [PromptFlag] ->   PromptEvent ->   PromptUpdate-basicTransitionInsert (PromptEvent.Character "esc") =-  PromptUpdate PromptState.Normal CursorUpdate.OneLeft TextUpdate.Unmodified PromptConsumed.Yes-basicTransitionInsert (PromptEvent.Character "bs") =-  PromptUpdate PromptState.Insert CursorUpdate.OneLeft TextUpdate.DeleteLeft PromptConsumed.Yes-basicTransitionInsert (PromptEvent.Character c) | c `elem` unprocessable =-  PromptUpdate PromptState.Insert CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.No-basicTransitionInsert (PromptEvent.Character c) =-  PromptUpdate PromptState.Insert CursorUpdate.OneRight (TextUpdate.Insert c) PromptConsumed.Yes-basicTransitionInsert _ =-  PromptUpdate PromptState.Insert CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.No+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 event PromptState.Normal =+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 event PromptState.Insert =-  return $ basicTransitionInsert event-basicTransition _ PromptState.Quit =+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

@@ -1,34 +1,45 @@ module Ribosome.Menu.Run where -import Conduit (ConduitT, await, awaitForever, mapC, yield, (.|))+import Conduit (ConduitT, MonadResource, await, awaitForever, mapC, runConduit, yield, (.|))+import Control.Concurrent.STM.TMChan (TMChan, writeTMChan) import Control.Exception.Lifted (bracket)-import Control.Monad.Trans.Control (MonadBaseControl)+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 (withMergedSources)+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 (renderNvimMenu)+import Ribosome.Menu.Nvim (menuSyntax, renderNvimMenu) import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))-import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig(PromptConfig))+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))@@ -37,24 +48,28 @@ 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.IO (windowSetOption)+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+  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 a) prompt@(Prompt _ PromptState.Insert _) _ =-  MenuEvent.PromptChange a prompt-promptEvent (PromptEvent.Character a) prompt _ =-  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) _ _ =@@ -65,8 +80,8 @@   MenuEvent.Quit (QuitReason.PromptError e)  menuEvent ::-  Either PromptConsumerUpdate MenuItem ->-  MenuEvent m a+  Either PromptConsumerUpdate [MenuItem i] ->+  MenuEvent m a i menuEvent =   either promptUpdate MenuEvent.NewItems   where@@ -75,39 +90,30 @@  updateMenu ::   MonadRibo m =>-  MenuConsumer m a ->-  Either PromptConsumerUpdate MenuItem ->-  ConduitT (Either PromptConsumerUpdate MenuItem) (MenuRenderEvent m a) (StateT Menu m) ()-updateMenu (MenuConsumer consumer) input = do-  showDebug "menu update:" input+  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) -menuSources ::-  MonadIO m =>-  MonadRibo m =>-  PromptConfig m ->-  ConduitT () MenuItem m () ->-  [ConduitT () (Either PromptConsumerUpdate MenuItem) m ()]-menuSources promptConfig items =-  [promptSource, itemSource]-  where-    promptSource =-      promptC promptConfig .| mapC Left-    itemSource =-      items .| mapC Right- menuTerminator ::   Monad m =>-  ConduitT (MenuRenderEvent m a) (QuitReason m a) m ()+  ConduitT (MenuRenderEvent m a i) (QuitReason m a) m () menuTerminator =   traverse_ check =<< await   where@@ -131,40 +137,100 @@ 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 ::-  MonadIO m =>   MonadRibo m =>+  MonadResource m =>   MonadBaseControl IO m =>-  MenuConfig m a ->+  MenuConfig m a i ->   m (MenuResult a)-runMenu (MenuConfig items handle render promptConfig@(PromptConfig _ _ promptRenderer _)) =-  withPrompt promptRenderer+runMenu config =+  bracketPrompt (view (MenuConfig.prompt . PromptConfig.render) config)   where-    withPrompt (PromptRenderer acquire release _) =-      bracket acquire release (const run)+    bracketPrompt (PromptRenderer acquire release _) =+      bracket acquire release (const runForResult)+    runForResult =+      menuResult =<< quitReason <$> run     run =-      menuResult =<< quitReason <$> withMergedSources consumer 64 (menuSources promptConfig items)-    consumer =-      evalStateC def (awaitForever (updateMenu handle)) .| iterM render .| menuTerminator .| Conduit.last+      runConduit (menuC config .| Conduit.last)     quitReason =       fromMaybe QuitReason.NoOutput  nvimMenu ::   NvimE e m =>-  MonadIO m =>   MonadRibo m =>+  MonadResource m =>   MonadBaseControl IO m =>   MonadDeepError e DecodeError m =>   ScratchOptions ->-  ConduitT () MenuItem m () ->-  (MenuUpdate m a -> m (MenuAction m a, Menu)) ->+  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 =-  run =<< showInScratch [] options+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+      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))

@@ -1,14 +1,23 @@ module Ribosome.Menu.Simple where -import Control.Lens ((^?))-import qualified Control.Lens as Lens (element, over, views)+import Control.Lens (_2, element, ifolded, over, set, toListOf, view, withIndex, (^..), (^?))+import qualified Control.Lens as Lens (filtered) import Data.Composition ((.:))-import Data.Map ((!?))-import qualified Data.Map as Map (fromList, union)+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 (filtered, items, selected)+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)@@ -17,12 +26,18 @@ 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 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 Mappings m a = Map Text (Menu -> Prompt -> m (MenuConsumerAction m a, Menu))+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)@@ -30,58 +45,123 @@     search =       not . Text.null . snd .: Text.breakOn -updateFilter :: Text -> Menu -> (Bool, MenuAction m a, Menu)-updateFilter text (Menu items oldFiltered stack selected _) =-  (filtered /= oldFiltered, MenuAction.Continue, Menu items filtered stack selected (MenuFilter text))+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 =-      filter (textContains text . MenuItem._text) items+      itemFilter text items -reapplyFilter :: Menu -> (Bool, MenuAction m a, Menu)-reapplyFilter menu@(Menu _ _ _ _ (MenuFilter currentFilter)) =-  updateFilter currentFilter menu+reapplyFilter :: MenuItemFilter i -> Menu i -> (BasicMenuChange, Menu i)+reapplyFilter itemFilter menu@(Menu _ _ _ _ (MenuFilter currentFilter) _) =+  updateFilter itemFilter currentFilter menu -basicMenuTransform :: MenuEvent m a -> Menu -> (Bool, MenuAction m a, Menu)-basicMenuTransform (MenuEvent.PromptChange _ (Prompt _ _ text)) =-  updateFilter text-basicMenuTransform (MenuEvent.Mapping _ _) =-  (False, MenuAction.Continue,)-basicMenuTransform (MenuEvent.NewItems item) =-  reapplyFilter . Lens.over Menu.items (item :)-basicMenuTransform (MenuEvent.Init _) =-  (True, MenuAction.Continue,)-basicMenuTransform (MenuEvent.Quit reason) =-  (False, MenuAction.Quit reason,)+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 =>-  (MenuUpdate m a -> m (MenuConsumerAction m a, Menu)) ->-  MenuUpdate m a ->-  m (MenuAction m a, Menu)-basicMenu consumer (MenuUpdate event menu) =-  consumerAction action+  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-    (changed, action, newMenu) = basicMenuTransform event menu-    consumerAction (MenuAction.Quit reason) =-      return (MenuAction.Quit reason, menu)-    consumerAction _ =-      first menuAction <$> consumer (MenuUpdate event newMenu)-    menuAction MenuConsumerAction.Continue =-      if changed then MenuAction.Render True else MenuAction.Continue-    menuAction (MenuConsumerAction.Render consumerChanged) =-      MenuAction.Render (changed || consumerChanged)-    menuAction (MenuConsumerAction.QuitWith ma) =-      MenuAction.Quit (QuitReason.Execute ma)-    menuAction MenuConsumerAction.Quit =-      MenuAction.Quit QuitReason.Aborted-    menuAction (MenuConsumerAction.Return a) =-      MenuAction.Quit (QuitReason.Return a)+    basicTransform =+      basicMenuTransform itemFilter event menu  mappingConsumer ::   Monad m =>-  Mappings m a ->-  MenuUpdate m a ->-  m (MenuConsumerAction m a, Menu)+  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@@ -92,78 +172,154 @@  simpleMenu ::   Monad m =>-  Mappings m a ->-  MenuUpdate m a ->-  m (MenuAction m a, Menu)+  Mappings m a i ->+  MenuUpdate m a i ->+  m (MenuAction m a, Menu i) simpleMenu =-  basicMenu . mappingConsumer--menuCycle ::-  Monad m =>-  Int ->-  Menu ->-  Prompt ->-  m (MenuConsumerAction m a, Menu)-menuCycle offset m _ =-  menuRender False (Lens.over Menu.selected add m)-  where-    count =-      Lens.views Menu.filtered length m-    add current =-      if count == 0 then 0 else (current + offset) `mod` count+  basicMenu fuzzyMenuItemMatcher . mappingConsumer  defaultMappings ::   Monad m =>-  Mappings m a+  Mappings m a i defaultMappings =-  Map.fromList [("k", menuCycle 1), ("j", menuCycle (-1))]+  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 ->-  MenuUpdate m a ->-  m (MenuAction m a, Menu)+  Mappings m a i ->+  MenuUpdate m a i ->+  m (MenuAction m a, Menu i) defaultMenu =   simpleMenu . (`Map.union` defaultMappings) -menuContinue ::+selectedMenuItem :: Menu i -> Maybe (MenuItem i)+selectedMenuItem (Menu _ filtered selected _ _ _) =+  filtered ^? element selected . FilteredMenuItem.item++withSelectedMenuItem ::   Monad m =>-  Menu ->-  m (MenuConsumerAction m a, Menu)-menuContinue =-  return . (MenuConsumerAction.Continue,)+  (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) -menuRender ::+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 =>-  Bool ->-  Menu ->-  m (MenuConsumerAction m a, Menu)-menuRender changed =-  return . (MenuConsumerAction.Render changed,)+  (NonEmpty (MenuItem i) -> m a) ->+  Menu i ->+  m (Maybe a)+withMarkedMenuItems f m =+  traverse f (markedMenuItems m) -menuQuit ::+withMarkedMenuItems_ ::   Monad m =>-  Menu ->-  m (MenuConsumerAction m a, Menu)-menuQuit =-  return . (MenuConsumerAction.Quit,)+  (NonEmpty (MenuItem i) -> m ()) ->+  Menu i ->+  m ()+withMarkedMenuItems_ f m =+  traverse_ f (markedMenuItems m) -menuQuitWith ::+actionWithMarkedMenuItems ::   Monad m =>-  m a ->-  Menu ->-  m (MenuConsumerAction m a, Menu)-menuQuitWith next =-  return . (MenuConsumerAction.QuitWith next,)+  (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 -menuReturn ::+traverseMarkedMenuItems ::   Monad m =>-  a ->-  Menu ->-  m (MenuConsumerAction m a, Menu)-menuReturn a =-  return . (MenuConsumerAction.Return a,)+  (MenuItem i -> m a) ->+  Menu i ->+  m (Maybe (NonEmpty a))+traverseMarkedMenuItems =+  withMarkedMenuItems . traverse -selectedMenuItem :: Menu -> Maybe MenuItem-selectedMenuItem (Menu _ items _ selected _) =-  items ^? Lens.element (length items - selected - 1)+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

@@ -1,20 +1,14 @@ module Ribosome.Msgpack.Decode where -import Control.Monad.DeepError (MonadDeepError, hoistEitherWith)-import Data.ByteString (ByteString) import qualified Data.ByteString.UTF8 as ByteString (toString)-import Data.Either.Combinators (mapLeft)-import Data.Int (Int64)-import Data.Map (Map, (!?))-import qualified Data.Map as Map (fromList, toList)+import qualified Data.Map.Strict as Map (empty, fromList, toList) import Data.MessagePack (Object(..))-import Data.Text.Prettyprint.Doc (pretty)-import GHC.Float (double2Float)+import Data.Text.Prettyprint.Doc (pretty, viaShow)+import GHC.Float (double2Float, float2Double) import GHC.Generics (   C1,   Constructor,   D1,-  Generic,   K1(..),   M1(..),   Rep,@@ -24,13 +18,15 @@   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, missingRecordKey, string)+import qualified Ribosome.Msgpack.Util as Util (illegalType, invalid, lookupObjectMap, missingRecordKey)  class MsgpackDecode a where   fromMsgpack :: Object -> Either Err a@@ -81,11 +77,24 @@     (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 (o !? Util.string key)+    M1 <$> maybe (gMissingKey key (ObjectMap o)) gMsgpackDecode lookup     where-      key = selName (undefined :: t s f p)+      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)@@ -107,13 +116,34 @@         v1 <- fromMsgpack v         return (k1, v1)   fromMsgpack o = Util.illegalType "Map" o+  missingKey _ _ = Right Map.empty -msgpackIntegral :: (Integral a, Read a) => Object -> Either Err a+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) = mapLeft pretty . readEither . ByteString.toString $ s+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 @@ -127,19 +157,24 @@   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 (ObjectString os) = Right $ decodeUtf8 os-  fromMsgpack (ObjectBinary os) = Right $ decodeUtf8 os-  fromMsgpack o = Util.illegalType "String" o+  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 (ObjectString os) = Right (decodeUtf8 os)-  fromMsgpack (ObjectBinary os) = Right (decodeUtf8 os)-  fromMsgpack o = Util.illegalType "Text" o+  fromMsgpack =+    msgpackText "Text" Right  instance MsgpackDecode ByteString where   fromMsgpack (ObjectString os) = Right os@@ -147,12 +182,12 @@   fromMsgpack o = Util.illegalType "ByteString" o  instance MsgpackDecode Char where-  fromMsgpack o@(ObjectString os) =-    check . decodeUtf8 $ os+  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-  fromMsgpack o = Util.illegalType "Char" o  instance MsgpackDecode a => MsgpackDecode (Maybe a) where   fromMsgpack ObjectNil = Right Nothing@@ -165,6 +200,8 @@  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@@ -183,6 +220,37 @@  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 =>@@ -192,7 +260,7 @@ fromMsgpack' =   hoistEitherWith DecodeError.Failed . fromMsgpack -msgpackFromString :: IsString a => String -> Object -> Either Err a+msgpackFromString :: IsString a => Text -> Object -> Either Err a msgpackFromString name o =   adapt $ fromMsgpack o   where

@@ -1,19 +1,14 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  module Ribosome.Msgpack.Encode where -import Data.Bifunctor (bimap)-import Data.ByteString (ByteString)-import Data.Int (Int64)-import Data.Map (Map)-import qualified Data.Map as Map (fromList, toList)+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,-  Generic,   K1(..),   M1(..),   Rep,@@ -23,7 +18,9 @@   from,   selName,   (:*:)(..),+  (:+:)(..),   )+import Path (Path, toFilePath) import qualified Ribosome.Msgpack.Util as Util (assembleMap, string, text)  class MsgpackEncode a where@@ -58,31 +55,45 @@   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) = [(selName s, gMsgpackEncode f)]+  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 (Ord k, MsgpackEncode k, MsgpackEncode v) => MsgpackEncode (Map k v) where+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 . fromIntegral+  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 @@ -103,3 +114,9 @@  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

@@ -1,8 +1,5 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Msgpack.Error where -import Data.DeepPrisms (deepPrisms) import System.Log.Logger (Priority(ERROR))  import Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty)

@@ -1,17 +1,13 @@-module Ribosome.Msgpack.NvimObject(-  NO(..),-  (-$),-) where+module Ribosome.Msgpack.NvimObject where -import Control.DeepSeq (NFData)-import GHC.Generics (Generic) import Neovim (NvimObject(..)) import Ribosome.Msgpack.Decode (MsgpackDecode(..)) import Ribosome.Msgpack.Encode (MsgpackEncode(..))  newtype NO a =   NO { unNO :: a }-  deriving (Eq, Show, Generic, NFData)+  deriving (Eq, Show, Generic)+  deriving newtype (NFData)  instance (MsgpackEncode a, MsgpackDecode a, NFData a) => NvimObject (NO a) where   toObject (NO a) = toMsgpack a

@@ -1,17 +1,19 @@ module Ribosome.Msgpack.Util where -import Data.Bifunctor (first)-import qualified Data.ByteString.UTF8 as ByteString (fromString)-import qualified Data.Map as Map (fromList)+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 :: String -> Object-string = ObjectString . ByteString.fromString+string :: ConvertUtf8 a ByteString => a -> Object+string = ObjectString . encodeUtf8 +binary :: ConvertUtf8 a ByteString => a -> Object+binary = ObjectBinary . encodeUtf8+ text :: Text -> Object text = ObjectString . encodeUtf8 @@ -19,14 +21,22 @@ assembleMap =   ObjectMap . Map.fromList . (fmap . first) string -invalid :: String -> Object -> Either Err a+invalid :: Text -> Object -> Either Err a invalid msg obj =-  Left $ pretty (msg ++ ": ") <+> viaShow obj+  Left $ pretty (msg <> ": ") <+> viaShow obj  missingRecordKey :: String -> Object -> Either Err a missingRecordKey key =-  invalid $ "missing record key " ++ key ++ " in ObjectMap"+  invalid $ "missing record key " <> toText key <> " in ObjectMap" -illegalType :: String -> Object -> Either Err a+illegalType :: Text -> Object -> Either Err a illegalType tpe =-  invalid $ "illegal type for " ++ 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)

@@ -1,5 +1,3 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Nvim.Api.Data where  import Data.MessagePack (Object(ObjectExt))

@@ -1,14 +1,7 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Nvim.Api.Generate where -import Control.Monad (join)-import Data.Bifunctor (first) import Data.Char (toUpper)-import Data.Int (Int64)-import Data.Map (Map)-import qualified Data.Map as Map (fromList, lookup)-import Data.Maybe (fromMaybe)+import qualified Data.Map.Strict as Map (fromList, lookup) import Data.MessagePack (Object) import Language.Haskell.TH import Neovim.API.Parser (

@@ -1,9 +1,5 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Nvim.Api.GenerateData where -import Data.ByteString (ByteString)-import Data.Int (Int64) import Data.MessagePack (Object(ObjectExt)) import Language.Haskell.TH import Neovim.Plugin.Classes (FunctionName(F))@@ -44,9 +40,9 @@ decClause :: Name -> Int64 -> ClauseQ decClause name number = do   bytesVar <- newName "bytes"-  clause [pattern bytesVar] (decBody bytesVar) []+  clause [pat bytesVar] (decBody bytesVar) []   where-    pattern bytesVar = conP (mkName "ObjectExt") [(litP . integerL . fromIntegral) number, varP bytesVar]+    pat bytesVar = conP (mkName "ObjectExt") [(litP . integerL . fromIntegral) number, varP bytesVar]     decBody bytesVar = (normalB [|return $ $(conE name) $(varE bytesVar)|])  decErrorClause :: Name -> ClauseQ

@@ -1,10 +1,5 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Nvim.Api.GenerateIO where -import Control.Monad ((<=<))-import Control.Monad.DeepError (MonadDeepError, hoistEither)-import Data.Maybe (maybeToList) import Language.Haskell.TH import Language.Haskell.TH.Syntax import Neovim.API.Parser (NeovimType(SimpleType))

@@ -1,5 +1,3 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Nvim.Api.IO where  import Data.MessagePack (Object)

@@ -1,9 +1,5 @@-{-# LANGUAGE TemplateHaskell #-}- module Ribosome.Nvim.Api.RpcCall where -import Data.DeepPrisms (deepPrisms)-import Data.Either.Combinators (mapLeft) import Data.MessagePack (Object) import Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty) import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)

@@ -2,8 +2,111 @@  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)) -deriving instance MonadCatch (Neovim e)-deriving instance MonadMask (Neovim e)+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

@@ -1,11 +1,9 @@ module Ribosome.Persist where  import Control.Exception (IOException, try)-import Control.Monad (unless) import Control.Monad.Catch (MonadThrow)-import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson (FromJSON, ToJSON, eitherDecodeFileStrict', encodeFile)-import Path (Abs, Dir, File, Path, Rel, parent, parseAbsDir, parseRelDir, toFilePath, (<.>), (</>))+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)@@ -23,7 +21,6 @@ persistencePath ::   MonadRibo m =>   NvimE e m =>-  MonadIO m =>   MonadThrow m =>   MonadDeepError e SettingError m =>   Path Rel File ->@@ -36,7 +33,6 @@ persistenceFile ::   MonadRibo m =>   NvimE e m =>-  MonadIO m =>   MonadThrow m =>   MonadDeepError e SettingError m =>   Path Rel File ->@@ -44,12 +40,11 @@ persistenceFile path = do   file <- persistencePath path   createDirIfMissing True (parent file)-  file <.> "json"+  addExtension ".json" file  persistStore ::   MonadRibo m =>   NvimE e m =>-  MonadIO m =>   MonadThrow m =>   MonadDeepError e SettingError m =>   ToJSON a =>@@ -73,7 +68,6 @@   unless exists (noSuchFile file)  decodeError ::-  MonadDeepError e SettingError m =>   MonadDeepError e PersistError m =>   Path Abs File ->   Text ->@@ -89,7 +83,6 @@  safeDecodeFile ::   MonadIO m =>-  MonadDeepError e SettingError m =>   MonadDeepError e PersistError m =>   FromJSON a =>   Path Abs File ->@@ -114,7 +107,6 @@   safeDecodeFile file  mayPersistLoad ::-  MonadIO m =>   MonadRibo m =>   NvimE e m =>   MonadDeepError e SettingError m =>

@@ -6,11 +6,7 @@   RpcDef(..), ) where -import Control.Monad (join, (<=<))-import Control.Monad.DeepError (MonadDeepError)-import Control.Monad.Trans.Except (runExceptT)-import Data.Default (def)-import qualified Data.Map as Map ()+import qualified Data.Map.Strict as Map () import Data.MessagePack (Object(ObjectNil, ObjectBool)) import Neovim.Context (Neovim) import Neovim.Plugin.Classes (@@ -25,10 +21,10 @@ 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 (rpcHandler, rpcHandlerDef) import Ribosome.Plugin.TH.Handler (   RpcDef(RpcDef),   RpcDefDetail(..),@@ -61,7 +57,6 @@  watcherRpc ::   MonadBaseControl IO m =>-  MonadDeepError e MappingError m =>   MonadRibo m =>   NvimE e m =>   Text ->@@ -95,7 +90,6 @@       Autocmd (encodeUtf8 event) n sync' options  nvimPlugin ::-  MonadDeepError e MappingError m =>   RpcHandler e env m =>   env ->   [[RpcDef m]] ->

@@ -1,10 +1,9 @@ module Ribosome.Plugin.Builtin where +import Data.MessagePack (Object(ObjectString, ObjectNil)) import Neovim.Plugin.Classes (Synchronous(Async)) -import Data.MessagePack (Object(ObjectString, ObjectNil)) import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)-import Ribosome.Data.Mapping (MappingError) import Ribosome.Data.Text (capitalize) import Ribosome.Plugin.TH.Handler (RpcDef(RpcDef), RpcDefDetail(RpcFunction)) import Ribosome.Scratch (killScratchByName)@@ -20,7 +19,6 @@   return ObjectNil  deleteScratchRpc ::-  MonadDeepError e MappingError m =>   MonadRibo m =>   NvimE e m =>   Text ->

@@ -1,7 +1,5 @@ module Ribosome.Plugin.Mapping where -import Control.Monad.DeepError (MonadDeepError(throwHoist))-import Data.Foldable (find) import Data.MessagePack (Object(ObjectString, ObjectNil))  import Ribosome.Data.Mapping (MappingError(InvalidArgs, NoSuchMapping), MappingIdent(MappingIdent))@@ -12,7 +10,7 @@     mhHandler :: m ()   } -mappingHandler :: Functor m => Text -> m () -> MappingHandler m+mappingHandler :: Text -> m () -> MappingHandler m mappingHandler ident =   MappingHandler (MappingIdent ident) @@ -24,7 +22,7 @@ noSuchMapping =   throwHoist . NoSuchMapping -executeMapping :: Functor m => MappingHandler m -> m ()+executeMapping :: MappingHandler m -> m () executeMapping (MappingHandler _ f) =   f 

@@ -1,6 +1,5 @@ module Ribosome.Plugin.RpcHandler where -import Control.Monad.Trans.Except (ExceptT) import Neovim (Neovim)  class RpcHandler e env m | m -> e env where

@@ -1,12 +1,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE TemplateHaskell #-}  module Ribosome.Plugin.TH where -import Data.Default (def)-import Data.Maybe (fromMaybe, maybeToList) import qualified Data.Text as Text (unpack)-import Language.Haskell.TH+import Language.Haskell.TH (ExpQ, Lit(StringL), Name, listE, litE, nameBase) import Neovim.Plugin.Classes (   AutocmdOptions,   Synchronous(..),@@ -53,7 +50,7 @@     handler (RpcHandlerConfig sync name cmd autocmd auOptions) funcName = do       params <- handlerParams funcName       rpcFun <- rpcFunction vimName' sync funcName-      rpcCmd <- traverse (rpcCommand vimName' funcName params) cmd+      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

@@ -1,22 +1,15 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE TemplateHaskell #-}  module Ribosome.Plugin.TH.Command where  import Control.Exception (throw)-import Control.Monad ((<=<)) import Data.Aeson (FromJSON, eitherDecodeStrict) import qualified Data.ByteString as ByteString (intercalate)-import Data.Either.Combinators (mapLeft) 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(..),-  mkCommandOptions,-  )+import Neovim.Plugin.Classes (CommandArguments, CommandOption(..), Synchronous, mkCommandOptions)  import Ribosome.Msgpack.Decode (fromMsgpack) import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))@@ -27,16 +20,25 @@   argsCase,   decodedCallSequence,   functionParamTypes,+  handlerCall,   lambdaNames,   listParamsPattern,   ) +data CmdParamType =+  PrimParam+  |+  DataParam+  |+  ListParam+  deriving (Eq, Show)+ data CmdParams =   ZeroParams   |-  OnlyPrims Int+  OneParam Bool CmdParamType   |-  OnlyData+  OnlyPrims Int   |   DataPlus Int   deriving (Eq, Show)@@ -69,6 +71,7 @@   mapLeft pretty . eitherDecodeStrict . ByteString.intercalate " " <=< traverse fromMsgpack  primDispatch ::+  [MatchQ] ->   String ->   Name ->   Name ->@@ -76,19 +79,64 @@   [Name] ->   Bool ->   ExpQ-primDispatch rpcName argsName handlerName cmdArgsName paramNames hasArgsParam =-  caseE (varE argsName) [matching, invalidArgs]+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)|]) []-    vars = varE <$> params+      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 ->@@ -134,8 +182,8 @@   where     normalize _ (cmdArgs : rest) =       return (cmdArgs, rest)-    normalize rpcName _ =-      shapeError rpcName+    normalize rpcName args =+      shapeError $ rpcName <> " (" <> show args <> ")"  normalizeArgsPlus ::   Monad m =>@@ -145,8 +193,8 @@   where     normalize _ [cmdArgs, first', ObjectArray rest] =       return (cmdArgs, first' : rest)-    normalize rpcName _ =-      shapeError rpcName+    normalize rpcName args =+      shapeError $ rpcName <> " (" <> show args <> ")"  normalizeArgs ::   CmdParams ->@@ -155,6 +203,10 @@   [|normalizeArgsFlat|] normalizeArgs (OnlyPrims 1) =   [|normalizeArgsFlat|]+normalizeArgs (OneParam _ PrimParam) =+  [|normalizeArgsFlat|]+normalizeArgs (OneParam _ ListParam) =+  [|normalizeArgsFlat|] normalizeArgs _ =   [|normalizeArgsPlus|] @@ -185,15 +237,14 @@   [Name] ->   HandlerParams ->   PatQ ->-  (Name -> Name -> [Name] -> Bool ->ExpQ) ->+  (Name -> Name -> [Name] -> Bool -> ExpQ) ->   ExpQ command rpcName handlerName paramNames (HandlerParams hasCmdArgs cmdParams) argsPattern dispatch = do   cmdArgsName <- newName "cmdArgs"-  let-    handler =-      lamE [firstParam cmdArgsName, argsPattern] (dispatch handlerName cmdArgsName paramNames hasCmdArgs)-  [|rpc $(nameLit) $(normalizeArgs cmdParams) $(handler)|]+  [|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@@ -205,13 +256,25 @@   Name ->   [Name] ->   HandlerParams ->+  Bool ->+  Bool ->   ExpQ-primCommand rpcName handlerName paramNames handlerPar = do+primCommand rpcName handlerName paramNames handlerPar isMaybe isL = do   argsName <- newName "args"-  command rpcName handlerName paramNames handlerPar (varP argsName) (primDispatch rpcName argsName)+  command rpcName handlerName paramNames handlerPar (varP argsName) (dispatch rpcName argsName)+  where+    dispatch | isMaybe = primDispatchMaybe+      | isL = primDispatchList+      | otherwise = primDispatchStrict -jsonCommand :: String -> Name -> [Name] -> HandlerParams -> ExpQ-jsonCommand rpcName handlerName paramNames handlerPar = do+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) @@ -220,15 +283,21 @@   forParams params   where     forParams ZeroParams =-      primCommand rpcName handlerName [] hps+      primCommand rpcName handlerName [] hps False False     forParams (OnlyPrims paramCount) = do       paramNames <- lambdaNames paramCount-      primCommand rpcName handlerName paramNames hps+      primCommand rpcName handlerName paramNames hps False False     forParams (DataPlus paramCount) = do       paramNames <- lambdaNames paramCount-      jsonCommand rpcName handlerName paramNames hps-    forParams OnlyData =-      jsonCommand rpcName handlerName [] hps+      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 _ _] _)) =@@ -242,31 +311,71 @@ 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-      isD <- isJsonDecodable a-      return $ if isD then OnlyData else OnlyPrims 1+      (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 "+" -rpcCommand :: String -> Name -> HandlerParams -> [CommandOption] -> ExpQ-rpcCommand rpcName funcName hps@(HandlerParams _ params) opts = do+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 : opts)) $((litE (StringL rpcName))) $(return fun)|]+  [|RpcDef (RpcCommand $ mkCommandOptions (nargs : amendSync sync opts)) $((litE (StringL rpcName))) $(return fun)|]   where     nargs = cmdNargs params 

@@ -1,12 +1,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE TemplateHaskell #-}  module Ribosome.Plugin.TH.Handler where  import Control.Exception (throw)-import Control.Monad (replicateM)-import Data.Functor ((<&>))-import Data.Maybe (maybeToList) import Data.MessagePack (Object) import Data.Text.Prettyprint.Doc (Doc, Pretty(..)) import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)@@ -20,6 +16,7 @@   RangeSpecification(..),   Synchronous(..),   )+import qualified Text.Show as Show (Show(show))  import Ribosome.Msgpack.Decode (fromMsgpack) import Ribosome.Msgpack.Encode (toMsgpack)@@ -48,6 +45,7 @@     raSync :: Synchronous,     raOptions :: AutocmdOptions     }+  deriving Show  data RpcDef m =   RpcDef {@@ -56,36 +54,18 @@     rdHandler :: [Object] -> m Object   } -instance Lift Synchronous where-  lift Sync = [|Sync|]-  lift Async = [|Async|]+instance Show (RpcDef m) where+  show (RpcDef d n _) =+    "RpcDef" <> show (d, n) -instance Lift RangeSpecification where-  lift CurrentLine =-    [|CurrentLine|]-  lift WholeFile =-    [|WholeFile|]-  lift (RangeCount a) =-    [|RangeCount a|]+deriving instance Lift Synchronous -instance Lift CommandOption where-  lift (CmdSync a) =-    [|CmdSync a|]-  lift CmdRegister =-    [|CmdRegister|]-  lift (CmdNargs a) =-    [|CmdNargs a|]-  lift (CmdRange a) =-    [|CmdRange a|]-  lift (CmdCount a) =-    [|CmdCount a|]-  lift CmdBang =-    [|CmdBang|]+deriving instance Lift RangeSpecification -instance Lift AutocmdOptions where-  lift (AutocmdOptions p n g) =-    [|AutocmdOptions p n g|]+deriving instance Lift CommandOption +deriving instance Lift AutocmdOptions+ unfoldFunctionParams :: Type -> [Type] unfoldFunctionParams (ForallT _ _ t) =   unfoldFunctionParams t@@ -128,11 +108,18 @@   where     resultCases = [successfulEvaluation, failedEvaluation] -decodedCallSequence :: Name -> [ExpQ] -> ExpQ-decodedCallSequence handlerName =+handlerCall :: Name -> [ExpQ] -> ExpQ+handlerCall handlerName =   foldl decodeSeq [|pure $(varE handlerName)|]   where-    decodeSeq z a = infixApp z [|(<*>)|] [|fromMsgpack $(a)|]+    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 =

@@ -2,9 +2,7 @@  import Control.Lens (Lens') import qualified Control.Lens as Lens (at)-import Control.Monad.DeepError (catchAt)-import qualified Data.Map as Map (toList)-import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map (toList) import Data.MessagePack (Object(ObjectNil))  import Ribosome.Control.Lock (lockOrSkip)

@@ -1,59 +1,46 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE NoImplicitPrelude #-}  module Ribosome.Prelude (-  module Control.Monad.DeepError,-  module Control.Monad.DeepState,   module Control.Monad.Trans.Control,-  module Data.DeepLenses,-  module Data.DeepPrisms,+  module Cornea,   module Data.Default,   module Data.Foldable,   module Relude,   dbg,   dbgs,   dbgm,+  dbgWith,+  dbgmWith,   makeClassy,   mapLeft,-  modify,   tuple,   undefined,   unit,-  unsafeLog,+  unsafeLogAnd,   unsafeLogS,+  unsafeLogSAnd,+  throwText,   (<$$>), ) where  import Control.Lens (makeClassy)-import Control.Monad.DeepError (MonadDeepError(throwHoist), catchAs, catchAt, hoistEither, hoistMaybe, ignoreError)-import Control.Monad.DeepState (-  MonadDeepState,-  get,-  getL,-  gets,-  getsL,-  modifyL,-  modifyM,-  modifyM',-  put,-  setL,-  stateM,-  )-import qualified Control.Monad.DeepState as DeepState (modify)-import Control.Monad.Trans.Control (MonadBaseControl)-import Data.DeepLenses (deepLenses)-import Data.DeepPrisms (deepPrisms)+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 (void) import Data.Functor.Syntax ((<$$>)) import GHC.Err (undefined) import GHC.IO.Unsafe (unsafePerformIO)-import Relude hiding (undefined, Type, state, modify, gets, get, put)+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 msg)+  () <- return $ unsafePerformIO (putStrLn (toString msg))   return ()  dbgs :: Monad m => Show a => a -> m ()@@ -63,9 +50,27 @@ dbgm :: Monad m => Show a => m a -> m a dbgm ma = do   a <- ma-  dbgs a-  return a+  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 ()@@ -80,16 +85,31 @@ tuple fa fb =   (,) <$> fa <*> fb -unsafeLogS :: Show a => a -> b -> b-unsafeLogS a b = unsafePerformIO $ print a >> return b+unsafeLogSAnd :: Show a => a -> b -> b+unsafeLogSAnd a b =+  unsafePerformIO $ print a >> return b -unsafeLog :: Text -> b -> b-unsafeLog a b = unsafePerformIO $ putStrLn a >> return b+unsafeLogAnd :: Text -> b -> b+unsafeLogAnd a b =+  unsafePerformIO $ putStrLn (toString a) >> return b -modify ::-  ∀ s' s m .-  MonadDeepState s s' m =>-  (s' -> s') ->-  m ()-modify =-  DeepState.modify+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

@@ -1,19 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Ribosome.PreludeExport (-  module Ribosome.Prelude,-  module Ribosome.Control.Monad.Ribo,-  module Ribosome.Log,-  module Ribosome.Nvim.Api.RpcCall,-  module Ribosome.Msgpack.Decode,-  module Ribosome.Msgpack.Encode,-  sleep,-) where--import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)-import Ribosome.Log (logDebug, logError, logInfo, showDebug)-import Ribosome.Msgpack.Decode (MsgpackDecode(fromMsgpack))-import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))-import Ribosome.Nvim.Api.RpcCall (RpcError(..))-import Ribosome.Prelude-import Ribosome.System.Time (sleep)

@@ -1,32 +1,40 @@ module Ribosome.Scratch where -import Control.Lens (Lens')-import qualified Control.Lens as Lens (at, set)-import Control.Monad (unless)-import Data.Default (Default(def))-import Data.Foldable (traverse_)+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 (executeWindowSyntax)+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))+import qualified Ribosome.Data.Scratch as Scratch (Scratch(scratchPrevious, scratchWindow, scratchBuffer)) import Ribosome.Data.ScratchOptions (ScratchOptions(ScratchOptions))-import qualified Ribosome.Data.ScratchOptions as ScratchOptions (ScratchOptions(name, resize, maxSize))+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,@@ -34,6 +42,7 @@   windowIsValid,   windowSetHeight,   windowSetOption,+  windowSetWidth,   ) import Ribosome.Nvim.Api.RpcCall (RpcError) @@ -42,71 +51,102 @@   vimCommand "tabnew"   vimGetCurrentTabpage -createScratchWindow :: NvimE e m => Bool -> Bool -> Bool -> Maybe Int -> m Window-createScratchWindow vertical wrap bottom size = do-  vimCommand $ prefix <> cmd+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)-  when bottom (vimCommand "wincmd J")-  return win+  windowSetOption win "colorcolumn" (toMsgpack ("" :: Text))+  windowSetOption win "foldmethod" (toMsgpack ("manual" :: Text))+  windowSetOption win "conceallevel" (toMsgpack (2 :: Int))+  return (buffer, win)   where-    cmd = if vertical then "vnew" else "new"-    prefix = maybe "" show size+    createWindow =+      maybe regular createFloat float+    regular =+      createRegularWindow vertical bottom size -createScratchUiInTab :: NvimE e m => m (Window, Maybe Tabpage)+createScratchUiInTab :: NvimE e m => m (Buffer, Window, Maybe Tabpage) createScratchUiInTab = do   tab <- createScratchTab   win <- vimGetCurrentWindow-  return (win, Just tab)--createScratchUiInWindow :: NvimE e m => Bool -> Bool -> Bool -> Maybe Int -> m (Window, Maybe Tabpage)-createScratchUiInWindow vertical wrap bottom size = do-  win <- createScratchWindow vertical wrap bottom size-  return (win, Nothing)+  buffer <- windowGetBuffer win+  return (buffer, win, Just tab) -createScratchUi :: NvimE e m => ScratchOptions -> m (Window, Maybe Tabpage)-createScratchUi (ScratchOptions False vertical wrap _ _ bottom _ size _ _ _) =-  createScratchUiInWindow vertical wrap bottom size+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 "buftype" (toMsgpack ("nofile" :: Text))   bufferSetOption buffer "bufhidden" (toMsgpack ("wipe" :: Text))+  bufferSetOption buffer "buftype" (toMsgpack ("nofile" :: Text))+  bufferSetOption buffer "swapfile" (toMsgpack False)   bufferSetName buffer name -setupScratchBuffer :: NvimE e m => Window -> Text -> m Buffer-setupScratchBuffer window name = do-  buffer <- windowGetBuffer window-  configureScratchBuffer buffer name-  return buffer+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 -setupScratchIn ::-  MonadDeepError e DecodeError m =>-  MonadRibo m =>-  NvimE e m =>-  Window ->-  Window ->-  Maybe Tabpage ->-  ScratchOptions ->-  m Scratch-setupScratchIn previous window tab (ScratchOptions useTab _ _ focus _ _ _ _ syntax mappings name) = do-  buffer <- setupScratchBuffer window name-  traverse_ (executeWindowSyntax window) syntax-  traverse_ (activateBufferMapping buffer) mappings-  unless (focus || useTab) $ vimSetCurrentWindow previous-  let scratch = Scratch name buffer window previous tab-  pluginInternalModify $ Lens.set (scratchLens name) (Just scratch)-  setupDeleteAutocmd scratch-  return scratch- setupDeleteAutocmd ::   MonadRibo m =>   NvimE e m =>@@ -114,36 +154,73 @@   m () setupDeleteAutocmd (Scratch name buffer _ _ _) = do   pname <- capitalize <$> pluginName-  number <- bufferGetNumber buffer-  vimCommand "augroup RibosomeScratch"-  vimCommand $ "autocmd RibosomeScratch BufDelete <buffer=" <> show number <> "> " <> deleteCall pname+  bufferAutocmd buffer "RibosomeScratch" "BufDelete" (deleteCall pname)   where     deleteCall pname =       "silent! call " <> pname <> "DeleteScratch('" <> name <> "')" -createScratch ::+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-  (window, tab) <- createScratchUi options-  setupScratchIn previous window tab options+  (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 ::-  MonadDeepError e DecodeError m =>-  MonadRibo m =>   NvimE e m =>+  MonadRibo m =>+  MonadBaseControl IO m =>+  MonadDeepError e DecodeError m =>   Scratch ->   ScratchOptions ->   m Scratch-updateScratch (Scratch _ _ oldWindow _ oldTab) options = do-  previous <- vimGetCurrentWindow-  winValid <- windowIsValid oldWindow-  (window, tab) <- if winValid then return (oldWindow, oldTab) else createScratchUi options-  setupScratchIn previous window tab options+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 =>@@ -153,15 +230,32 @@   pluginInternalL (scratchLens name)  ensureScratch ::-  MonadDeepError e DecodeError m =>-  MonadRibo m =>   NvimE e m =>+  MonadRibo m =>+  MonadBaseControl IO m =>+  MonadDeepError e DecodeError m =>   ScratchOptions ->   m Scratch ensureScratch options = do-  f <- maybe createScratch updateScratch <$> lookupScratch (ScratchOptions.name options)+  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 =>@@ -170,18 +264,26 @@   t Text ->   m () setScratchContent options (Scratch _ buffer win _ _) lines' = do-  bufferSetOption buffer "modifiable" (toMsgpack True)-  setBufferContent buffer (toList lines')-  bufferSetOption buffer "modifiable" (toMsgpack False)-  when (ScratchOptions.resize options) (ignoreError @RpcError $ windowSetHeight win size)+  withModifiable buffer options $ setBufferContent buffer (toList lines')+  when (view ScratchOptions.resize options) (ignoreError @RpcError $ setSize win size)   where-    size = max 1 $ min (length lines') (fromMaybe 30 (ScratchOptions.maxSize options))+    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 =>-  MonadDeepError e DecodeError m =>-  MonadRibo m =>   NvimE e m =>+  MonadRibo m =>+  MonadBaseControl IO m =>+  MonadDeepError e DecodeError m =>   t Text ->   ScratchOptions ->   m Scratch@@ -192,9 +294,10 @@  showInScratchDef ::   Foldable t =>-  MonadDeepError e DecodeError m =>-  MonadRibo m =>   NvimE e m =>+  MonadRibo m =>+  MonadBaseControl IO m =>+  MonadDeepError e DecodeError m =>   t Text ->   m Scratch showInScratchDef lines' =@@ -208,7 +311,7 @@ killScratch (Scratch name buffer window _ tab) = do   catchAs @RpcError () removeAutocmd   traverse_ closeTabpage tab *> closeWindow window *> wipeBuffer buffer-  pluginInternalModify $ Lens.set (scratchLens name) Nothing+  pluginInternalModify $ set (scratchLens name) Nothing   where     removeAutocmd = do       number <- bufferGetNumber buffer@@ -219,8 +322,8 @@   NvimE e m =>   Text ->   m ()-killScratchByName name = do-  traverse_ killScratch =<< lookupScratch name+killScratchByName =+  traverse_ killScratch <=< lookupScratch  scratchPreviousWindow ::   MonadRibo m =>@@ -235,3 +338,10 @@   m (Maybe Window) scratchWindow =   fmap Scratch.scratchWindow <$$> lookupScratch++scratchBuffer ::+  MonadRibo m =>+  Text ->+  m (Maybe Buffer)+scratchBuffer =+  fmap Scratch.scratchBuffer <$$> lookupScratch

@@ -1,12 +1,12 @@ module Ribosome.System.Time where  import Control.Concurrent (threadDelay)-import Control.Monad.IO.Class (MonadIO, liftIO)+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 $ fmap round getPOSIXTime+epochSeconds = liftIO $ round <$> getPOSIXTime  usleep :: MonadIO m => Double -> m () usleep =@@ -18,3 +18,10 @@  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

@@ -5,9 +5,6 @@ import qualified Chiasma.Monad.Stream as Chiasma (runTmux) import Chiasma.Native.Api (TmuxNative(TmuxNative)) import Control.Monad.Catch (MonadMask)-import Control.Monad.DeepError (MonadDeepError)-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Trans.Except (ExceptT, runExceptT) import Data.DeepPrisms (DeepPrisms)  import Ribosome.Config.Setting (settingMaybe)@@ -15,7 +12,12 @@ import Ribosome.Control.Monad.Ribo (MonadRibo, Nvim, Ribo)  runTmux ::-  (MonadIO m, MonadRibo m, MonadDeepError e TmuxError m, MonadMask m, Nvim m) =>+  MonadIO m =>+  MonadRibo m =>+  MonadBaseControl IO m =>+  MonadDeepError e TmuxError m =>+  MonadMask m =>+  Nvim m =>   TmuxProg m a ->   m a runTmux prog = do@@ -23,7 +25,11 @@   Chiasma.runTmux (TmuxNative socket) prog  runTmuxE ::-  (MonadIO m, MonadRibo m, MonadMask m, Nvim m) =>+  MonadIO m =>+  MonadRibo m =>+  MonadBaseControl IO m =>+  MonadMask m =>+  Nvim m =>   TmuxProg (ExceptT TmuxError m) a ->   m (Either TmuxError a) runTmuxE =

@@ -1,9 +0,0 @@-module Ribosome.Unsafe where--import GHC.IO.Unsafe (unsafePerformIO)--unsafeLogS :: Show a => a -> b -> b-unsafeLogS a b = unsafePerformIO $ print a >> return b--unsafeLog :: Text -> b -> b-unsafeLog a b = unsafePerformIO $ putStrLn a >> return b

@@ -0,0 +1,91 @@+# 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

@@ -1,194 +1,269 @@-cabal-version: 1.12-name: ribosome-version: 0.3.0.1-license: OtherLicense-license-file: LICENSE-copyright: 2019 Torsten Schmits-maintainer: tek@tryp.io-author: Torsten Schmits-homepage: https://github.com/tek/ribosome-hs#readme-bug-reports: https://github.com/tek/ribosome-hs/issues-synopsis: api extensions for nvim-hs-description:-    Please see the README on GitHub at <https://github.com/tek/ribosome-hs>-category: Neovim-build-type: Simple+cabal-version: 2.2 +-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- 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>+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+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-hs+  type: git+  location: https://github.com/tek/ribosome  library-    exposed-modules:-        Ribosome.Api.Atomic-        Ribosome.Api.Autocmd-        Ribosome.Api.Buffer-        Ribosome.Api.Echo-        Ribosome.Api.Exists-        Ribosome.Api.Function-        Ribosome.Api.Input-        Ribosome.Api.Option-        Ribosome.Api.Path-        Ribosome.Api.Process-        Ribosome.Api.Response-        Ribosome.Api.Sleep-        Ribosome.Api.Syntax-        Ribosome.Api.Tabpage-        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.Data.Foldable-        Ribosome.Data.Mapping-        Ribosome.Data.Maybe-        Ribosome.Data.PersistError-        Ribosome.Data.Scratch-        Ribosome.Data.ScratchOptions-        Ribosome.Data.Setting-        Ribosome.Data.SettingError-        Ribosome.Data.String-        Ribosome.Data.Syntax-        Ribosome.Data.Text-        Ribosome.Error.Report-        Ribosome.Error.Report.Class-        Ribosome.File-        Ribosome.Internal.IO-        Ribosome.Internal.NvimObject-        Ribosome.Log-        Ribosome.Mapping-        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.MenuRenderEvent-        Ribosome.Menu.Data.MenuResult-        Ribosome.Menu.Data.MenuUpdate-        Ribosome.Menu.Nvim-        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.PreludeExport-        Ribosome.Scratch-        Ribosome.System.Time-        Ribosome.Tmux.Run-        Ribosome.Unsafe-    hs-source-dirs: lib-    other-modules:-        Prelude-    default-language: Haskell2010-    default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals-                        ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable-                        DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable-                        DoAndIfThenElse EmptyDataDecls ExistentialQuantification-                        FlexibleContexts FlexibleInstances FunctionalDependencies GADTs-                        GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase-                        MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns-                        OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds-                        RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving-                        TupleSections TypeApplications TypeFamilies TypeOperators-                        TypeSynonymInstances UnicodeSyntax ViewPatterns-    build-depends:-        MissingH >=1.4.1.0 && <1.5,-        aeson >=1.3.1.1 && <1.4,-        ansi-terminal >=0.8.2 && <0.9,-        base-noprelude >=4.7 && <5,-        bytestring >=0.10.8.2 && <0.11,-        cereal >=0.5.7.0 && <0.6,-        cereal-conduit >=0.8.0 && <0.9,-        chiasma >=0.1.0.0 && <0.2,-        composition >=1.0.2.1 && <1.1,-        composition-extra >=2.0.0 && <2.1,-        conduit >=1.3.1 && <1.4,-        conduit-extra >=1.3.0 && <1.4,-        containers >=0.5.11.0 && <0.6,-        cornea >=0.2.2.0 && <0.3,-        data-default >=0.7.1.1 && <0.8,-        deepseq >=1.4.3.0 && <1.5,-        directory >=1.3.1.5 && <1.4,-        either >=5.0.1 && <5.1,-        exceptions >=0.10.0 && <0.11,-        filepath >=1.4.2 && <1.5,-        free >=5.0.2 && <5.1,-        hslogger >=1.2.12 && <1.3,-        lens >=4.16.1 && <4.17,-        lifted-async >=0.10.0.3 && <0.11,-        lifted-base >=0.2.3.12 && <0.3,-        messagepack >=0.5.4 && <0.6,-        monad-control >=1.0.2.3 && <1.1,-        monad-loops >=0.4.3 && <0.5,-        mtl >=2.2.2 && <2.3,-        nvim-hs >=2.1.0.0 && <2.2,-        path >=0.6.1 && <0.7,-        path-io >=1.3.3 && <1.4,-        pretty-terminal >=0.1.0.0 && <0.2,-        prettyprinter >=1.2.1 && <1.3,-        prettyprinter-ansi-terminal >=1.1.1.2 && <1.2,-        process >=1.6.3.0 && <1.7,-        relude >=0.1.1 && <0.2,-        resourcet >=1.2.2 && <1.3,-        safe >=0.3.17 && <0.4,-        split >=0.2.3.3 && <0.3,-        stm >=2.4.5.1 && <2.5,-        stm-chans >=3.0.0.4 && <3.1,-        stm-conduit >=4.0.1 && <4.1,-        template-haskell >=2.13.0.0 && <2.14,-        text >=1.2.3.1 && <1.3,-        th-abstraction >=0.2.10.0 && <0.3,-        time >=1.8.0.2 && <1.9,-        transformers >=0.5.5.0 && <0.6,-        transformers-base >=0.4.5.2 && <0.5,-        typed-process >=0.2.3.0 && <0.3,-        unix >=2.7.2.2 && <2.8,-        unliftio >=0.2.9.0 && <0.3,-        unliftio-core >=0.1.2.0 && <0.2,-        utf8-string >=1.0.1.1 && <1.1+  exposed-modules:+      Ribosome.Api.Atomic+      Ribosome.Api.Autocmd+      Ribosome.Api.Buffer+      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.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.Data.FloatOptions+      Ribosome.Data.Foldable+      Ribosome.Data.List+      Ribosome.Data.Mapping+      Ribosome.Data.PersistError+      Ribosome.Data.Register+      Ribosome.Data.RegisterType+      Ribosome.Data.RiboError+      Ribosome.Data.Scratch+      Ribosome.Data.ScratchOptions+      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.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.Scratch+      Ribosome.System.Time+      Ribosome.Tmux.Run+  other-modules:+      Prelude+      Paths_ribosome+  autogen-modules:+      Paths_ribosome+  hs-source-dirs:+      lib+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedStrings+      OverloadedLists+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -Wall -Wredundant-constraints -Wsimplifiable-class-constraints+  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+    , messagepack+    , monad-control+    , monad-loops+    , mtl+    , nvim-hs+    , path+    , path-io+    , pretty-terminal+    , 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+  mixins:+      base hiding (Prelude)+  default-language: Haskell2010