{-# options_haddock prune #-}

-- |Internal logic for 'Ribosome.Scratch'.
module Ribosome.Internal.Scratch where

import qualified Data.Map.Strict as Map
import Data.MessagePack (Object)
import Exon (exon)
import qualified Polysemy.Log as Log
import Prelude hiding (group)

import Ribosome.Api.Autocmd (bufferAutocmd, eventignore)
import Ribosome.Api.Buffer (setBufferContent, wipeBuffer)
import Ribosome.Api.Syntax (executeWindowSyntax)
import Ribosome.Api.Tabpage (closeTabpage)
import Ribosome.Api.Window (closeWindow)
import Ribosome.Data.FloatOptions (FloatOptions, enter)
import Ribosome.Data.PluginName (PluginName (PluginName))
import Ribosome.Data.ScratchId (ScratchId (ScratchId, unScratchId))
import Ribosome.Data.ScratchOptions (ScratchOptions (ScratchOptions, filetype, name), focus, mappings, syntax)
import qualified Ribosome.Data.ScratchState as ScratchState
import Ribosome.Data.ScratchState (ScratchState (ScratchState))
import Ribosome.Host.Api.Data (Buffer, Tabpage, Window)
import Ribosome.Host.Api.Effect (
  bufferGetName,
  bufferSetName,
  bufferSetOption,
  nvimBufIsLoaded,
  nvimCreateBuf,
  nvimDelAutocmd,
  nvimOpenWin,
  vimCommand,
  vimGetCurrentBuffer,
  vimGetCurrentTabpage,
  vimGetCurrentWindow,
  vimSetCurrentWindow,
  windowGetBuffer,
  windowIsValid,
  windowSetHeight,
  windowSetOption,
  windowSetWidth,
  )
import Ribosome.Host.Class.Msgpack.Decode (fromMsgpack)
import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)
import Ribosome.Host.Data.RpcError (RpcError)
import Ribosome.Host.Data.RpcType (AutocmdId (AutocmdId), group)
import Ribosome.Host.Effect.Rpc (Rpc)
import Ribosome.Mapping (activateBufferMapping)
import Ribosome.PluginName (pluginNamePascalCase)

createScratchTab :: Member Rpc r => Sem r Tabpage
createScratchTab :: forall (r :: EffectRow). Member Rpc r => Sem r Tabpage
createScratchTab = do
  Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
vimCommand Text
"tabnew"
  Sem r Tabpage
forall (r :: EffectRow). Member Rpc r => Sem r Tabpage
vimGetCurrentTabpage

createRegularWindow ::
  Member Rpc r =>
  Bool ->
  Bool ->
  Maybe Int ->
  Sem r (Buffer, Window)
createRegularWindow :: forall (r :: EffectRow).
Member Rpc r =>
Bool -> Bool -> Maybe Int -> Sem r (Buffer, Window)
createRegularWindow Bool
vertical Bool
bottom Maybe Int
size = do
  Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
vimCommand Text
prefixedCmd
  Buffer
buf <- Sem r Buffer
forall (r :: EffectRow). Member Rpc r => Sem r Buffer
vimGetCurrentBuffer
  Window
win <- Sem r Window
forall (r :: EffectRow). Member Rpc r => Sem r Window
vimGetCurrentWindow
  pure (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 Text (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 Text (Map Text Object) -> Map Text Object)
-> (FloatOptions -> Either Text (Map Text Object))
-> FloatOptions
-> Map Text Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Either Text (Map Text Object)
forall a. MsgpackDecode a => Object -> Either Text a
fromMsgpack (Object -> Either Text (Map Text Object))
-> (FloatOptions -> Object)
-> FloatOptions
-> Either Text (Map Text Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatOptions -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack

createFloatWith ::
  Member Rpc r =>
  Bool ->
  Bool ->
  FloatOptions ->
  Sem r (Buffer, Window)
createFloatWith :: forall (r :: EffectRow).
Member Rpc r =>
Bool -> Bool -> FloatOptions -> Sem r (Buffer, Window)
createFloatWith Bool
listed Bool
scratch FloatOptions
options = do
  Buffer
buffer <- Bool -> Bool -> Sem r Buffer
forall (r :: EffectRow).
Member Rpc r =>
Bool -> Bool -> Sem r Buffer
nvimCreateBuf Bool
listed Bool
scratch
  Window
window <- Buffer -> Bool -> Map Text Object -> Sem r Window
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Bool -> Map Text Object -> Sem r Window
nvimOpenWin Buffer
buffer (FloatOptions -> Bool
enter FloatOptions
options) (FloatOptions -> Map Text Object
floatConfig FloatOptions
options)
  pure (Buffer
buffer, Window
window)

createFloat ::
  Member Rpc r =>
  FloatOptions ->
  Sem r (Buffer, Window)
createFloat :: forall (r :: EffectRow).
Member Rpc r =>
FloatOptions -> Sem r (Buffer, Window)
createFloat =
  Bool -> Bool -> FloatOptions -> Sem r (Buffer, Window)
forall (r :: EffectRow).
Member Rpc r =>
Bool -> Bool -> FloatOptions -> Sem r (Buffer, Window)
createFloatWith Bool
True Bool
True

createScratchWindow ::
  Member Rpc r =>
  Bool ->
  Bool ->
  Bool ->
  Maybe FloatOptions ->
  Maybe Int ->
  Sem r (Buffer, Window)
createScratchWindow :: forall (r :: EffectRow).
Member Rpc r =>
Bool
-> Bool
-> Bool
-> Maybe FloatOptions
-> Maybe Int
-> Sem r (Buffer, Window)
createScratchWindow Bool
vertical Bool
wrap Bool
bottom Maybe FloatOptions
float Maybe Int
size = do
  (Buffer
buffer, Window
win) <- Sem r (Buffer, Window)
createWindow
  Window -> Text -> Object -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Window -> Text -> p_2 -> Sem r ()
windowSetOption Window
win Text
"wrap" (Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
wrap)
  Window -> Text -> Object -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Window -> Text -> p_2 -> Sem r ()
windowSetOption Window
win Text
"number" (Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
False)
  Window -> Text -> Object -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Window -> Text -> p_2 -> Sem r ()
windowSetOption Window
win Text
"cursorline" (Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True)
  Window -> Text -> Object -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Window -> Text -> p_2 -> Sem r ()
windowSetOption Window
win Text
"colorcolumn" (Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"" :: Text))
  Window -> Text -> Object -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Window -> Text -> p_2 -> Sem r ()
windowSetOption Window
win Text
"foldmethod" (Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"manual" :: Text))
  Window -> Text -> Object -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Window -> Text -> p_2 -> Sem r ()
windowSetOption Window
win Text
"conceallevel" (Int -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Int
2 :: Int))
  Window -> Text -> Object -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Window -> Text -> p_2 -> Sem r ()
windowSetOption Window
win Text
"concealcursor" (Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"nvic" :: Text))
  pure (Buffer
buffer, Window
win)
  where
    createWindow :: Sem r (Buffer, Window)
createWindow =
      Sem r (Buffer, Window)
-> (FloatOptions -> Sem r (Buffer, Window))
-> Maybe FloatOptions
-> Sem r (Buffer, Window)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sem r (Buffer, Window)
regular FloatOptions -> Sem r (Buffer, Window)
forall (r :: EffectRow).
Member Rpc r =>
FloatOptions -> Sem r (Buffer, Window)
createFloat Maybe FloatOptions
float
    regular :: Sem r (Buffer, Window)
regular =
      Bool -> Bool -> Maybe Int -> Sem r (Buffer, Window)
forall (r :: EffectRow).
Member Rpc r =>
Bool -> Bool -> Maybe Int -> Sem r (Buffer, Window)
createRegularWindow Bool
vertical Bool
bottom Maybe Int
size

createScratchUiInTab :: Member Rpc r => Sem r (Buffer, Window, Maybe Tabpage)
createScratchUiInTab :: forall (r :: EffectRow).
Member Rpc r =>
Sem r (Buffer, Window, Maybe Tabpage)
createScratchUiInTab = do
  Tabpage
tab <- Sem r Tabpage
forall (r :: EffectRow). Member Rpc r => Sem r Tabpage
createScratchTab
  Window
win <- Sem r Window
forall (r :: EffectRow). Member Rpc r => Sem r Window
vimGetCurrentWindow
  Buffer
buffer <- Window -> Sem r Buffer
forall (r :: EffectRow). Member Rpc r => Window -> Sem r Buffer
windowGetBuffer Window
win
  pure (Buffer
buffer, Window
win, Tabpage -> Maybe Tabpage
forall a. a -> Maybe a
Just Tabpage
tab)

createScratchUi ::
  Member Rpc r =>
  ScratchOptions ->
  Sem r (Buffer, Window, Maybe Tabpage)
createScratchUi :: forall (r :: EffectRow).
Member Rpc r =>
ScratchOptions -> Sem r (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]
_ Maybe Text
_ ScratchId
_) =
  (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))
-> Sem r (Buffer, Window) -> Sem r (Buffer, Window, Maybe Tabpage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Bool
-> Bool
-> Maybe FloatOptions
-> Maybe Int
-> Sem r (Buffer, Window)
forall (r :: EffectRow).
Member Rpc r =>
Bool
-> Bool
-> Bool
-> Maybe FloatOptions
-> Maybe Int
-> Sem r (Buffer, Window)
createScratchWindow Bool
vertical Bool
wrap Bool
bottom Maybe FloatOptions
float Maybe Int
size
createScratchUi ScratchOptions
_ =
  Sem r (Buffer, Window, Maybe Tabpage)
forall (r :: EffectRow).
Member Rpc r =>
Sem r (Buffer, Window, Maybe Tabpage)
createScratchUiInTab

configureScratchBuffer ::
  Member Rpc r =>
  Buffer ->
  Maybe Text ->
  ScratchId ->
  Sem r ()
configureScratchBuffer :: forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Maybe Text -> ScratchId -> Sem r ()
configureScratchBuffer Buffer
buffer Maybe Text
ft (ScratchId Text
name) = do
  Buffer -> Text -> Text -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Buffer -> Text -> p_2 -> Sem r ()
bufferSetOption Buffer
buffer Text
"bufhidden" (Text
"wipe" :: Text)
  Buffer -> Text -> Text -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Buffer -> Text -> p_2 -> Sem r ()
bufferSetOption Buffer
buffer Text
"buftype" (Text
"nofile" :: Text)
  Buffer -> Text -> Bool -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Buffer -> Text -> p_2 -> Sem r ()
bufferSetOption Buffer
buffer Text
"swapfile" Bool
False
  (Text -> Sem r ()) -> Maybe Text -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Buffer -> Text -> Text -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Buffer -> Text -> p_2 -> Sem r ()
bufferSetOption Buffer
buffer Text
"filetype") Maybe Text
ft
  Buffer -> Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Buffer -> Text -> Sem r ()
bufferSetName Buffer
buffer Text
name

setupScratchBuffer ::
  Members [Rpc, Log] r =>
  Window ->
  Buffer ->
  Maybe Text ->
  ScratchId ->
  Sem r Buffer
setupScratchBuffer :: forall (r :: EffectRow).
Members '[Rpc, Log] r =>
Window -> Buffer -> Maybe Text -> ScratchId -> Sem r Buffer
setupScratchBuffer Window
window Buffer
buffer Maybe Text
ft ScratchId
name = do
  Bool
valid <- Buffer -> Sem r Bool
forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r Bool
nvimBufIsLoaded Buffer
buffer
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|#{if valid then "" else "in"}valid scratch buffer|]
  Buffer
validBuffer <- if Bool
valid then Buffer -> Sem r Buffer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Buffer
buffer else Window -> Sem r Buffer
forall (r :: EffectRow). Member Rpc r => Window -> Sem r Buffer
windowGetBuffer Window
window
  Buffer -> Maybe Text -> ScratchId -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Maybe Text -> ScratchId -> Sem r ()
configureScratchBuffer Buffer
validBuffer Maybe Text
ft ScratchId
name
  pure Buffer
validBuffer

setupDeleteAutocmd ::
  Members [Rpc, Reader PluginName] r =>
  ScratchId ->
  Buffer ->
  Sem r AutocmdId
setupDeleteAutocmd :: forall (r :: EffectRow).
Members '[Rpc, Reader PluginName] r =>
ScratchId -> Buffer -> Sem r AutocmdId
setupDeleteAutocmd (ScratchId Text
name) Buffer
buffer = do
  PluginName Text
pname <- Sem r PluginName
forall (r :: EffectRow).
Member (Reader PluginName) r =>
Sem r PluginName
pluginNamePascalCase
  Buffer
-> AutocmdEvents -> AutocmdOptions -> Text -> Sem r AutocmdId
forall (r :: EffectRow).
Member Rpc r =>
Buffer
-> AutocmdEvents -> AutocmdOptions -> Text -> Sem r AutocmdId
bufferAutocmd Buffer
buffer AutocmdEvents
"BufDelete" AutocmdOptions
forall a. Default a => a
def { $sel:group:AutocmdOptions :: Maybe AutocmdGroup
group = AutocmdGroup -> Maybe AutocmdGroup
forall a. a -> Maybe a
Just AutocmdGroup
"RibosomeScratch" } (Text -> Text
deleteCall Text
pname)
  where
    deleteCall :: Text -> Text
deleteCall Text
pname =
      [exon|silent! call #{pname}DeleteScratch('#{name}')|]

setupScratchIn ::
  Members [Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log] r =>
  Buffer ->
  Window ->
  Window ->
  Maybe Tabpage ->
  ScratchOptions ->
  Sem r ScratchState
setupScratchIn :: forall (r :: EffectRow).
Members
  '[Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName,
    Log]
  r =>
Buffer
-> Window
-> Window
-> Maybe Tabpage
-> ScratchOptions
-> Sem r ScratchState
setupScratchIn Buffer
buffer Window
previous Window
window Maybe Tabpage
tab options :: ScratchOptions
options@(ScratchOptions {Bool
[Mapping]
[Syntax]
Maybe Text
ScratchId
name :: ScratchId
filetype :: Maybe Text
mappings :: [Mapping]
syntax :: [Syntax]
focus :: Bool
$sel:syntax:ScratchOptions :: ScratchOptions -> [Syntax]
$sel:mappings:ScratchOptions :: ScratchOptions -> [Mapping]
$sel:focus:ScratchOptions :: ScratchOptions -> Bool
$sel:name:ScratchOptions :: ScratchOptions -> ScratchId
$sel:filetype:ScratchOptions :: ScratchOptions -> Maybe Text
..}) = do
  Buffer
validBuffer <- Window -> Buffer -> Maybe Text -> ScratchId -> Sem r Buffer
forall (r :: EffectRow).
Members '[Rpc, Log] r =>
Window -> Buffer -> Maybe Text -> ScratchId -> Sem r Buffer
setupScratchBuffer Window
window Buffer
buffer Maybe Text
filetype ScratchId
name
  (Syntax -> Sem r ()) -> [Syntax] -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Window -> Syntax -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Window -> Syntax -> Sem r ()
executeWindowSyntax Window
window) [Syntax]
syntax
  (Mapping -> Sem r ()) -> [Mapping] -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Buffer -> Mapping -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Mapping -> Sem r ()
activateBufferMapping Buffer
validBuffer) [Mapping]
mappings
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
focus (Window -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Window -> Sem r ()
vimSetCurrentWindow Window
previous)
  AutocmdId
auId <- ScratchId -> Buffer -> Sem r AutocmdId
forall (r :: EffectRow).
Members '[Rpc, Reader PluginName] r =>
ScratchId -> Buffer -> Sem r AutocmdId
setupDeleteAutocmd ScratchId
name Buffer
validBuffer
  let scratch :: ScratchState
scratch = ScratchId
-> ScratchOptions
-> Buffer
-> Window
-> Window
-> Maybe Tabpage
-> AutocmdId
-> ScratchState
ScratchState ScratchId
name ScratchOptions
options Buffer
validBuffer Window
window Window
previous Maybe Tabpage
tab AutocmdId
auId
  (Map ScratchId ScratchState -> Map ScratchId ScratchState)
-> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (ScratchId
-> ScratchState
-> Map ScratchId ScratchState
-> Map ScratchId ScratchState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ScratchId
name ScratchState
scratch)
  pure ScratchState
scratch

createScratch ::
  Members [Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>
  ScratchOptions ->
  Sem r ScratchState
createScratch :: forall (r :: EffectRow).
Members
  '[Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName,
    Log, Resource]
  r =>
ScratchOptions -> Sem r ScratchState
createScratch ScratchOptions
options = do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|creating new scratch: #{show options}|]
  Window
previous <- Sem r Window
forall (r :: EffectRow). Member Rpc r => Sem r Window
vimGetCurrentWindow
  (Buffer
buffer, Window
window, Maybe Tabpage
tab) <- Sem r (Buffer, Window, Maybe Tabpage)
-> Sem r (Buffer, Window, Maybe Tabpage)
forall (r :: EffectRow) a.
Members '[Rpc, Resource] r =>
Sem r a -> Sem r a
eventignore (ScratchOptions -> Sem r (Buffer, Window, Maybe Tabpage)
forall (r :: EffectRow).
Member Rpc r =>
ScratchOptions -> Sem r (Buffer, Window, Maybe Tabpage)
createScratchUi ScratchOptions
options)
  Sem r ScratchState -> Sem r ScratchState
forall (r :: EffectRow) a.
Members '[Rpc, Resource] r =>
Sem r a -> Sem r a
eventignore (Sem r ScratchState -> Sem r ScratchState)
-> Sem r ScratchState -> Sem r ScratchState
forall a b. (a -> b) -> a -> b
$ Buffer
-> Window
-> Window
-> Maybe Tabpage
-> ScratchOptions
-> Sem r ScratchState
forall (r :: EffectRow).
Members
  '[Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName,
    Log]
  r =>
Buffer
-> Window
-> Window
-> Maybe Tabpage
-> ScratchOptions
-> Sem r ScratchState
setupScratchIn Buffer
buffer Window
previous Window
window Maybe Tabpage
tab ScratchOptions
options

bufferStillLoaded ::
  Members [Rpc !! RpcError, Rpc] r =>
  ScratchId ->
  Buffer ->
  Sem r Bool
bufferStillLoaded :: forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc] r =>
ScratchId -> Buffer -> Sem r Bool
bufferStillLoaded (ScratchId Text
name) Buffer
buffer =
  Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> Sem r Bool -> Sem r (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r Bool
loaded Sem r (Bool -> Bool) -> Sem r Bool -> Sem r Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sem r Bool
loadedName
  where
    loaded :: Sem r Bool
loaded =
      Buffer -> Sem r Bool
forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r Bool
nvimBufIsLoaded Buffer
buffer
    loadedName :: Sem r Bool
loadedName =
      forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
a -> Sem (eff : r) a -> Sem r a
resumeAs @RpcError Bool
False ((Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool) -> Sem (Rpc : r) Text -> Sem (Rpc : r) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Sem (Rpc : r) Text
forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r Text
bufferGetName Buffer
buffer)

updateScratch ::
  Members [Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>
  ScratchState ->
  ScratchOptions ->
  Sem r ScratchState
updateScratch :: forall (r :: EffectRow).
Members
  '[Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState),
    Reader PluginName, Log, Resource]
  r =>
ScratchState -> ScratchOptions -> Sem r ScratchState
updateScratch oldScratch :: ScratchState
oldScratch@(ScratchState ScratchId
name ScratchOptions
_ Buffer
oldBuffer Window
oldWindow Window
_ Maybe Tabpage
_ AutocmdId
_) ScratchOptions
options = do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|updating existing scratch `#{coerce name}`|]
  Sem r Bool
-> Sem r ScratchState -> Sem r ScratchState -> Sem r ScratchState
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Window -> Sem r Bool
forall (r :: EffectRow). Member Rpc r => Window -> Sem r Bool
windowIsValid Window
oldWindow) Sem r ScratchState
attemptReuseWindow Sem r ScratchState
reset
  where
    attemptReuseWindow :: Sem r ScratchState
attemptReuseWindow =
      Sem r Bool
-> Sem r ScratchState -> Sem r ScratchState -> Sem r ScratchState
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (ScratchId -> Buffer -> Sem r Bool
forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc] r =>
ScratchId -> Buffer -> Sem r Bool
bufferStillLoaded ScratchId
name Buffer
oldBuffer) (ScratchState -> Sem r ScratchState
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScratchState
oldScratch) Sem r ScratchState
closeAndReset
    closeAndReset :: Sem r ScratchState
closeAndReset =
      Window -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Window -> Sem r ()
closeWindow Window
oldWindow Sem r () -> Sem r ScratchState -> Sem r ScratchState
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Sem r ScratchState
reset
    reset :: Sem r ScratchState
reset =
      ScratchOptions -> Sem r ScratchState
forall (r :: EffectRow).
Members
  '[Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName,
    Log, Resource]
  r =>
ScratchOptions -> Sem r ScratchState
createScratch ScratchOptions
options

lookupScratch ::
  Member (AtomicState (Map ScratchId ScratchState)) r =>
  ScratchId ->
  Sem r (Maybe ScratchState)
lookupScratch :: forall (r :: EffectRow).
Member (AtomicState (Map ScratchId ScratchState)) r =>
ScratchId -> Sem r (Maybe ScratchState)
lookupScratch ScratchId
name =
  (Map ScratchId ScratchState -> Maybe ScratchState)
-> Sem r (Maybe ScratchState)
forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets (ScratchId -> Map ScratchId ScratchState -> Maybe ScratchState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScratchId
name)

ensureScratch ::
  Members [Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>
  ScratchOptions ->
  Sem r ScratchState
ensureScratch :: forall (r :: EffectRow).
Members
  '[Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState),
    Reader PluginName, Log, Resource]
  r =>
ScratchOptions -> Sem r ScratchState
ensureScratch ScratchOptions
options = do
  ScratchOptions -> Sem r ScratchState
f <- (ScratchOptions -> Sem r ScratchState)
-> (ScratchState -> ScratchOptions -> Sem r ScratchState)
-> Maybe ScratchState
-> ScratchOptions
-> Sem r ScratchState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ScratchOptions -> Sem r ScratchState
forall (r :: EffectRow).
Members
  '[Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName,
    Log, Resource]
  r =>
ScratchOptions -> Sem r ScratchState
createScratch ScratchState -> ScratchOptions -> Sem r ScratchState
forall (r :: EffectRow).
Members
  '[Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState),
    Reader PluginName, Log, Resource]
  r =>
ScratchState -> ScratchOptions -> Sem r ScratchState
updateScratch (Maybe ScratchState -> ScratchOptions -> Sem r ScratchState)
-> Sem r (Maybe ScratchState)
-> Sem r (ScratchOptions -> Sem r ScratchState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScratchId -> Sem r (Maybe ScratchState)
forall (r :: EffectRow).
Member (AtomicState (Map ScratchId ScratchState)) r =>
ScratchId -> Sem r (Maybe ScratchState)
lookupScratch (ScratchOptions
options ScratchOptions
-> Getting ScratchId ScratchOptions ScratchId -> ScratchId
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting ScratchId ScratchOptions ScratchId)
Getting ScratchId ScratchOptions ScratchId
#name)
  ScratchOptions -> Sem r ScratchState
f ScratchOptions
options

withModifiable ::
  Member Rpc r =>
  Buffer ->
  ScratchOptions ->
  Sem r a ->
  Sem r a
withModifiable :: forall (r :: EffectRow) a.
Member Rpc r =>
Buffer -> ScratchOptions -> Sem r a -> Sem r a
withModifiable Buffer
buffer ScratchOptions
options Sem r a
thunk =
  if Bool
isWrite then Sem r a
thunk else Sem r a
wrap
  where
    isWrite :: Bool
isWrite =
      ScratchOptions
options ScratchOptions -> Getting Bool ScratchOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. IsLabel "modify" (Getting Bool ScratchOptions Bool)
Getting Bool ScratchOptions Bool
#modify
    wrap :: Sem r a
wrap =
      Bool -> Sem r ()
update Bool
True Sem r () -> Sem r a -> Sem r a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Sem r a
thunk Sem r a -> Sem r () -> Sem r a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Bool -> Sem r ()
update Bool
False
    update :: Bool -> Sem r ()
update =
      Buffer -> Text -> Bool -> Sem r ()
forall p_2 (r :: EffectRow).
(Member Rpc r, MsgpackEncode p_2) =>
Buffer -> Text -> p_2 -> Sem r ()
bufferSetOption Buffer
buffer Text
"modifiable"

setScratchContent ::
  Foldable t =>
  Members [Rpc !! RpcError, Rpc] r =>
  ScratchState ->
  t Text ->
  Sem r ()
setScratchContent :: forall (t :: * -> *) (r :: EffectRow).
(Foldable t, Members '[Rpc !! RpcError, Rpc] r) =>
ScratchState -> t Text -> Sem r ()
setScratchContent (ScratchState ScratchId
_ ScratchOptions
options Buffer
buffer Window
win Window
_ Maybe Tabpage
_ AutocmdId
_) t Text
lines' = do
  Buffer -> ScratchOptions -> Sem r () -> Sem r ()
forall (r :: EffectRow) a.
Member Rpc r =>
Buffer -> ScratchOptions -> Sem r a -> Sem r a
withModifiable Buffer
buffer ScratchOptions
options (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Buffer -> [Text] -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> [Text] -> Sem r ()
setBufferContent Buffer
buffer (t Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Text
lines')
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ScratchOptions
options ScratchOptions -> Getting Bool ScratchOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. IsLabel "resize" (Getting Bool ScratchOptions Bool)
Getting Bool ScratchOptions Bool
#resize) (forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Member (Resumable err eff) r =>
Sem (eff : r) () -> Sem r ()
resume_ @RpcError @Rpc (Window -> Int -> Sem (Rpc : r) ()
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 =
      ScratchOptions
options ScratchOptions
-> Getting (Maybe Int) ScratchOptions (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. IsLabel "maxSize" (Getting (Maybe Int) ScratchOptions (Maybe Int))
Getting (Maybe Int) ScratchOptions (Maybe Int)
#maxSize
    vertical :: Bool
vertical =
      ScratchOptions
options ScratchOptions -> Getting Bool ScratchOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. IsLabel "vertical" (Getting Bool ScratchOptions Bool)
Getting Bool ScratchOptions Bool
#vertical
    setSize :: Window -> Int -> Sem (Rpc : r) ()
setSize =
      if Bool
vertical then Window -> Int -> Sem (Rpc : r) ()
forall (r :: EffectRow). Member Rpc r => Window -> Int -> Sem r ()
windowSetWidth else Window -> Int -> Sem (Rpc : r) ()
forall (r :: EffectRow). Member Rpc r => Window -> Int -> Sem r ()
windowSetHeight

showInScratch ::
  Foldable t =>
  Members [Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>
  t Text ->
  ScratchOptions ->
  Sem r ScratchState
showInScratch :: forall (t :: * -> *) (r :: EffectRow).
(Foldable t,
 Members
   '[Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState),
     Reader PluginName, Log, Resource]
   r) =>
t Text -> ScratchOptions -> Sem r ScratchState
showInScratch t Text
lines' ScratchOptions
options = do
  ScratchState
scratch <- ScratchOptions -> Sem r ScratchState
forall (r :: EffectRow).
Members
  '[Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState),
    Reader PluginName, Log, Resource]
  r =>
ScratchOptions -> Sem r ScratchState
ensureScratch ScratchOptions
options
  ScratchState
scratch ScratchState -> Sem r () -> Sem r ScratchState
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ScratchState -> t Text -> Sem r ()
forall (t :: * -> *) (r :: EffectRow).
(Foldable t, Members '[Rpc !! RpcError, Rpc] r) =>
ScratchState -> t Text -> Sem r ()
setScratchContent ScratchState
scratch t Text
lines'

showInScratchDef ::
  Foldable t =>
  Members [Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState), Reader PluginName, Log, Resource] r =>
  t Text ->
  Sem r ScratchState
showInScratchDef :: forall (t :: * -> *) (r :: EffectRow).
(Foldable t,
 Members
   '[Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState),
     Reader PluginName, Log, Resource]
   r) =>
t Text -> Sem r ScratchState
showInScratchDef t Text
lines' =
  t Text -> ScratchOptions -> Sem r ScratchState
forall (t :: * -> *) (r :: EffectRow).
(Foldable t,
 Members
   '[Rpc !! RpcError, Rpc, AtomicState (Map ScratchId ScratchState),
     Reader PluginName, Log, Resource]
   r) =>
t Text -> ScratchOptions -> Sem r ScratchState
showInScratch t Text
lines' ScratchOptions
forall a. Default a => a
def

killScratch ::
  Members [Rpc !! RpcError, AtomicState (Map ScratchId ScratchState), Log] r =>
  ScratchState ->
  Sem r ()
killScratch :: forall (r :: EffectRow).
Members
  '[Rpc !! RpcError, AtomicState (Map ScratchId ScratchState), Log]
  r =>
ScratchState -> Sem r ()
killScratch (ScratchState ScratchId
name ScratchOptions
_ Buffer
buffer Window
window Window
_ Maybe Tabpage
tab (AutocmdId Int
auId)) = do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|Killing scratch buffer `#{unScratchId name}`|]
  (Map ScratchId ScratchState -> Map ScratchId ScratchState)
-> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete @_ @ScratchState ScratchId
name)
  Sem (Rpc : r) () -> Sem r ()
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Member (Resumable err eff) r =>
Sem (eff : r) () -> Sem r ()
resume_ (Int -> Sem (Rpc : r) ()
forall (r :: EffectRow). Member Rpc r => Int -> Sem r ()
nvimDelAutocmd Int
auId)
  (Tabpage -> Sem r ()) -> Maybe Tabpage -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Sem (Rpc : r) () -> Sem r ()
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Member (Resumable err eff) r =>
Sem (eff : r) () -> Sem r ()
resume_ (Sem (Rpc : r) () -> Sem r ())
-> (Tabpage -> Sem (Rpc : r) ()) -> Tabpage -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tabpage -> Sem (Rpc : r) ()
forall (r :: EffectRow). Member Rpc r => Tabpage -> Sem r ()
closeTabpage) Maybe Tabpage
tab
  Sem (Rpc : r) () -> Sem r ()
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Member (Resumable err eff) r =>
Sem (eff : r) () -> Sem r ()
resume_ (Window -> Sem (Rpc : r) ()
forall (r :: EffectRow). Member Rpc r => Window -> Sem r ()
closeWindow Window
window)
  Sem (Rpc : r) () -> Sem r ()
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Member (Resumable err eff) r =>
Sem (eff : r) () -> Sem r ()
resume_ (Buffer -> Sem (Rpc : r) ()
forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r ()
wipeBuffer Buffer
buffer)

scratchPreviousWindow ::
  Member (AtomicState (Map ScratchId ScratchState)) r =>
  ScratchId ->
  Sem r (Maybe Window)
scratchPreviousWindow :: forall (r :: EffectRow).
Member (AtomicState (Map ScratchId ScratchState)) r =>
ScratchId -> Sem r (Maybe Window)
scratchPreviousWindow =
  (Maybe ScratchState -> Maybe Window)
-> Sem r (Maybe ScratchState) -> Sem r (Maybe Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ScratchState -> Window) -> Maybe ScratchState -> Maybe Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScratchState -> Window
ScratchState.previous) (Sem r (Maybe ScratchState) -> Sem r (Maybe Window))
-> (ScratchId -> Sem r (Maybe ScratchState))
-> ScratchId
-> Sem r (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScratchId -> Sem r (Maybe ScratchState)
forall (r :: EffectRow).
Member (AtomicState (Map ScratchId ScratchState)) r =>
ScratchId -> Sem r (Maybe ScratchState)
lookupScratch

scratchWindow ::
  Member (AtomicState (Map ScratchId ScratchState)) r =>
  ScratchId ->
  Sem r (Maybe Window)
scratchWindow :: forall (r :: EffectRow).
Member (AtomicState (Map ScratchId ScratchState)) r =>
ScratchId -> Sem r (Maybe Window)
scratchWindow =
  (Maybe ScratchState -> Maybe Window)
-> Sem r (Maybe ScratchState) -> Sem r (Maybe Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ScratchState -> Window) -> Maybe ScratchState -> Maybe Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScratchState -> Window
ScratchState.window) (Sem r (Maybe ScratchState) -> Sem r (Maybe Window))
-> (ScratchId -> Sem r (Maybe ScratchState))
-> ScratchId
-> Sem r (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScratchId -> Sem r (Maybe ScratchState)
forall (r :: EffectRow).
Member (AtomicState (Map ScratchId ScratchState)) r =>
ScratchId -> Sem r (Maybe ScratchState)
lookupScratch

scratchBuffer ::
  Member (AtomicState (Map ScratchId ScratchState)) r =>
  ScratchId ->
  Sem r (Maybe Buffer)
scratchBuffer :: forall (r :: EffectRow).
Member (AtomicState (Map ScratchId ScratchState)) r =>
ScratchId -> Sem r (Maybe Buffer)
scratchBuffer =
  (Maybe ScratchState -> Maybe Buffer)
-> Sem r (Maybe ScratchState) -> Sem r (Maybe Buffer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ScratchState -> Buffer) -> Maybe ScratchState -> Maybe Buffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScratchState -> Buffer
ScratchState.buffer) (Sem r (Maybe ScratchState) -> Sem r (Maybe Buffer))
-> (ScratchId -> Sem r (Maybe ScratchState))
-> ScratchId
-> Sem r (Maybe Buffer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScratchId -> Sem r (Maybe ScratchState)
forall (r :: EffectRow).
Member (AtomicState (Map ScratchId ScratchState)) r =>
ScratchId -> Sem r (Maybe ScratchState)
lookupScratch