module Chiasma.Codec.Data.PaneCoords where

import Chiasma.Data.TmuxId (HasPaneId, PaneId, SessionId, WindowId)
import qualified Chiasma.Data.TmuxId as HasPaneId (HasPaneId(..))

import Chiasma.Codec (TmuxCodec)

data PaneCoords =
  PaneCoords {
    PaneCoords -> SessionId
sessionId :: SessionId,
    PaneCoords -> WindowId
windowId :: WindowId,
    PaneCoords -> PaneId
paneId :: PaneId
  }
  deriving (PaneCoords -> PaneCoords -> Bool
(PaneCoords -> PaneCoords -> Bool)
-> (PaneCoords -> PaneCoords -> Bool) -> Eq PaneCoords
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PaneCoords -> PaneCoords -> Bool
$c/= :: PaneCoords -> PaneCoords -> Bool
== :: PaneCoords -> PaneCoords -> Bool
$c== :: PaneCoords -> PaneCoords -> Bool
Eq, Int -> PaneCoords -> ShowS
[PaneCoords] -> ShowS
PaneCoords -> String
(Int -> PaneCoords -> ShowS)
-> (PaneCoords -> String)
-> ([PaneCoords] -> ShowS)
-> Show PaneCoords
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PaneCoords] -> ShowS
$cshowList :: [PaneCoords] -> ShowS
show :: PaneCoords -> String
$cshow :: PaneCoords -> String
showsPrec :: Int -> PaneCoords -> ShowS
$cshowsPrec :: Int -> PaneCoords -> ShowS
Show, (forall x. PaneCoords -> Rep PaneCoords x)
-> (forall x. Rep PaneCoords x -> PaneCoords) -> Generic PaneCoords
forall x. Rep PaneCoords x -> PaneCoords
forall x. PaneCoords -> Rep PaneCoords x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PaneCoords x -> PaneCoords
$cfrom :: forall x. PaneCoords -> Rep PaneCoords x
Generic, TmuxQuery
Text -> Either TmuxDecodeError PaneCoords
(Text -> Either TmuxDecodeError PaneCoords)
-> TmuxQuery -> TmuxCodec PaneCoords
forall a.
(Text -> Either TmuxDecodeError a) -> TmuxQuery -> TmuxCodec a
query :: TmuxQuery
$cquery :: TmuxQuery
decode :: Text -> Either TmuxDecodeError PaneCoords
$cdecode :: Text -> Either TmuxDecodeError PaneCoords
TmuxCodec)

instance HasPaneId PaneCoords where
  paneId :: PaneCoords -> PaneId
paneId = PaneCoords -> PaneId
paneId