module Ribosome.Scratch where

import Control.Lens (Lens', set, view)
import qualified Control.Lens as Lens (at)
import qualified Data.Map.Strict as Map (empty)
import Data.MessagePack (Object)

import Ribosome.Api.Autocmd (bufferAutocmd, eventignore)
import Ribosome.Api.Buffer (setBufferContent, wipeBuffer)
import Ribosome.Api.Syntax (executeCurrentWindowSyntax)
import Ribosome.Api.Tabpage (closeTabpage)
import Ribosome.Api.Window (closeWindow)
import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, pluginInternalL, pluginInternalModify, pluginName)
import Ribosome.Control.Ribosome (RibosomeInternal)
import qualified Ribosome.Control.Ribosome as Ribosome (scratch)
import Ribosome.Data.FloatOptions (FloatOptions)
import Ribosome.Data.Scratch (Scratch(Scratch))
import qualified Ribosome.Data.Scratch as Scratch (Scratch(scratchPrevious, scratchWindow, scratchBuffer))
import Ribosome.Data.ScratchOptions (ScratchOptions(ScratchOptions))
import qualified Ribosome.Data.ScratchOptions as ScratchOptions (maxSize, modify, name, resize, vertical)
import Ribosome.Data.Text (capitalize)
import Ribosome.Log (logDebug)
import Ribosome.Mapping (activateBufferMapping)
import Ribosome.Msgpack.Decode (fromMsgpack)
import Ribosome.Msgpack.Encode (toMsgpack)
import Ribosome.Msgpack.Error (DecodeError)
import Ribosome.Nvim.Api.Data (Buffer, Tabpage, Window)
import Ribosome.Nvim.Api.IO (
  bufferGetName,
  bufferGetNumber,
  bufferSetName,
  bufferSetOption,
  nvimBufIsLoaded,
  nvimCreateBuf,
  nvimOpenWin,
  vimCommand,
  vimGetCurrentBuffer,
  vimGetCurrentTabpage,
  vimGetCurrentWindow,
  vimSetCurrentWindow,
  windowGetBuffer,
  windowIsValid,
  windowSetHeight,
  windowSetOption,
  windowSetWidth,
  )
import Ribosome.Nvim.Api.RpcCall (RpcError)

createScratchTab :: NvimE e m => m Tabpage
createScratchTab :: m Tabpage
createScratchTab = do
  Text -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Text -> m ()
vimCommand Text
"tabnew"
  m Tabpage
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
m Tabpage
vimGetCurrentTabpage

createRegularWindow ::
  NvimE e m =>
  Bool ->
  Bool ->
  Maybe Int ->
  m (Buffer, Window)
createRegularWindow :: Bool -> Bool -> Maybe Int -> m (Buffer, Window)
createRegularWindow Bool
vertical Bool
bottom Maybe Int
size = do
  Text -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Text -> m ()
vimCommand Text
prefixedCmd
  Buffer
buf <- m Buffer
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
m Buffer
vimGetCurrentBuffer
  Window
win <- m Window
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
m Window
vimGetCurrentWindow
  return (Buffer
buf, Window
win)
  where
    prefixedCmd :: Text
prefixedCmd = Text
locationPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sizePrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd
    cmd :: Text
cmd = if Bool
vertical then Text
"vnew" else Text
"new"
    sizePrefix :: Text
sizePrefix = Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Maybe Int
size
    locationPrefix :: Text
locationPrefix = if Bool
bottom then Text
"belowright" else Text
"aboveleft"

floatConfig ::
  FloatOptions ->
  Map Text Object
floatConfig :: FloatOptions -> Map Text Object
floatConfig =
  Map Text Object -> Either Err (Map Text Object) -> Map Text Object
forall b a. b -> Either a b -> b
fromRight Map Text Object
forall k a. Map k a
Map.empty (Either Err (Map Text Object) -> Map Text Object)
-> (FloatOptions -> Either Err (Map Text Object))
-> FloatOptions
-> Map Text Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Either Err (Map Text Object)
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack (Object -> Either Err (Map Text Object))
-> (FloatOptions -> Object)
-> FloatOptions
-> Either Err (Map Text Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatOptions -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack

createFloat ::
  NvimE e m =>
  FloatOptions ->
  m (Buffer, Window)
createFloat :: FloatOptions -> m (Buffer, Window)
createFloat FloatOptions
options = do
  Buffer
buffer <- Bool -> Bool -> m Buffer
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Bool -> Bool -> m Buffer
nvimCreateBuf Bool
True Bool
True
  Window
window <- Buffer -> Bool -> Map Text Object -> m Window
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Buffer -> Bool -> Map Text Object -> m Window
nvimOpenWin Buffer
buffer Bool
True (FloatOptions -> Map Text Object
floatConfig FloatOptions
options)
  return (Buffer
buffer, Window
window)

createScratchWindow ::
  NvimE e m =>
  Bool ->
  Bool ->
  Bool ->
  Maybe FloatOptions ->
  Maybe Int ->
  m (Buffer, Window)
createScratchWindow :: Bool
-> Bool
-> Bool
-> Maybe FloatOptions
-> Maybe Int
-> m (Buffer, Window)
createScratchWindow Bool
vertical Bool
wrap Bool
bottom Maybe FloatOptions
float Maybe Int
size = do
  (Buffer
buffer, Window
win) <- m (Buffer, Window)
createWindow
  Window -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> Text -> Object -> m ()
windowSetOption Window
win Text
"wrap" (Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
wrap)
  Window -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> Text -> Object -> m ()
windowSetOption Window
win Text
"number" (Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
False)
  Window -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> Text -> Object -> m ()
windowSetOption Window
win Text
"cursorline" (Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True)
  Window -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> Text -> Object -> m ()
windowSetOption Window
win Text
"colorcolumn" (Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"" :: Text))
  Window -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> Text -> Object -> m ()
windowSetOption Window
win Text
"foldmethod" (Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"manual" :: Text))
  Window -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> Text -> Object -> m ()
windowSetOption Window
win Text
"conceallevel" (Int -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Int
2 :: Int))
  return (Buffer
buffer, Window
win)
  where
    createWindow :: m (Buffer, Window)
createWindow =
      m (Buffer, Window)
-> (FloatOptions -> m (Buffer, Window))
-> Maybe FloatOptions
-> m (Buffer, Window)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (Buffer, Window)
regular FloatOptions -> m (Buffer, Window)
forall e (m :: * -> *).
NvimE e m =>
FloatOptions -> m (Buffer, Window)
createFloat Maybe FloatOptions
float
    regular :: m (Buffer, Window)
regular =
      Bool -> Bool -> Maybe Int -> m (Buffer, Window)
forall e (m :: * -> *).
NvimE e m =>
Bool -> Bool -> Maybe Int -> m (Buffer, Window)
createRegularWindow Bool
vertical Bool
bottom Maybe Int
size

createScratchUiInTab :: NvimE e m => m (Buffer, Window, Maybe Tabpage)
createScratchUiInTab :: m (Buffer, Window, Maybe Tabpage)
createScratchUiInTab = do
  Tabpage
tab <- m Tabpage
forall e (m :: * -> *). NvimE e m => m Tabpage
createScratchTab
  Window
win <- m Window
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
m Window
vimGetCurrentWindow
  Buffer
buffer <- Window -> m Buffer
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> m Buffer
windowGetBuffer Window
win
  return (Buffer
buffer, Window
win, Tabpage -> Maybe Tabpage
forall a. a -> Maybe a
Just Tabpage
tab)

createScratchUi ::
  NvimE e m =>
  ScratchOptions ->
  m (Buffer, Window, Maybe Tabpage)
createScratchUi :: ScratchOptions -> m (Buffer, Window, Maybe Tabpage)
createScratchUi (ScratchOptions Bool
False Bool
vertical Bool
wrap Bool
_ Bool
_ Bool
bottom Bool
_ Maybe FloatOptions
float Maybe Int
size Maybe Int
_ [Syntax]
_ [Mapping]
_ Text
_) =
  (Buffer -> Window -> (Buffer, Window, Maybe Tabpage))
-> (Buffer, Window) -> (Buffer, Window, Maybe Tabpage)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (,,Maybe Tabpage
forall a. Maybe a
Nothing) ((Buffer, Window) -> (Buffer, Window, Maybe Tabpage))
-> m (Buffer, Window) -> m (Buffer, Window, Maybe Tabpage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Bool
-> Bool
-> Maybe FloatOptions
-> Maybe Int
-> m (Buffer, Window)
forall e (m :: * -> *).
NvimE e m =>
Bool
-> Bool
-> Bool
-> Maybe FloatOptions
-> Maybe Int
-> m (Buffer, Window)
createScratchWindow Bool
vertical Bool
wrap Bool
bottom Maybe FloatOptions
float Maybe Int
size
createScratchUi ScratchOptions
_ =
  m (Buffer, Window, Maybe Tabpage)
forall e (m :: * -> *).
NvimE e m =>
m (Buffer, Window, Maybe Tabpage)
createScratchUiInTab

configureScratchBuffer :: NvimE e m => Buffer -> Text -> m ()
configureScratchBuffer :: Buffer -> Text -> m ()
configureScratchBuffer Buffer
buffer Text
name = do
  Buffer -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Buffer -> Text -> Object -> m ()
bufferSetOption Buffer
buffer Text
"bufhidden" (Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"wipe" :: Text))
  Buffer -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Buffer -> Text -> Object -> m ()
bufferSetOption Buffer
buffer Text
"buftype" (Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"nofile" :: Text))
  Buffer -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Buffer -> Text -> Object -> m ()
bufferSetOption Buffer
buffer Text
"swapfile" (Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
False)
  Buffer -> Text -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Buffer -> Text -> m ()
bufferSetName Buffer
buffer Text
name

setupScratchBuffer ::
  NvimE e m =>
  MonadRibo m =>
  Window ->
  Buffer ->
  Text ->
  m Buffer
setupScratchBuffer :: Window -> Buffer -> Text -> m Buffer
setupScratchBuffer Window
window Buffer
buffer Text
name = do
  Bool
valid <- Buffer -> m Bool
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Buffer -> m Bool
nvimBufIsLoaded Buffer
buffer
  forall a (m :: * -> *). (Loggable a, MonadRibo m) => a -> m ()
forall (m :: * -> *). (Loggable Text, MonadRibo m) => Text -> m ()
logDebug @Text (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ (if Bool
valid then Text
"" else Text
"in") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"valid scratch buffer"
  Buffer
validBuffer <- if Bool
valid then Buffer -> m Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
buffer else Window -> m Buffer
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> m Buffer
windowGetBuffer Window
window
  Buffer -> Text -> m ()
forall e (m :: * -> *). NvimE e m => Buffer -> Text -> m ()
configureScratchBuffer Buffer
validBuffer Text
name
  return Buffer
validBuffer

scratchLens :: Text -> Lens' RibosomeInternal (Maybe Scratch)
scratchLens :: Text -> Lens' RibosomeInternal (Maybe Scratch)
scratchLens Text
name =
  (Map Text Scratch -> f (Map Text Scratch))
-> RibosomeInternal -> f RibosomeInternal
forall c. HasRibosomeInternal c => Lens' c (Map Text Scratch)
Ribosome.scratch ((Map Text Scratch -> f (Map Text Scratch))
 -> RibosomeInternal -> f RibosomeInternal)
-> ((Maybe Scratch -> f (Maybe Scratch))
    -> Map Text Scratch -> f (Map Text Scratch))
-> (Maybe Scratch -> f (Maybe Scratch))
-> RibosomeInternal
-> f RibosomeInternal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Text Scratch)
-> Lens' (Map Text Scratch) (Maybe (IxValue (Map Text Scratch)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
Lens.at Text
Index (Map Text Scratch)
name

setupDeleteAutocmd ::
  MonadRibo m =>
  NvimE e m =>
  Scratch ->
  m ()
setupDeleteAutocmd :: Scratch -> m ()
setupDeleteAutocmd (Scratch Text
name Buffer
buffer Window
_ Window
_ Maybe Tabpage
_) = do
  Text
pname <- Text -> Text
capitalize (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
forall (m :: * -> *). MonadRibo m => m Text
pluginName
  Buffer -> Text -> Text -> Text -> m ()
forall e (m :: * -> *).
NvimE e m =>
Buffer -> Text -> Text -> Text -> m ()
bufferAutocmd Buffer
buffer Text
"RibosomeScratch" Text
"BufDelete" (Text -> Text
deleteCall Text
pname)
  where
    deleteCall :: Text -> Text
deleteCall Text
pname =
      Text
"silent! call " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"DeleteScratch('" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"')"

setupScratchIn ::
  MonadDeepError e DecodeError m =>
  MonadRibo m =>
  NvimE e m =>
  Buffer ->
  Window ->
  Window ->
  Maybe Tabpage ->
  ScratchOptions ->
  m Scratch
setupScratchIn :: Buffer
-> Window -> Window -> Maybe Tabpage -> ScratchOptions -> m Scratch
setupScratchIn Buffer
buffer Window
previous Window
window Maybe Tabpage
tab (ScratchOptions Bool
_ Bool
_ Bool
_ Bool
focus Bool
_ Bool
_ Bool
_ Maybe FloatOptions
_ Maybe Int
_ Maybe Int
_ [Syntax]
syntax [Mapping]
mappings Text
name) = do
  Buffer
validBuffer <- Window -> Buffer -> Text -> m Buffer
forall e (m :: * -> *).
(NvimE e m, MonadRibo m) =>
Window -> Buffer -> Text -> m Buffer
setupScratchBuffer Window
window Buffer
buffer Text
name
  (Syntax -> m [Object]) -> [Syntax] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Syntax -> m [Object]
forall e (m :: * -> *).
(MonadDeepError e DecodeError m, NvimE e m) =>
Syntax -> m [Object]
executeCurrentWindowSyntax [Syntax]
syntax
  (Mapping -> m ()) -> [Mapping] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Buffer -> Mapping -> m ()
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m) =>
Buffer -> Mapping -> m ()
activateBufferMapping Buffer
validBuffer) [Mapping]
mappings
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
focus (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Window -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> m ()
vimSetCurrentWindow Window
previous
  let scratch :: Scratch
scratch = Text -> Buffer -> Window -> Window -> Maybe Tabpage -> Scratch
Scratch Text
name Buffer
validBuffer Window
window Window
previous Maybe Tabpage
tab
  (RibosomeInternal -> RibosomeInternal) -> m ()
forall (m :: * -> *).
MonadRibo m =>
(RibosomeInternal -> RibosomeInternal) -> m ()
pluginInternalModify ((RibosomeInternal -> RibosomeInternal) -> m ())
-> (RibosomeInternal -> RibosomeInternal) -> m ()
forall a b. (a -> b) -> a -> b
$ ASetter
  RibosomeInternal RibosomeInternal (Maybe Scratch) (Maybe Scratch)
-> Maybe Scratch -> RibosomeInternal -> RibosomeInternal
forall s t a b. ASetter s t a b -> b -> s -> t
set (Text -> Lens' RibosomeInternal (Maybe Scratch)
scratchLens Text
name) (Scratch -> Maybe Scratch
forall a. a -> Maybe a
Just Scratch
scratch)
  Scratch -> m ()
forall (m :: * -> *) e. (MonadRibo m, NvimE e m) => Scratch -> m ()
setupDeleteAutocmd Scratch
scratch
  return Scratch
scratch

createScratch ::
  NvimE e m =>
  MonadRibo m =>
  MonadBaseControl IO m =>
  MonadDeepError e DecodeError m =>
  ScratchOptions ->
  m Scratch
createScratch :: ScratchOptions -> m Scratch
createScratch ScratchOptions
options = do
  forall a (m :: * -> *). (Loggable a, MonadRibo m) => a -> m ()
forall (m :: * -> *). (Loggable Text, MonadRibo m) => Text -> m ()
logDebug @Text (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"creating new scratch `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScratchOptions -> Text
forall b a. (Show a, IsString b) => a -> b
show ScratchOptions
options Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
  Window
previous <- m Window
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
m Window
vimGetCurrentWindow
  (Buffer
buffer, Window
window, Maybe Tabpage
tab) <- m (Buffer, Window, Maybe Tabpage)
-> m (Buffer, Window, Maybe Tabpage)
forall e (m :: * -> *) a.
(NvimE e m, MonadBaseControl IO m) =>
m a -> m a
eventignore (m (Buffer, Window, Maybe Tabpage)
 -> m (Buffer, Window, Maybe Tabpage))
-> m (Buffer, Window, Maybe Tabpage)
-> m (Buffer, Window, Maybe Tabpage)
forall a b. (a -> b) -> a -> b
$ ScratchOptions -> m (Buffer, Window, Maybe Tabpage)
forall e (m :: * -> *).
NvimE e m =>
ScratchOptions -> m (Buffer, Window, Maybe Tabpage)
createScratchUi ScratchOptions
options
  m Scratch -> m Scratch
forall e (m :: * -> *) a.
(NvimE e m, MonadBaseControl IO m) =>
m a -> m a
eventignore (m Scratch -> m Scratch) -> m Scratch -> m Scratch
forall a b. (a -> b) -> a -> b
$ Buffer
-> Window -> Window -> Maybe Tabpage -> ScratchOptions -> m Scratch
forall e (m :: * -> *).
(MonadDeepError e DecodeError m, MonadRibo m, NvimE e m) =>
Buffer
-> Window -> Window -> Maybe Tabpage -> ScratchOptions -> m Scratch
setupScratchIn Buffer
buffer Window
previous Window
window Maybe Tabpage
tab ScratchOptions
options

bufferStillLoaded ::
  NvimE e m =>
  Text ->
  Buffer ->
  m Bool
bufferStillLoaded :: Text -> Buffer -> m Bool
bufferStillLoaded Text
name Buffer
buffer =
  Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> m Bool -> m (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
loaded m (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Bool
loadedName
  where
    loaded :: m Bool
loaded = Buffer -> m Bool
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Buffer -> m Bool
nvimBufIsLoaded Buffer
buffer
    loadedName :: m Bool
loadedName = Bool -> m Bool -> m Bool
forall e' e (m :: * -> *) a.
MonadDeepError e e' m =>
a -> m a -> m a
catchAs @RpcError Bool
False ((Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool) -> m Text -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> m Text
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Buffer -> m Text
bufferGetName Buffer
buffer)

updateScratch ::
  NvimE e m =>
  MonadRibo m =>
  MonadBaseControl IO m =>
  MonadDeepError e DecodeError m =>
  Scratch ->
  ScratchOptions ->
  m Scratch
updateScratch :: Scratch -> ScratchOptions -> m Scratch
updateScratch oldScratch :: Scratch
oldScratch@(Scratch Text
name Buffer
oldBuffer Window
oldWindow Window
_ Maybe Tabpage
_) ScratchOptions
options = do
  Text -> m ()
forall a (m :: * -> *). (Loggable a, MonadRibo m) => a -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"updating existing scratch `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
  m Bool -> m Scratch -> m Scratch -> m Scratch
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Window -> m Bool
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> m Bool
windowIsValid Window
oldWindow) m Scratch
attemptReuseWindow m Scratch
reset
  where
    attemptReuseWindow :: m Scratch
attemptReuseWindow =
      m Bool -> m Scratch -> m Scratch -> m Scratch
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Text -> Buffer -> m Bool
forall e (m :: * -> *). NvimE e m => Text -> Buffer -> m Bool
bufferStillLoaded Text
name Buffer
oldBuffer) (Scratch -> m Scratch
forall (m :: * -> *) a. Monad m => a -> m a
return Scratch
oldScratch) m Scratch
closeAndReset
    closeAndReset :: m Scratch
closeAndReset =
      Window -> m ()
forall e (m :: * -> *). NvimE e m => Window -> m ()
closeWindow Window
oldWindow m () -> m Scratch -> m Scratch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Scratch
reset
    reset :: m Scratch
reset =
      ScratchOptions -> m Scratch
forall e (m :: * -> *).
(NvimE e m, MonadRibo m, MonadBaseControl IO m,
 MonadDeepError e DecodeError m) =>
ScratchOptions -> m Scratch
createScratch ScratchOptions
options

lookupScratch ::
  MonadRibo m =>
  Text ->
  m (Maybe Scratch)
lookupScratch :: Text -> m (Maybe Scratch)
lookupScratch Text
name =
  Lens' RibosomeInternal (Maybe Scratch) -> m (Maybe Scratch)
forall (m :: * -> *) a.
MonadRibo m =>
Lens' RibosomeInternal a -> m a
pluginInternalL (Text -> Lens' RibosomeInternal (Maybe Scratch)
scratchLens Text
name)

ensureScratch ::
  NvimE e m =>
  MonadRibo m =>
  MonadBaseControl IO m =>
  MonadDeepError e DecodeError m =>
  ScratchOptions ->
  m Scratch
ensureScratch :: ScratchOptions -> m Scratch
ensureScratch ScratchOptions
options = do
  ScratchOptions -> m Scratch
f <- (ScratchOptions -> m Scratch)
-> (Scratch -> ScratchOptions -> m Scratch)
-> Maybe Scratch
-> ScratchOptions
-> m Scratch
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ScratchOptions -> m Scratch
forall e (m :: * -> *).
(NvimE e m, MonadRibo m, MonadBaseControl IO m,
 MonadDeepError e DecodeError m) =>
ScratchOptions -> m Scratch
createScratch Scratch -> ScratchOptions -> m Scratch
forall e (m :: * -> *).
(NvimE e m, MonadRibo m, MonadBaseControl IO m,
 MonadDeepError e DecodeError m) =>
Scratch -> ScratchOptions -> m Scratch
updateScratch (Maybe Scratch -> ScratchOptions -> m Scratch)
-> m (Maybe Scratch) -> m (ScratchOptions -> m Scratch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (Maybe Scratch)
forall (m :: * -> *). MonadRibo m => Text -> m (Maybe Scratch)
lookupScratch (Getting Text ScratchOptions Text -> ScratchOptions -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ScratchOptions Text
forall c. HasScratchOptions c => Lens' c Text
ScratchOptions.name ScratchOptions
options)
  ScratchOptions -> m Scratch
f ScratchOptions
options

withModifiable ::
  NvimE e m =>
  Buffer ->
  ScratchOptions ->
  m a ->
  m a
withModifiable :: Buffer -> ScratchOptions -> m a -> m a
withModifiable Buffer
buffer ScratchOptions
options m a
thunk =
  if Bool
isWrite then m a
thunk else m a
wrap
  where
    isWrite :: Bool
isWrite =
      Getting Bool ScratchOptions Bool -> ScratchOptions -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ScratchOptions Bool
forall c. HasScratchOptions c => Lens' c Bool
ScratchOptions.modify ScratchOptions
options
    wrap :: m a
wrap =
      Bool -> m ()
update Bool
True m () -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
thunk m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Bool -> m ()
update Bool
False
    update :: Bool -> m ()
update Bool
value =
      Buffer -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Buffer -> Text -> Object -> m ()
bufferSetOption Buffer
buffer Text
"modifiable" (Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
value)

setScratchContent ::
  Foldable t =>
  NvimE e m =>
  ScratchOptions ->
  Scratch ->
  t Text ->
  m ()
setScratchContent :: ScratchOptions -> Scratch -> t Text -> m ()
setScratchContent ScratchOptions
options (Scratch Text
_ Buffer
buffer Window
win Window
_ Maybe Tabpage
_) t Text
lines' = do
  Buffer -> ScratchOptions -> m () -> m ()
forall e (m :: * -> *) a.
NvimE e m =>
Buffer -> ScratchOptions -> m a -> m a
withModifiable Buffer
buffer ScratchOptions
options (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Buffer -> [Text] -> m ()
forall e (m :: * -> *). NvimE e m => Buffer -> [Text] -> m ()
setBufferContent Buffer
buffer (t Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Text
lines')
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Getting Bool ScratchOptions Bool -> ScratchOptions -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ScratchOptions Bool
forall c. HasScratchOptions c => Lens' c Bool
ScratchOptions.resize ScratchOptions
options) (forall e' e (m :: * -> *). MonadDeepError e e' m => m () -> m ()
forall e (m :: * -> *). MonadDeepError e RpcError m => m () -> m ()
ignoreError @RpcError (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Window -> Int -> m ()
setSize Window
win Int
size)
  where
    size :: Int
size =
      Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
calculateSize
    calculateSize :: Int
calculateSize =
      if Bool
vertical then Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
50 Maybe Int
maxSize else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (t Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t Text
lines') (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
30 Maybe Int
maxSize)
    maxSize :: Maybe Int
maxSize =
      Getting (Maybe Int) ScratchOptions (Maybe Int)
-> ScratchOptions -> Maybe Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Int) ScratchOptions (Maybe Int)
forall c. HasScratchOptions c => Lens' c (Maybe Int)
ScratchOptions.maxSize ScratchOptions
options
    vertical :: Bool
vertical =
      Getting Bool ScratchOptions Bool -> ScratchOptions -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ScratchOptions Bool
forall c. HasScratchOptions c => Lens' c Bool
ScratchOptions.vertical ScratchOptions
options
    setSize :: Window -> Int -> m ()
setSize =
      if Bool
vertical then Window -> Int -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> Int -> m ()
windowSetWidth else Window -> Int -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> Int -> m ()
windowSetHeight

showInScratch ::
  Foldable t =>
  NvimE e m =>
  MonadRibo m =>
  MonadBaseControl IO m =>
  MonadDeepError e DecodeError m =>
  t Text ->
  ScratchOptions ->
  m Scratch
showInScratch :: t Text -> ScratchOptions -> m Scratch
showInScratch t Text
lines' ScratchOptions
options = do
  Scratch
scratch <- ScratchOptions -> m Scratch
forall e (m :: * -> *).
(NvimE e m, MonadRibo m, MonadBaseControl IO m,
 MonadDeepError e DecodeError m) =>
ScratchOptions -> m Scratch
ensureScratch ScratchOptions
options
  ScratchOptions -> Scratch -> t Text -> m ()
forall (t :: * -> *) e (m :: * -> *).
(Foldable t, NvimE e m) =>
ScratchOptions -> Scratch -> t Text -> m ()
setScratchContent ScratchOptions
options Scratch
scratch t Text
lines'
  return Scratch
scratch

showInScratchDef ::
  Foldable t =>
  NvimE e m =>
  MonadRibo m =>
  MonadBaseControl IO m =>
  MonadDeepError e DecodeError m =>
  t Text ->
  m Scratch
showInScratchDef :: t Text -> m Scratch
showInScratchDef t Text
lines' =
  t Text -> ScratchOptions -> m Scratch
forall (t :: * -> *) e (m :: * -> *).
(Foldable t, NvimE e m, MonadRibo m, MonadBaseControl IO m,
 MonadDeepError e DecodeError m) =>
t Text -> ScratchOptions -> m Scratch
showInScratch t Text
lines' ScratchOptions
forall a. Default a => a
def

killScratch ::
  MonadRibo m =>
  NvimE e m =>
  Scratch ->
  m ()
killScratch :: Scratch -> m ()
killScratch (Scratch Text
name Buffer
buffer Window
window Window
_ Maybe Tabpage
tab) = do
  () -> m () -> m ()
forall e' e (m :: * -> *) a.
MonadDeepError e e' m =>
a -> m a -> m a
catchAs @RpcError () m ()
removeAutocmd
  (Tabpage -> m ()) -> Maybe Tabpage -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Tabpage -> m ()
forall e (m :: * -> *). NvimE e m => Tabpage -> m ()
closeTabpage Maybe Tabpage
tab m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Window -> m ()
forall e (m :: * -> *). NvimE e m => Window -> m ()
closeWindow Window
window m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Buffer -> m ()
forall e (m :: * -> *). NvimE e m => Buffer -> m ()
wipeBuffer Buffer
buffer
  (RibosomeInternal -> RibosomeInternal) -> m ()
forall (m :: * -> *).
MonadRibo m =>
(RibosomeInternal -> RibosomeInternal) -> m ()
pluginInternalModify ((RibosomeInternal -> RibosomeInternal) -> m ())
-> (RibosomeInternal -> RibosomeInternal) -> m ()
forall a b. (a -> b) -> a -> b
$ ASetter
  RibosomeInternal RibosomeInternal (Maybe Scratch) (Maybe Scratch)
-> Maybe Scratch -> RibosomeInternal -> RibosomeInternal
forall s t a b. ASetter s t a b -> b -> s -> t
set (Text -> Lens' RibosomeInternal (Maybe Scratch)
scratchLens Text
name) Maybe Scratch
forall a. Maybe a
Nothing
  where
    removeAutocmd :: m ()
removeAutocmd = do
      Int
number <- Buffer -> m Int
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Buffer -> m Int
bufferGetNumber Buffer
buffer
      Text -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Text -> m ()
vimCommand (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"autocmd! RibosomeScratch BufDelete <buffer=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
number Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"

killScratchByName ::
  MonadRibo m =>
  NvimE e m =>
  Text ->
  m ()
killScratchByName :: Text -> m ()
killScratchByName =
  (Scratch -> m ()) -> Maybe Scratch -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Scratch -> m ()
forall (m :: * -> *) e. (MonadRibo m, NvimE e m) => Scratch -> m ()
killScratch (Maybe Scratch -> m ())
-> (Text -> m (Maybe Scratch)) -> Text -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> m (Maybe Scratch)
forall (m :: * -> *). MonadRibo m => Text -> m (Maybe Scratch)
lookupScratch

scratchPreviousWindow ::
  MonadRibo m =>
  Text ->
  m (Maybe Window)
scratchPreviousWindow :: Text -> m (Maybe Window)
scratchPreviousWindow =
  (Scratch -> Window) -> Maybe Scratch -> Maybe Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scratch -> Window
Scratch.scratchPrevious (Maybe Scratch -> Maybe Window)
-> (Text -> m (Maybe Scratch)) -> Text -> m (Maybe Window)
forall (f0 :: * -> *) (f1 :: * -> *) a b.
(Functor f0, Functor f1) =>
(a -> b) -> f1 (f0 a) -> f1 (f0 b)
<$$> Text -> m (Maybe Scratch)
forall (m :: * -> *). MonadRibo m => Text -> m (Maybe Scratch)
lookupScratch

scratchWindow ::
  MonadRibo m =>
  Text ->
  m (Maybe Window)
scratchWindow :: Text -> m (Maybe Window)
scratchWindow =
  (Scratch -> Window) -> Maybe Scratch -> Maybe Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scratch -> Window
Scratch.scratchWindow (Maybe Scratch -> Maybe Window)
-> (Text -> m (Maybe Scratch)) -> Text -> m (Maybe Window)
forall (f0 :: * -> *) (f1 :: * -> *) a b.
(Functor f0, Functor f1) =>
(a -> b) -> f1 (f0 a) -> f1 (f0 b)
<$$> Text -> m (Maybe Scratch)
forall (m :: * -> *). MonadRibo m => Text -> m (Maybe Scratch)
lookupScratch

scratchBuffer ::
  MonadRibo m =>
  Text ->
  m (Maybe Buffer)
scratchBuffer :: Text -> m (Maybe Buffer)
scratchBuffer =
  (Scratch -> Buffer) -> Maybe Scratch -> Maybe Buffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scratch -> Buffer
Scratch.scratchBuffer (Maybe Scratch -> Maybe Buffer)
-> (Text -> m (Maybe Scratch)) -> Text -> m (Maybe Buffer)
forall (f0 :: * -> *) (f1 :: * -> *) a b.
(Functor f0, Functor f1) =>
(a -> b) -> f1 (f0 a) -> f1 (f0 b)
<$$> Text -> m (Maybe Scratch)
forall (m :: * -> *). MonadRibo m => Text -> m (Maybe Scratch)
lookupScratch