module Chiasma.Data.TmuxId where

import Data.Data (Data)
import Prettyprinter (Pretty (..))

newtype ClientId =
  ClientId { ClientId -> Text
unClientId :: Text }
  deriving stock (ClientId -> ClientId -> Bool
(ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> Bool) -> Eq ClientId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientId -> ClientId -> Bool
== :: ClientId -> ClientId -> Bool
$c/= :: ClientId -> ClientId -> Bool
/= :: ClientId -> ClientId -> Bool
Eq, Int -> ClientId -> ShowS
[ClientId] -> ShowS
ClientId -> String
(Int -> ClientId -> ShowS)
-> (ClientId -> String) -> ([ClientId] -> ShowS) -> Show ClientId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientId -> ShowS
showsPrec :: Int -> ClientId -> ShowS
$cshow :: ClientId -> String
show :: ClientId -> String
$cshowList :: [ClientId] -> ShowS
showList :: [ClientId] -> ShowS
Show, (forall x. ClientId -> Rep ClientId x)
-> (forall x. Rep ClientId x -> ClientId) -> Generic ClientId
forall x. Rep ClientId x -> ClientId
forall x. ClientId -> Rep ClientId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientId -> Rep ClientId x
from :: forall x. ClientId -> Rep ClientId x
$cto :: forall x. Rep ClientId x -> ClientId
to :: forall x. Rep ClientId x -> ClientId
Generic)
  deriving newtype (String -> ClientId
(String -> ClientId) -> IsString ClientId
forall a. (String -> a) -> IsString a
$cfromString :: String -> ClientId
fromString :: String -> ClientId
IsString)

instance Pretty ClientId where
  pretty :: forall ann. ClientId -> Doc ann
pretty = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (ClientId -> Text) -> ClientId -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.unClientId)

sessionPrefix :: Text
sessionPrefix :: Text
sessionPrefix = Text
"$"

newtype SessionId =
  SessionId Int
  deriving stock (SessionId -> SessionId -> Bool
(SessionId -> SessionId -> Bool)
-> (SessionId -> SessionId -> Bool) -> Eq SessionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionId -> SessionId -> Bool
== :: SessionId -> SessionId -> Bool
$c/= :: SessionId -> SessionId -> Bool
/= :: SessionId -> SessionId -> Bool
Eq, Int -> SessionId -> ShowS
[SessionId] -> ShowS
SessionId -> String
(Int -> SessionId -> ShowS)
-> (SessionId -> String)
-> ([SessionId] -> ShowS)
-> Show SessionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionId -> ShowS
showsPrec :: Int -> SessionId -> ShowS
$cshow :: SessionId -> String
show :: SessionId -> String
$cshowList :: [SessionId] -> ShowS
showList :: [SessionId] -> ShowS
Show, (forall x. SessionId -> Rep SessionId x)
-> (forall x. Rep SessionId x -> SessionId) -> Generic SessionId
forall x. Rep SessionId x -> SessionId
forall x. SessionId -> Rep SessionId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SessionId -> Rep SessionId x
from :: forall x. SessionId -> Rep SessionId x
$cto :: forall x. Rep SessionId x -> SessionId
to :: forall x. Rep SessionId x -> SessionId
Generic)
  deriving newtype (Integer -> SessionId
SessionId -> SessionId
SessionId -> SessionId -> SessionId
(SessionId -> SessionId -> SessionId)
-> (SessionId -> SessionId -> SessionId)
-> (SessionId -> SessionId -> SessionId)
-> (SessionId -> SessionId)
-> (SessionId -> SessionId)
-> (SessionId -> SessionId)
-> (Integer -> SessionId)
-> Num SessionId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: SessionId -> SessionId -> SessionId
+ :: SessionId -> SessionId -> SessionId
$c- :: SessionId -> SessionId -> SessionId
- :: SessionId -> SessionId -> SessionId
$c* :: SessionId -> SessionId -> SessionId
* :: SessionId -> SessionId -> SessionId
$cnegate :: SessionId -> SessionId
negate :: SessionId -> SessionId
$cabs :: SessionId -> SessionId
abs :: SessionId -> SessionId
$csignum :: SessionId -> SessionId
signum :: SessionId -> SessionId
$cfromInteger :: Integer -> SessionId
fromInteger :: Integer -> SessionId
Num, Eq SessionId
Eq SessionId
-> (SessionId -> SessionId -> Ordering)
-> (SessionId -> SessionId -> Bool)
-> (SessionId -> SessionId -> Bool)
-> (SessionId -> SessionId -> Bool)
-> (SessionId -> SessionId -> Bool)
-> (SessionId -> SessionId -> SessionId)
-> (SessionId -> SessionId -> SessionId)
-> Ord SessionId
SessionId -> SessionId -> Bool
SessionId -> SessionId -> Ordering
SessionId -> SessionId -> SessionId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SessionId -> SessionId -> Ordering
compare :: SessionId -> SessionId -> Ordering
$c< :: SessionId -> SessionId -> Bool
< :: SessionId -> SessionId -> Bool
$c<= :: SessionId -> SessionId -> Bool
<= :: SessionId -> SessionId -> Bool
$c> :: SessionId -> SessionId -> Bool
> :: SessionId -> SessionId -> Bool
$c>= :: SessionId -> SessionId -> Bool
>= :: SessionId -> SessionId -> Bool
$cmax :: SessionId -> SessionId -> SessionId
max :: SessionId -> SessionId -> SessionId
$cmin :: SessionId -> SessionId -> SessionId
min :: SessionId -> SessionId -> SessionId
Ord)

instance Pretty SessionId where
  pretty :: forall ann. SessionId -> Doc ann
pretty = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (SessionId -> Text) -> SessionId -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId -> Text
forall a. TmuxId a => a -> Text
formatId

windowPrefix :: Text
windowPrefix :: Text
windowPrefix = Text
"@"

newtype WindowId =
  WindowId Int
  deriving stock (WindowId -> WindowId -> Bool
(WindowId -> WindowId -> Bool)
-> (WindowId -> WindowId -> Bool) -> Eq WindowId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowId -> WindowId -> Bool
== :: WindowId -> WindowId -> Bool
$c/= :: WindowId -> WindowId -> Bool
/= :: WindowId -> WindowId -> Bool
Eq, Int -> WindowId -> ShowS
[WindowId] -> ShowS
WindowId -> String
(Int -> WindowId -> ShowS)
-> (WindowId -> String) -> ([WindowId] -> ShowS) -> Show WindowId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowId -> ShowS
showsPrec :: Int -> WindowId -> ShowS
$cshow :: WindowId -> String
show :: WindowId -> String
$cshowList :: [WindowId] -> ShowS
showList :: [WindowId] -> ShowS
Show, (forall x. WindowId -> Rep WindowId x)
-> (forall x. Rep WindowId x -> WindowId) -> Generic WindowId
forall x. Rep WindowId x -> WindowId
forall x. WindowId -> Rep WindowId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowId -> Rep WindowId x
from :: forall x. WindowId -> Rep WindowId x
$cto :: forall x. Rep WindowId x -> WindowId
to :: forall x. Rep WindowId x -> WindowId
Generic)
  deriving newtype (Integer -> WindowId
WindowId -> WindowId
WindowId -> WindowId -> WindowId
(WindowId -> WindowId -> WindowId)
-> (WindowId -> WindowId -> WindowId)
-> (WindowId -> WindowId -> WindowId)
-> (WindowId -> WindowId)
-> (WindowId -> WindowId)
-> (WindowId -> WindowId)
-> (Integer -> WindowId)
-> Num WindowId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: WindowId -> WindowId -> WindowId
+ :: WindowId -> WindowId -> WindowId
$c- :: WindowId -> WindowId -> WindowId
- :: WindowId -> WindowId -> WindowId
$c* :: WindowId -> WindowId -> WindowId
* :: WindowId -> WindowId -> WindowId
$cnegate :: WindowId -> WindowId
negate :: WindowId -> WindowId
$cabs :: WindowId -> WindowId
abs :: WindowId -> WindowId
$csignum :: WindowId -> WindowId
signum :: WindowId -> WindowId
$cfromInteger :: Integer -> WindowId
fromInteger :: Integer -> WindowId
Num, Eq WindowId
Eq WindowId
-> (WindowId -> WindowId -> Ordering)
-> (WindowId -> WindowId -> Bool)
-> (WindowId -> WindowId -> Bool)
-> (WindowId -> WindowId -> Bool)
-> (WindowId -> WindowId -> Bool)
-> (WindowId -> WindowId -> WindowId)
-> (WindowId -> WindowId -> WindowId)
-> Ord WindowId
WindowId -> WindowId -> Bool
WindowId -> WindowId -> Ordering
WindowId -> WindowId -> WindowId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowId -> WindowId -> Ordering
compare :: WindowId -> WindowId -> Ordering
$c< :: WindowId -> WindowId -> Bool
< :: WindowId -> WindowId -> Bool
$c<= :: WindowId -> WindowId -> Bool
<= :: WindowId -> WindowId -> Bool
$c> :: WindowId -> WindowId -> Bool
> :: WindowId -> WindowId -> Bool
$c>= :: WindowId -> WindowId -> Bool
>= :: WindowId -> WindowId -> Bool
$cmax :: WindowId -> WindowId -> WindowId
max :: WindowId -> WindowId -> WindowId
$cmin :: WindowId -> WindowId -> WindowId
min :: WindowId -> WindowId -> WindowId
Ord)

instance Pretty WindowId where
  pretty :: forall ann. WindowId -> Doc ann
pretty = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (WindowId -> Text) -> WindowId -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowId -> Text
forall a. TmuxId a => a -> Text
formatId

panePrefix :: Text
panePrefix :: Text
panePrefix = Text
"%"

newtype PaneId =
  PaneId Int
  deriving stock (PaneId -> PaneId -> Bool
(PaneId -> PaneId -> Bool)
-> (PaneId -> PaneId -> Bool) -> Eq PaneId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PaneId -> PaneId -> Bool
== :: PaneId -> PaneId -> Bool
$c/= :: PaneId -> PaneId -> Bool
/= :: PaneId -> PaneId -> Bool
Eq, Int -> PaneId -> ShowS
[PaneId] -> ShowS
PaneId -> String
(Int -> PaneId -> ShowS)
-> (PaneId -> String) -> ([PaneId] -> ShowS) -> Show PaneId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PaneId -> ShowS
showsPrec :: Int -> PaneId -> ShowS
$cshow :: PaneId -> String
show :: PaneId -> String
$cshowList :: [PaneId] -> ShowS
showList :: [PaneId] -> ShowS
Show, (forall x. PaneId -> Rep PaneId x)
-> (forall x. Rep PaneId x -> PaneId) -> Generic PaneId
forall x. Rep PaneId x -> PaneId
forall x. PaneId -> Rep PaneId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PaneId -> Rep PaneId x
from :: forall x. PaneId -> Rep PaneId x
$cto :: forall x. Rep PaneId x -> PaneId
to :: forall x. Rep PaneId x -> PaneId
Generic, Typeable PaneId
Typeable PaneId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PaneId -> c PaneId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PaneId)
-> (PaneId -> Constr)
-> (PaneId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PaneId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PaneId))
-> ((forall b. Data b => b -> b) -> PaneId -> PaneId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PaneId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PaneId -> r)
-> (forall u. (forall d. Data d => d -> u) -> PaneId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PaneId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PaneId -> m PaneId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PaneId -> m PaneId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PaneId -> m PaneId)
-> Data PaneId
PaneId -> Constr
PaneId -> DataType
(forall b. Data b => b -> b) -> PaneId -> PaneId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PaneId -> u
forall u. (forall d. Data d => d -> u) -> PaneId -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PaneId -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PaneId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PaneId -> m PaneId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PaneId -> m PaneId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PaneId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PaneId -> c PaneId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PaneId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PaneId)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PaneId -> c PaneId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PaneId -> c PaneId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PaneId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PaneId
$ctoConstr :: PaneId -> Constr
toConstr :: PaneId -> Constr
$cdataTypeOf :: PaneId -> DataType
dataTypeOf :: PaneId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PaneId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PaneId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PaneId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PaneId)
$cgmapT :: (forall b. Data b => b -> b) -> PaneId -> PaneId
gmapT :: (forall b. Data b => b -> b) -> PaneId -> PaneId
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PaneId -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PaneId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PaneId -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PaneId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PaneId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PaneId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PaneId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PaneId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PaneId -> m PaneId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PaneId -> m PaneId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PaneId -> m PaneId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PaneId -> m PaneId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PaneId -> m PaneId
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PaneId -> m PaneId
Data)
  deriving newtype (Integer -> PaneId
PaneId -> PaneId
PaneId -> PaneId -> PaneId
(PaneId -> PaneId -> PaneId)
-> (PaneId -> PaneId -> PaneId)
-> (PaneId -> PaneId -> PaneId)
-> (PaneId -> PaneId)
-> (PaneId -> PaneId)
-> (PaneId -> PaneId)
-> (Integer -> PaneId)
-> Num PaneId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: PaneId -> PaneId -> PaneId
+ :: PaneId -> PaneId -> PaneId
$c- :: PaneId -> PaneId -> PaneId
- :: PaneId -> PaneId -> PaneId
$c* :: PaneId -> PaneId -> PaneId
* :: PaneId -> PaneId -> PaneId
$cnegate :: PaneId -> PaneId
negate :: PaneId -> PaneId
$cabs :: PaneId -> PaneId
abs :: PaneId -> PaneId
$csignum :: PaneId -> PaneId
signum :: PaneId -> PaneId
$cfromInteger :: Integer -> PaneId
fromInteger :: Integer -> PaneId
Num, Eq PaneId
Eq PaneId
-> (PaneId -> PaneId -> Ordering)
-> (PaneId -> PaneId -> Bool)
-> (PaneId -> PaneId -> Bool)
-> (PaneId -> PaneId -> Bool)
-> (PaneId -> PaneId -> Bool)
-> (PaneId -> PaneId -> PaneId)
-> (PaneId -> PaneId -> PaneId)
-> Ord PaneId
PaneId -> PaneId -> Bool
PaneId -> PaneId -> Ordering
PaneId -> PaneId -> PaneId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PaneId -> PaneId -> Ordering
compare :: PaneId -> PaneId -> Ordering
$c< :: PaneId -> PaneId -> Bool
< :: PaneId -> PaneId -> Bool
$c<= :: PaneId -> PaneId -> Bool
<= :: PaneId -> PaneId -> Bool
$c> :: PaneId -> PaneId -> Bool
> :: PaneId -> PaneId -> Bool
$c>= :: PaneId -> PaneId -> Bool
>= :: PaneId -> PaneId -> Bool
$cmax :: PaneId -> PaneId -> PaneId
max :: PaneId -> PaneId -> PaneId
$cmin :: PaneId -> PaneId -> PaneId
min :: PaneId -> PaneId -> PaneId
Ord)

instance Pretty PaneId where
  pretty :: forall ann. PaneId -> Doc ann
pretty = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (PaneId -> Text) -> PaneId -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PaneId -> Text
forall a. TmuxId a => a -> Text
formatId

class HasPaneId a where
  paneId :: a -> PaneId

newtype TmuxIdPrefix a =
  TmuxIdPrefix { forall {k} (a :: k). TmuxIdPrefix a -> Text
unTmuxIdPrefix :: Text }
  deriving stock (TmuxIdPrefix a -> TmuxIdPrefix a -> Bool
(TmuxIdPrefix a -> TmuxIdPrefix a -> Bool)
-> (TmuxIdPrefix a -> TmuxIdPrefix a -> Bool)
-> Eq (TmuxIdPrefix a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). TmuxIdPrefix a -> TmuxIdPrefix a -> Bool
$c== :: forall k (a :: k). TmuxIdPrefix a -> TmuxIdPrefix a -> Bool
== :: TmuxIdPrefix a -> TmuxIdPrefix a -> Bool
$c/= :: forall k (a :: k). TmuxIdPrefix a -> TmuxIdPrefix a -> Bool
/= :: TmuxIdPrefix a -> TmuxIdPrefix a -> Bool
Eq, Int -> TmuxIdPrefix a -> ShowS
[TmuxIdPrefix a] -> ShowS
TmuxIdPrefix a -> String
(Int -> TmuxIdPrefix a -> ShowS)
-> (TmuxIdPrefix a -> String)
-> ([TmuxIdPrefix a] -> ShowS)
-> Show (TmuxIdPrefix a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> TmuxIdPrefix a -> ShowS
forall k (a :: k). [TmuxIdPrefix a] -> ShowS
forall k (a :: k). TmuxIdPrefix a -> String
$cshowsPrec :: forall k (a :: k). Int -> TmuxIdPrefix a -> ShowS
showsPrec :: Int -> TmuxIdPrefix a -> ShowS
$cshow :: forall k (a :: k). TmuxIdPrefix a -> String
show :: TmuxIdPrefix a -> String
$cshowList :: forall k (a :: k). [TmuxIdPrefix a] -> ShowS
showList :: [TmuxIdPrefix a] -> ShowS
Show, (forall x. TmuxIdPrefix a -> Rep (TmuxIdPrefix a) x)
-> (forall x. Rep (TmuxIdPrefix a) x -> TmuxIdPrefix a)
-> Generic (TmuxIdPrefix a)
forall x. Rep (TmuxIdPrefix a) x -> TmuxIdPrefix a
forall x. TmuxIdPrefix a -> Rep (TmuxIdPrefix a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (a :: k) x. Rep (TmuxIdPrefix a) x -> TmuxIdPrefix a
forall k (a :: k) x. TmuxIdPrefix a -> Rep (TmuxIdPrefix a) x
$cfrom :: forall k (a :: k) x. TmuxIdPrefix a -> Rep (TmuxIdPrefix a) x
from :: forall x. TmuxIdPrefix a -> Rep (TmuxIdPrefix a) x
$cto :: forall k (a :: k) x. Rep (TmuxIdPrefix a) x -> TmuxIdPrefix a
to :: forall x. Rep (TmuxIdPrefix a) x -> TmuxIdPrefix a
Generic)
  deriving newtype (String -> TmuxIdPrefix a
(String -> TmuxIdPrefix a) -> IsString (TmuxIdPrefix a)
forall a. (String -> a) -> IsString a
forall k (a :: k). String -> TmuxIdPrefix a
$cfromString :: forall k (a :: k). String -> TmuxIdPrefix a
fromString :: String -> TmuxIdPrefix a
IsString)

class TmuxId a where
  prefix :: TmuxIdPrefix a
  number :: a -> Int

  formatId :: a -> Text
  formatId a
a =
    Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (a -> Int
forall a. TmuxId a => a -> Int
number a
a)
    where
      (TmuxIdPrefix Text
p) = forall a. TmuxId a => TmuxIdPrefix a
prefix @a

instance TmuxId SessionId where
  prefix :: TmuxIdPrefix SessionId
prefix = Text -> TmuxIdPrefix SessionId
forall {k} (a :: k). Text -> TmuxIdPrefix a
TmuxIdPrefix Text
sessionPrefix
  number :: SessionId -> Int
number (SessionId Int
i) = Int
i

instance TmuxId WindowId where
  prefix :: TmuxIdPrefix WindowId
prefix = Text -> TmuxIdPrefix WindowId
forall {k} (a :: k). Text -> TmuxIdPrefix a
TmuxIdPrefix Text
windowPrefix
  number :: WindowId -> Int
number (WindowId Int
i) = Int
i

instance TmuxId PaneId where
  prefix :: TmuxIdPrefix PaneId
prefix = Text -> TmuxIdPrefix PaneId
forall {k} (a :: k). Text -> TmuxIdPrefix a
TmuxIdPrefix Text
panePrefix
  number :: PaneId -> Int
number (PaneId Int
i) = Int
i