module Chiasma.Data.WithPaneId where

import qualified Data.Text as Text

import Chiasma.Codec (TmuxCodec (decode, query), trim)
import Chiasma.Codec.Decode (primDecode)
import Chiasma.Data.DecodeError (DecodeError (DecodeError), DecodeFailure (TooFewFields))
import qualified Chiasma.Data.TmuxId as TmuxId
import Chiasma.Data.TmuxId (HasPaneId, PaneId)
import Chiasma.Data.TmuxQuery (TmuxQuery (TmuxQuery))

data WithPaneId a =
  WithPaneId {
    forall a. WithPaneId a -> PaneId
paneId :: PaneId,
    forall a. WithPaneId a -> a
pane :: a
  }
  deriving stock (WithPaneId a -> WithPaneId a -> Bool
(WithPaneId a -> WithPaneId a -> Bool)
-> (WithPaneId a -> WithPaneId a -> Bool) -> Eq (WithPaneId a)
forall a. Eq a => WithPaneId a -> WithPaneId a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithPaneId a -> WithPaneId a -> Bool
$c/= :: forall a. Eq a => WithPaneId a -> WithPaneId a -> Bool
== :: WithPaneId a -> WithPaneId a -> Bool
$c== :: forall a. Eq a => WithPaneId a -> WithPaneId a -> Bool
Eq, Int -> WithPaneId a -> ShowS
[WithPaneId a] -> ShowS
WithPaneId a -> String
(Int -> WithPaneId a -> ShowS)
-> (WithPaneId a -> String)
-> ([WithPaneId a] -> ShowS)
-> Show (WithPaneId a)
forall a. Show a => Int -> WithPaneId a -> ShowS
forall a. Show a => [WithPaneId a] -> ShowS
forall a. Show a => WithPaneId a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithPaneId a] -> ShowS
$cshowList :: forall a. Show a => [WithPaneId a] -> ShowS
show :: WithPaneId a -> String
$cshow :: forall a. Show a => WithPaneId a -> String
showsPrec :: Int -> WithPaneId a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WithPaneId a -> ShowS
Show, (forall x. WithPaneId a -> Rep (WithPaneId a) x)
-> (forall x. Rep (WithPaneId a) x -> WithPaneId a)
-> Generic (WithPaneId a)
forall x. Rep (WithPaneId a) x -> WithPaneId a
forall x. WithPaneId a -> Rep (WithPaneId a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (WithPaneId a) x -> WithPaneId a
forall a x. WithPaneId a -> Rep (WithPaneId a) x
$cto :: forall a x. Rep (WithPaneId a) x -> WithPaneId a
$cfrom :: forall a x. WithPaneId a -> Rep (WithPaneId a) x
Generic)

instance HasPaneId (WithPaneId a) where
  paneId :: WithPaneId a -> PaneId
paneId = WithPaneId a -> PaneId
forall a. WithPaneId a -> PaneId
paneId

safeBreakOn :: Text -> Text -> Maybe (Text, Text)
safeBreakOn :: Text -> Text -> Maybe (Text, Text)
safeBreakOn Text
n = \case
  Text
"" -> Maybe (Text, Text)
forall a. Maybe a
Nothing
  Text
t -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just ((Text -> Text) -> (Text, Text) -> (Text, Text)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> Text -> Text
Text.drop Int
1) (Text -> Text -> (Text, Text)
Text.breakOn Text
n Text
t))

instance TmuxCodec a => TmuxCodec (WithPaneId a) where
  decode :: Text -> Either DecodeError (WithPaneId a)
decode Text
payload =
    case Text -> Text -> Maybe (Text, Text)
safeBreakOn Text
" " (Text -> Text
trim Text
payload) of
      Just (Text
idField, Text
rest) -> do
        a
pane <- Text -> Either DecodeError a
forall a. TmuxCodec a => Text -> Either DecodeError a
decode Text
rest
        PaneId
paneId <- (DecodeFailure -> DecodeError)
-> Either DecodeFailure PaneId -> Either DecodeError PaneId
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Text] -> DecodeFailure -> DecodeError
DecodeError [Text
Item [Text]
payload]) (Text -> Either DecodeFailure PaneId
forall a. TmuxPrimDecode a => Text -> Either DecodeFailure a
primDecode Text
idField)
        pure WithPaneId :: forall a. PaneId -> a -> WithPaneId a
WithPaneId {a
PaneId
paneId :: PaneId
pane :: a
$sel:pane:WithPaneId :: a
$sel:paneId:WithPaneId :: PaneId
..}
      Maybe (Text, Text)
Nothing ->
        DecodeError -> Either DecodeError (WithPaneId a)
forall a b. a -> Either a b
Left ([Text] -> DecodeFailure -> DecodeError
DecodeError [Text
Item [Text]
payload] DecodeFailure
TooFewFields)

  query :: TmuxQuery
query =
    let TmuxQuery Text
paneQuery = forall a. TmuxCodec a => TmuxQuery
query @a
    in Text -> TmuxQuery
TmuxQuery (Text
"#{pane_id} " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
paneQuery)