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