-- |Scratch buffer state.
module Ribosome.Data.ScratchState where

import Ribosome.Data.ScratchId (ScratchId)
import Ribosome.Data.ScratchOptions (ScratchOptions)
import Ribosome.Host.Api.Data (Buffer, Tabpage, Window)
import Ribosome.Host.Data.RpcType (AutocmdId)

-- |The configuration and Neovim resources that define a scratch buffer and describe its previously recorded UI state.
data ScratchState =
  ScratchState {
    -- |The scratch buffer's ID stored in the state.
    ScratchState -> ScratchId
id :: ScratchId,
    -- |The configuration used to create the scratch buffer.
    ScratchState -> ScratchOptions
options :: ScratchOptions,
    -- |The Neovim buffer handle that was returned when it was last updated.
    ScratchState -> Buffer
buffer :: Buffer,
    -- |The Neovim window handle that was returned when it was last updated.
    ScratchState -> Window
window :: Window,
    -- |The Neovim window handle that denotes the window that was active when the scratch buffer was created.
    ScratchState -> Window
previous :: Window,
    -- |The Neovim tabpage handle that was returned when it was last updated, if a tab was requested by the
    -- configuration.
    ScratchState -> Maybe Tabpage
tab :: Maybe Tabpage,
    -- |The ID of the autocmd that fires when the user deletes the scratch buffer.
    ScratchState -> AutocmdId
autocmdId :: AutocmdId
  }
  deriving stock (ScratchState -> ScratchState -> Bool
(ScratchState -> ScratchState -> Bool)
-> (ScratchState -> ScratchState -> Bool) -> Eq ScratchState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScratchState -> ScratchState -> Bool
$c/= :: ScratchState -> ScratchState -> Bool
== :: ScratchState -> ScratchState -> Bool
$c== :: ScratchState -> ScratchState -> Bool
Eq, Int -> ScratchState -> ShowS
[ScratchState] -> ShowS
ScratchState -> String
(Int -> ScratchState -> ShowS)
-> (ScratchState -> String)
-> ([ScratchState] -> ShowS)
-> Show ScratchState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScratchState] -> ShowS
$cshowList :: [ScratchState] -> ShowS
show :: ScratchState -> String
$cshow :: ScratchState -> String
showsPrec :: Int -> ScratchState -> ShowS
$cshowsPrec :: Int -> ScratchState -> ShowS
Show, (forall x. ScratchState -> Rep ScratchState x)
-> (forall x. Rep ScratchState x -> ScratchState)
-> Generic ScratchState
forall x. Rep ScratchState x -> ScratchState
forall x. ScratchState -> Rep ScratchState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScratchState x -> ScratchState
$cfrom :: forall x. ScratchState -> Rep ScratchState x
Generic)