module Chiasma.Codec.Decode where

import qualified Data.Text as Text (null, unpack)
import Data.Text.Read (decimal)
import GHC.Generics (K1 (..), M1 (..), (:*:) (..))
import Prelude hiding (many)
import Text.Parsec.Char (digit, string)
import Text.ParserCombinators.Parsec (GenParser, many, parse)

import Chiasma.Data.DecodeError (DecodeFailure (BoolParsingFailure, IntParsingFailure, ParseFailure, TooFewFields))
import Chiasma.Data.TmuxId (
  ClientId (ClientId),
  PaneId (..),
  SessionId (..),
  WindowId (..),
  panePrefix,
  sessionPrefix,
  windowPrefix,
  )

class TmuxPrimDecode a where
  primDecode :: Text -> Either DecodeFailure a

class TmuxDataDecode f where
  dataDecode :: [Text] -> Either DecodeFailure ([Text], f a)

instance (TmuxDataDecode f, TmuxDataDecode g) => TmuxDataDecode (f :*: g) where
  dataDecode :: forall (a :: k).
[Text] -> Either DecodeFailure ([Text], (:*:) f g a)
dataDecode [Text]
fields = do
    ([Text]
rest, f a
left) <- [Text] -> Either DecodeFailure ([Text], f a)
forall (a :: k). [Text] -> Either DecodeFailure ([Text], f a)
forall {k} (f :: k -> *) (a :: k).
TmuxDataDecode f =>
[Text] -> Either DecodeFailure ([Text], f a)
dataDecode [Text]
fields
    ([Text]
rest1, g a
right) <- [Text] -> Either DecodeFailure ([Text], g a)
forall (a :: k). [Text] -> Either DecodeFailure ([Text], g a)
forall {k} (f :: k -> *) (a :: k).
TmuxDataDecode f =>
[Text] -> Either DecodeFailure ([Text], f a)
dataDecode [Text]
rest
    ([Text], (:*:) f g a) -> Either DecodeFailure ([Text], (:*:) f g a)
forall a. a -> Either DecodeFailure a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
rest1, f a
left f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
right)

instance TmuxDataDecode f => (TmuxDataDecode (M1 i c f)) where
  dataDecode :: forall (a :: k).
[Text] -> Either DecodeFailure ([Text], M1 i c f a)
dataDecode [Text]
fields =
    (f a -> M1 i c f a) -> ([Text], f a) -> ([Text], M1 i c f a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (([Text], f a) -> ([Text], M1 i c f a))
-> Either DecodeFailure ([Text], f a)
-> Either DecodeFailure ([Text], M1 i c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Either DecodeFailure ([Text], f a)
forall (a :: k). [Text] -> Either DecodeFailure ([Text], f a)
forall {k} (f :: k -> *) (a :: k).
TmuxDataDecode f =>
[Text] -> Either DecodeFailure ([Text], f a)
dataDecode [Text]
fields

instance TmuxPrimDecode a => (TmuxDataDecode (K1 c a)) where
  dataDecode :: forall (a :: k). [Text] -> Either DecodeFailure ([Text], K1 c a a)
dataDecode (Text
a:[Text]
as') = do
    a
prim <- Text -> Either DecodeFailure a
forall a. TmuxPrimDecode a => Text -> Either DecodeFailure a
primDecode Text
a
    pure ([Text]
as', a -> K1 c a a
forall k i c (p :: k). c -> K1 i c p
K1 a
prim)
  dataDecode [] = DecodeFailure -> Either DecodeFailure ([Text], K1 c a a)
forall a b. a -> Either a b
Left DecodeFailure
TooFewFields

readInt :: Text -> Text -> Either DecodeFailure Int
readInt :: Text -> Text -> Either DecodeFailure Int
readInt Text
text Text
num =
  (String -> DecodeFailure)
-> Either String Int -> Either DecodeFailure Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (DecodeFailure -> String -> DecodeFailure
forall a b. a -> b -> a
const (DecodeFailure -> String -> DecodeFailure)
-> DecodeFailure -> String -> DecodeFailure
forall a b. (a -> b) -> a -> b
$ Text -> DecodeFailure
IntParsingFailure Text
text) Either String Int
parsed
  where
    parsed :: Either String Int
parsed = do
      (Int
num', Text
rest) <- Reader Int
forall a. Integral a => Reader a
decimal Text
num
      if Text -> Bool
Text.null Text
rest then Int -> Either String Int
forall a b. b -> Either a b
Right Int
num' else String -> Either String Int
forall a b. a -> Either a b
Left String
""

instance TmuxPrimDecode Int where
  primDecode :: Text -> Either DecodeFailure Int
primDecode Text
field = Text -> Text -> Either DecodeFailure Int
readInt Text
field Text
field

instance TmuxPrimDecode Bool where
  primDecode :: Text -> Either DecodeFailure Bool
primDecode Text
field =
    Int -> Either DecodeFailure Bool
convert (Int -> Either DecodeFailure Bool)
-> Either DecodeFailure Int -> Either DecodeFailure Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Either DecodeFailure Int
readInt Text
field Text
field
    where
      convert :: Int -> Either DecodeFailure Bool
convert Int
0 =
        Bool -> Either DecodeFailure Bool
forall a b. b -> Either a b
Right Bool
False
      convert Int
1 =
        Bool -> Either DecodeFailure Bool
forall a b. b -> Either a b
Right Bool
True
      convert Int
_ =
        DecodeFailure -> Either DecodeFailure Bool
forall a b. a -> Either a b
Left (Text -> DecodeFailure
BoolParsingFailure (Text -> DecodeFailure) -> Text -> DecodeFailure
forall a b. (a -> b) -> a -> b
$ Text
"got non-bool `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall b a. (Show a, IsString b) => a -> b
show Text
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`")

idParser :: Text -> GenParser Char st Text
idParser :: forall st. Text -> GenParser Char st Text
idParser Text
sym =
  String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Text -> String
forall a. ToString a => a -> String
toString Text
sym) ParsecT String st Identity String
-> ParsecT String st Identity Text
-> ParsecT String st Identity Text
forall a b.
ParsecT String st Identity a
-> ParsecT String st Identity b -> ParsecT String st Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> ParsecT String st Identity String
-> ParsecT String st Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String st Identity Char
-> ParsecT String st Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)

parseId :: (Int -> a) -> Text -> Text -> Either DecodeFailure a
parseId :: forall a. (Int -> a) -> Text -> Text -> Either DecodeFailure a
parseId Int -> a
cons Text
sym Text
text = do
  Text
num <- (ParseError -> DecodeFailure)
-> Either ParseError Text -> Either DecodeFailure Text
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> ParseError -> DecodeFailure
ParseFailure Text
"id") (Either ParseError Text -> Either DecodeFailure Text)
-> Either ParseError Text -> Either DecodeFailure Text
forall a b. (a -> b) -> a -> b
$ Parsec String () Text -> String -> String -> Either ParseError Text
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Text -> Parsec String () Text
forall st. Text -> GenParser Char st Text
idParser Text
sym) String
"none" (Text -> String
Text.unpack Text
text)
  Int
i <- Text -> Text -> Either DecodeFailure Int
readInt Text
text Text
num
  pure (Int -> a
cons Int
i)

instance TmuxPrimDecode ClientId where
  primDecode :: Text -> Either DecodeFailure ClientId
primDecode = ClientId -> Either DecodeFailure ClientId
forall a. a -> Either DecodeFailure a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientId -> Either DecodeFailure ClientId)
-> (Text -> ClientId) -> Text -> Either DecodeFailure ClientId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ClientId
ClientId

instance TmuxPrimDecode SessionId where
  primDecode :: Text -> Either DecodeFailure SessionId
primDecode = (Int -> SessionId)
-> Text -> Text -> Either DecodeFailure SessionId
forall a. (Int -> a) -> Text -> Text -> Either DecodeFailure a
parseId Int -> SessionId
SessionId Text
sessionPrefix

instance TmuxPrimDecode WindowId where
  primDecode :: Text -> Either DecodeFailure WindowId
primDecode = (Int -> WindowId) -> Text -> Text -> Either DecodeFailure WindowId
forall a. (Int -> a) -> Text -> Text -> Either DecodeFailure a
parseId Int -> WindowId
WindowId Text
windowPrefix

instance TmuxPrimDecode PaneId where
  primDecode :: Text -> Either DecodeFailure PaneId
primDecode = (Int -> PaneId) -> Text -> Text -> Either DecodeFailure PaneId
forall a. (Int -> a) -> Text -> Text -> Either DecodeFailure a
parseId Int -> PaneId
PaneId Text
panePrefix

instance TmuxPrimDecode [Char] where
  primDecode :: Text -> Either DecodeFailure String
primDecode = String -> Either DecodeFailure String
forall a b. b -> Either a b
Right (String -> Either DecodeFailure String)
-> (Text -> String) -> Text -> Either DecodeFailure String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString

instance TmuxPrimDecode Text where
  primDecode :: Text -> Either DecodeFailure Text
primDecode = Text -> Either DecodeFailure Text
forall a b. b -> Either a b
Right