{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedLists     #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE ViewPatterns        #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Support for the "JSONPB" canonical JSON encoding described at
-- https://developers.google.com/protocol-buffers/docs/proto3#json.
--
-- This modules provides 'Data.Aeson'-like helper functions, typeclasses, and
-- instances for converting to and from values of types which have a JSONPB
-- representation and equivalent underlying 'Data.Aeson' representations.
--
-- This module also presents a (very minimal) surface syntax for Aeson-like
-- operations; the idea is that we can write 'ToJSONPB' and 'FromJSONPB'
-- instances in a very similar manner to 'A.ToJSON' and 'A.FromJSON' instances,
-- except that doing so specifies JSONPB codecs instead of vanilla JSON codecs.
--
-- Example use:
--
-- @
-- message Scalar32 {
--   int32     i32 = 1;
--   uint32    u32 = 2;
--   sint32    s32 = 3;
--   fixed32   f32 = 4;
--   sfixed32 sf32 = 5;
-- }
--
-- instance ToJSONPB Scalar32 where
--   toJSONPB (Scalar32 i32 u32 s32 f32 sf32) = object
--       [ "i32"  .= i32
--       , "u32"  .= u32
--       , "s32"  .= s32
--       , "f32"  .= f32
--       , "sf32" .= sf32
--       ]
--   toEncodingPB (Scalar32 i32 u32 s32 f32 sf32) = pairs
--       [ "i32"  .= i32
--       , "u32"  .= u32
--       , "s32"  .= s32
--       , "f32"  .= f32
--       , "sf32" .= sf32
--       ]
--
-- instance FromJSONPB Scalar32 where
--   parseJSONPB = withObject "Scalar32" $ \obj ->
--     pure Scalar32
--     <*> obj .: "i32"
--     <*> obj .: "u32"
--     <*> obj .: "s32"
--     <*> obj .: "f32"
--     <*> obj .: "sf32"
-- @

module Proto3.Suite.JSONPB.Class where

import qualified Data.Aeson                       as A (Encoding, FromJSON (..),
                                                        FromJSONKey (..),
                                                        FromJSONKeyFunction (..),
                                                        ToJSON (..), Value (..),
                                                        ToJSON1(..), FromJSON1(..),
                                                        ToJSONKey(..),
                                                        decode, eitherDecode, json,
                                                        (.!=))
import qualified Data.Aeson.Encoding              as E
import qualified Data.Aeson.Encoding.Internal     as E
import qualified Data.Aeson.Internal              as A (formatError, iparse)
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key                   as A
#endif
import qualified Data.Aeson.Parser                as A (eitherDecodeWith)
import qualified Data.Aeson.Types                 as A (Object, Pair, Parser,
                                                        Series,
                                                        explicitParseField,
                                                        explicitParseFieldMaybe,
                                                        object, typeMismatch)
import qualified Data.Attoparsec.ByteString       as Atto (skipWhile)
import qualified Data.Attoparsec.ByteString.Char8 as Atto (Parser, endOfInput)
import qualified Data.Binary.Builder              as Builder
import qualified Data.ByteString                  as BS
import qualified Data.ByteString.Base64           as B64
import qualified Data.ByteString.Lazy             as LBS
import           Data.Coerce
import           Data.Maybe
import qualified Data.Map                         as M
import           Data.Text                        (Text)
import qualified Data.Text                        as T
import qualified Data.Text.Encoding               as T
import qualified Data.Text.Lazy                   as TL
import qualified Data.Text.Lazy.Encoding          as TL
import qualified Data.Vector                      as V
import           GHC.Exts                         (Proxy#, proxy#)
import           GHC.Generics                     (Generic)
import           GHC.Int                          (Int32, Int64)
import           GHC.Word                         (Word32, Word64)
import           Proto3.Suite.Class               (HasDefault (def, isDefault),
                                                   Named (nameOf))
import           Proto3.Suite.Types               (Enumerated (..), Fixed (..))
import           Proto3.Wire.Class                (ProtoEnum(..))
import           Test.QuickCheck.Arbitrary        (Arbitrary(..))

#if MIN_VERSION_aeson(2,0,0)
type Key = A.Key
keyFromText :: Text -> Key
keyFromText :: Text -> Key
keyFromText = Text -> Key
A.fromText
#else
type Key = Text
keyFromText :: Text -> Text
keyFromText = id
#endif

-- * Typeclass definitions

-- | 'A.ToJSON' variant for JSONPB direct encoding via 'A.Encoding'
class ToJSONPB a where
  -- | 'A.toJSON' variant for JSONPB encoders.
  toJSONPB :: a -> Options -> A.Value

  -- | 'A.toEncoding' variant for JSONPB encoders. If an implementation is not
  -- provided, uses 'toJSONPB' (which is less efficient since it indirects
  -- through the 'A.Value' IR).
  toEncodingPB :: a -> Options -> A.Encoding
  toEncodingPB a
x = Value -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding (Value -> Encoding) -> (Options -> Value) -> Options -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB a
x

instance ToJSONPB A.Value where
  toJSONPB :: Value -> Options -> Value
toJSONPB Value
v Options
_ = Value
v
  toEncodingPB :: Value -> Options -> Encoding
toEncodingPB Value
v Options
_ = Value -> Encoding
E.value Value
v

instance ToJSONPB A.Encoding where
  toJSONPB :: Encoding -> Options -> Value
toJSONPB Encoding
e Options
_ = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
A.Null (Maybe Value -> Value)
-> (Encoding -> Maybe Value) -> Encoding -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
A.decode (ByteString -> Maybe Value)
-> (Encoding -> ByteString) -> Encoding -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (Encoding -> Builder) -> Encoding -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
forall tag. Encoding' tag -> Builder
E.fromEncoding (Encoding -> Value) -> Encoding -> Value
forall a b. (a -> b) -> a -> b
$ Encoding
e
  toEncodingPB :: Encoding -> Options -> Encoding
toEncodingPB Encoding
e Options
_ = Encoding
e

-- | 'A.FromJSON' variant for JSONPB decoding from the 'A.Value' IR
class FromJSONPB a where
  -- | 'A.parseJSON' variant for JSONPB decoders.
  parseJSONPB :: A.Value -> A.Parser a

instance FromJSONPB A.Value where
  parseJSONPB :: Value -> Parser Value
parseJSONPB = Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- * JSONPB codec entry points

-- | 'Data.Aeson.encode' variant for serializing a JSONPB value as a lazy
-- 'LBS.ByteString'.
encode :: ToJSONPB a => Options -> a -> LBS.ByteString
encode :: Options -> a -> ByteString
encode Options
opts a
x = Encoding -> ByteString
forall a. Encoding' a -> ByteString
E.encodingToLazyByteString (a -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
toEncodingPB a
x Options
opts)
{-# INLINE encode #-}

-- | 'Data.Aeson.eitherDecode' variant for deserializing a JSONPB value from a
-- lazy 'LBS.ByteString'.
eitherDecode :: FromJSONPB a => LBS.ByteString -> Either String a
eitherDecode :: ByteString -> Either String a
eitherDecode = Either (JSONPath, String) a -> Either String a
forall b. Either (JSONPath, String) b -> Either String b
eitherFormatError (Either (JSONPath, String) a -> Either String a)
-> (ByteString -> Either (JSONPath, String) a)
-> ByteString
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
forall a.
Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
A.eitherDecodeWith Parser Value
jsonEOF ((Value -> Parser a) -> Value -> IResult a
forall a b. (a -> Parser b) -> a -> IResult b
A.iparse Value -> Parser a
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB)
  where
    eitherFormatError :: Either (JSONPath, String) b -> Either String b
eitherFormatError = ((JSONPath, String) -> Either String b)
-> (b -> Either String b)
-> Either (JSONPath, String) b
-> Either String b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b)
-> ((JSONPath, String) -> String)
-> (JSONPath, String)
-> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSONPath -> String -> String) -> (JSONPath, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JSONPath -> String -> String
A.formatError) b -> Either String b
forall a b. b -> Either a b
Right
    {-# INLINE eitherFormatError #-}

    -- NB: cribbed from aeson-1.1.1.0:Data.Aeson.Parser.Internal.jsonEOF, which
    -- is not exported. It's simple, so we just inline it here. Might be worth
    -- submitting a PR to export this.
    jsonEOF :: Atto.Parser A.Value
    jsonEOF :: Parser Value
jsonEOF = Parser Value
A.json Parser Value -> Parser ByteString () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
skipSpace Parser Value -> Parser ByteString () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
Atto.endOfInput
      where
        skipSpace :: Atto.Parser ()
        skipSpace :: Parser ByteString ()
skipSpace = (Word8 -> Bool) -> Parser ByteString ()
Atto.skipWhile ((Word8 -> Bool) -> Parser ByteString ())
-> (Word8 -> Bool) -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ \Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0d Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09
        {-# INLINE skipSpace #-}
{-# INLINE eitherDecode #-}

-- * Operator definitions

-- | JSONPB-encoded monoidal key-value pairs
class Monoid m => KeyValuePB m where
  pair :: ToJSONPB v => Text -> v -> Options -> m

instance KeyValuePB A.Series where pair :: Text -> v -> Options -> Series
pair Text
k v
v Options
opts = Key -> Encoding -> Series
E.pair (Text -> Key
keyFromText Text
k) (v -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
toEncodingPB v
v Options
opts)
instance KeyValuePB [A.Pair] where pair :: Text -> v -> Options -> [Pair]
pair Text
k v
v Options
opts = Pair -> [Pair]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Key
keyFromText Text
k, v -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB v
v Options
opts)

-- | Construct a monoidal key-value pair, using 'mempty' to represent omission
-- of default values (unless the given 'Options' force their emission).
(.=) :: (HasDefault v, ToJSONPB v, KeyValuePB kvp) => Text -> v -> Options -> kvp
Text
k .= :: Text -> v -> Options -> kvp
.= v
v = Options -> kvp
forall p. KeyValuePB p => Options -> p
mk
  where
    mk :: Options -> p
mk opts :: Options
opts@Options{Bool
optEmitNamedOneof :: Options -> Bool
optEmitDefaultValuedFields :: Options -> Bool
optEmitNamedOneof :: Bool
optEmitDefaultValuedFields :: Bool
..}
      | Bool -> Bool
not Bool
optEmitDefaultValuedFields Bool -> Bool -> Bool
&& v -> Bool
forall a. HasDefault a => a -> Bool
isDefault v
v
        = p
forall a. Monoid a => a
mempty
      | Bool
otherwise
        = Text -> v -> Options -> p
forall m v. (KeyValuePB m, ToJSONPB v) => Text -> v -> Options -> m
pair Text
k v
v Options
opts


-- | 'Data.Aeson..:' variant for JSONPB; if the given key is missing from the
-- object, or if it is present but its value is null, we produce the default
-- protobuf value for the field type
(.:) :: (FromJSONPB a, HasDefault a) => A.Object -> Text -> A.Parser a
Object
obj .: :: Object -> Text -> Parser a
.: Text
key = Object
obj Object -> Key -> Parser (Maybe a)
.:? Text -> Key
keyFromText Text
key Parser (Maybe a) -> a -> Parser a
forall a. Parser (Maybe a) -> a -> Parser a
A..!= a
forall a. HasDefault a => a
def
  where
    .:? :: Object -> Key -> Parser (Maybe a)
(.:?) = (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
A.explicitParseFieldMaybe Value -> Parser a
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB

parseField :: FromJSONPB a
           => A.Object -> Key -> A.Parser a
parseField :: Object -> Key -> Parser a
parseField = (Value -> Parser a) -> Object -> Key -> Parser a
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
A.explicitParseField Value -> Parser a
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB

-- | >>> isDefault (def @E.Encoding)
-- True
instance HasDefault E.Encoding where
  def :: Encoding
def       = Encoding
forall a. Encoding' a
E.empty
  isDefault :: Encoding -> Bool
isDefault = Encoding -> Bool
forall a. Encoding' a -> Bool
E.nullEncoding

-- | >>> isDefault (def @A.Value)
-- True
instance HasDefault A.Value where
  def :: Value
def       = Value
A.Null
  isDefault :: Value -> Bool
isDefault = (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
A.Null)

-- * JSONPB rendering and parsing options

data Options = Options
  { Options -> Bool
optEmitDefaultValuedFields :: Bool
  , Options -> Bool
optEmitNamedOneof :: Bool
  -- ^ For compatibility with the Go JSONPB implementation.
  --
  -- If 'False', the following message
  --
  -- > message MyMessage {
  -- >   oneof animal {
  -- >     Cat cat = 1;
  -- >     Dog dog = 2;
  -- >   }
  -- > }
  --
  -- will be serialized as
  --
  -- > MyMessage (Animal (Cat "Simba")) => { "cat": "Simba" }
  --
  -- instead of
  --
  -- > MyMessage (Animal (Cat "Simba")) => { "animal": { "cat": "Simba" } }
  --
  } deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, (forall x. Options -> Rep Options x)
-> (forall x. Rep Options x -> Options) -> Generic Options
forall x. Rep Options x -> Options
forall x. Options -> Rep Options x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Options x -> Options
$cfrom :: forall x. Options -> Rep Options x
Generic, Int -> Options -> String -> String
[Options] -> String -> String
Options -> String
(Int -> Options -> String -> String)
-> (Options -> String)
-> ([Options] -> String -> String)
-> Show Options
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Options] -> String -> String
$cshowList :: [Options] -> String -> String
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> String -> String
$cshowsPrec :: Int -> Options -> String -> String
Show)

instance Arbitrary Options where
  arbitrary :: Gen Options
arbitrary = Bool -> Bool -> Options
Options (Bool -> Bool -> Options) -> Gen Bool -> Gen (Bool -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary Gen (Bool -> Options) -> Gen Bool -> Gen Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary

-- | Default options for JSON encoding. By default, all options are @True@.
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: Bool -> Bool -> Options
Options
  { optEmitDefaultValuedFields :: Bool
optEmitDefaultValuedFields = Bool
True
  , optEmitNamedOneof :: Bool
optEmitNamedOneof = Bool
True
  }

-- | Options for JSONPB encoding.
jsonPBOptions :: Options
jsonPBOptions :: Options
jsonPBOptions = Options :: Bool -> Bool -> Options
Options
  { optEmitDefaultValuedFields :: Bool
optEmitDefaultValuedFields = Bool
False
  , optEmitNamedOneof :: Bool
optEmitNamedOneof = Bool
False
  }

-- * Helper types and functions

dropNamedPrefix :: Named a => Proxy# a -> String -> String
dropNamedPrefix :: Proxy# a -> String -> String
dropNamedPrefix Proxy# a
p = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Proxy# a -> String
forall a string. (Named a, IsString string) => Proxy# a -> string
nameOf Proxy# a
p :: String))

object :: [Options -> [A.Pair]] -> Options -> A.Value
object :: [Options -> [Pair]] -> Options -> Value
object [Options -> [Pair]]
fs = [Pair] -> Value
A.object ([Pair] -> Value) -> (Options -> [Pair]) -> Options -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Options -> [Pair]] -> Options -> [Pair]
forall a. Monoid a => [a] -> a
mconcat [Options -> [Pair]]
fs

-- | As 'object', but produces 'A.Null' when there are no pairs to wrap (cf. the
-- empty object result of 'object)
--
-- >>> object [const []] defaultOptions
-- Object (fromList [])
-- >>> objectOrNull [const []] defaultOptions
-- Null
objectOrNull :: [Options -> [A.Pair]] -> Options -> A.Value
objectOrNull :: [Options -> [Pair]] -> Options -> Value
objectOrNull [Options -> [Pair]]
fs Options
options = case [Options -> [Pair]] -> Options -> [Pair]
forall a. Monoid a => [a] -> a
mconcat [Options -> [Pair]]
fs Options
options of
  []       -> Value
A.Null
  [Pair]
nonEmpty -> [Pair] -> Value
A.object [Pair]
nonEmpty

pairs :: [Options -> A.Series] -> Options -> E.Encoding
pairs :: [Options -> Series] -> Options -> Encoding
pairs [Options -> Series]
fs = Series -> Encoding
E.pairs (Series -> Encoding) -> (Options -> Series) -> Options -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Options -> Series] -> Options -> Series
forall a. Monoid a => [a] -> a
mconcat [Options -> Series]
fs

-- | As 'pairs', but produces the "null" when there is no series to encode
-- (cf. the empty object encoding of 'pairs')
--
-- >>> pairs [const mempty] defaultOptions
-- "{}"
-- >>> pairsOrNull [const mempty] defaultOptions
-- "null"
pairsOrNull :: [Options -> A.Series] -> Options -> E.Encoding
pairsOrNull :: [Options -> Series] -> Options -> Encoding
pairsOrNull [Options -> Series]
fs Options
options = case [Options -> Series] -> Options -> Series
forall a. Monoid a => [a] -> a
mconcat [Options -> Series]
fs Options
options of
  Series
E.Empty  -> Encoding
E.null_
  Series
nonEmpty -> Series -> Encoding
E.pairs Series
nonEmpty

enumFieldString :: forall a. (Named a, Show a) => a -> A.Value
enumFieldString :: a -> Value
enumFieldString = Text -> Value
A.String (Text -> Value) -> (a -> Text) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy# a -> String -> String
forall a. Named a => Proxy# a -> String -> String
dropNamedPrefix (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a) (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

enumFieldEncoding :: forall a. (Named a, Show a) => a -> A.Encoding
enumFieldEncoding :: a -> Encoding
enumFieldEncoding = String -> Encoding
forall a. String -> Encoding' a
E.string (String -> Encoding) -> (a -> String) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy# a -> String -> String
forall a. Named a => Proxy# a -> String -> String
dropNamedPrefix (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a) (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | A 'Data.Aeson' 'A.Value' encoder for values which can be
-- JSONPB-encoded.
toAesonValue :: ToJSONPB a => a -> A.Value
toAesonValue :: a -> Value
toAesonValue = (a -> Options -> Value) -> Options -> a -> Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB Options
defaultOptions

-- | A direct 'A.Encoding' for values which can be JSONPB-encoded.
toAesonEncoding :: ToJSONPB a => a -> A.Encoding
toAesonEncoding :: a -> Encoding
toAesonEncoding = (a -> Options -> Encoding) -> Options -> a -> Encoding
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
toEncodingPB Options
defaultOptions

-- | Parse a JSONPB floating point value; first parameter provides context for
-- type mismatches
parseFP :: (A.FromJSON a, A.FromJSONKey a) => String -> A.Value -> A.Parser a
parseFP :: String -> Value -> Parser a
parseFP String
tyDesc Value
v = case Value
v of
  A.Number{} -> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v
  A.String Text
t -> case FromJSONKeyFunction a
forall a. FromJSONKey a => FromJSONKeyFunction a
A.fromJSONKey of
                  A.FromJSONKeyTextParser Text -> Parser a
p
                    -> Text -> Parser a
p Text
t
                  FromJSONKeyFunction a
_ -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"internal: parseKeyPB: unexpected FromJSONKey summand"
  Value
_          -> String -> Value -> Parser a
forall a. String -> Value -> Parser a
A.typeMismatch String
tyDesc Value
v

-- | Liberally parse an integer value (e.g. 42 or "42" as 42); first parameter
-- provides context for type mismatches
parseNumOrDecimalString :: (A.FromJSON a) => String -> A.Value -> A.Parser a
parseNumOrDecimalString :: String -> Value -> Parser a
parseNumOrDecimalString String
tyDesc Value
v = case Value
v of
  A.Number{} -> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v
  A.String Text
t -> (String -> Parser a)
-> (a -> Parser a) -> Either String a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> Parser a)
-> (Text -> Either String a) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode (ByteString -> Either String a)
-> (Text -> ByteString) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TL.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict (Text -> Parser a) -> Text -> Parser a
forall a b. (a -> b) -> a -> b
$ Text
t
  Value
_          -> String -> Value -> Parser a
forall a. String -> Value -> Parser a
A.typeMismatch String
tyDesc Value
v

-- * Common instances for jsonpb codec implementations

-- ** Instances for scalar types

--------------------------------------------------------------------------------
-- Boolean scalar type

instance ToJSONPB Bool where
  toJSONPB :: Bool -> Options -> Value
toJSONPB     = Value -> Options -> Value
forall a b. a -> b -> a
const (Value -> Options -> Value)
-> (Bool -> Value) -> Bool -> Options -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Value
forall a. ToJSON a => a -> Value
A.toJSON
  toEncodingPB :: Bool -> Options -> Encoding
toEncodingPB = Encoding -> Options -> Encoding
forall a b. a -> b -> a
const (Encoding -> Options -> Encoding)
-> (Bool -> Encoding) -> Bool -> Options -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding

instance FromJSONPB Bool where
  parseJSONPB :: Value -> Parser Bool
parseJSONPB = Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
A.parseJSON

--------------------------------------------------------------------------------
-- Integer scalar types
--
--   * 32 bit integer values render to JSON decimal numbers; either numbers or
--     strings are accepted.
--
--   * 64 bit integer values render to JSON decimal strings; either numbers
--     or strings are accepted.
--

-- int32 / sint32
instance ToJSONPB Int32 where
  toJSONPB :: Int32 -> Options -> Value
toJSONPB     = Value -> Options -> Value
forall a b. a -> b -> a
const (Value -> Options -> Value)
-> (Int32 -> Value) -> Int32 -> Options -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Value
forall a. ToJSON a => a -> Value
A.toJSON
  toEncodingPB :: Int32 -> Options -> Encoding
toEncodingPB = Encoding -> Options -> Encoding
forall a b. a -> b -> a
const (Encoding -> Options -> Encoding)
-> (Int32 -> Encoding) -> Int32 -> Options -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding

instance FromJSONPB Int32 where
  parseJSONPB :: Value -> Parser Int32
parseJSONPB = String -> Value -> Parser Int32
forall a. FromJSON a => String -> Value -> Parser a
parseNumOrDecimalString String
"int32 / sint32"

-- uint32
instance ToJSONPB Word32 where
  toJSONPB :: Word32 -> Options -> Value
toJSONPB     = Value -> Options -> Value
forall a b. a -> b -> a
const (Value -> Options -> Value)
-> (Word32 -> Value) -> Word32 -> Options -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Value
forall a. ToJSON a => a -> Value
A.toJSON
  toEncodingPB :: Word32 -> Options -> Encoding
toEncodingPB = Encoding -> Options -> Encoding
forall a b. a -> b -> a
const (Encoding -> Options -> Encoding)
-> (Word32 -> Encoding) -> Word32 -> Options -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding

instance FromJSONPB Word32 where
  parseJSONPB :: Value -> Parser Word32
parseJSONPB = String -> Value -> Parser Word32
forall a. FromJSON a => String -> Value -> Parser a
parseNumOrDecimalString String
"uint32"

-- int64 / sint64
instance ToJSONPB Int64 where
  toJSONPB :: Int64 -> Options -> Value
toJSONPB Int64
x Options
_     = Text -> Value
A.String (Text -> Value) -> (Int64 -> Text) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Int64 -> String) -> Int64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> Value) -> Int64 -> Value
forall a b. (a -> b) -> a -> b
$ Int64
x
  toEncodingPB :: Int64 -> Options -> Encoding
toEncodingPB Int64
x Options
_ = String -> Encoding
forall a. String -> Encoding' a
E.string (Int64 -> String
forall a. Show a => a -> String
show Int64
x)
instance FromJSONPB Int64 where
  parseJSONPB :: Value -> Parser Int64
parseJSONPB = String -> Value -> Parser Int64
forall a. FromJSON a => String -> Value -> Parser a
parseNumOrDecimalString String
"int64 / sint64"

-- unit64
instance ToJSONPB Word64 where
  toJSONPB :: Word64 -> Options -> Value
toJSONPB Word64
x Options
_     = Text -> Value
A.String (Text -> Value) -> (Word64 -> Text) -> Word64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Word64 -> String) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> Value) -> Word64 -> Value
forall a b. (a -> b) -> a -> b
$ Word64
x
  toEncodingPB :: Word64 -> Options -> Encoding
toEncodingPB Word64
x Options
_ = String -> Encoding
forall a. String -> Encoding' a
E.string (Word64 -> String
forall a. Show a => a -> String
show Word64
x)
instance FromJSONPB Word64 where
  parseJSONPB :: Value -> Parser Word64
parseJSONPB = String -> Value -> Parser Word64
forall a. FromJSON a => String -> Value -> Parser a
parseNumOrDecimalString String
"int64 / sint64"

-- fixed32
instance ToJSONPB (Fixed Word32) where
  toJSONPB :: Fixed Word32 -> Options -> Value
toJSONPB     = (Word32 -> Options -> Value) -> Fixed Word32 -> Options -> Value
coerce (ToJSONPB Word32 => Word32 -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB @Word32)
  toEncodingPB :: Fixed Word32 -> Options -> Encoding
toEncodingPB = (Word32 -> Options -> Encoding)
-> Fixed Word32 -> Options -> Encoding
coerce (ToJSONPB Word32 => Word32 -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
toEncodingPB @Word32)
instance FromJSONPB (Fixed Word32) where
  parseJSONPB :: Value -> Parser (Fixed Word32)
parseJSONPB = (Value -> Parser Word32) -> Value -> Parser (Fixed Word32)
coerce (FromJSONPB Word32 => Value -> Parser Word32
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB @Word32)

-- fixed64
instance ToJSONPB (Fixed Word64) where
  toJSONPB :: Fixed Word64 -> Options -> Value
toJSONPB = (Word64 -> Options -> Value) -> Fixed Word64 -> Options -> Value
coerce (ToJSONPB Word64 => Word64 -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB @Word64)
  toEncodingPB :: Fixed Word64 -> Options -> Encoding
toEncodingPB = (Word64 -> Options -> Encoding)
-> Fixed Word64 -> Options -> Encoding
coerce (ToJSONPB Word64 => Word64 -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
toEncodingPB @Word64)
instance FromJSONPB (Fixed Word64) where
  parseJSONPB :: Value -> Parser (Fixed Word64)
parseJSONPB = (Value -> Parser Word64) -> Value -> Parser (Fixed Word64)
coerce (FromJSONPB Word64 => Value -> Parser Word64
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB @Word64)

-- sfixed32
instance ToJSONPB (Fixed Int32) where
  toJSONPB :: Fixed Int32 -> Options -> Value
toJSONPB = (Int32 -> Options -> Value) -> Fixed Int32 -> Options -> Value
coerce (ToJSONPB Int32 => Int32 -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB @Int32)
  toEncodingPB :: Fixed Int32 -> Options -> Encoding
toEncodingPB = (Int32 -> Options -> Encoding)
-> Fixed Int32 -> Options -> Encoding
coerce (ToJSONPB Int32 => Int32 -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
toEncodingPB @Int32)
instance FromJSONPB (Fixed Int32) where
  parseJSONPB :: Value -> Parser (Fixed Int32)
parseJSONPB = (Value -> Parser Int32) -> Value -> Parser (Fixed Int32)
coerce (FromJSONPB Int32 => Value -> Parser Int32
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB @Int32)

-- sfixed64
instance ToJSONPB (Fixed Int64) where
  toJSONPB :: Fixed Int64 -> Options -> Value
toJSONPB = (Int64 -> Options -> Value) -> Fixed Int64 -> Options -> Value
coerce (ToJSONPB Int64 => Int64 -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB @Int64)
  toEncodingPB :: Fixed Int64 -> Options -> Encoding
toEncodingPB = (Int64 -> Options -> Encoding)
-> Fixed Int64 -> Options -> Encoding
coerce (ToJSONPB Int64 => Int64 -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
toEncodingPB @Int64)
instance FromJSONPB (Fixed Int64) where
  parseJSONPB :: Value -> Parser (Fixed Int64)
parseJSONPB = (Value -> Parser Int64) -> Value -> Parser (Fixed Int64)
coerce (FromJSONPB Int64 => Value -> Parser Int64
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB @Int64)

--------------------------------------------------------------------------------
-- Floating point scalar types
--
-- JSON value will be a number or one of the special string values "NaN",
-- "Infinity", and "-Infinity". Either numbers or strings are accepted. Exponent
-- notation is also accepted.

-- float
instance ToJSONPB Float where
  toJSONPB :: Float -> Options -> Value
toJSONPB     = Value -> Options -> Value
forall a b. a -> b -> a
const (Value -> Options -> Value)
-> (Float -> Value) -> Float -> Options -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Value
forall a. ToJSON a => a -> Value
A.toJSON
  toEncodingPB :: Float -> Options -> Encoding
toEncodingPB = Encoding -> Options -> Encoding
forall a b. a -> b -> a
const (Encoding -> Options -> Encoding)
-> (Float -> Encoding) -> Float -> Options -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding

instance FromJSONPB Float where
  parseJSONPB :: Value -> Parser Float
parseJSONPB = String -> Value -> Parser Float
forall a.
(FromJSON a, FromJSONKey a) =>
String -> Value -> Parser a
parseFP String
"float"

-- double
instance ToJSONPB Double where
  toJSONPB :: Double -> Options -> Value
toJSONPB     = Value -> Options -> Value
forall a b. a -> b -> a
const (Value -> Options -> Value)
-> (Double -> Value) -> Double -> Options -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Value
forall a. ToJSON a => a -> Value
A.toJSON
  toEncodingPB :: Double -> Options -> Encoding
toEncodingPB = Encoding -> Options -> Encoding
forall a b. a -> b -> a
const (Encoding -> Options -> Encoding)
-> (Double -> Encoding) -> Double -> Options -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding
instance FromJSONPB Double where
  parseJSONPB :: Value -> Parser Double
parseJSONPB = String -> Value -> Parser Double
forall a.
(FromJSON a, FromJSONKey a) =>
String -> Value -> Parser a
parseFP String
"double"

--------------------------------------------------------------------------------
-- Stringly types (string and bytes)

-- string
instance ToJSONPB TL.Text where
  toJSONPB :: Text -> Options -> Value
toJSONPB     = Value -> Options -> Value
forall a b. a -> b -> a
const (Value -> Options -> Value)
-> (Text -> Value) -> Text -> Options -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON
  toEncodingPB :: Text -> Options -> Encoding
toEncodingPB = Encoding -> Options -> Encoding
forall a b. a -> b -> a
const (Encoding -> Options -> Encoding)
-> (Text -> Encoding) -> Text -> Options -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding
instance FromJSONPB TL.Text where
  parseJSONPB :: Value -> Parser Text
parseJSONPB = Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON

-- bytes

bsToJSONPB :: BS.ByteString -> A.Value
bsToJSONPB :: ByteString -> Value
bsToJSONPB (ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode -> Either UnicodeException Text
ebs) = case Either UnicodeException Text
ebs of
  Right Text
bs -> Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Text
bs
  Left UnicodeException
e   -> String -> Value
forall a. HasCallStack => String -> a
error (String
"internal: failed to encode B64-encoded bytestring: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e)
              -- NB: T.decodeUtf8' should never fail because we B64-encode the
              -- incoming bytestring.

instance ToJSONPB BS.ByteString where
  toJSONPB :: ByteString -> Options -> Value
toJSONPB ByteString
bs Options
_        = ByteString -> Value
bsToJSONPB ByteString
bs
  toEncodingPB :: ByteString -> Options -> Encoding
toEncodingPB ByteString
bs Options
opts = Value -> Encoding
E.value (ByteString -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB ByteString
bs Options
opts)

instance FromJSONPB BS.ByteString where
  parseJSONPB :: Value -> Parser ByteString
parseJSONPB (A.String Text
b64enc) = ByteString -> Parser ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Parser ByteString)
-> (Text -> ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.decodeLenient (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> Parser ByteString) -> Text -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ Text
b64enc
  parseJSONPB Value
v                 = String -> Value -> Parser ByteString
forall a. String -> Value -> Parser a
A.typeMismatch String
"bytes" Value
v

--------------------------------------------------------------------------------
-- Enumerated types

enumToJSONPB :: (e -> Options -> a) -- ^ JSONPB encoder function to use
             -> a                   -- ^ null value to use for out-of-range enums
             -> Enumerated e        -- ^ the enumerated value to encode
             -> Options             -- ^ JSONPB encoding options
             -> a                   -- ^ the JSONPB-encoded value
enumToJSONPB :: (e -> Options -> a) -> a -> Enumerated e -> Options -> a
enumToJSONPB e -> Options -> a
enc a
null_ (Enumerated Either Int32 e
e) Options
opts = (Int32 -> a) -> (e -> a) -> Either Int32 e -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Int32 -> a
forall a. (Eq a, Num a) => a -> a
err (\e
input -> e -> Options -> a
enc e
input Options
opts) Either Int32 e
e
  where
    err :: a -> a
err a
0 = String -> a
forall a. HasCallStack => String -> a
error String
"enumToJSONPB: The first enum value must be zero in proto3"
            -- TODO: Raise a compilation error when the first enum value in an
            -- enumeration is not zero.
            --
            -- See https://github.com/awakesecurity/proto3-suite/issues/28
            --
            -- The proto3 spec states that the default value is the first
            -- defined enum value, which must be 0. Since we currently don't
            -- raise a compilation error for this like we should, we have to
            -- handle this case.
            --
            -- For now, die horribly to mimic what should be a compilation
            -- error.
    err a
_ = a
null_
            -- From the JSONPB spec:
            --
            --   If a value is missing in the JSON-encoded data or if its value
            --   is null, it will be interpreted as the appropriate default
            --   value when parsed into a protocol buffer.
            --
            -- Thus, interpreting a wire value out of enum range as "missing",
            -- we yield null here to mean the default value.


instance ToJSONPB e => ToJSONPB (Enumerated e) where
  toJSONPB :: Enumerated e -> Options -> Value
toJSONPB     = (e -> Options -> Value)
-> Value -> Enumerated e -> Options -> Value
forall e a.
(e -> Options -> a) -> a -> Enumerated e -> Options -> a
enumToJSONPB e -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB Value
A.Null
  toEncodingPB :: Enumerated e -> Options -> Encoding
toEncodingPB = (e -> Options -> Encoding)
-> Encoding -> Enumerated e -> Options -> Encoding
forall e a.
(e -> Options -> a) -> a -> Enumerated e -> Options -> a
enumToJSONPB e -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
toEncodingPB Encoding
E.null_

instance (ProtoEnum e, FromJSONPB e) => FromJSONPB (Enumerated e) where
  parseJSONPB :: Value -> Parser (Enumerated e)
parseJSONPB Value
A.Null = Enumerated e -> Parser (Enumerated e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Enumerated e
forall a. HasDefault a => a
def -- So CG does not have to handle this case in
                                -- every generated instance
  parseJSONPB Value
v      = Either Int32 e -> Enumerated e
forall a. Either Int32 a -> Enumerated a
Enumerated (Either Int32 e -> Enumerated e)
-> (e -> Either Int32 e) -> e -> Enumerated e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either Int32 e
forall a b. b -> Either a b
Right (e -> Enumerated e) -> Parser e -> Parser (Enumerated e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser e
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB Value
v

-- ** Instances for composite types

--------------------------------------------------------------------------------
-- Instances for repeated messages
--
-- JSON value will be the vector elements encoded as a JSON array. The null
-- value is accepted as the empty list, @[]@.

instance ToJSONPB a => ToJSONPB (V.Vector a) where
  toJSONPB :: Vector a -> Options -> Value
toJSONPB Vector a
v Options
opts     = Array -> Value
A.Array ((a -> Value) -> Vector a -> Array
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\a
x -> a -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB a
x Options
opts) Vector a
v)
  toEncodingPB :: Vector a -> Options -> Encoding
toEncodingPB Vector a
v Options
opts = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
E.list (\a
x -> a -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
toEncodingPB a
x Options
opts) (Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector a
v)
instance FromJSONPB a => FromJSONPB (V.Vector a) where
  parseJSONPB :: Value -> Parser (Vector a)
parseJSONPB (A.Array Array
vs) = (Value -> Parser a) -> Array -> Parser (Vector a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser a
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB Array
vs
  parseJSONPB Value
A.Null       = Vector a -> Parser (Vector a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  parseJSONPB Value
v            = String -> Value -> Parser (Vector a)
forall a. String -> Value -> Parser a
A.typeMismatch String
"repeated" Value
v

--------------------------------------------------------------------------------
-- Instances for nested messages

instance ToJSONPB a => ToJSONPB (Maybe a) where
  toJSONPB :: Maybe a -> Options -> Value
toJSONPB Maybe a
mx Options
opts     = Value -> (a -> Value) -> Maybe a -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
A.Null (\a
x -> a -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
toJSONPB a
x Options
opts) Maybe a
mx
  toEncodingPB :: Maybe a -> Options -> Encoding
toEncodingPB Maybe a
mx Options
opts = Encoding -> (a -> Encoding) -> Maybe a -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
E.null_ (\a
x -> a -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
toEncodingPB a
x Options
opts) Maybe a
mx
instance FromJSONPB a => FromJSONPB (Maybe a) where
  parseJSONPB :: Value -> Parser (Maybe a)
parseJSONPB Value
A.Null = Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  parseJSONPB Value
v      = (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Value -> Parser a
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB Value
v)

--------------------------------------------------------------------------------
-- Instances for map

instance (A.ToJSONKey k, ToJSONPB k, ToJSONPB v) => ToJSONPB (M.Map k v) where
  toJSONPB :: Map k v -> Options -> Value
toJSONPB Map k v
m Options
opts = (v -> Value) -> ([v] -> Value) -> Map k v -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Value) -> ([a] -> Value) -> f a -> Value
A.liftToJSON @(M.Map k) (v -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
`toJSONPB` Options
opts) (Array -> Value
A.Array (Array -> Value) -> ([v] -> Array) -> [v] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> ([v] -> [Value]) -> [v] -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Value) -> [v] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (v -> Options -> Value
forall a. ToJSONPB a => a -> Options -> Value
`toJSONPB` Options
opts)) Map k v
m
  toEncodingPB :: Map k v -> Options -> Encoding
toEncodingPB Map k v
m Options
opts = (v -> Encoding) -> ([v] -> Encoding) -> Map k v -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
A.liftToEncoding @(M.Map k) (v -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
`toEncodingPB` Options
opts) ((v -> Encoding) -> [v] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
E.list (v -> Options -> Encoding
forall a. ToJSONPB a => a -> Options -> Encoding
`toEncodingPB` Options
opts)) Map k v
m

instance (Ord k, A.FromJSONKey k, FromJSONPB k, FromJSONPB v) => FromJSONPB (M.Map k v) where
  parseJSONPB :: Value -> Parser (Map k v)
parseJSONPB = (Value -> Parser v)
-> (Value -> Parser [v]) -> Value -> Parser (Map k v)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
A.liftParseJSON @(M.Map k) Value -> Parser v
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB Value -> Parser [v]
forall b. FromJSONPB b => Value -> Parser [b]
parseList
    where
      parseList :: Value -> Parser [b]
parseList (A.Array Array
a) = (Value -> Parser b) -> [Value] -> Parser [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser b
forall a. FromJSONPB a => Value -> Parser a
parseJSONPB (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a)
      parseList Value
v = String -> Value -> Parser [b]
forall a. String -> Value -> Parser a
A.typeMismatch String
"not a list" Value
v