module Chiasma.Codec where

import qualified Data.Text as Text
import GHC.Generics (Rep, to)
import Prelude hiding (to)

import Chiasma.Codec.Decode (TmuxDataDecode (..))
import Chiasma.Codec.Query (TmuxDataQuery (..))
import qualified Chiasma.Data.DecodeError as DecodeFailure (DecodeFailure (..))
import Chiasma.Data.DecodeError (DecodeError (DecodeError), DecodeFailure)
import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)
import Chiasma.Data.TmuxQuery (TmuxQuery (TmuxQuery))

-- |Remove one leading and trailing space from tmux output if both are present.
tryTrim :: Text -> Maybe Text
tryTrim :: Text -> Maybe Text
tryTrim Text
text = do
  (Text
prefix, Char
lastChar) <- Text -> Maybe (Text, Char)
Text.unsnoc Text
text
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Char
lastChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
  (Char
firstChar, Text
payload) <- Text -> Maybe (Char, Text)
Text.uncons Text
prefix
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Char
firstChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
  pure Text
payload

trim :: Text -> Text
trim :: Text -> Text
trim Text
text =
  Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
text (Text -> Maybe Text
tryTrim Text
text)

checkRemainder :: ([Text], b) -> Either DecodeFailure b
checkRemainder :: forall b. ([Text], b) -> Either DecodeFailure b
checkRemainder = \case
  ([], b
result) -> b -> Either DecodeFailure b
forall a b. b -> Either a b
Right b
result
  ([Text]
a, b
_) -> DecodeFailure -> Either DecodeFailure b
forall a b. a -> Either a b
Left ([Text] -> DecodeFailure
DecodeFailure.TooManyFields [Text]
a)

genDecode ::
  Generic a =>
  TmuxDataDecode (Rep a) =>
  Text ->
  Either DecodeError a
genDecode :: forall a.
(Generic a, TmuxDataDecode (Rep a)) =>
Text -> Either DecodeError a
genDecode Text
fields = do
  (DecodeFailure -> DecodeError)
-> (Rep a Any -> a)
-> Either DecodeFailure (Rep a Any)
-> Either DecodeError a
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([Text] -> DecodeFailure -> DecodeError
DecodeError [Text
Item [Text]
fields]) Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to do
    ([Text], Rep a Any) -> Either DecodeFailure (Rep a Any)
forall b. ([Text], b) -> Either DecodeFailure b
checkRemainder (([Text], Rep a Any) -> Either DecodeFailure (Rep a Any))
-> Either DecodeFailure ([Text], Rep a Any)
-> Either DecodeFailure (Rep a Any)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> Either DecodeFailure ([Text], Rep a Any)
forall {k} (f :: k -> *) (a :: k).
TmuxDataDecode f =>
[Text] -> Either DecodeFailure ([Text], f a)
dataDecode (Text -> Text -> [Text]
Text.splitOn Text
" " (Text -> Text
trim Text
fields))

class TmuxCodec a where
  decode :: Text -> Either DecodeError a
  default decode ::
    Generic a =>
    TmuxDataDecode (Rep a) =>
    Text ->
    Either DecodeError a
  decode =
    Text -> Either DecodeError a
forall a.
(Generic a, TmuxDataDecode (Rep a)) =>
Text -> Either DecodeError a
genDecode

  query :: TmuxQuery
  default query :: TmuxDataQuery (Rep a) => TmuxQuery
  query =
    Text -> TmuxQuery
TmuxQuery ([Text] -> Text
Text.unwords (forall {k} (f :: k). TmuxDataQuery f => [Text]
forall (f :: * -> *). TmuxDataQuery f => [Text]
dataQuery @(Rep a)))

instance TmuxCodec SessionId
instance TmuxCodec WindowId
instance TmuxCodec PaneId

multi ::
  TmuxCodec a =>
  [Text] ->
  Either DecodeError [a]
multi :: forall a. TmuxCodec a => [Text] -> Either DecodeError [a]
multi =
  (Text -> Either DecodeError a) -> [Text] -> Either DecodeError [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Either DecodeError a
forall a. TmuxCodec a => Text -> Either DecodeError a
decode

single ::
  TmuxCodec a =>
  [Text] ->
  Either DecodeError a
single :: forall a. TmuxCodec a => [Text] -> Either DecodeError a
single = \case
  [Item [Text]
out] -> Text -> Either DecodeError a
forall a. TmuxCodec a => Text -> Either DecodeError a
decode Text
Item [Text]
out
  [] -> DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left ([Text] -> DecodeFailure -> DecodeError
DecodeError [] DecodeFailure
DecodeFailure.TargetMissing)
  [Text]
out -> DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left ([Text] -> DecodeFailure -> DecodeError
DecodeError [Text]
out ([Text] -> DecodeFailure
DecodeFailure.TooManyRecords [Text]
out))