-- | This module provides type classes for encoding and decoding protocol
-- buffers message, as well as a safer alternative to the raw 'Proto3.Wire'
-- library based on 'GHC.Generics'.
--
-- = Classes
--
-- The 'Primitive' class captures those types which correspond to primitive field
-- types, as defined by the protocol buffers specification. A 'Primitive' type is
-- one which can always be encoded as a single key/value pair in the wire format.
--
-- The 'MessageField' class captures those types which are encoded under a single
-- key in the wire format, i.e. primitives, packed and unpacked lists, and
-- embedded messages.
--
-- The 'Message' class captures types which correspond to protocol buffers messages.
-- Instances of 'Message' can be written by hand for your types by using the
-- functions in the 'Proto3.Suite.Encode' and 'Proto3.Suite.Decode'
-- modules. In the case where the message format is determined by your Haskell code,
-- you might prefer to derive your 'Message' instances using generic deriving.
--
-- = Generic Instances
--
-- Using the 'GHC.Generics' approach, instead of generating Haskell code from a
-- .proto file, we write our message formats as Haskell types, and generate a
-- serializer/deserializer pair.
--
-- To use this library, simply derive a 'Generic' instance for your type(s), and
-- use the default `Message` instance.
--
-- For generic 'Message' instances, field numbers are automatically generated,
-- starting at 1. Therefore, adding new fields is a compatible change only at the
-- end of a record. Renaming fields is also safe. You should not use the generic
-- instances if you are starting from an existing .proto file.
--
-- = Strings
--
-- Use 'TL.Text' instead of 'String' for string types inside messages.
--
-- = Example
--
-- > data MultipleFields =
-- >   MultipleFields { multiFieldDouble :: Double
-- >                  , multiFieldFloat  :: Float
-- >                  , multiFieldInt32  :: Int32
-- >                  , multiFieldInt64  :: Int64
-- >                  , multiFieldString :: TL.Text
-- >                  , multiFieldBool   :: Bool
-- >                  } deriving (Show, Generic, Eq)
-- >
-- > instance Message MultipleFields
-- >
-- > serialized = toLazyByteString $ MultipleFields 1.0 1.0 1 1 "hi" True
-- >
-- > deserialized :: MultipleFields
-- > deserialized = case parse (toStrict serialized) of
-- >                  Left e -> error e
-- >                  Right msg -> msg

{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}

module Proto3.Suite.Class
  ( Primitive(..)
  , MessageField(..)
  , Message(..)

  -- * Encoding
  , toLazyByteString

  -- * Decoding
  , HasDefault(..)
  , fromByteString
  , fromB64
  , coerceOver
  , unsafeCoerceOver

  -- * Documentation
  , Named(..)
  , Finite(..)
  , message
  , Proto3.Suite.Class.enum

  -- * Generic Classes
  , GenericMessage(..)
  ) where

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString        as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy   as BL
import           Data.Coerce            (Coercible, coerce)
import qualified Data.Foldable          as Foldable
import           Data.Functor           (($>))
import           Data.Int               (Int32, Int64)
import           Data.Kind              (Type)
import qualified Data.Map               as M
import           Data.Maybe             (fromMaybe, isNothing)
import           Data.Proxy             (Proxy (..))
import           Data.String            (IsString (..))
import qualified Data.Text              as T
import qualified Data.Text.Lazy         as TL
import qualified Data.Text.Short        as TS
import qualified Data.Traversable       as TR
import           Data.Vector            (Vector)
import           Data.Word              (Word32, Word64)
import           GHC.Exts               (fromList, Proxy#, proxy#)
import           GHC.Generics
import           GHC.TypeLits
import           Google.Protobuf.Wrappers.Polymorphic (Wrapped(..))
import           Proto3.Suite.DotProto
import qualified Proto3.Suite.Types
import           Proto3.Suite.Types     hiding (Bytes, String)
import           Proto3.Wire
import           Proto3.Wire.Decode     (ParseError, Parser (..), RawField,
                                         RawMessage, RawPrimitive, runParser)
import qualified Proto3.Wire.Decode     as Decode
import qualified Proto3.Wire.Encode     as Encode
import           Unsafe.Coerce          (unsafeCoerce)

#ifdef LARGE_RECORDS
import qualified Data.Record.Generic as LG
import qualified Data.Record.Generic.GHC as LG
import qualified Data.Record.Generic.Rep as LG
#endif

-- | Pass through those values that are outside the enum range;
-- this is for forward compatibility as enumerations are extended.
codeFromEnumerated :: ProtoEnum e => Enumerated e -> Int32
codeFromEnumerated :: Enumerated e -> Int32
codeFromEnumerated = (Int32 -> Int32) -> (e -> Int32) -> Either Int32 e -> Int32
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Int32 -> Int32
forall a. a -> a
id e -> Int32
forall a. ProtoEnum a => a -> Int32
fromProtoEnum (Either Int32 e -> Int32)
-> (Enumerated e -> Either Int32 e) -> Enumerated e -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumerated e -> Either Int32 e
forall a. Enumerated a -> Either Int32 a
enumerated
{-# INLINE codeFromEnumerated #-}

-- | Values inside the enum range are in Right, the rest in Left;
-- this is for forward compatibility as enumerations are extended.
codeToEnumerated :: ProtoEnum e => Int32 -> Enumerated e
codeToEnumerated :: Int32 -> Enumerated e
codeToEnumerated Int32
code =
  Either Int32 e -> Enumerated e
forall a. Either Int32 a -> Enumerated a
Enumerated (Either Int32 e -> Enumerated e) -> Either Int32 e -> Enumerated e
forall a b. (a -> b) -> a -> b
$ Either Int32 e
-> (e -> Either Int32 e) -> Maybe e -> Either Int32 e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int32 -> Either Int32 e
forall a b. a -> Either a b
Left Int32
code) e -> Either Int32 e
forall a b. b -> Either a b
Right (Int32 -> Maybe e
forall a. ProtoEnum a => Int32 -> Maybe a
toProtoEnumMay Int32
code)
{-# INLINE codeToEnumerated #-}

-- | A class for types with default values per the protocol buffers spec.
class HasDefault a where
  -- | The default value for this type.
  def :: a

  default def :: (Generic a, GenericHasDefault (Rep a)) => a
  def = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (forall x. GenericHasDefault (Rep a) => Rep a x
forall (f :: * -> *) x. GenericHasDefault f => f x
genericDef @(Rep a))

  isDefault :: a -> Bool

  default isDefault :: Eq a => a -> Bool
  isDefault = (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. HasDefault a => a
def)

-- | Do not encode the default value
omittingDefault
  :: HasDefault a
  => (a -> Encode.MessageBuilder)
  -> a
  -> Encode.MessageBuilder
omittingDefault :: (a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault a -> MessageBuilder
f a
p
  | a -> Bool
forall a. HasDefault a => a -> Bool
isDefault a
p = MessageBuilder
forall a. Monoid a => a
mempty
  | Bool
otherwise = a -> MessageBuilder
f a
p

-- -- | Numeric types default to zero
-- instance Num a => HasDefault a where def = 0

instance HasDefault Int where def :: Int
def = Int
0
instance HasDefault Integer where def :: Integer
def = Integer
0

instance HasDefault Int32 where def :: Int32
def = Int32
0
instance HasDefault Int64 where def :: Int64
def = Int64
0
instance HasDefault Word32 where def :: Word32
def = Word32
0
instance HasDefault Word64 where def :: Word64
def = Word64
0
instance HasDefault (Signed Int32) where def :: Signed Int32
def = Signed Int32
0
instance HasDefault (Signed Int64) where def :: Signed Int64
def = Signed Int64
0
-- | Used in generated records to represent @sfixed32@
instance HasDefault (Fixed Int32) where def :: Fixed Int32
def = Fixed Int32
0
-- | Used in generated records to represent @sfixed64@
instance HasDefault (Fixed Int64) where def :: Fixed Int64
def = Fixed Int64
0
instance HasDefault (Fixed Word32) where def :: Fixed Word32
def = Fixed Word32
0
instance HasDefault (Fixed Word64) where def :: Fixed Word64
def = Fixed Word64
0
instance HasDefault (Signed (Fixed Int32)) where def :: Signed (Fixed Int32)
def = Signed (Fixed Int32)
0
instance HasDefault (Signed (Fixed Int64)) where def :: Signed (Fixed Int64)
def = Signed (Fixed Int64)
0
instance HasDefault Float where def :: Float
def = Float
0
instance HasDefault Double where def :: Double
def = Double
0

instance HasDefault Bool where
  def :: Bool
def = Bool
False

instance HasDefault T.Text where
  def :: Text
def = Text
forall a. Monoid a => a
mempty

deriving via T.Text instance HasDefault (Proto3.Suite.Types.String T.Text)

instance HasDefault TL.Text where
  def :: Text
def = Text
forall a. Monoid a => a
mempty

deriving via TL.Text instance HasDefault (Proto3.Suite.Types.String TL.Text)

instance HasDefault TS.ShortText where
  def :: ShortText
def = ShortText
forall a. Monoid a => a
mempty

deriving via TS.ShortText instance HasDefault (Proto3.Suite.Types.String TS.ShortText)

instance HasDefault B.ByteString where
  def :: ByteString
def = ByteString
forall a. Monoid a => a
mempty

deriving via B.ByteString instance HasDefault (Proto3.Suite.Types.Bytes B.ByteString)

instance HasDefault BL.ByteString where
  def :: ByteString
def = ByteString
forall a. Monoid a => a
mempty

deriving via BL.ByteString instance HasDefault (Proto3.Suite.Types.Bytes BL.ByteString)

instance ProtoEnum e => HasDefault (Enumerated e) where
  def :: Enumerated e
def = Int32 -> Enumerated e
forall e. ProtoEnum e => Int32 -> Enumerated e
codeToEnumerated Int32
0
  isDefault :: Enumerated e -> Bool
isDefault = (Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0) (Int32 -> Bool) -> (Enumerated e -> Int32) -> Enumerated e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumerated e -> Int32
forall e. ProtoEnum e => Enumerated e -> Int32
codeFromEnumerated

deriving via (a :: Type) instance HasDefault a => HasDefault (Wrapped a)

instance HasDefault (UnpackedVec a) where
  def :: UnpackedVec a
def = UnpackedVec a
forall a. Monoid a => a
mempty
  isDefault :: UnpackedVec a -> Bool
isDefault = Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Vector a -> Bool)
-> (UnpackedVec a -> Vector a) -> UnpackedVec a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpackedVec a -> Vector a
forall a. UnpackedVec a -> Vector a
unpackedvec

instance HasDefault (PackedVec a) where
  def :: PackedVec a
def = PackedVec a
forall a. Monoid a => a
mempty
  isDefault :: PackedVec a -> Bool
isDefault = Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Vector a -> Bool)
-> (PackedVec a -> Vector a) -> PackedVec a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedVec a -> Vector a
forall a. PackedVec a -> Vector a
packedvec

instance HasDefault (NestedVec a) where
  def :: NestedVec a
def = NestedVec a
forall a. Monoid a => a
mempty
  isDefault :: NestedVec a -> Bool
isDefault = Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Vector a -> Bool)
-> (NestedVec a -> Vector a) -> NestedVec a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedVec a -> Vector a
forall a. NestedVec a -> Vector a
nestedvec

instance HasDefault (Nested a) where
  def :: Nested a
def = Maybe a -> Nested a
forall a. Maybe a -> Nested a
Nested Maybe a
forall a. Maybe a
Nothing
  isDefault :: Nested a -> Bool
isDefault = Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe a -> Bool) -> (Nested a -> Maybe a) -> Nested a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nested a -> Maybe a
forall a. Nested a -> Maybe a
nested

instance (HasDefault a) => HasDefault (ForceEmit a) where
  def :: ForceEmit a
def       = a -> ForceEmit a
forall a. a -> ForceEmit a
ForceEmit a
forall a. HasDefault a => a
def
  isDefault :: ForceEmit a -> Bool
isDefault = a -> Bool
forall a. HasDefault a => a -> Bool
isDefault (a -> Bool) -> (ForceEmit a -> a) -> ForceEmit a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForceEmit a -> a
forall a. ForceEmit a -> a
forceEmit

-- | Used in fields of generated records to represent an unwrapped
-- 'PackedVec'/'UnpackedVec'
instance HasDefault (Vector a) where
  def :: Vector a
def       = Vector a
forall a. Monoid a => a
mempty
  isDefault :: Vector a -> Bool
isDefault = Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

-- | Used in generated records to represent an unwrapped 'Nested'
instance HasDefault (Maybe a) where
  def :: Maybe a
def       = Maybe a
forall a. Maybe a
Nothing
  isDefault :: Maybe a -> Bool
isDefault = Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing

instance HasDefault (M.Map k v) where
  def :: Map k v
def = Map k v
forall k v. Map k v
M.empty
  isDefault :: Map k v -> Bool
isDefault = Map k v -> Bool
forall k v. Map k v -> Bool
M.null

class GenericHasDefault (f :: Type -> Type) where
  genericDef :: f x
instance HasDefault f => GenericHasDefault (K1 i f) where
  genericDef :: K1 i f x
genericDef = f -> K1 i f x
forall k i c (p :: k). c -> K1 i c p
K1 (HasDefault f => f
forall a. HasDefault a => a
def @f)
instance (GenericHasDefault f, GenericHasDefault g) => GenericHasDefault (f :*: g) where
  genericDef :: (:*:) f g x
genericDef = forall x. GenericHasDefault f => f x
forall (f :: * -> *) x. GenericHasDefault f => f x
genericDef @f f x -> g x -> (:*:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall x. GenericHasDefault g => g x
forall (f :: * -> *) x. GenericHasDefault f => f x
genericDef @g
instance (GenericHasDefault f, GenericHasDefault g) => GenericHasDefault (f :+: g) where
  genericDef :: (:+:) f g x
genericDef = f x -> (:+:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall x. GenericHasDefault f => f x
forall (f :: * -> *) x. GenericHasDefault f => f x
genericDef @f)
instance GenericHasDefault U1 where
  genericDef :: U1 x
genericDef = U1 x
forall k (p :: k). U1 p
U1 -- unit constructor
instance (Constructor i, GenericHasDefault f) => GenericHasDefault (C1 i f) where
  genericDef :: C1 i f x
genericDef = f x -> C1 i f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall x. GenericHasDefault f => f x
forall (f :: * -> *) x. GenericHasDefault f => f x
genericDef @f)
instance (Datatype i, GenericHasDefault f) => GenericHasDefault (D1 i f) where
  genericDef :: D1 i f x
genericDef = f x -> D1 i f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall x. GenericHasDefault f => f x
forall (f :: * -> *) x. GenericHasDefault f => f x
genericDef @f)
instance (Selector i, GenericHasDefault f) => GenericHasDefault (S1 i f) where
  genericDef :: S1 i f x
genericDef = f x -> S1 i f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall x. GenericHasDefault f => f x
forall (f :: * -> *) x. GenericHasDefault f => f x
genericDef @f)

#ifdef LARGE_RECORDS

instance (LG.Generic a, LG.Constraints a HasDefault) => GenericHasDefault (LG.ThroughLRGenerics a) where
  genericDef :: ThroughLRGenerics a x
genericDef = a -> ThroughLRGenerics a x
forall a p. a -> ThroughLRGenerics a p
LG.WrapThroughLRGenerics (a -> ThroughLRGenerics a x) -> a -> ThroughLRGenerics a x
forall a b. (a -> b) -> a -> b
$ Rep I a -> a
forall a. Generic a => Rep I a -> a
LG.to (Rep I a -> a) -> Rep I a -> a
forall a b. (a -> b) -> a -> b
$ Proxy HasDefault -> (forall x. HasDefault x => I x) -> Rep I a
forall a (c :: * -> Constraint) (f :: * -> *).
(Generic a, Constraints a c) =>
Proxy c -> (forall x. c x => f x) -> Rep f a
LG.cpure (Proxy HasDefault
forall k (t :: k). Proxy t
Proxy @HasDefault) (x -> I x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
forall a. HasDefault a => a
def)

#endif

-- | This class captures those types whose names need to appear in .proto files.
--
-- It has a default implementation for any data type which is an instance of the
-- 'Generic' class, which will extract the name of the type constructor.
class Named a where
  -- | Get the name of a type constructor
  nameOf :: IsString string => Proxy# a -> string

  default nameOf :: (IsString string, GenericNamed (Rep a)) => Proxy# a -> string
  nameOf Proxy# a
_ = Proxy# (Rep a) -> string
forall (f :: * -> *) string.
(GenericNamed f, IsString string) =>
Proxy# f -> string
genericNameOf (Proxy# (Rep a)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (Rep a))

class GenericNamed (f :: Type -> Type) where
  genericNameOf :: IsString string => Proxy# f -> string

instance Datatype d => GenericNamed (M1 D d f) where
  genericNameOf :: Proxy# (M1 D d f) -> string
genericNameOf Proxy# (M1 D d f)
_ = String -> string
forall a. IsString a => String -> a
fromString (M1 D d f () -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName (M1 D d f ()
forall a. HasCallStack => a
undefined :: M1 D d f ()))

instance NameOfWrapperFor a => Named (Wrapped a) where
  nameOf :: Proxy# (Wrapped a) -> string
nameOf Proxy# (Wrapped a)
_ = forall string. (NameOfWrapperFor a, IsString string) => string
forall k (a :: k) string.
(NameOfWrapperFor a, IsString string) =>
string
nameOfWrapperFor @a
  {-# INLINE nameOf #-}

-- | Defines the name to be returned by @`HsProtobuf.Named` (`Wrapped` a)@.
class NameOfWrapperFor a where
  nameOfWrapperFor :: forall string . IsString string => string

instance NameOfWrapperFor Double where
  nameOfWrapperFor :: string
nameOfWrapperFor = string
"DoubleValue"

instance NameOfWrapperFor Float where
  nameOfWrapperFor :: string
nameOfWrapperFor = string
"FloatValue"

instance NameOfWrapperFor Int64 where
  nameOfWrapperFor :: string
nameOfWrapperFor = string
"Int64Value"

instance NameOfWrapperFor Word64 where
  nameOfWrapperFor :: string
nameOfWrapperFor = string
"UInt64Value"

instance NameOfWrapperFor Int32 where
  nameOfWrapperFor :: string
nameOfWrapperFor = string
"Int32Value"

instance NameOfWrapperFor Word32 where
  nameOfWrapperFor :: string
nameOfWrapperFor = string
"UInt32Value"

instance NameOfWrapperFor Bool where
  nameOfWrapperFor :: string
nameOfWrapperFor = string
"BoolValue"

instance NameOfWrapperFor (Proto3.Suite.Types.String a) where
  nameOfWrapperFor :: string
nameOfWrapperFor = string
"StringValue"

instance NameOfWrapperFor (Proto3.Suite.Types.Bytes a) where
  nameOfWrapperFor :: string
nameOfWrapperFor = string
"BytesValue"

-- | Enumerable types with finitely many values.
--
-- This class can be derived whenever a sum type is an instance of 'Generic',
-- and only consists of zero-argument constructors. The derived instance should
-- be compatible with `ProtoEnum` instances, in the sense that
--
-- > map (fromJust . toProtoEnumMay . snd) enumerate
--
-- should enumerate all values of the type without runtime errors.
class ProtoEnum a => Finite a where
  -- | Enumerate values of a finite type, along with names of constructors.
  enumerate :: IsString string => Proxy# a -> [(string, Int32)]

  default enumerate ::
    (IsString string, Generic a, GenericFinite (Rep a)) =>
    Proxy# a -> [(string, Int32)]
  enumerate Proxy# a
_ =
    (Rep a Any -> Int32) -> (string, Rep a Any) -> (string, Int32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Int32
forall a. ProtoEnum a => a -> Int32
fromProtoEnum (a -> Int32) -> (Rep a Any -> a) -> Rep a Any -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a x. Generic a => Rep a x -> a
forall p. Rep a p -> a
to :: Rep a p -> a)) ((string, Rep a Any) -> (string, Int32))
-> [(string, Rep a Any)] -> [(string, Int32)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(string, Rep a Any)]
forall (f :: * -> *) string p.
(GenericFinite f, IsString string) =>
[(string, f p)]
genericEnumerate

-- | Generate metadata for an enum type.
enum :: (Finite e, Named e) => Proxy# e -> DotProtoDefinition
enum :: Proxy# e -> DotProtoDefinition
enum Proxy# e
pr = String
-> DotProtoIdentifier -> [DotProtoEnumPart] -> DotProtoDefinition
DotProtoEnum String
"" (String -> DotProtoIdentifier
Single (String -> DotProtoIdentifier) -> String -> DotProtoIdentifier
forall a b. (a -> b) -> a -> b
$ Proxy# e -> String
forall a string. (Named a, IsString string) => Proxy# a -> string
nameOf Proxy# e
pr) (((String, Int32) -> DotProtoEnumPart)
-> [(String, Int32)] -> [DotProtoEnumPart]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int32) -> DotProtoEnumPart
enumField ([(String, Int32)] -> [DotProtoEnumPart])
-> [(String, Int32)] -> [DotProtoEnumPart]
forall a b. (a -> b) -> a -> b
$ Proxy# e -> [(String, Int32)]
forall a string.
(Finite a, IsString string) =>
Proxy# a -> [(string, Int32)]
enumerate Proxy# e
pr)
  where
    enumField :: (String, Int32) -> DotProtoEnumPart
enumField (String
name, Int32
value) = DotProtoIdentifier -> Int32 -> [DotProtoOption] -> DotProtoEnumPart
DotProtoEnumField (String -> DotProtoIdentifier
Single String
name) Int32
value []

class GenericFinite (f :: Type -> Type) where
  genericEnumerate :: IsString string => [(string, f p)]

instance ( GenericFinite f
         , GenericFinite g
         ) => GenericFinite (f :+: g) where
  genericEnumerate :: [(string, (:+:) f g p)]
genericEnumerate =
    ((f p -> (:+:) f g p) -> (string, f p) -> (string, (:+:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((string, f p) -> (string, (:+:) f g p))
-> [(string, f p)] -> [(string, (:+:) f g p)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(string, f p)]
forall (f :: * -> *) string p.
(GenericFinite f, IsString string) =>
[(string, f p)]
genericEnumerate) [(string, (:+:) f g p)]
-> [(string, (:+:) f g p)] -> [(string, (:+:) f g p)]
forall a. Semigroup a => a -> a -> a
<>
    ((g p -> (:+:) f g p) -> (string, g p) -> (string, (:+:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((string, g p) -> (string, (:+:) f g p))
-> [(string, g p)] -> [(string, (:+:) f g p)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(string, g p)]
forall (f :: * -> *) string p.
(GenericFinite f, IsString string) =>
[(string, f p)]
genericEnumerate)

instance Constructor c => GenericFinite (M1 C c U1) where
  genericEnumerate :: [(string, M1 C c U1 p)]
genericEnumerate = [ (String -> string
forall a. IsString a => String -> a
fromString String
name, U1 p -> M1 C c U1 p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 U1 p
forall k (p :: k). U1 p
U1) ]
    where
      name :: String
name = M1 C c Any () -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. HasCallStack => a
forall (f :: * -> *). M1 C c f ()
undefined :: M1 C c f ())

instance GenericFinite f => GenericFinite (M1 D t f) where
  genericEnumerate :: [(string, M1 D t f p)]
genericEnumerate = (f p -> M1 D t f p) -> (string, f p) -> (string, M1 D t f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f p -> M1 D t f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((string, f p) -> (string, M1 D t f p))
-> [(string, f p)] -> [(string, M1 D t f p)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(string, f p)]
forall (f :: * -> *) string p.
(GenericFinite f, IsString string) =>
[(string, f p)]
genericEnumerate

-- | This class captures those types which correspond to primitives in
-- the protocol buffers specification.
--
-- It should be possible to fully reconstruct values of these types from
-- a single 'RawPrimitive'. Notably, then, `Nested` is not `Primitive` even
-- though it can be 'embedded', since a nested message may by split up over
-- multiple 'embedded' fields.
class Primitive a where
  -- | Encode a primitive value
  encodePrimitive :: FieldNumber -> a -> Encode.MessageBuilder
  -- | Decode a primitive value
  decodePrimitive :: Parser RawPrimitive a
  -- | Get the type which represents this type inside another message.
  primType :: Proxy# a -> DotProtoPrimType

  default primType :: Named a => Proxy# a -> DotProtoPrimType
  primType Proxy# a
pr = DotProtoIdentifier -> DotProtoPrimType
Named (String -> DotProtoIdentifier
Single (Proxy# a -> String
forall a string. (Named a, IsString string) => Proxy# a -> string
nameOf Proxy# a
pr))

-- | Serialize a message as a lazy 'BL.ByteString'.
toLazyByteString :: Message a => a -> BL.ByteString
toLazyByteString :: a -> ByteString
toLazyByteString = MessageBuilder -> ByteString
Encode.toLazyByteString (MessageBuilder -> ByteString)
-> (a -> MessageBuilder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> a -> MessageBuilder
forall a. Message a => FieldNumber -> a -> MessageBuilder
encodeMessage (Word64 -> FieldNumber
fieldNumber Word64
1)

-- | Parse any message that can be decoded.
fromByteString :: Message a => B.ByteString -> Either ParseError a
fromByteString :: ByteString -> Either ParseError a
fromByteString = Parser RawMessage a -> ByteString -> Either ParseError a
forall a. Parser RawMessage a -> ByteString -> Either ParseError a
Decode.parse (FieldNumber -> Parser RawMessage a
forall a. Message a => FieldNumber -> Parser RawMessage a
decodeMessage (Word64 -> FieldNumber
fieldNumber Word64
1))

-- | As 'fromByteString', except the input bytestring is base64-encoded.
fromB64 :: Message a => B.ByteString -> Either ParseError a
fromB64 :: ByteString -> Either ParseError a
fromB64 = ByteString -> Either ParseError a
forall a. Message a => ByteString -> Either ParseError a
fromByteString (ByteString -> Either ParseError a)
-> (ByteString -> ByteString) -> ByteString -> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.decodeLenient

-- | Like `coerce` but lets you avoid specifying a type constructor
-- (such a as parser) that is common to both the input and output types.
coerceOver :: forall a b f . Coercible (f a) (f b) => f a -> f b
coerceOver :: f a -> f b
coerceOver = f a -> f b
coerce

-- | Like `unsafeCoerce` but lets you avoid specifying a type constructor
-- (such a as parser) that is common to both the input and output types.
unsafeCoerceOver :: forall a b f . f a -> f b
unsafeCoerceOver :: f a -> f b
unsafeCoerceOver = f a -> f b
forall a b. a -> b
unsafeCoerce

instance Primitive Int32 where
  encodePrimitive :: FieldNumber -> Int32 -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Int32 -> MessageBuilder
Encode.int32 FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive Int32
decodePrimitive = Parser RawPrimitive Int32
Decode.int32
  primType :: Proxy# Int32 -> DotProtoPrimType
primType Proxy# Int32
_ = DotProtoPrimType
Int32

instance Primitive Int64 where
  encodePrimitive :: FieldNumber -> Int64 -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Int64 -> MessageBuilder
Encode.int64 FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive Int64
decodePrimitive = Parser RawPrimitive Int64
Decode.int64
  primType :: Proxy# Int64 -> DotProtoPrimType
primType Proxy# Int64
_ = DotProtoPrimType
Int64

instance Primitive Word32 where
  encodePrimitive :: FieldNumber -> Word32 -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Word32 -> MessageBuilder
Encode.uint32 FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive Word32
decodePrimitive = Parser RawPrimitive Word32
Decode.uint32
  primType :: Proxy# Word32 -> DotProtoPrimType
primType Proxy# Word32
_ = DotProtoPrimType
UInt32

instance Primitive Word64 where
  encodePrimitive :: FieldNumber -> Word64 -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Word64 -> MessageBuilder
Encode.uint64 FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive Word64
decodePrimitive = Parser RawPrimitive Word64
Decode.uint64
  primType :: Proxy# Word64 -> DotProtoPrimType
primType Proxy# Word64
_ = DotProtoPrimType
UInt64

instance Primitive (Signed Int32) where
  encodePrimitive :: FieldNumber -> Signed Int32 -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Int32 -> MessageBuilder
Encode.sint32 FieldNumber
num (Int32 -> MessageBuilder)
-> (Signed Int32 -> Int32) -> Signed Int32 -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed Int32 -> Int32
coerce
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive (Signed Int32)
decodePrimitive = Parser RawPrimitive Int32 -> Parser RawPrimitive (Signed Int32)
coerce Parser RawPrimitive Int32
Decode.sint32
  primType :: Proxy# (Signed Int32) -> DotProtoPrimType
primType Proxy# (Signed Int32)
_ = DotProtoPrimType
SInt32

instance Primitive (Signed Int64) where
  encodePrimitive :: FieldNumber -> Signed Int64 -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Int64 -> MessageBuilder
Encode.sint64 FieldNumber
num (Int64 -> MessageBuilder)
-> (Signed Int64 -> Int64) -> Signed Int64 -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed Int64 -> Int64
coerce
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive (Signed Int64)
decodePrimitive = Parser RawPrimitive Int64 -> Parser RawPrimitive (Signed Int64)
coerce Parser RawPrimitive Int64
Decode.sint64
  primType :: Proxy# (Signed Int64) -> DotProtoPrimType
primType Proxy# (Signed Int64)
_ = DotProtoPrimType
SInt64

instance Primitive (Fixed Word32) where
  encodePrimitive :: FieldNumber -> Fixed Word32 -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Word32 -> MessageBuilder
Encode.fixed32 FieldNumber
num (Word32 -> MessageBuilder)
-> (Fixed Word32 -> Word32) -> Fixed Word32 -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed Word32 -> Word32
coerce
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive (Fixed Word32)
decodePrimitive = Parser RawPrimitive Word32 -> Parser RawPrimitive (Fixed Word32)
coerce Parser RawPrimitive Word32
Decode.fixed32
  primType :: Proxy# (Fixed Word32) -> DotProtoPrimType
primType Proxy# (Fixed Word32)
_ = DotProtoPrimType
Fixed32

instance Primitive (Fixed Word64) where
  encodePrimitive :: FieldNumber -> Fixed Word64 -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Word64 -> MessageBuilder
Encode.fixed64 FieldNumber
num (Word64 -> MessageBuilder)
-> (Fixed Word64 -> Word64) -> Fixed Word64 -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed Word64 -> Word64
coerce
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive (Fixed Word64)
decodePrimitive = Parser RawPrimitive Word64 -> Parser RawPrimitive (Fixed Word64)
coerce Parser RawPrimitive Word64
Decode.fixed64
  primType :: Proxy# (Fixed Word64) -> DotProtoPrimType
primType Proxy# (Fixed Word64)
_ = DotProtoPrimType
Fixed64

instance Primitive (Signed (Fixed Int32)) where
  encodePrimitive :: FieldNumber -> Signed (Fixed Int32) -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Int32 -> MessageBuilder
Encode.sfixed32 FieldNumber
num (Int32 -> MessageBuilder)
-> (Signed (Fixed Int32) -> Int32)
-> Signed (Fixed Int32)
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed (Fixed Int32) -> Int32
coerce
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive (Signed (Fixed Int32))
decodePrimitive = Parser RawPrimitive Int32
-> Parser RawPrimitive (Signed (Fixed Int32))
coerce Parser RawPrimitive Int32
Decode.sfixed32
  primType :: Proxy# (Signed (Fixed Int32)) -> DotProtoPrimType
primType Proxy# (Signed (Fixed Int32))
_ = DotProtoPrimType
SFixed32

instance Primitive (Signed (Fixed Int64)) where
  encodePrimitive :: FieldNumber -> Signed (Fixed Int64) -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Int64 -> MessageBuilder
Encode.sfixed64 FieldNumber
num (Int64 -> MessageBuilder)
-> (Signed (Fixed Int64) -> Int64)
-> Signed (Fixed Int64)
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed (Fixed Int64) -> Int64
coerce
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive (Signed (Fixed Int64))
decodePrimitive = Parser RawPrimitive Int64
-> Parser RawPrimitive (Signed (Fixed Int64))
coerce Parser RawPrimitive Int64
Decode.sfixed64
  primType :: Proxy# (Signed (Fixed Int64)) -> DotProtoPrimType
primType Proxy# (Signed (Fixed Int64))
_ = DotProtoPrimType
SFixed64

instance Primitive Bool where
  encodePrimitive :: FieldNumber -> Bool -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Bool -> MessageBuilder
Encode.bool FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive Bool
decodePrimitive = Parser RawPrimitive Bool
Decode.bool
  primType :: Proxy# Bool -> DotProtoPrimType
primType Proxy# Bool
_ = DotProtoPrimType
Bool

instance Primitive Float where
  encodePrimitive :: FieldNumber -> Float -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Float -> MessageBuilder
Encode.float FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive Float
decodePrimitive = Parser RawPrimitive Float
Decode.float
  primType :: Proxy# Float -> DotProtoPrimType
primType Proxy# Float
_ = DotProtoPrimType
Float

instance Primitive Double where
  encodePrimitive :: FieldNumber -> Double -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Double -> MessageBuilder
Encode.double FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive Double
decodePrimitive = Parser RawPrimitive Double
Decode.double
  primType :: Proxy# Double -> DotProtoPrimType
primType Proxy# Double
_ = DotProtoPrimType
Double

instance Primitive T.Text where
  encodePrimitive :: FieldNumber -> Text -> MessageBuilder
encodePrimitive !FieldNumber
fn = FieldNumber -> Text -> MessageBuilder
Encode.text FieldNumber
fn (Text -> MessageBuilder)
-> (Text -> Text) -> Text -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive Text
decodePrimitive = (Text -> Text)
-> Parser RawPrimitive Text -> Parser RawPrimitive Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
TL.toStrict Parser RawPrimitive Text
Decode.text
  primType :: Proxy# Text -> DotProtoPrimType
primType Proxy# Text
_ = DotProtoPrimType
String

deriving via T.Text instance Primitive (Proto3.Suite.Types.String T.Text)

instance Primitive TL.Text where
  encodePrimitive :: FieldNumber -> Text -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> Text -> MessageBuilder
Encode.text FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive Text
decodePrimitive = Parser RawPrimitive Text
Decode.text
  primType :: Proxy# Text -> DotProtoPrimType
primType Proxy# Text
_ = DotProtoPrimType
String

deriving via TL.Text instance Primitive (Proto3.Suite.Types.String TL.Text)

instance Primitive TS.ShortText where
  encodePrimitive :: FieldNumber -> ShortText -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> ShortText -> MessageBuilder
Encode.shortText FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive ShortText
decodePrimitive = Parser RawPrimitive ShortText
Decode.shortText
  primType :: Proxy# ShortText -> DotProtoPrimType
primType Proxy# ShortText
_ = DotProtoPrimType
String

deriving via TS.ShortText instance Primitive (Proto3.Suite.Types.String TS.ShortText)

instance Primitive B.ByteString where
  encodePrimitive :: FieldNumber -> ByteString -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> ByteString -> MessageBuilder
Encode.byteString FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive ByteString
decodePrimitive = Parser RawPrimitive ByteString
Decode.byteString
  primType :: Proxy# ByteString -> DotProtoPrimType
primType Proxy# ByteString
_ = DotProtoPrimType
Bytes

deriving via B.ByteString instance Primitive (Proto3.Suite.Types.Bytes B.ByteString)

instance Primitive BL.ByteString where
  encodePrimitive :: FieldNumber -> ByteString -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> ByteString -> MessageBuilder
Encode.lazyByteString FieldNumber
num
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive ByteString
decodePrimitive = Parser RawPrimitive ByteString
Decode.lazyByteString
  primType :: Proxy# ByteString -> DotProtoPrimType
primType Proxy# ByteString
_ = DotProtoPrimType
Bytes

deriving via BL.ByteString instance Primitive (Proto3.Suite.Types.Bytes BL.ByteString)

instance forall e. (Named e, ProtoEnum e) => Primitive (Enumerated e) where
  encodePrimitive :: FieldNumber -> Enumerated e -> MessageBuilder
encodePrimitive !FieldNumber
num = (Int32 -> MessageBuilder)
-> (e -> MessageBuilder) -> Either Int32 e -> MessageBuilder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FieldNumber -> Int32 -> MessageBuilder
Encode.int32 FieldNumber
num) (FieldNumber -> e -> MessageBuilder
forall e. ProtoEnum e => FieldNumber -> e -> MessageBuilder
Encode.enum FieldNumber
num) (Either Int32 e -> MessageBuilder)
-> (Enumerated e -> Either Int32 e)
-> Enumerated e
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumerated e -> Either Int32 e
forall a. Enumerated a -> Either Int32 a
enumerated
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive (Enumerated e)
decodePrimitive = Parser RawPrimitive (Either Int32 e)
-> Parser RawPrimitive (Enumerated e)
coerce
    @(Parser RawPrimitive (Either Int32 e))
    @(Parser RawPrimitive (Enumerated e))
    Parser RawPrimitive (Either Int32 e)
forall e. ProtoEnum e => Parser RawPrimitive (Either Int32 e)
Decode.enum
  primType :: Proxy# (Enumerated e) -> DotProtoPrimType
primType Proxy# (Enumerated e)
_ = DotProtoIdentifier -> DotProtoPrimType
Named (String -> DotProtoIdentifier
Single (Proxy# e -> String
forall a string. (Named a, IsString string) => Proxy# a -> string
nameOf (Proxy# e
forall k (a :: k). Proxy# a
proxy# :: Proxy# e)))

instance (Primitive a) => Primitive (ForceEmit a) where
  encodePrimitive :: FieldNumber -> ForceEmit a -> MessageBuilder
encodePrimitive !FieldNumber
num = FieldNumber -> a -> MessageBuilder
forall a. Primitive a => FieldNumber -> a -> MessageBuilder
encodePrimitive FieldNumber
num (a -> MessageBuilder)
-> (ForceEmit a -> a) -> ForceEmit a -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForceEmit a -> a
forall a. ForceEmit a -> a
forceEmit
  {-# INLINE encodePrimitive #-}
  decodePrimitive :: Parser RawPrimitive (ForceEmit a)
decodePrimitive     = Parser RawPrimitive a -> Parser RawPrimitive (ForceEmit a)
coerce @(Parser RawPrimitive a) @(Parser RawPrimitive (ForceEmit a)) Parser RawPrimitive a
forall a. Primitive a => Parser RawPrimitive a
decodePrimitive
  primType :: Proxy# (ForceEmit a) -> DotProtoPrimType
primType Proxy# (ForceEmit a)
_          = Proxy# a -> DotProtoPrimType
forall a. Primitive a => Proxy# a -> DotProtoPrimType
primType (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a)

-- | This class captures those types which can appear as message fields in
-- the protocol buffers specification, i.e. 'Primitive' types, or lists of
-- 'Primitive' types
class MessageField a where
  -- | Encode a message field
  encodeMessageField :: FieldNumber -> a -> Encode.MessageBuilder
  -- | Decode a message field
  decodeMessageField :: Parser RawField a

  default encodeMessageField :: (HasDefault a, Primitive a)
                             => FieldNumber -> a -> Encode.MessageBuilder
  encodeMessageField !FieldNumber
num a
x
    | a -> Bool
forall a. HasDefault a => a -> Bool
isDefault a
x = MessageBuilder
forall a. Monoid a => a
mempty
    | Bool
otherwise = FieldNumber -> a -> MessageBuilder
forall a. Primitive a => FieldNumber -> a -> MessageBuilder
encodePrimitive FieldNumber
num a
x
  {-# INLINE encodeMessageField #-}

  default decodeMessageField :: (HasDefault a, Primitive a) => Parser RawField a
  decodeMessageField = Parser RawPrimitive a -> a -> Parser RawField a
forall a. Parser RawPrimitive a -> a -> Parser RawField a
one Parser RawPrimitive a
forall a. Primitive a => Parser RawPrimitive a
decodePrimitive a
forall a. HasDefault a => a
def

  -- | Get the type which represents this type inside another message.
  protoType :: Proxy# a -> DotProtoField
  default protoType :: Primitive a => Proxy# a -> DotProtoField
  protoType Proxy# a
p = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Prim (DotProtoPrimType -> DotProtoType)
-> DotProtoPrimType -> DotProtoType
forall a b. (a -> b) -> a -> b
$ Proxy# a -> DotProtoPrimType
forall a. Primitive a => Proxy# a -> DotProtoPrimType
primType Proxy# a
p) Maybe Packing
forall a. Maybe a
Nothing

messageField :: DotProtoType -> Maybe Packing -> DotProtoField
messageField :: DotProtoType -> Maybe Packing -> DotProtoField
messageField DotProtoType
ty Maybe Packing
packing = DotProtoField :: FieldNumber
-> DotProtoType
-> DotProtoIdentifier
-> [DotProtoOption]
-> String
-> DotProtoField
DotProtoField
    { dotProtoFieldNumber :: FieldNumber
dotProtoFieldNumber = Word64 -> FieldNumber
fieldNumber Word64
1
    , dotProtoFieldType :: DotProtoType
dotProtoFieldType = DotProtoType
ty
    , dotProtoFieldName :: DotProtoIdentifier
dotProtoFieldName = DotProtoIdentifier
Anonymous
    , dotProtoFieldOptions :: [DotProtoOption]
dotProtoFieldOptions = [DotProtoOption]
packingOption
    , dotProtoFieldComment :: String
dotProtoFieldComment = String
""
    }
  where
    packingOption :: [DotProtoOption]
packingOption = [DotProtoOption]
-> (Packing -> [DotProtoOption])
-> Maybe Packing
-> [DotProtoOption]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Bool -> [DotProtoOption]
toDotProtoOption (Bool -> [DotProtoOption])
-> (Packing -> Bool) -> Packing -> [DotProtoOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Packing -> Bool
isPacked) Maybe Packing
packing

    toDotProtoOption :: Bool -> [DotProtoOption]
toDotProtoOption Bool
b = [DotProtoIdentifier -> DotProtoValue -> DotProtoOption
DotProtoOption (String -> DotProtoIdentifier
Single String
"packed") (Bool -> DotProtoValue
BoolLit Bool
b)]

    isPacked :: Packing -> Bool
isPacked Packing
PackedField   = Bool
True
    isPacked Packing
UnpackedField = Bool
False

instance MessageField Int32
instance MessageField Int64
instance MessageField Word32
instance MessageField Word64
instance MessageField (Signed Int32)
instance MessageField (Signed Int64)
instance MessageField (Fixed Word32)
instance MessageField (Fixed Word64)
instance MessageField (Signed (Fixed Int32))
instance MessageField (Signed (Fixed Int64))
instance MessageField Bool
instance MessageField Float
instance MessageField Double
instance MessageField T.Text
deriving via T.Text instance MessageField (Proto3.Suite.Types.String T.Text)
instance MessageField TL.Text
deriving via TL.Text instance MessageField (Proto3.Suite.Types.String TL.Text)
instance MessageField TS.ShortText
deriving via TS.ShortText instance MessageField (Proto3.Suite.Types.String TS.ShortText)
instance MessageField B.ByteString
deriving via B.ByteString instance MessageField (Proto3.Suite.Types.Bytes B.ByteString)
instance MessageField BL.ByteString
deriving via BL.ByteString instance MessageField (Proto3.Suite.Types.Bytes BL.ByteString)
instance (Named e, ProtoEnum e) => MessageField (Enumerated e)

instance (Ord k, Primitive k, MessageField k, Primitive v, MessageField v) => MessageField (M.Map k v) where
  encodeMessageField :: FieldNumber -> Map k v -> MessageBuilder
encodeMessageField !FieldNumber
num = ((k, v) -> MessageBuilder) -> Map k v -> MessageBuilder
forall c k a. Monoid c => ((k, a) -> c) -> Map k a -> c
go (k, v) -> MessageBuilder
op
    where
      go :: ((k, a) -> c) -> Map k a -> c
go (k, a) -> c
f = ((k, a) -> c) -> [(k, a)] -> c
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (k, a) -> c
f ([(k, a)] -> c) -> (Map k a -> [(k, a)]) -> Map k a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
M.toList
      op :: (k, v) -> MessageBuilder
op = FieldNumber -> MessageBuilder -> MessageBuilder
Encode.embedded FieldNumber
num (MessageBuilder -> MessageBuilder)
-> ((k, v) -> MessageBuilder) -> (k, v) -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> (k, v) -> MessageBuilder
forall a. Message a => FieldNumber -> a -> MessageBuilder
encodeMessage (Word64 -> FieldNumber
fieldNumber Word64
1)
      {-# INLINABLE op #-}  -- To allow specialization to a particular type class or field number.
  {-# INLINE encodeMessageField #-}

  -- Data.Map.fromList will retain the last key/value mapping. From the spec:
  --
  -- > When parsing from the wire or when merging, if there are duplicate map
  -- > keys the last key seen is used.
  decodeMessageField :: Parser RawField (Map k v)
decodeMessageField = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, v)] -> Map k v)
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> Map k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> [(k, v)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
                       ([(k, v)] -> Map k v)
-> Parser RawField [(k, v)] -> Parser RawField (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive (k, v) -> Parser RawField [(k, v)]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Parser RawMessage (k, v) -> Parser RawPrimitive (k, v)
forall a. Parser RawMessage a -> Parser RawPrimitive a
Decode.embedded' (FieldNumber -> Parser RawMessage (k, v)
forall a. Message a => FieldNumber -> Parser RawMessage a
decodeMessage (Word64 -> FieldNumber
fieldNumber Word64
1)))
  protoType :: Proxy# (Map k v) -> DotProtoField
protoType Proxy# (Map k v)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoPrimType -> DotProtoType
Map (Proxy# k -> DotProtoPrimType
forall a. Primitive a => Proxy# a -> DotProtoPrimType
primType (Proxy# k
forall k (a :: k). Proxy# a
proxy# :: Proxy# k)) (Proxy# v -> DotProtoPrimType
forall a. Primitive a => Proxy# a -> DotProtoPrimType
primType (Proxy# v
forall k (a :: k). Proxy# a
proxy# :: Proxy# v))) Maybe Packing
forall a. Maybe a
Nothing

instance {-# OVERLAPS #-} (Ord k, Primitive k, Named v, Message v, MessageField k) => MessageField (M.Map k (Nested v)) where
  encodeMessageField :: FieldNumber -> Map k (Nested v) -> MessageBuilder
encodeMessageField !FieldNumber
num = ((k, Nested v) -> MessageBuilder)
-> Map k (Nested v) -> MessageBuilder
forall c k a. Monoid c => ((k, a) -> c) -> Map k a -> c
go (k, Nested v) -> MessageBuilder
op
    where
      go :: ((k, a) -> c) -> Map k a -> c
go (k, a) -> c
f = ((k, a) -> c) -> [(k, a)] -> c
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (k, a) -> c
f ([(k, a)] -> c) -> (Map k a -> [(k, a)]) -> Map k a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
M.toList
      op :: (k, Nested v) -> MessageBuilder
op = FieldNumber -> MessageBuilder -> MessageBuilder
Encode.embedded FieldNumber
num (MessageBuilder -> MessageBuilder)
-> ((k, Nested v) -> MessageBuilder)
-> (k, Nested v)
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> (k, Nested v) -> MessageBuilder
forall a. Message a => FieldNumber -> a -> MessageBuilder
encodeMessage (Word64 -> FieldNumber
fieldNumber Word64
1)
      {-# INLINABLE op #-}  -- To allow specialization to a particular type class or field number.
  {-# INLINE encodeMessageField #-}

  -- Data.Map.fromList will retain the last key/value mapping. From the spec:
  --
  -- > When parsing from the wire or when merging, if there are duplicate map
  -- > keys the last key seen is used.
  decodeMessageField :: Parser RawField (Map k (Nested v))
decodeMessageField = [(k, Nested v)] -> Map k (Nested v)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, Nested v)] -> Map k (Nested v))
-> ([(k, Nested v)] -> [(k, Nested v)])
-> [(k, Nested v)]
-> Map k (Nested v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, Nested v)] -> [(k, Nested v)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
                       ([(k, Nested v)] -> Map k (Nested v))
-> Parser RawField [(k, Nested v)]
-> Parser RawField (Map k (Nested v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive (k, Nested v)
-> Parser RawField [(k, Nested v)]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Parser RawMessage (k, Nested v)
-> Parser RawPrimitive (k, Nested v)
forall a. Parser RawMessage a -> Parser RawPrimitive a
Decode.embedded' (FieldNumber -> Parser RawMessage (k, Nested v)
forall a. Message a => FieldNumber -> Parser RawMessage a
decodeMessage (Word64 -> FieldNumber
fieldNumber Word64
1)))
  protoType :: Proxy# (Map k (Nested v)) -> DotProtoField
protoType Proxy# (Map k (Nested v))
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoPrimType -> DotProtoType
Map (Proxy# k -> DotProtoPrimType
forall a. Primitive a => Proxy# a -> DotProtoPrimType
primType (Proxy# k
forall k (a :: k). Proxy# a
proxy# :: Proxy# k)) (DotProtoIdentifier -> DotProtoPrimType
Named (DotProtoIdentifier -> DotProtoPrimType)
-> (String -> DotProtoIdentifier) -> String -> DotProtoPrimType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DotProtoIdentifier
Single (String -> DotProtoPrimType) -> String -> DotProtoPrimType
forall a b. (a -> b) -> a -> b
$ Proxy# v -> String
forall a string. (Named a, IsString string) => Proxy# a -> string
nameOf (Proxy# v
forall k (a :: k). Proxy# a
proxy# :: Proxy# v))) Maybe Packing
forall a. Maybe a
Nothing

instance (HasDefault a, Primitive a) => MessageField (ForceEmit a) where
  encodeMessageField :: FieldNumber -> ForceEmit a -> MessageBuilder
encodeMessageField !FieldNumber
num = FieldNumber -> ForceEmit a -> MessageBuilder
forall a. Primitive a => FieldNumber -> a -> MessageBuilder
encodePrimitive FieldNumber
num
  {-# INLINE encodeMessageField #-}

instance (Named a, Message a) => MessageField (Nested a) where
  encodeMessageField :: FieldNumber -> Nested a -> MessageBuilder
encodeMessageField !FieldNumber
num = (a -> MessageBuilder) -> Nested a -> MessageBuilder
go a -> MessageBuilder
op
    where
      go :: (a -> MessageBuilder) -> Nested a -> MessageBuilder
go a -> MessageBuilder
f = (a -> MessageBuilder) -> Maybe a -> MessageBuilder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> MessageBuilder
f (Maybe a -> MessageBuilder)
-> (Nested a -> Maybe a) -> Nested a -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible (Nested a) (Maybe a) => Nested a -> Maybe a
coerce @(Nested a) @(Maybe a)
      op :: a -> MessageBuilder
op = FieldNumber -> MessageBuilder -> MessageBuilder
Encode.embedded FieldNumber
num (MessageBuilder -> MessageBuilder)
-> (a -> MessageBuilder) -> a -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> a -> MessageBuilder
forall a. Message a => FieldNumber -> a -> MessageBuilder
encodeMessage (Word64 -> FieldNumber
fieldNumber Word64
1)
      {-# INLINABLE op #-}  -- To allow specialization to a particular type class or field number.
  {-# INLINE encodeMessageField #-}
  decodeMessageField :: Parser RawField (Nested a)
decodeMessageField = Parser RawField (Maybe a) -> Parser RawField (Nested a)
coerce @(Parser RawField (Maybe a)) @(Parser RawField (Nested a))
                       (Parser RawMessage a -> Parser RawField (Maybe a)
forall a. Parser RawMessage a -> Parser RawField (Maybe a)
Decode.embedded (FieldNumber -> Parser RawMessage a
forall a. Message a => FieldNumber -> Parser RawMessage a
decodeMessage (Word64 -> FieldNumber
fieldNumber Word64
1)))
  protoType :: Proxy# (Nested a) -> DotProtoField
protoType Proxy# (Nested a)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Prim (DotProtoPrimType -> DotProtoType)
-> (String -> DotProtoPrimType) -> String -> DotProtoType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotProtoIdentifier -> DotProtoPrimType
Named (DotProtoIdentifier -> DotProtoPrimType)
-> (String -> DotProtoIdentifier) -> String -> DotProtoPrimType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DotProtoIdentifier
Single (String -> DotProtoType) -> String -> DotProtoType
forall a b. (a -> b) -> a -> b
$ Proxy# a -> String
forall a string. (Named a, IsString string) => Proxy# a -> string
nameOf (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a)) Maybe Packing
forall a. Maybe a
Nothing

instance Primitive a => MessageField (UnpackedVec a) where
  encodeMessageField :: FieldNumber -> UnpackedVec a -> MessageBuilder
encodeMessageField !FieldNumber
fn = (a -> MessageBuilder) -> UnpackedVec a -> MessageBuilder
forall a. (a -> MessageBuilder) -> UnpackedVec a -> MessageBuilder
go a -> MessageBuilder
op
    where
      go :: (a -> MessageBuilder) -> UnpackedVec a -> MessageBuilder
go a -> MessageBuilder
f = (a -> MessageBuilder) -> Vector a -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> MessageBuilder) -> v a -> MessageBuilder
Encode.vectorMessageBuilder a -> MessageBuilder
f (Vector a -> MessageBuilder)
-> (UnpackedVec a -> Vector a) -> UnpackedVec a -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpackedVec a -> Vector a
forall a. UnpackedVec a -> Vector a
unpackedvec
      op :: a -> MessageBuilder
op = FieldNumber -> a -> MessageBuilder
forall a. Primitive a => FieldNumber -> a -> MessageBuilder
encodePrimitive FieldNumber
fn
      {-# INLINABLE op #-}  -- To allow specialization to a particular type class or field number.
  {-# INLINE encodeMessageField #-}
  decodeMessageField :: Parser RawField (UnpackedVec a)
decodeMessageField =
    Vector a -> UnpackedVec a
forall a. Vector a -> UnpackedVec a
UnpackedVec (Vector a -> UnpackedVec a)
-> ([a] -> Vector a) -> [a] -> UnpackedVec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall l. IsList l => [Item l] -> l
fromList ([a] -> Vector a) -> ([a] -> [a]) -> [a] -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList ([a] -> UnpackedVec a)
-> Parser RawField [a] -> Parser RawField (UnpackedVec a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive a -> Parser RawField [a]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated Parser RawPrimitive a
forall a. Primitive a => Parser RawPrimitive a
decodePrimitive
  protoType :: Proxy# (UnpackedVec a) -> DotProtoField
protoType Proxy# (UnpackedVec a)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated (DotProtoPrimType -> DotProtoType)
-> DotProtoPrimType -> DotProtoType
forall a b. (a -> b) -> a -> b
$ Proxy# a -> DotProtoPrimType
forall a. Primitive a => Proxy# a -> DotProtoPrimType
primType (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a)) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
UnpackedField)

instance forall a. (Named a, Message a) => MessageField (NestedVec a) where
  encodeMessageField :: FieldNumber -> NestedVec a -> MessageBuilder
encodeMessageField !FieldNumber
fn = (a -> MessageBuilder) -> NestedVec a -> MessageBuilder
forall a. (a -> MessageBuilder) -> NestedVec a -> MessageBuilder
go a -> MessageBuilder
op
    where
      go :: (a -> MessageBuilder) -> NestedVec a -> MessageBuilder
go a -> MessageBuilder
f = (a -> MessageBuilder) -> Vector a -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> MessageBuilder) -> v a -> MessageBuilder
Encode.vectorMessageBuilder a -> MessageBuilder
f (Vector a -> MessageBuilder)
-> (NestedVec a -> Vector a) -> NestedVec a -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedVec a -> Vector a
forall a. NestedVec a -> Vector a
nestedvec
      op :: a -> MessageBuilder
op = FieldNumber -> MessageBuilder -> MessageBuilder
Encode.embedded FieldNumber
fn (MessageBuilder -> MessageBuilder)
-> (a -> MessageBuilder) -> a -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> a -> MessageBuilder
forall a. Message a => FieldNumber -> a -> MessageBuilder
encodeMessage (Word64 -> FieldNumber
fieldNumber Word64
1)
      {-# INLINABLE op #-}  -- To allow specialization to a particular type class or field number.
  {-# INLINE encodeMessageField #-}
  decodeMessageField :: Parser RawField (NestedVec a)
decodeMessageField =
      ([a] -> NestedVec a)
-> Parser RawField [a] -> Parser RawField (NestedVec a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Coercible (Vector a) (NestedVec a) => Vector a -> NestedVec a
coerce @(Vector a) @(NestedVec a) (Vector a -> NestedVec a)
-> ([a] -> Vector a) -> [a] -> NestedVec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall l. IsList l => [Item l] -> l
fromList ([a] -> Vector a) -> ([a] -> [a]) -> [a] -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList)
           (Parser RawPrimitive a -> Parser RawField [a]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Parser RawMessage a -> Parser RawPrimitive a
forall a. Parser RawMessage a -> Parser RawPrimitive a
Decode.embedded' Parser RawMessage a
oneMsg))
    where
      oneMsg :: Parser RawMessage a
      oneMsg :: Parser RawMessage a
oneMsg = FieldNumber -> Parser RawMessage a
forall a. Message a => FieldNumber -> Parser RawMessage a
decodeMessage (Word64 -> FieldNumber
fieldNumber Word64
1)
  protoType :: Proxy# (NestedVec a) -> DotProtoField
protoType Proxy# (NestedVec a)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
NestedRepeated (DotProtoPrimType -> DotProtoType)
-> (String -> DotProtoPrimType) -> String -> DotProtoType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotProtoIdentifier -> DotProtoPrimType
Named (DotProtoIdentifier -> DotProtoPrimType)
-> (String -> DotProtoIdentifier) -> String -> DotProtoPrimType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DotProtoIdentifier
Single (String -> DotProtoType) -> String -> DotProtoType
forall a b. (a -> b) -> a -> b
$ Proxy# a -> String
forall a string. (Named a, IsString string) => Proxy# a -> string
nameOf (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a)) Maybe Packing
forall a. Maybe a
Nothing

instance (Named e, ProtoEnum e) => MessageField (PackedVec (Enumerated e)) where
  encodeMessageField :: FieldNumber -> PackedVec (Enumerated e) -> MessageBuilder
encodeMessageField !FieldNumber
fn =
    (Vector (Enumerated e) -> MessageBuilder)
-> Vector (Enumerated e) -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Enumerated e -> Word64)
-> FieldNumber -> Vector (Enumerated e) -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word64) -> FieldNumber -> v a -> MessageBuilder
Encode.packedVarintsV (Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word64)
-> (Enumerated e -> Int32) -> Enumerated e -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumerated e -> Int32
forall e. ProtoEnum e => Enumerated e -> Int32
codeFromEnumerated) FieldNumber
fn)
    (Vector (Enumerated e) -> MessageBuilder)
-> (PackedVec (Enumerated e) -> Vector (Enumerated e))
-> PackedVec (Enumerated e)
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedVec (Enumerated e) -> Vector (Enumerated e)
forall a. PackedVec a -> Vector a
packedvec
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedVarintsV' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec (Enumerated e))
decodeMessageField = Parser RawPrimitive [Enumerated e]
-> Parser RawField (PackedVec (Enumerated e))
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked ((Word64 -> Enumerated e) -> [Word64] -> [Enumerated e]
forall a b. (a -> b) -> [a] -> [b]
map (Int32 -> Enumerated e
forall e. ProtoEnum e => Int32 -> Enumerated e
codeToEnumerated (Int32 -> Enumerated e)
-> (Word64 -> Int32) -> Word64 -> Enumerated e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word64] -> [Enumerated e])
-> Parser RawPrimitive [Word64]
-> Parser RawPrimitive [Enumerated e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integral Word64 => Parser RawPrimitive [Word64]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedVarints @Word64)
  protoType :: Proxy# (PackedVec (Enumerated e)) -> DotProtoField
protoType Proxy# (PackedVec (Enumerated e))
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated (DotProtoPrimType -> DotProtoType)
-> (String -> DotProtoPrimType) -> String -> DotProtoType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotProtoIdentifier -> DotProtoPrimType
Named (DotProtoIdentifier -> DotProtoPrimType)
-> (String -> DotProtoIdentifier) -> String -> DotProtoPrimType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DotProtoIdentifier
Single (String -> DotProtoType) -> String -> DotProtoType
forall a b. (a -> b) -> a -> b
$ Proxy# e -> String
forall a string. (Named a, IsString string) => Proxy# a -> string
nameOf (Proxy# e
forall k (a :: k). Proxy# a
proxy# :: Proxy# e)) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec Bool) where
  encodeMessageField :: FieldNumber -> PackedVec Bool -> MessageBuilder
encodeMessageField !FieldNumber
fn = (Vector Bool -> MessageBuilder) -> Vector Bool -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Bool -> Bool) -> FieldNumber -> Vector Bool -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Bool) -> FieldNumber -> v a -> MessageBuilder
Encode.packedBoolsV Bool -> Bool
forall a. a -> a
id FieldNumber
fn) (Vector Bool -> MessageBuilder)
-> (PackedVec Bool -> Vector Bool)
-> PackedVec Bool
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedVec Bool -> Vector Bool
forall a. PackedVec a -> Vector a
packedvec
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedBoolsV' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec Bool)
decodeMessageField = (PackedVec Word64 -> PackedVec Bool)
-> Parser RawField (PackedVec Word64)
-> Parser RawField (PackedVec Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word64 -> Bool) -> PackedVec Word64 -> PackedVec Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Bool
toBool) (Parser RawPrimitive [Word64] -> Parser RawField (PackedVec Word64)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Word64]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedVarints)
    where
      toBool :: Word64 -> Bool
      toBool :: Word64 -> Bool
toBool Word64
1 = Bool
True
      toBool Word64
_ = Bool
False
  protoType :: Proxy# (PackedVec Bool) -> DotProtoField
protoType Proxy# (PackedVec Bool)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
Bool) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec Word32) where
  encodeMessageField :: FieldNumber -> PackedVec Word32 -> MessageBuilder
encodeMessageField !FieldNumber
fn = (Vector Word32 -> MessageBuilder)
-> Vector Word32 -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Word32 -> Word64)
-> FieldNumber -> Vector Word32 -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word64) -> FieldNumber -> v a -> MessageBuilder
Encode.packedVarintsV Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral FieldNumber
fn) (Vector Word32 -> MessageBuilder)
-> (PackedVec Word32 -> Vector Word32)
-> PackedVec Word32
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedVec Word32 -> Vector Word32
forall a. PackedVec a -> Vector a
packedvec
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedVarintsV' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec Word32)
decodeMessageField = Parser RawPrimitive [Word32] -> Parser RawField (PackedVec Word32)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Word32]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedVarints
  protoType :: Proxy# (PackedVec Word32) -> DotProtoField
protoType Proxy# (PackedVec Word32)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
UInt32) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec Word64) where
  encodeMessageField :: FieldNumber -> PackedVec Word64 -> MessageBuilder
encodeMessageField !FieldNumber
fn = (Vector Word64 -> MessageBuilder)
-> Vector Word64 -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Word64 -> Word64)
-> FieldNumber -> Vector Word64 -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word64) -> FieldNumber -> v a -> MessageBuilder
Encode.packedVarintsV Word64 -> Word64
forall a. a -> a
id FieldNumber
fn) (Vector Word64 -> MessageBuilder)
-> (PackedVec Word64 -> Vector Word64)
-> PackedVec Word64
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedVec Word64 -> Vector Word64
forall a. PackedVec a -> Vector a
packedvec
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedVarintsV' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec Word64)
decodeMessageField = Parser RawPrimitive [Word64] -> Parser RawField (PackedVec Word64)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Word64]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedVarints
  protoType :: Proxy# (PackedVec Word64) -> DotProtoField
protoType Proxy# (PackedVec Word64)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
UInt64) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec Int32) where
  encodeMessageField :: FieldNumber -> PackedVec Int32 -> MessageBuilder
encodeMessageField !FieldNumber
fn = (Vector Int32 -> MessageBuilder) -> Vector Int32 -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Int32 -> Word64) -> FieldNumber -> Vector Int32 -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word64) -> FieldNumber -> v a -> MessageBuilder
Encode.packedVarintsV Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral FieldNumber
fn) (Vector Int32 -> MessageBuilder)
-> (PackedVec Int32 -> Vector Int32)
-> PackedVec Int32
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedVec Int32 -> Vector Int32
forall a. PackedVec a -> Vector a
packedvec
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedVarintsV' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec Int32)
decodeMessageField = Parser RawPrimitive [Int32] -> Parser RawField (PackedVec Int32)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Int32]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedVarints
  protoType :: Proxy# (PackedVec Int32) -> DotProtoField
protoType Proxy# (PackedVec Int32)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
Int32) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec Int64) where
  encodeMessageField :: FieldNumber -> PackedVec Int64 -> MessageBuilder
encodeMessageField !FieldNumber
fn = (Vector Int64 -> MessageBuilder) -> Vector Int64 -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Int64 -> Word64) -> FieldNumber -> Vector Int64 -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word64) -> FieldNumber -> v a -> MessageBuilder
Encode.packedVarintsV Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral FieldNumber
fn) (Vector Int64 -> MessageBuilder)
-> (PackedVec Int64 -> Vector Int64)
-> PackedVec Int64
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedVec Int64 -> Vector Int64
forall a. PackedVec a -> Vector a
packedvec
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedVarintsV' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec Int64)
decodeMessageField = Parser RawPrimitive [Int64] -> Parser RawField (PackedVec Int64)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Int64]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedVarints
  protoType :: Proxy# (PackedVec Int64) -> DotProtoField
protoType Proxy# (PackedVec Int64)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
Int64) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec (Signed Int32)) where
  encodeMessageField :: FieldNumber -> PackedVec (Signed Int32) -> MessageBuilder
encodeMessageField !FieldNumber
fn =
      (Vector Int32 -> MessageBuilder) -> Vector Int32 -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Int32 -> Word64) -> FieldNumber -> Vector Int32 -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word64) -> FieldNumber -> v a -> MessageBuilder
Encode.packedVarintsV Int32 -> Word64
zigZag FieldNumber
fn) (Vector Int32 -> MessageBuilder)
-> (PackedVec (Signed Int32) -> Vector Int32)
-> PackedVec (Signed Int32)
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible (PackedVec (Signed Int32)) (Vector Int32) =>
PackedVec (Signed Int32) -> Vector Int32
coerce @_ @(Vector Int32)
    where
      zigZag :: Int32 -> Word64
zigZag = Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word64) -> (Int32 -> Int32) -> Int32 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
forall a. (Num a, FiniteBits a) => a -> a
Encode.zigZagEncode
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedVarintsV' figure out how much to inline.

  decodeMessageField :: Parser RawField (PackedVec (Signed Int32))
decodeMessageField = Parser RawPrimitive [Signed Int32]
-> Parser RawField (PackedVec (Signed Int32))
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked (([Word32] -> [Signed Int32])
-> Parser RawPrimitive [Word32]
-> Parser RawPrimitive [Signed Int32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word32 -> Signed Int32) -> [Word32] -> [Signed Int32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Signed Int32
zagZig) Parser RawPrimitive [Word32]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedVarints)
    where
      -- This type signature is important: `Decode.zigZagDecode` will not undo
      -- `Encode.zigZagEncode` if given a signed value with the high order bit
      -- set. So we don't allow GHC to infer a signed input type.
      zagZig :: Word32 -> Signed Int32
      zagZig :: Word32 -> Signed Int32
zagZig = Int32 -> Signed Int32
forall a. a -> Signed a
Signed (Int32 -> Signed Int32)
-> (Word32 -> Int32) -> Word32 -> Signed Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> (Word32 -> Word32) -> Word32 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
forall a. (Num a, Bits a) => a -> a
Decode.zigZagDecode

  protoType :: Proxy# (PackedVec (Signed Int32)) -> DotProtoField
protoType Proxy# (PackedVec (Signed Int32))
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
SInt32) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec (Signed Int64)) where
  encodeMessageField :: FieldNumber -> PackedVec (Signed Int64) -> MessageBuilder
encodeMessageField !FieldNumber
fn =
      (Vector Int64 -> MessageBuilder) -> Vector Int64 -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Int64 -> Word64) -> FieldNumber -> Vector Int64 -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word64) -> FieldNumber -> v a -> MessageBuilder
Encode.packedVarintsV Int64 -> Word64
zigZag FieldNumber
fn) (Vector Int64 -> MessageBuilder)
-> (PackedVec (Signed Int64) -> Vector Int64)
-> PackedVec (Signed Int64)
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible (PackedVec (Signed Int64)) (Vector Int64) =>
PackedVec (Signed Int64) -> Vector Int64
coerce @_ @(Vector Int64)
    where
      zigZag :: Int64 -> Word64
zigZag = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> (Int64 -> Int64) -> Int64 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a. (Num a, FiniteBits a) => a -> a
Encode.zigZagEncode
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedVarintsV' figure out how much to inline.

  decodeMessageField :: Parser RawField (PackedVec (Signed Int64))
decodeMessageField = Parser RawPrimitive [Signed Int64]
-> Parser RawField (PackedVec (Signed Int64))
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked (([Word64] -> [Signed Int64])
-> Parser RawPrimitive [Word64]
-> Parser RawPrimitive [Signed Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word64 -> Signed Int64) -> [Word64] -> [Signed Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Signed Int64
zagZig) Parser RawPrimitive [Word64]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedVarints)
    where
      -- This type signature is important: `Decode.zigZagDecode` will not undo
      -- `Encode.zigZagEncode` if given a signed value with the high order bit
      -- set. So we don't allow GHC to infer a signed input type.
      zagZig :: Word64 -> Signed Int64
      zagZig :: Word64 -> Signed Int64
zagZig = Int64 -> Signed Int64
forall a. a -> Signed a
Signed (Int64 -> Signed Int64)
-> (Word64 -> Int64) -> Word64 -> Signed Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (Word64 -> Word64) -> Word64 -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
forall a. (Num a, Bits a) => a -> a
Decode.zigZagDecode

  protoType :: Proxy# (PackedVec (Signed Int64)) -> DotProtoField
protoType Proxy# (PackedVec (Signed Int64))
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
SInt64) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)


instance MessageField (PackedVec (Fixed Word32)) where
  encodeMessageField :: FieldNumber -> PackedVec (Fixed Word32) -> MessageBuilder
encodeMessageField !FieldNumber
fn =
    (Vector Word32 -> MessageBuilder)
-> Vector Word32 -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Word32 -> Word32)
-> FieldNumber -> Vector Word32 -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word32) -> FieldNumber -> v a -> MessageBuilder
Encode.packedFixed32V Word32 -> Word32
forall a. a -> a
id FieldNumber
fn) (Vector Word32 -> MessageBuilder)
-> (PackedVec (Fixed Word32) -> Vector Word32)
-> PackedVec (Fixed Word32)
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible (PackedVec (Fixed Word32)) (Vector Word32) =>
PackedVec (Fixed Word32) -> Vector Word32
coerce @_ @(Vector Word32)
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedFixed32V' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec (Fixed Word32))
decodeMessageField = Parser RawField (PackedVec Word32)
-> Parser RawField (PackedVec (Fixed Word32))
coerce @(Parser RawField (PackedVec Word32))
                              @(Parser RawField (PackedVec (Fixed Word32)))
                              (Parser RawPrimitive [Word32] -> Parser RawField (PackedVec Word32)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Word32]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedFixed32)
  protoType :: Proxy# (PackedVec (Fixed Word32)) -> DotProtoField
protoType Proxy# (PackedVec (Fixed Word32))
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
Fixed32) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec (Fixed Word64)) where
  encodeMessageField :: FieldNumber -> PackedVec (Fixed Word64) -> MessageBuilder
encodeMessageField !FieldNumber
fn =
    (Vector Word64 -> MessageBuilder)
-> Vector Word64 -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Word64 -> Word64)
-> FieldNumber -> Vector Word64 -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word64) -> FieldNumber -> v a -> MessageBuilder
Encode.packedFixed64V Word64 -> Word64
forall a. a -> a
id FieldNumber
fn) (Vector Word64 -> MessageBuilder)
-> (PackedVec (Fixed Word64) -> Vector Word64)
-> PackedVec (Fixed Word64)
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible (PackedVec (Fixed Word64)) (Vector Word64) =>
PackedVec (Fixed Word64) -> Vector Word64
coerce @_ @(Vector Word64)
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedFixed64V' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec (Fixed Word64))
decodeMessageField = Parser RawField (PackedVec Word64)
-> Parser RawField (PackedVec (Fixed Word64))
coerce @(Parser RawField (PackedVec Word64))
                              @(Parser RawField (PackedVec (Fixed Word64)))
                              (Parser RawPrimitive [Word64] -> Parser RawField (PackedVec Word64)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Word64]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedFixed64)
  protoType :: Proxy# (PackedVec (Fixed Word64)) -> DotProtoField
protoType Proxy# (PackedVec (Fixed Word64))
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
Fixed64) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec (Signed (Fixed Int32))) where
  encodeMessageField :: FieldNumber -> PackedVec (Signed (Fixed Int32)) -> MessageBuilder
encodeMessageField !FieldNumber
fn =
    (Vector Int32 -> MessageBuilder) -> Vector Int32 -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Int32 -> Word32) -> FieldNumber -> Vector Int32 -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word32) -> FieldNumber -> v a -> MessageBuilder
Encode.packedFixed32V Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral FieldNumber
fn) (Vector Int32 -> MessageBuilder)
-> (PackedVec (Signed (Fixed Int32)) -> Vector Int32)
-> PackedVec (Signed (Fixed Int32))
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible (PackedVec (Signed (Fixed Int32))) (Vector Int32) =>
PackedVec (Signed (Fixed Int32)) -> Vector Int32
coerce @_ @(Vector Int32)
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedFixed32V' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec (Signed (Fixed Int32)))
decodeMessageField = Parser RawField (PackedVec Int32)
-> Parser RawField (PackedVec (Signed (Fixed Int32)))
coerce @(Parser RawField (PackedVec Int32))
                              @(Parser RawField (PackedVec (Signed (Fixed Int32))))
                             (Parser RawPrimitive [Int32] -> Parser RawField (PackedVec Int32)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Int32]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedFixed32)
  protoType :: Proxy# (PackedVec (Signed (Fixed Int32))) -> DotProtoField
protoType Proxy# (PackedVec (Signed (Fixed Int32)))
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
SFixed32) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec (Signed (Fixed Int64))) where
  encodeMessageField :: FieldNumber -> PackedVec (Signed (Fixed Int64)) -> MessageBuilder
encodeMessageField !FieldNumber
fn =
    (Vector Int64 -> MessageBuilder) -> Vector Int64 -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Int64 -> Word64) -> FieldNumber -> Vector Int64 -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Word64) -> FieldNumber -> v a -> MessageBuilder
Encode.packedFixed64V Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral FieldNumber
fn) (Vector Int64 -> MessageBuilder)
-> (PackedVec (Signed (Fixed Int64)) -> Vector Int64)
-> PackedVec (Signed (Fixed Int64))
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible (PackedVec (Signed (Fixed Int64))) (Vector Int64) =>
PackedVec (Signed (Fixed Int64)) -> Vector Int64
coerce @_ @(Vector Int64)
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedFixed64V' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec (Signed (Fixed Int64)))
decodeMessageField = Parser RawField (PackedVec Int64)
-> Parser RawField (PackedVec (Signed (Fixed Int64)))
coerce @(Parser RawField (PackedVec Int64))
                              @(Parser RawField (PackedVec (Signed (Fixed Int64))))
                              (Parser RawPrimitive [Int64] -> Parser RawField (PackedVec Int64)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Int64]
forall a. Integral a => Parser RawPrimitive [a]
Decode.packedFixed64)
  protoType :: Proxy# (PackedVec (Signed (Fixed Int64))) -> DotProtoField
protoType Proxy# (PackedVec (Signed (Fixed Int64)))
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
SFixed64) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec Float) where
  encodeMessageField :: FieldNumber -> PackedVec Float -> MessageBuilder
encodeMessageField !FieldNumber
fn = (Vector Float -> MessageBuilder) -> Vector Float -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Float -> Float) -> FieldNumber -> Vector Float -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Float) -> FieldNumber -> v a -> MessageBuilder
Encode.packedFloatsV Float -> Float
forall a. a -> a
id FieldNumber
fn) (Vector Float -> MessageBuilder)
-> (PackedVec Float -> Vector Float)
-> PackedVec Float
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedVec Float -> Vector Float
forall a. PackedVec a -> Vector a
packedvec
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedFloatsV' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec Float)
decodeMessageField = Parser RawPrimitive [Float] -> Parser RawField (PackedVec Float)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Float]
Decode.packedFloats
  protoType :: Proxy# (PackedVec Float) -> DotProtoField
protoType Proxy# (PackedVec Float)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
Float) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance MessageField (PackedVec Double) where
  encodeMessageField :: FieldNumber -> PackedVec Double -> MessageBuilder
encodeMessageField !FieldNumber
fn = (Vector Double -> MessageBuilder)
-> Vector Double -> MessageBuilder
forall a.
HasDefault a =>
(a -> MessageBuilder) -> a -> MessageBuilder
omittingDefault ((Double -> Double)
-> FieldNumber -> Vector Double -> MessageBuilder
forall (v :: * -> *) a.
Vector v a =>
(a -> Double) -> FieldNumber -> v a -> MessageBuilder
Encode.packedDoublesV Double -> Double
forall a. a -> a
id FieldNumber
fn) (Vector Double -> MessageBuilder)
-> (PackedVec Double -> Vector Double)
-> PackedVec Double
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedVec Double -> Vector Double
forall a. PackedVec a -> Vector a
packedvec
  {-# INLINE encodeMessageField #-}  -- Let 'Encode.packedDoublesV' figure out how much to inline.
  decodeMessageField :: Parser RawField (PackedVec Double)
decodeMessageField = Parser RawPrimitive [Double] -> Parser RawField (PackedVec Double)
forall a. Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked Parser RawPrimitive [Double]
Decode.packedDoubles
  protoType :: Proxy# (PackedVec Double) -> DotProtoField
protoType Proxy# (PackedVec Double)
_ = DotProtoType -> Maybe Packing -> DotProtoField
messageField (DotProtoPrimType -> DotProtoType
Repeated DotProtoPrimType
Double) (Packing -> Maybe Packing
forall a. a -> Maybe a
Just Packing
PackedField)

instance (MessageField e, KnownSymbol comments) => MessageField (e // comments) where
  encodeMessageField :: FieldNumber -> (e // comments) -> MessageBuilder
encodeMessageField !FieldNumber
fn = FieldNumber -> e -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeMessageField FieldNumber
fn (e -> MessageBuilder)
-> ((e // comments) -> e) -> (e // comments) -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e // comments) -> e
forall (comment :: Symbol) a. Commented comment a -> a
unCommented
  {-# INLINE encodeMessageField #-}
  decodeMessageField :: Parser RawField (e // comments)
decodeMessageField = Parser RawField e -> Parser RawField (e // comments)
coerce @(Parser RawField e)
                              @(Parser RawField (Commented comments e))
                              Parser RawField e
forall a. MessageField a => Parser RawField a
decodeMessageField
  protoType :: Proxy# (e // comments) -> DotProtoField
protoType Proxy# (e // comments)
p = (Proxy# e -> DotProtoField
forall a. MessageField a => Proxy# a -> DotProtoField
protoType (Proxy# (e // comments) -> Proxy# e
forall k k (f :: k -> k) (a :: k). Proxy# (f a) -> Proxy# a
lowerProxy1 Proxy# (e // comments)
p))
                  { dotProtoFieldComment :: String
dotProtoFieldComment = Proxy comments -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy# (e // comments) -> Proxy comments
forall k k k (f :: k -> k -> k) (a :: k) (b :: k).
Proxy# (f a b) -> Proxy a
lowerProxy2 Proxy# (e // comments)
p) }
    where
      lowerProxy1 :: forall k f (a :: k). Proxy# (f a) -> Proxy# a
      lowerProxy1 :: Proxy# (f a) -> Proxy# a
lowerProxy1 Proxy# (f a)
_ = Proxy# a
forall k (a :: k). Proxy# a
proxy#

      lowerProxy2 :: forall k f (a :: k) b. Proxy# (f a b) -> Proxy a
      lowerProxy2 :: Proxy# (f a b) -> Proxy a
lowerProxy2 Proxy# (f a b)
_ = Proxy a
forall k (t :: k). Proxy t
Proxy

decodePacked
  :: Parser RawPrimitive [a]
  -> Parser RawField (PackedVec a)
decodePacked :: Parser RawPrimitive [a] -> Parser RawField (PackedVec a)
decodePacked = (RawField -> Either ParseError (PackedVec a))
-> Parser RawField (PackedVec a)
forall input a. (input -> Either ParseError a) -> Parser input a
Parser
             ((RawField -> Either ParseError (PackedVec a))
 -> Parser RawField (PackedVec a))
-> (Parser RawPrimitive [a]
    -> RawField -> Either ParseError (PackedVec a))
-> Parser RawPrimitive [a]
-> Parser RawField (PackedVec a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ParseError [[a]] -> Either ParseError (PackedVec a))
-> (RawField -> Either ParseError [[a]])
-> RawField
-> Either ParseError (PackedVec a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([[a]] -> PackedVec a)
-> Either ParseError [[a]] -> Either ParseError (PackedVec a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[a]] -> PackedVec a
forall a. [[a]] -> PackedVec a
pack ([[a]] -> PackedVec a) -> ([[a]] -> [[a]]) -> [[a]] -> PackedVec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList))
             ((RawField -> Either ParseError [[a]])
 -> RawField -> Either ParseError (PackedVec a))
-> (Parser RawPrimitive [a] -> RawField -> Either ParseError [[a]])
-> Parser RawPrimitive [a]
-> RawField
-> Either ParseError (PackedVec a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawPrimitive -> Either ParseError [a])
-> RawField -> Either ParseError [[a]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
TR.traverse
             ((RawPrimitive -> Either ParseError [a])
 -> RawField -> Either ParseError [[a]])
-> (Parser RawPrimitive [a]
    -> RawPrimitive -> Either ParseError [a])
-> Parser RawPrimitive [a]
-> RawField
-> Either ParseError [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser RawPrimitive [a] -> RawPrimitive -> Either ParseError [a]
forall input a. Parser input a -> input -> Either ParseError a
runParser
  where
    pack :: forall a. [[a]] -> PackedVec a
    pack :: [[a]] -> PackedVec a
pack = [a] -> PackedVec a
forall l. IsList l => [Item l] -> l
fromList ([a] -> PackedVec a) -> ([[a]] -> [a]) -> [[a]] -> PackedVec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[a]] -> [a]) -> ([[a]] -> [[a]]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [a] -> [a]
reverse


-- | This class captures those types which correspond to protocol buffer messages.
class Message a where
  -- | Encode a message
  encodeMessage :: FieldNumber -> a -> Encode.MessageBuilder
  -- | Decode a message
  decodeMessage :: FieldNumber -> Parser RawMessage a
  -- | Generate a .proto message from the type information.
  dotProto :: Proxy# a -> [DotProtoField]

  default encodeMessage :: (Generic a, GenericMessage (Rep a))
                        => FieldNumber -> a -> Encode.MessageBuilder
  encodeMessage FieldNumber
num = FieldNumber -> Rep a Any -> MessageBuilder
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> f a -> MessageBuilder
genericEncodeMessage FieldNumber
num (Rep a Any -> MessageBuilder)
-> (a -> Rep a Any) -> a -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

  default decodeMessage :: (Generic a, GenericMessage (Rep a))
                        => FieldNumber -> Parser RawMessage a
  decodeMessage = (Rep a Any -> a)
-> Parser RawMessage (Rep a Any) -> Parser RawMessage a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Parser RawMessage (Rep a Any) -> Parser RawMessage a)
-> (FieldNumber -> Parser RawMessage (Rep a Any))
-> FieldNumber
-> Parser RawMessage a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> Parser RawMessage (Rep a Any)
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> Parser RawMessage (f a)
genericDecodeMessage

  default dotProto :: GenericMessage (Rep a)
                   => Proxy# a -> [DotProtoField]
  dotProto Proxy# a
_ = Proxy# (Rep a) -> [DotProtoField]
forall (f :: * -> *).
GenericMessage f =>
Proxy# f -> [DotProtoField]
genericDotProto (Proxy# (Rep a)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (Rep a))

instance (MessageField k, MessageField v) => Message (k, v)

instance (MessageField a, Primitive a) => Message (Wrapped a) where
  encodeMessage :: FieldNumber -> Wrapped a -> MessageBuilder
encodeMessage FieldNumber
_ (Wrapped a
v) = FieldNumber -> a -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeMessageField (Word64 -> FieldNumber
FieldNumber Word64
1) a
v
  {-# INLINABLE encodeMessage #-}
  decodeMessage :: FieldNumber -> Parser RawMessage (Wrapped a)
decodeMessage FieldNumber
_ = a -> Wrapped a
forall a. a -> Wrapped a
Wrapped (a -> Wrapped a)
-> Parser RawMessage a -> Parser RawMessage (Wrapped a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField a -> FieldNumber -> Parser RawMessage a
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at Parser RawField a
forall a. MessageField a => Parser RawField a
decodeMessageField (Word64 -> FieldNumber
FieldNumber Word64
1)
  {-# INLINABLE decodeMessage #-}
  dotProto :: Proxy# (Wrapped a) -> [DotProtoField]
dotProto Proxy# (Wrapped a)
_ =
    [ FieldNumber
-> DotProtoType
-> DotProtoIdentifier
-> [DotProtoOption]
-> String
-> DotProtoField
DotProtoField
        (Word64 -> FieldNumber
FieldNumber Word64
1)
        (DotProtoPrimType -> DotProtoType
Prim (Proxy# a -> DotProtoPrimType
forall a. Primitive a => Proxy# a -> DotProtoPrimType
primType (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a)))
        (String -> DotProtoIdentifier
Single String
"value")
        []
        String
""
    ]

-- | Generate metadata for a message type.
message :: (Message a, Named a) => Proxy# a -> DotProtoDefinition
message :: Proxy# a -> DotProtoDefinition
message Proxy# a
proxy = String
-> DotProtoIdentifier
-> [DotProtoMessagePart]
-> DotProtoDefinition
DotProtoMessage String
""
                                (String -> DotProtoIdentifier
Single (String -> DotProtoIdentifier) -> String -> DotProtoIdentifier
forall a b. (a -> b) -> a -> b
$ Proxy# a -> String
forall a string. (Named a, IsString string) => Proxy# a -> string
nameOf Proxy# a
proxy)
                                (DotProtoField -> DotProtoMessagePart
DotProtoMessageField (DotProtoField -> DotProtoMessagePart)
-> [DotProtoField] -> [DotProtoMessagePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy# a -> [DotProtoField]
forall a. Message a => Proxy# a -> [DotProtoField]
dotProto Proxy# a
proxy)

-- * Wrapped Type Instances

encodeWrapperMessage
  :: MessageField a
  => FieldNumber
  -> a
  -> Encode.MessageBuilder
encodeWrapperMessage :: FieldNumber -> a -> MessageBuilder
encodeWrapperMessage FieldNumber
_ a
x = FieldNumber -> a -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeMessageField (Word64 -> FieldNumber
FieldNumber Word64
1) a
x

decodeWrapperMessage
  :: MessageField a
  => FieldNumber
  -> Decode.Parser Decode.RawMessage a
decodeWrapperMessage :: FieldNumber -> Parser RawMessage a
decodeWrapperMessage FieldNumber
_ = Parser RawField a -> FieldNumber -> Parser RawMessage a
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at Parser RawField a
forall a. MessageField a => Parser RawField a
decodeMessageField (Word64 -> FieldNumber
FieldNumber Word64
1)

dotProtoWrapper :: Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper :: Proxy# a -> [DotProtoField]
dotProtoWrapper Proxy# a
proxy =
  [ FieldNumber
-> DotProtoType
-> DotProtoIdentifier
-> [DotProtoOption]
-> String
-> DotProtoField
DotProtoField
      (Word64 -> FieldNumber
FieldNumber Word64
1)
      (DotProtoPrimType -> DotProtoType
Prim (Proxy# a -> DotProtoPrimType
forall a. Primitive a => Proxy# a -> DotProtoPrimType
primType Proxy# a
proxy))
      (String -> DotProtoIdentifier
Single String
"value")
      []
      String
""
  ]

instance Message Double where
  encodeMessage :: FieldNumber -> Double -> MessageBuilder
encodeMessage = FieldNumber -> Double -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage Double
decodeMessage = FieldNumber -> Parser RawMessage Double
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# Double -> [DotProtoField]
dotProto = Proxy# Double -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

instance Message Float where
  encodeMessage :: FieldNumber -> Float -> MessageBuilder
encodeMessage = FieldNumber -> Float -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage Float
decodeMessage = FieldNumber -> Parser RawMessage Float
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# Float -> [DotProtoField]
dotProto = Proxy# Float -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

instance Message Int64 where
  encodeMessage :: FieldNumber -> Int64 -> MessageBuilder
encodeMessage = FieldNumber -> Int64 -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage Int64
decodeMessage = FieldNumber -> Parser RawMessage Int64
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# Int64 -> [DotProtoField]
dotProto = Proxy# Int64 -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

instance Message Word64 where
  encodeMessage :: FieldNumber -> Word64 -> MessageBuilder
encodeMessage = FieldNumber -> Word64 -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage Word64
decodeMessage = FieldNumber -> Parser RawMessage Word64
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# Word64 -> [DotProtoField]
dotProto = Proxy# Word64 -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

instance Message Int32 where
  encodeMessage :: FieldNumber -> Int32 -> MessageBuilder
encodeMessage = FieldNumber -> Int32 -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage Int32
decodeMessage = FieldNumber -> Parser RawMessage Int32
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# Int32 -> [DotProtoField]
dotProto = Proxy# Int32 -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

instance Message Word32 where
  encodeMessage :: FieldNumber -> Word32 -> MessageBuilder
encodeMessage = FieldNumber -> Word32 -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage Word32
decodeMessage = FieldNumber -> Parser RawMessage Word32
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# Word32 -> [DotProtoField]
dotProto = Proxy# Word32 -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

instance Message Bool where
  encodeMessage :: FieldNumber -> Bool -> MessageBuilder
encodeMessage = FieldNumber -> Bool -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage Bool
decodeMessage = FieldNumber -> Parser RawMessage Bool
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# Bool -> [DotProtoField]
dotProto = Proxy# Bool -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

instance Message T.Text where
  encodeMessage :: FieldNumber -> Text -> MessageBuilder
encodeMessage = FieldNumber -> Text -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage Text
decodeMessage = FieldNumber -> Parser RawMessage Text
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# Text -> [DotProtoField]
dotProto = Proxy# Text -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

deriving via T.Text instance Message (Proto3.Suite.Types.String T.Text)

instance Message TL.Text where
  encodeMessage :: FieldNumber -> Text -> MessageBuilder
encodeMessage = FieldNumber -> Text -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage Text
decodeMessage = FieldNumber -> Parser RawMessage Text
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# Text -> [DotProtoField]
dotProto = Proxy# Text -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

deriving via TL.Text instance Message (Proto3.Suite.Types.String TL.Text)

instance Message TS.ShortText where
  encodeMessage :: FieldNumber -> ShortText -> MessageBuilder
encodeMessage = FieldNumber -> ShortText -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage ShortText
decodeMessage = FieldNumber -> Parser RawMessage ShortText
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# ShortText -> [DotProtoField]
dotProto = Proxy# ShortText -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

deriving via TS.ShortText instance Message (Proto3.Suite.Types.String TS.ShortText)

instance Message B.ByteString where
  encodeMessage :: FieldNumber -> ByteString -> MessageBuilder
encodeMessage = FieldNumber -> ByteString -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage ByteString
decodeMessage = FieldNumber -> Parser RawMessage ByteString
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# ByteString -> [DotProtoField]
dotProto = Proxy# ByteString -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

instance Message BL.ByteString where
  encodeMessage :: FieldNumber -> ByteString -> MessageBuilder
encodeMessage = FieldNumber -> ByteString -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeWrapperMessage
  decodeMessage :: FieldNumber -> Parser RawMessage ByteString
decodeMessage = FieldNumber -> Parser RawMessage ByteString
forall a. MessageField a => FieldNumber -> Parser RawMessage a
decodeWrapperMessage
  dotProto :: Proxy# ByteString -> [DotProtoField]
dotProto = Proxy# ByteString -> [DotProtoField]
forall a. Primitive a => Proxy# a -> [DotProtoField]
dotProtoWrapper

-- * Generic Instances

class GenericMessage (f :: Type -> Type) where
  type GenericFieldCount f :: Nat

  genericEncodeMessage :: FieldNumber -> f a -> Encode.MessageBuilder
  genericDecodeMessage :: FieldNumber -> Parser RawMessage (f a)
  genericDotProto      :: Proxy# f -> [DotProtoField]

instance GenericMessage U1 where
  type GenericFieldCount U1 = 0
  genericEncodeMessage :: FieldNumber -> U1 a -> MessageBuilder
genericEncodeMessage FieldNumber
_ = U1 a -> MessageBuilder
forall a. Monoid a => a
mempty
  genericDecodeMessage :: FieldNumber -> Parser RawMessage (U1 a)
genericDecodeMessage FieldNumber
_ = U1 a -> Parser RawMessage (U1 a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1
  genericDotProto :: Proxy# U1 -> [DotProtoField]
genericDotProto Proxy# U1
_      = [DotProtoField]
forall a. Monoid a => a
mempty

instance (KnownNat (GenericFieldCount f), GenericMessage f, GenericMessage g)
           => GenericMessage (f :*: g)
  where
    type GenericFieldCount (f :*: g) = GenericFieldCount f + GenericFieldCount g
    genericEncodeMessage :: FieldNumber -> (:*:) f g a -> MessageBuilder
genericEncodeMessage FieldNumber
num (f a
x :*: g a
y) =
        FieldNumber -> f a -> MessageBuilder
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> f a -> MessageBuilder
genericEncodeMessage FieldNumber
num f a
x MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<>
        FieldNumber -> g a -> MessageBuilder
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> f a -> MessageBuilder
genericEncodeMessage (Word64 -> FieldNumber
FieldNumber (FieldNumber -> Word64
getFieldNumber FieldNumber
num Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
offset)) g a
y
      where
        offset :: Word64
offset = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Proxy (GenericFieldCount f) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (GenericFieldCount f)
forall k (t :: k). Proxy t
Proxy @(GenericFieldCount f))

    genericDecodeMessage :: FieldNumber -> Parser RawMessage ((:*:) f g a)
genericDecodeMessage FieldNumber
num =
        (f a -> g a -> (:*:) f g a)
-> Parser RawMessage (f a)
-> Parser RawMessage (g a)
-> Parser RawMessage ((:*:) f g a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (FieldNumber -> Parser RawMessage (f a)
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> Parser RawMessage (f a)
genericDecodeMessage FieldNumber
num)
                     (FieldNumber -> Parser RawMessage (g a)
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> Parser RawMessage (f a)
genericDecodeMessage FieldNumber
num2)
      where
        num2 :: FieldNumber
num2 = Word64 -> FieldNumber
FieldNumber (Word64 -> FieldNumber) -> Word64 -> FieldNumber
forall a b. (a -> b) -> a -> b
$ FieldNumber -> Word64
getFieldNumber FieldNumber
num Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
offset
        offset :: Word64
offset = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Proxy (GenericFieldCount f) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (GenericFieldCount f)
forall k (t :: k). Proxy t
Proxy @(GenericFieldCount f))

    genericDotProto :: Proxy# (f :*: g) -> [DotProtoField]
genericDotProto Proxy# (f :*: g)
_ =
        Proxy# f -> [DotProtoField]
forall (f :: * -> *).
GenericMessage f =>
Proxy# f -> [DotProtoField]
genericDotProto (Proxy# f
forall k (a :: k). Proxy# a
proxy# :: Proxy# f) [DotProtoField] -> [DotProtoField] -> [DotProtoField]
forall a. Semigroup a => a -> a -> a
<>
        [DotProtoField] -> [DotProtoField]
adjust (Proxy# g -> [DotProtoField]
forall (f :: * -> *).
GenericMessage f =>
Proxy# f -> [DotProtoField]
genericDotProto (Proxy# g
forall k (a :: k). Proxy# a
proxy# :: Proxy# g))
      where
        offset :: Word64
offset = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Proxy (GenericFieldCount f) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (GenericFieldCount f)
forall k (t :: k). Proxy t
Proxy @(GenericFieldCount f))
        adjust :: [DotProtoField] -> [DotProtoField]
adjust = (DotProtoField -> DotProtoField)
-> [DotProtoField] -> [DotProtoField]
forall a b. (a -> b) -> [a] -> [b]
map DotProtoField -> DotProtoField
adjustPart
        adjustPart :: DotProtoField -> DotProtoField
adjustPart DotProtoField
part = DotProtoField
part
          { dotProtoFieldNumber :: FieldNumber
dotProtoFieldNumber = Word64 -> FieldNumber
FieldNumber (Word64 -> FieldNumber)
-> (DotProtoField -> Word64) -> DotProtoField -> FieldNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64
offset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+)
                                  (Word64 -> Word64)
-> (DotProtoField -> Word64) -> DotProtoField -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> Word64
getFieldNumber (FieldNumber -> Word64)
-> (DotProtoField -> FieldNumber) -> DotProtoField -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotProtoField -> FieldNumber
dotProtoFieldNumber
                                  (DotProtoField -> FieldNumber) -> DotProtoField -> FieldNumber
forall a b. (a -> b) -> a -> b
$ DotProtoField
part
          }

instance MessageField c => GenericMessage (K1 i c) where
  type GenericFieldCount (K1 i c) = 1
  genericEncodeMessage :: FieldNumber -> K1 i c a -> MessageBuilder
genericEncodeMessage FieldNumber
num (K1 c
x) = FieldNumber -> c -> MessageBuilder
forall a. MessageField a => FieldNumber -> a -> MessageBuilder
encodeMessageField FieldNumber
num c
x
  genericDecodeMessage :: FieldNumber -> Parser RawMessage (K1 i c a)
genericDecodeMessage FieldNumber
num        = c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1 (c -> K1 i c a)
-> Parser RawMessage c -> Parser RawMessage (K1 i c a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField c -> FieldNumber -> Parser RawMessage c
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at Parser RawField c
forall a. MessageField a => Parser RawField a
decodeMessageField FieldNumber
num
  genericDotProto :: Proxy# (K1 i c) -> [DotProtoField]
genericDotProto Proxy# (K1 i c)
_               = [Proxy# c -> DotProtoField
forall a. MessageField a => Proxy# a -> DotProtoField
protoType (Proxy# c
forall k (a :: k). Proxy# a
proxy# :: Proxy# c)]

instance (Selector s, GenericMessage f) => GenericMessage (M1 S s f) where
  type GenericFieldCount (M1 S s f) = GenericFieldCount f
  genericEncodeMessage :: FieldNumber -> M1 S s f a -> MessageBuilder
genericEncodeMessage FieldNumber
num (M1 f a
x)   = FieldNumber -> f a -> MessageBuilder
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> f a -> MessageBuilder
genericEncodeMessage FieldNumber
num f a
x
  genericDecodeMessage :: FieldNumber -> Parser RawMessage (M1 S s f a)
genericDecodeMessage FieldNumber
num          = f a -> M1 S s f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 S s f a)
-> Parser RawMessage (f a) -> Parser RawMessage (M1 S s f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldNumber -> Parser RawMessage (f a)
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> Parser RawMessage (f a)
genericDecodeMessage FieldNumber
num
  genericDotProto :: Proxy# (M1 S s f) -> [DotProtoField]
genericDotProto Proxy# (M1 S s f)
_                 = (DotProtoField -> DotProtoField)
-> [DotProtoField] -> [DotProtoField]
forall a b. (a -> b) -> [a] -> [b]
map DotProtoField -> DotProtoField
applyName ([DotProtoField] -> [DotProtoField])
-> [DotProtoField] -> [DotProtoField]
forall a b. (a -> b) -> a -> b
$ Proxy# f -> [DotProtoField]
forall (f :: * -> *).
GenericMessage f =>
Proxy# f -> [DotProtoField]
genericDotProto (Proxy# f
forall k (a :: k). Proxy# a
proxy# :: Proxy# f)
    where
      applyName :: DotProtoField -> DotProtoField
      applyName :: DotProtoField -> DotProtoField
applyName DotProtoField
mp = DotProtoField
mp { dotProtoFieldName :: DotProtoIdentifier
dotProtoFieldName = DotProtoIdentifier
-> Maybe DotProtoIdentifier -> DotProtoIdentifier
forall a. a -> Maybe a -> a
fromMaybe DotProtoIdentifier
Anonymous Maybe DotProtoIdentifier
newName}
      -- [issue] this probably doesn't match the intended name generating semantics

      newName :: Maybe DotProtoIdentifier
      newName :: Maybe DotProtoIdentifier
newName = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name)) Maybe () -> DotProtoIdentifier -> Maybe DotProtoIdentifier
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String -> DotProtoIdentifier
Single String
name
        where
          name :: String
name = M1 S s f () -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (M1 S s f ()
forall a. HasCallStack => a
undefined :: S1 s f ())

instance GenericMessage f => GenericMessage (M1 C t f) where
  type GenericFieldCount (M1 C t f) = GenericFieldCount f
  genericEncodeMessage :: FieldNumber -> M1 C t f a -> MessageBuilder
genericEncodeMessage FieldNumber
num (M1 f a
x)   = FieldNumber -> f a -> MessageBuilder
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> f a -> MessageBuilder
genericEncodeMessage FieldNumber
num f a
x
  genericDecodeMessage :: FieldNumber -> Parser RawMessage (M1 C t f a)
genericDecodeMessage FieldNumber
num          = f a -> M1 C t f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 C t f a)
-> Parser RawMessage (f a) -> Parser RawMessage (M1 C t f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldNumber -> Parser RawMessage (f a)
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> Parser RawMessage (f a)
genericDecodeMessage FieldNumber
num
  genericDotProto :: Proxy# (M1 C t f) -> [DotProtoField]
genericDotProto Proxy# (M1 C t f)
_                 = Proxy# f -> [DotProtoField]
forall (f :: * -> *).
GenericMessage f =>
Proxy# f -> [DotProtoField]
genericDotProto (Proxy# f
forall k (a :: k). Proxy# a
proxy# :: Proxy# f)

instance GenericMessage f => GenericMessage (M1 D t f) where
  type GenericFieldCount (M1 D t f) = GenericFieldCount f
  genericEncodeMessage :: FieldNumber -> M1 D t f a -> MessageBuilder
genericEncodeMessage FieldNumber
num (M1 f a
x)   = FieldNumber -> f a -> MessageBuilder
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> f a -> MessageBuilder
genericEncodeMessage FieldNumber
num f a
x
  genericDecodeMessage :: FieldNumber -> Parser RawMessage (M1 D t f a)
genericDecodeMessage FieldNumber
num          = f a -> M1 D t f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 D t f a)
-> Parser RawMessage (f a) -> Parser RawMessage (M1 D t f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldNumber -> Parser RawMessage (f a)
forall (f :: * -> *) a.
GenericMessage f =>
FieldNumber -> Parser RawMessage (f a)
genericDecodeMessage FieldNumber
num
  genericDotProto :: Proxy# (M1 D t f) -> [DotProtoField]
genericDotProto Proxy# (M1 D t f)
_                 = Proxy# f -> [DotProtoField]
forall (f :: * -> *).
GenericMessage f =>
Proxy# f -> [DotProtoField]
genericDotProto (Proxy# f
forall k (a :: k). Proxy# a
proxy# :: Proxy# f)