{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Werror #-} module Text.ProtocolBuffers.ProtoJSON where import Data.Aeson import Data.Aeson.Types import qualified Data.Vector as V import Text.ProtocolBuffers.Basic import Text.Read (readEither) import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Base16 as B16 import qualified Data.Text.Encoding as T objectNoEmpty :: [Pair] -> Value objectNoEmpty :: [Pair] -> Value objectNoEmpty = [Pair] -> Value object ([Pair] -> Value) -> ([Pair] -> [Pair]) -> [Pair] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . (Pair -> Bool) -> [Pair] -> [Pair] forall a. (a -> Bool) -> [a] -> [a] filter (Value -> Bool hasContent (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Pair -> Value forall a b. (a, b) -> b snd) where hasContent :: Value -> Bool hasContent Null = Bool False hasContent (Array xs :: Array xs) | Array -> Bool forall a. Vector a -> Bool V.null Array xs = Bool False hasContent _ = Bool True toJSONShowWithPayload :: Show a => a -> Value toJSONShowWithPayload :: a -> Value toJSONShowWithPayload x :: a x = [Pair] -> Value object [("payload", String -> Value forall a. ToJSON a => a -> Value toJSON (String -> Value) -> (a -> String) -> a -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> String forall a. Show a => a -> String show (a -> Value) -> a -> Value forall a b. (a -> b) -> a -> b $ a x)] parseJSONReadWithPayload :: Read a => String -> Value -> Parser a parseJSONReadWithPayload :: String -> Value -> Parser a parseJSONReadWithPayload tyName :: String tyName = String -> (Object -> Parser a) -> Value -> Parser a forall a. String -> (Object -> Parser a) -> Value -> Parser a withObject String tyName ((Object -> Parser a) -> Value -> Parser a) -> (Object -> Parser a) -> Value -> Parser a forall a b. (a -> b) -> a -> b $ \o :: Object o -> do String t <- Object o Object -> Text -> Parser String forall a. FromJSON a => Object -> Text -> Parser a .: "payload" case String -> Either String a forall a. Read a => String -> Either String a readEither String t of Left e :: String e -> String -> Parser a forall (m :: * -> *) a. MonadFail m => String -> m a fail String e Right res :: a res -> a -> Parser a forall (m :: * -> *) a. Monad m => a -> m a return a res parseJSONBool :: Value -> Parser Bool parseJSONBool :: Value -> Parser Bool parseJSONBool (Bool b :: Bool b) = Bool -> Parser Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool b parseJSONBool (Number sci :: Scientific sci) = Bool -> Parser Bool forall (m :: * -> *) a. Monad m => a -> m a return (Scientific sci Scientific -> Scientific -> Bool forall a. Ord a => a -> a -> Bool >= 1) parseJSONBool _ = String -> Parser Bool forall (m :: * -> *) a. MonadFail m => String -> m a fail "Expected Bool" toJSONByteString :: ByteString -> Value toJSONByteString :: ByteString -> Value toJSONByteString bs :: ByteString bs = [Pair] -> Value object [("payload", Text -> Value String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Text T.decodeUtf8 (ByteString -> Text) -> (ByteString -> ByteString) -> ByteString -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString B16.encode (ByteString -> ByteString) -> (ByteString -> ByteString) -> ByteString -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString BL.toStrict (ByteString -> Value) -> ByteString -> Value forall a b. (a -> b) -> a -> b $ ByteString bs)] parseJSONByteString :: Value -> Parser ByteString parseJSONByteString :: Value -> Parser ByteString parseJSONByteString = String -> (Object -> Parser ByteString) -> Value -> Parser ByteString forall a. String -> (Object -> Parser a) -> Value -> Parser a withObject "bytes" ((Object -> Parser ByteString) -> Value -> Parser ByteString) -> (Object -> Parser ByteString) -> Value -> Parser ByteString forall a b. (a -> b) -> a -> b $ \o :: Object o -> do Text t <- Object o Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: "payload" case ByteString -> (ByteString, ByteString) B16.decode (Text -> ByteString T.encodeUtf8 Text t) of (bs :: ByteString bs, "") -> ByteString -> Parser ByteString forall (m :: * -> *) a. Monad m => a -> m a return (ByteString -> ByteString BL.fromStrict ByteString bs) _ -> String -> Parser ByteString forall (m :: * -> *) a. MonadFail m => String -> m a fail "Failed to parse base16."