module Chiasma.Data.TmuxId where

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
/= :: ClientId -> ClientId -> Bool
$c/= :: ClientId -> ClientId -> Bool
== :: ClientId -> ClientId -> Bool
$c== :: 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
showList :: [ClientId] -> ShowS
$cshowList :: [ClientId] -> ShowS
show :: ClientId -> String
$cshow :: ClientId -> String
showsPrec :: Int -> ClientId -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep ClientId x -> ClientId
$cfrom :: forall x. ClientId -> Rep ClientId x
Generic)
  deriving newtype (String -> ClientId
(String -> ClientId) -> IsString ClientId
forall a. (String -> a) -> IsString a
fromString :: String -> ClientId
$cfromString :: String -> ClientId
IsString)

instance Pretty ClientId where
  pretty :: forall ann. ClientId -> Doc ann
pretty = 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
. ClientId -> Text
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
/= :: SessionId -> SessionId -> Bool
$c/= :: SessionId -> SessionId -> Bool
== :: SessionId -> SessionId -> Bool
$c== :: 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
showList :: [SessionId] -> ShowS
$cshowList :: [SessionId] -> ShowS
show :: SessionId -> String
$cshow :: SessionId -> String
showsPrec :: Int -> SessionId -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep SessionId x -> SessionId
$cfrom :: forall x. SessionId -> Rep SessionId x
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
fromInteger :: Integer -> SessionId
$cfromInteger :: Integer -> SessionId
signum :: SessionId -> SessionId
$csignum :: SessionId -> SessionId
abs :: SessionId -> SessionId
$cabs :: SessionId -> SessionId
negate :: SessionId -> SessionId
$cnegate :: SessionId -> SessionId
* :: SessionId -> SessionId -> SessionId
$c* :: SessionId -> SessionId -> SessionId
- :: SessionId -> SessionId -> SessionId
$c- :: SessionId -> SessionId -> SessionId
+ :: SessionId -> SessionId -> SessionId
$c+ :: SessionId -> SessionId -> 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
min :: SessionId -> SessionId -> SessionId
$cmin :: SessionId -> SessionId -> SessionId
max :: SessionId -> SessionId -> SessionId
$cmax :: SessionId -> SessionId -> SessionId
>= :: SessionId -> SessionId -> Bool
$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
compare :: SessionId -> SessionId -> Ordering
$ccompare :: SessionId -> SessionId -> Ordering
Ord)

instance Pretty SessionId where
  pretty :: forall ann. SessionId -> Doc ann
pretty = 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
/= :: WindowId -> WindowId -> Bool
$c/= :: WindowId -> WindowId -> Bool
== :: WindowId -> WindowId -> Bool
$c== :: 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
showList :: [WindowId] -> ShowS
$cshowList :: [WindowId] -> ShowS
show :: WindowId -> String
$cshow :: WindowId -> String
showsPrec :: Int -> WindowId -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep WindowId x -> WindowId
$cfrom :: forall x. WindowId -> Rep WindowId x
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
fromInteger :: Integer -> WindowId
$cfromInteger :: Integer -> WindowId
signum :: WindowId -> WindowId
$csignum :: WindowId -> WindowId
abs :: WindowId -> WindowId
$cabs :: WindowId -> WindowId
negate :: WindowId -> WindowId
$cnegate :: WindowId -> WindowId
* :: WindowId -> WindowId -> WindowId
$c* :: WindowId -> WindowId -> WindowId
- :: WindowId -> WindowId -> WindowId
$c- :: WindowId -> WindowId -> WindowId
+ :: WindowId -> WindowId -> WindowId
$c+ :: WindowId -> WindowId -> 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
min :: WindowId -> WindowId -> WindowId
$cmin :: WindowId -> WindowId -> WindowId
max :: WindowId -> WindowId -> WindowId
$cmax :: WindowId -> WindowId -> WindowId
>= :: WindowId -> WindowId -> Bool
$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
compare :: WindowId -> WindowId -> Ordering
$ccompare :: WindowId -> WindowId -> Ordering
Ord)

instance Pretty WindowId where
  pretty :: forall ann. WindowId -> Doc ann
pretty = 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
/= :: PaneId -> PaneId -> Bool
$c/= :: PaneId -> PaneId -> Bool
== :: PaneId -> PaneId -> Bool
$c== :: 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
showList :: [PaneId] -> ShowS
$cshowList :: [PaneId] -> ShowS
show :: PaneId -> String
$cshow :: PaneId -> String
showsPrec :: Int -> PaneId -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep PaneId x -> PaneId
$cfrom :: forall x. PaneId -> Rep PaneId x
Generic)
  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
fromInteger :: Integer -> PaneId
$cfromInteger :: Integer -> PaneId
signum :: PaneId -> PaneId
$csignum :: PaneId -> PaneId
abs :: PaneId -> PaneId
$cabs :: PaneId -> PaneId
negate :: PaneId -> PaneId
$cnegate :: PaneId -> PaneId
* :: PaneId -> PaneId -> PaneId
$c* :: PaneId -> PaneId -> PaneId
- :: PaneId -> PaneId -> PaneId
$c- :: PaneId -> PaneId -> PaneId
+ :: PaneId -> PaneId -> PaneId
$c+ :: PaneId -> PaneId -> 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
min :: PaneId -> PaneId -> PaneId
$cmin :: PaneId -> PaneId -> PaneId
max :: PaneId -> PaneId -> PaneId
$cmax :: PaneId -> PaneId -> PaneId
>= :: PaneId -> PaneId -> Bool
$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
compare :: PaneId -> PaneId -> Ordering
$ccompare :: PaneId -> PaneId -> Ordering
Ord)

instance Pretty PaneId where
  pretty :: forall ann. PaneId -> Doc ann
pretty = 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
/= :: 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
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
showList :: [TmuxIdPrefix a] -> ShowS
$cshowList :: forall k (a :: k). [TmuxIdPrefix a] -> ShowS
show :: TmuxIdPrefix a -> String
$cshow :: forall k (a :: k). TmuxIdPrefix a -> String
showsPrec :: Int -> TmuxIdPrefix a -> ShowS
$cshowsPrec :: forall k (a :: k). Int -> 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
$cto :: forall k (a :: k) x. Rep (TmuxIdPrefix a) x -> TmuxIdPrefix a
$cfrom :: forall k (a :: k) x. TmuxIdPrefix a -> Rep (TmuxIdPrefix a) x
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
fromString :: String -> TmuxIdPrefix a
$cfromString :: forall k (a :: k). 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