{-# 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