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