{-# 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 Value Null = Bool False hasContent (Array Array xs) | Array -> Bool forall a. Vector a -> Bool V.null Array xs = Bool False hasContent Value _ = Bool True toJSONShowWithPayload :: Show a => a -> Value toJSONShowWithPayload :: a -> Value toJSONShowWithPayload a x = [Pair] -> Value object [(Text "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 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 $ \Object o -> do String t <- Object o Object -> Text -> Parser String forall a. FromJSON a => Object -> Text -> Parser a .: Text "payload" case String -> Either String a forall a. Read a => String -> Either String a readEither String t of Left String e -> String -> Parser a forall (m :: * -> *) a. MonadFail m => String -> m a fail String e Right 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 Bool b) = Bool -> Parser Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool b parseJSONBool (Number 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 >= Scientific 1) parseJSONBool Value _ = String -> Parser Bool forall (m :: * -> *) a. MonadFail m => String -> m a fail String "Expected Bool" toJSONByteString :: ByteString -> Value toJSONByteString :: ByteString -> Value toJSONByteString ByteString bs = [Pair] -> Value object [(Text "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 String "bytes" ((Object -> Parser ByteString) -> Value -> Parser ByteString) -> (Object -> Parser ByteString) -> Value -> Parser ByteString forall a b. (a -> b) -> a -> b $ \Object o -> do Text t <- Object o Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: Text "payload" case ByteString -> Either String ByteString B16.decode (Text -> ByteString T.encodeUtf8 Text t) of # if MIN_VERSION_base16_bytestring(1,0,0) Right ByteString bs -> ByteString -> Parser ByteString forall (m :: * -> *) a. Monad m => a -> m a return (ByteString -> ByteString BL.fromStrict ByteString bs) Left String err -> String -> Parser ByteString forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Parser ByteString) -> String -> Parser ByteString forall a b. (a -> b) -> a -> b $ String "Failed to parse base16: " String -> String -> String forall a. Semigroup a => a -> a -> a <> String err # else (bs, "") -> return (BL.fromStrict bs) _ -> fail "Failed to parse base16." # endif