{-# LANGUAGE TypeOperators #-}

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 (char, digit)
import Text.ParserCombinators.Parsec (
  GenParser,
  ParseError,
  many,
  parse,
  )

import Chiasma.Data.TmuxId (PaneId(..), SessionId(..), WindowId(..), panePrefix, sessionPrefix, windowPrefix)

data TmuxDecodeError =
  ParseFailure Text ParseError
  |
  IntParsingFailure Text
  |
  BoolParsingFailure Text
  |
  TooFewFields
  |
  TooManyFields [Text]
  deriving (TmuxDecodeError -> TmuxDecodeError -> Bool
(TmuxDecodeError -> TmuxDecodeError -> Bool)
-> (TmuxDecodeError -> TmuxDecodeError -> Bool)
-> Eq TmuxDecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TmuxDecodeError -> TmuxDecodeError -> Bool
$c/= :: TmuxDecodeError -> TmuxDecodeError -> Bool
== :: TmuxDecodeError -> TmuxDecodeError -> Bool
$c== :: TmuxDecodeError -> TmuxDecodeError -> Bool
Eq, Int -> TmuxDecodeError -> ShowS
[TmuxDecodeError] -> ShowS
TmuxDecodeError -> String
(Int -> TmuxDecodeError -> ShowS)
-> (TmuxDecodeError -> String)
-> ([TmuxDecodeError] -> ShowS)
-> Show TmuxDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TmuxDecodeError] -> ShowS
$cshowList :: [TmuxDecodeError] -> ShowS
show :: TmuxDecodeError -> String
$cshow :: TmuxDecodeError -> String
showsPrec :: Int -> TmuxDecodeError -> ShowS
$cshowsPrec :: Int -> TmuxDecodeError -> ShowS
Show)

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

class TmuxDataDecode f where
  decode' :: [Text] -> Either TmuxDecodeError ([Text], f a)

instance (TmuxDataDecode f, TmuxDataDecode g) => TmuxDataDecode (f :*: g) where
  decode' :: [Text] -> Either TmuxDecodeError ([Text], (:*:) f g a)
decode' [Text]
fields = do
    ([Text]
rest, f a
left) <- [Text] -> Either TmuxDecodeError ([Text], f a)
forall k (f :: k -> *) (a :: k).
TmuxDataDecode f =>
[Text] -> Either TmuxDecodeError ([Text], f a)
decode' [Text]
fields
    ([Text]
rest1, g a
right) <- [Text] -> Either TmuxDecodeError ([Text], g a)
forall k (f :: k -> *) (a :: k).
TmuxDataDecode f =>
[Text] -> Either TmuxDecodeError ([Text], f a)
decode' [Text]
rest
    ([Text], (:*:) f g a)
-> Either TmuxDecodeError ([Text], (:*:) f g a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([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
  decode' :: [Text] -> Either TmuxDecodeError ([Text], M1 i c f a)
decode' [Text]
fields =
    (f a -> M1 i c f a) -> ([Text], f a) -> ([Text], M1 i c f a)
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 TmuxDecodeError ([Text], f a)
-> Either TmuxDecodeError ([Text], M1 i c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Either TmuxDecodeError ([Text], f a)
forall k (f :: k -> *) (a :: k).
TmuxDataDecode f =>
[Text] -> Either TmuxDecodeError ([Text], f a)
decode' [Text]
fields

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

readInt :: Text -> Text -> Either TmuxDecodeError Int
readInt :: Text -> Text -> Either TmuxDecodeError Int
readInt Text
input Text
num =
  (String -> TmuxDecodeError)
-> Either String Int -> Either TmuxDecodeError Int
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TmuxDecodeError -> String -> TmuxDecodeError
forall a b. a -> b -> a
const (TmuxDecodeError -> String -> TmuxDecodeError)
-> TmuxDecodeError -> String -> TmuxDecodeError
forall a b. (a -> b) -> a -> b
$ Text -> TmuxDecodeError
IntParsingFailure Text
input) 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 TmuxDecodeError Int
primDecode Text
field = Text -> Text -> Either TmuxDecodeError Int
readInt Text
field Text
field

instance TmuxPrimDecode Bool where
  primDecode :: Text -> Either TmuxDecodeError Bool
primDecode Text
field =
    Int -> Either TmuxDecodeError Bool
convert (Int -> Either TmuxDecodeError Bool)
-> Either TmuxDecodeError Int -> Either TmuxDecodeError Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Either TmuxDecodeError Int
readInt Text
field Text
field
    where
      convert :: Int -> Either TmuxDecodeError Bool
convert Int
0 =
        Bool -> Either TmuxDecodeError Bool
forall a b. b -> Either a b
Right Bool
False
      convert Int
1 =
        Bool -> Either TmuxDecodeError Bool
forall a b. b -> Either a b
Right Bool
True
      convert Int
_ =
        TmuxDecodeError -> Either TmuxDecodeError Bool
forall a b. a -> Either a b
Left (Text -> TmuxDecodeError
BoolParsingFailure (Text -> TmuxDecodeError) -> Text -> TmuxDecodeError
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 :: Char -> GenParser Char st Text
idParser :: Char -> GenParser Char st Text
idParser Char
sym =
  Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
sym ParsecT String st Identity Char
-> GenParser Char st Text -> GenParser Char st Text
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 -> GenParser Char st 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) -> Char -> Text -> Either TmuxDecodeError a
parseId :: (Int -> a) -> Char -> Text -> Either TmuxDecodeError a
parseId Int -> a
cons Char
sym Text
input = do
  Text
num <- (ParseError -> TmuxDecodeError)
-> Either ParseError Text -> Either TmuxDecodeError Text
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> ParseError -> TmuxDecodeError
ParseFailure Text
"id") (Either ParseError Text -> Either TmuxDecodeError Text)
-> Either ParseError Text -> Either TmuxDecodeError 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 (Char -> Parsec String () Text
forall st. Char -> GenParser Char st Text
idParser Char
sym) String
"none" (Text -> String
Text.unpack Text
input)
  Int
i <- Text -> Text -> Either TmuxDecodeError Int
readInt Text
input Text
num
  return $ Int -> a
cons Int
i

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

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

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

instance TmuxPrimDecode [Char] where
  primDecode :: Text -> Either TmuxDecodeError String
primDecode = String -> Either TmuxDecodeError String
forall a b. b -> Either a b
Right (String -> Either TmuxDecodeError String)
-> (Text -> String) -> Text -> Either TmuxDecodeError 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 TmuxDecodeError Text
primDecode = Text -> Either TmuxDecodeError Text
forall a b. b -> Either a b
Right