{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS_GHC  -fno-warn-unused-imports #-}
module Text.DescriptorProtos.FieldDescriptorProto (FieldDescriptorProto(..)) where
import Prelude ((+), (/))
import qualified Prelude as Prelude'
import qualified Data.Typeable as Prelude'
import qualified GHC.Generics as Prelude'
import qualified Data.Data as Prelude'
import qualified Text.ProtocolBuffers.Header as P'
import qualified Text.DescriptorProtos.FieldDescriptorProto.Label as DescriptorProtos.FieldDescriptorProto (Label)
import qualified Text.DescriptorProtos.FieldDescriptorProto.Type as DescriptorProtos.FieldDescriptorProto (Type)
import qualified Text.DescriptorProtos.FieldOptions as DescriptorProtos (FieldOptions)

data FieldDescriptorProto = FieldDescriptorProto{FieldDescriptorProto -> Maybe Utf8
name :: !(P'.Maybe P'.Utf8), FieldDescriptorProto -> Maybe Int32
number :: !(P'.Maybe P'.Int32),
                                                 FieldDescriptorProto -> Maybe Label
label :: !(P'.Maybe DescriptorProtos.FieldDescriptorProto.Label),
                                                 FieldDescriptorProto -> Maybe Type
type' :: !(P'.Maybe DescriptorProtos.FieldDescriptorProto.Type),
                                                 FieldDescriptorProto -> Maybe Utf8
type_name :: !(P'.Maybe P'.Utf8), FieldDescriptorProto -> Maybe Utf8
extendee :: !(P'.Maybe P'.Utf8),
                                                 FieldDescriptorProto -> Maybe Utf8
default_value :: !(P'.Maybe P'.Utf8), FieldDescriptorProto -> Maybe Int32
oneof_index :: !(P'.Maybe P'.Int32),
                                                 FieldDescriptorProto -> Maybe Utf8
json_name :: !(P'.Maybe P'.Utf8),
                                                 FieldDescriptorProto -> Maybe FieldOptions
options :: !(P'.Maybe DescriptorProtos.FieldOptions),
                                                 FieldDescriptorProto -> UnknownField
unknown'field :: !(P'.UnknownField)}
                            deriving (Int -> FieldDescriptorProto -> ShowS
[FieldDescriptorProto] -> ShowS
FieldDescriptorProto -> String
(Int -> FieldDescriptorProto -> ShowS)
-> (FieldDescriptorProto -> String)
-> ([FieldDescriptorProto] -> ShowS)
-> Show FieldDescriptorProto
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldDescriptorProto] -> ShowS
$cshowList :: [FieldDescriptorProto] -> ShowS
show :: FieldDescriptorProto -> String
$cshow :: FieldDescriptorProto -> String
showsPrec :: Int -> FieldDescriptorProto -> ShowS
$cshowsPrec :: Int -> FieldDescriptorProto -> ShowS
Prelude'.Show, FieldDescriptorProto -> FieldDescriptorProto -> Bool
(FieldDescriptorProto -> FieldDescriptorProto -> Bool)
-> (FieldDescriptorProto -> FieldDescriptorProto -> Bool)
-> Eq FieldDescriptorProto
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
$c/= :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
== :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
$c== :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
Prelude'.Eq, Eq FieldDescriptorProto
Eq FieldDescriptorProto
-> (FieldDescriptorProto -> FieldDescriptorProto -> Ordering)
-> (FieldDescriptorProto -> FieldDescriptorProto -> Bool)
-> (FieldDescriptorProto -> FieldDescriptorProto -> Bool)
-> (FieldDescriptorProto -> FieldDescriptorProto -> Bool)
-> (FieldDescriptorProto -> FieldDescriptorProto -> Bool)
-> (FieldDescriptorProto
    -> FieldDescriptorProto -> FieldDescriptorProto)
-> (FieldDescriptorProto
    -> FieldDescriptorProto -> FieldDescriptorProto)
-> Ord FieldDescriptorProto
FieldDescriptorProto -> FieldDescriptorProto -> Bool
FieldDescriptorProto -> FieldDescriptorProto -> Ordering
FieldDescriptorProto
-> FieldDescriptorProto -> FieldDescriptorProto
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldDescriptorProto
-> FieldDescriptorProto -> FieldDescriptorProto
$cmin :: FieldDescriptorProto
-> FieldDescriptorProto -> FieldDescriptorProto
max :: FieldDescriptorProto
-> FieldDescriptorProto -> FieldDescriptorProto
$cmax :: FieldDescriptorProto
-> FieldDescriptorProto -> FieldDescriptorProto
>= :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
$c>= :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
> :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
$c> :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
<= :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
$c<= :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
< :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
$c< :: FieldDescriptorProto -> FieldDescriptorProto -> Bool
compare :: FieldDescriptorProto -> FieldDescriptorProto -> Ordering
$ccompare :: FieldDescriptorProto -> FieldDescriptorProto -> Ordering
$cp1Ord :: Eq FieldDescriptorProto
Prelude'.Ord, Prelude'.Typeable, Typeable FieldDescriptorProto
DataType
Constr
Typeable FieldDescriptorProto
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> FieldDescriptorProto
    -> c FieldDescriptorProto)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FieldDescriptorProto)
-> (FieldDescriptorProto -> Constr)
-> (FieldDescriptorProto -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FieldDescriptorProto))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FieldDescriptorProto))
-> ((forall b. Data b => b -> b)
    -> FieldDescriptorProto -> FieldDescriptorProto)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldDescriptorProto -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldDescriptorProto -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FieldDescriptorProto -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FieldDescriptorProto -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FieldDescriptorProto -> m FieldDescriptorProto)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FieldDescriptorProto -> m FieldDescriptorProto)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FieldDescriptorProto -> m FieldDescriptorProto)
-> Data FieldDescriptorProto
FieldDescriptorProto -> DataType
FieldDescriptorProto -> Constr
(forall b. Data b => b -> b)
-> FieldDescriptorProto -> FieldDescriptorProto
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FieldDescriptorProto
-> c FieldDescriptorProto
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldDescriptorProto
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FieldDescriptorProto -> u
forall u.
(forall d. Data d => d -> u) -> FieldDescriptorProto -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldDescriptorProto -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldDescriptorProto -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldDescriptorProto -> m FieldDescriptorProto
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldDescriptorProto -> m FieldDescriptorProto
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldDescriptorProto
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FieldDescriptorProto
-> c FieldDescriptorProto
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldDescriptorProto)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldDescriptorProto)
$cFieldDescriptorProto :: Constr
$tFieldDescriptorProto :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> FieldDescriptorProto -> m FieldDescriptorProto
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldDescriptorProto -> m FieldDescriptorProto
gmapMp :: (forall d. Data d => d -> m d)
-> FieldDescriptorProto -> m FieldDescriptorProto
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldDescriptorProto -> m FieldDescriptorProto
gmapM :: (forall d. Data d => d -> m d)
-> FieldDescriptorProto -> m FieldDescriptorProto
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldDescriptorProto -> m FieldDescriptorProto
gmapQi :: Int -> (forall d. Data d => d -> u) -> FieldDescriptorProto -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FieldDescriptorProto -> u
gmapQ :: (forall d. Data d => d -> u) -> FieldDescriptorProto -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> FieldDescriptorProto -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldDescriptorProto -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldDescriptorProto -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldDescriptorProto -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldDescriptorProto -> r
gmapT :: (forall b. Data b => b -> b)
-> FieldDescriptorProto -> FieldDescriptorProto
$cgmapT :: (forall b. Data b => b -> b)
-> FieldDescriptorProto -> FieldDescriptorProto
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldDescriptorProto)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldDescriptorProto)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FieldDescriptorProto)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldDescriptorProto)
dataTypeOf :: FieldDescriptorProto -> DataType
$cdataTypeOf :: FieldDescriptorProto -> DataType
toConstr :: FieldDescriptorProto -> Constr
$ctoConstr :: FieldDescriptorProto -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldDescriptorProto
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldDescriptorProto
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FieldDescriptorProto
-> c FieldDescriptorProto
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FieldDescriptorProto
-> c FieldDescriptorProto
$cp1Data :: Typeable FieldDescriptorProto
Prelude'.Data, (forall x. FieldDescriptorProto -> Rep FieldDescriptorProto x)
-> (forall x. Rep FieldDescriptorProto x -> FieldDescriptorProto)
-> Generic FieldDescriptorProto
forall x. Rep FieldDescriptorProto x -> FieldDescriptorProto
forall x. FieldDescriptorProto -> Rep FieldDescriptorProto x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldDescriptorProto x -> FieldDescriptorProto
$cfrom :: forall x. FieldDescriptorProto -> Rep FieldDescriptorProto x
Prelude'.Generic)

instance P'.UnknownMessage FieldDescriptorProto where
  getUnknownField :: FieldDescriptorProto -> UnknownField
getUnknownField = FieldDescriptorProto -> UnknownField
unknown'field
  putUnknownField :: UnknownField -> FieldDescriptorProto -> FieldDescriptorProto
putUnknownField UnknownField
u'f FieldDescriptorProto
msg = FieldDescriptorProto
msg{unknown'field :: UnknownField
unknown'field = UnknownField
u'f}

instance P'.Mergeable FieldDescriptorProto where
  mergeAppend :: FieldDescriptorProto
-> FieldDescriptorProto -> FieldDescriptorProto
mergeAppend (FieldDescriptorProto Maybe Utf8
x'1 Maybe Int32
x'2 Maybe Label
x'3 Maybe Type
x'4 Maybe Utf8
x'5 Maybe Utf8
x'6 Maybe Utf8
x'7 Maybe Int32
x'8 Maybe Utf8
x'9 Maybe FieldOptions
x'10 UnknownField
x'11)
   (FieldDescriptorProto Maybe Utf8
y'1 Maybe Int32
y'2 Maybe Label
y'3 Maybe Type
y'4 Maybe Utf8
y'5 Maybe Utf8
y'6 Maybe Utf8
y'7 Maybe Int32
y'8 Maybe Utf8
y'9 Maybe FieldOptions
y'10 UnknownField
y'11)
   = Maybe Utf8
-> Maybe Int32
-> Maybe Label
-> Maybe Type
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Int32
-> Maybe Utf8
-> Maybe FieldOptions
-> UnknownField
-> FieldDescriptorProto
FieldDescriptorProto (Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'1 Maybe Utf8
y'1) (Maybe Int32 -> Maybe Int32 -> Maybe Int32
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Int32
x'2 Maybe Int32
y'2) (Maybe Label -> Maybe Label -> Maybe Label
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Label
x'3 Maybe Label
y'3) (Maybe Type -> Maybe Type -> Maybe Type
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Type
x'4 Maybe Type
y'4)
      (Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'5 Maybe Utf8
y'5)
      (Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'6 Maybe Utf8
y'6)
      (Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'7 Maybe Utf8
y'7)
      (Maybe Int32 -> Maybe Int32 -> Maybe Int32
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Int32
x'8 Maybe Int32
y'8)
      (Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'9 Maybe Utf8
y'9)
      (Maybe FieldOptions -> Maybe FieldOptions -> Maybe FieldOptions
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe FieldOptions
x'10 Maybe FieldOptions
y'10)
      (UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'11 UnknownField
y'11)

instance P'.Default FieldDescriptorProto where
  defaultValue :: FieldDescriptorProto
defaultValue
   = Maybe Utf8
-> Maybe Int32
-> Maybe Label
-> Maybe Type
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Int32
-> Maybe Utf8
-> Maybe FieldOptions
-> UnknownField
-> FieldDescriptorProto
FieldDescriptorProto Maybe Utf8
forall a. Default a => a
P'.defaultValue Maybe Int32
forall a. Default a => a
P'.defaultValue Maybe Label
forall a. Default a => a
P'.defaultValue Maybe Type
forall a. Default a => a
P'.defaultValue Maybe Utf8
forall a. Default a => a
P'.defaultValue Maybe Utf8
forall a. Default a => a
P'.defaultValue
      Maybe Utf8
forall a. Default a => a
P'.defaultValue
      Maybe Int32
forall a. Default a => a
P'.defaultValue
      Maybe Utf8
forall a. Default a => a
P'.defaultValue
      Maybe FieldOptions
forall a. Default a => a
P'.defaultValue
      UnknownField
forall a. Default a => a
P'.defaultValue

instance P'.Wire FieldDescriptorProto where
  wireSize :: FieldType -> FieldDescriptorProto -> WireSize
wireSize FieldType
ft' self' :: FieldDescriptorProto
self'@(FieldDescriptorProto Maybe Utf8
x'1 Maybe Int32
x'2 Maybe Label
x'3 Maybe Type
x'4 Maybe Utf8
x'5 Maybe Utf8
x'6 Maybe Utf8
x'7 Maybe Int32
x'8 Maybe Utf8
x'9 Maybe FieldOptions
x'10 UnknownField
x'11)
   = case FieldType
ft' of
       FieldType
10 -> WireSize
calc'Size
       FieldType
11 -> WireSize -> WireSize
P'.prependMessageSize WireSize
calc'Size
       FieldType
_ -> FieldType -> FieldDescriptorProto -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' FieldDescriptorProto
self'
    where
        calc'Size :: WireSize
calc'Size
         = (WireSize -> FieldType -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'1 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Int32 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
5 Maybe Int32
x'2 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Label -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
14 Maybe Label
x'3 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Type -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
14 Maybe Type
x'4 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+
             WireSize -> FieldType -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'5
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'6
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'7
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Int32 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
5 Maybe Int32
x'8
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'9
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe FieldOptions -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
11 Maybe FieldOptions
x'10
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'11)
  wirePutWithSize :: FieldType -> FieldDescriptorProto -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: FieldDescriptorProto
self'@(FieldDescriptorProto Maybe Utf8
x'1 Maybe Int32
x'2 Maybe Label
x'3 Maybe Type
x'4 Maybe Utf8
x'5 Maybe Utf8
x'6 Maybe Utf8
x'7 Maybe Int32
x'8 Maybe Utf8
x'9 Maybe FieldOptions
x'10 UnknownField
x'11)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> FieldDescriptorProto -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' FieldDescriptorProto
self'
    where
        put'Fields :: PutM WireSize
put'Fields
         = [PutM WireSize] -> PutM WireSize
forall (f :: * -> *).
Foldable f =>
f (PutM WireSize) -> PutM WireSize
P'.sequencePutWithSize
            [WireTag -> FieldType -> Maybe Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
10 FieldType
9 Maybe Utf8
x'1, WireTag -> FieldType -> Maybe Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
18 FieldType
9 Maybe Utf8
x'6, WireTag -> FieldType -> Maybe Int32 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
24 FieldType
5 Maybe Int32
x'2,
             WireTag -> FieldType -> Maybe Label -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
32 FieldType
14 Maybe Label
x'3, WireTag -> FieldType -> Maybe Type -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
40 FieldType
14 Maybe Type
x'4, WireTag -> FieldType -> Maybe Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
50 FieldType
9 Maybe Utf8
x'5,
             WireTag -> FieldType -> Maybe Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
58 FieldType
9 Maybe Utf8
x'7, WireTag -> FieldType -> Maybe FieldOptions -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
66 FieldType
11 Maybe FieldOptions
x'10, WireTag -> FieldType -> Maybe Int32 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
72 FieldType
5 Maybe Int32
x'8,
             WireTag -> FieldType -> Maybe Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
82 FieldType
9 Maybe Utf8
x'9, UnknownField -> PutM WireSize
P'.wirePutUnknownFieldWithSize UnknownField
x'11]
        put'FieldsSized :: PutM WireSize
put'FieldsSized
         = let size' :: WireSize
size' = (WireSize, ByteString) -> WireSize
forall a b. (a, b) -> a
Prelude'.fst (PutM WireSize -> (WireSize, ByteString)
forall a. PutM a -> (a, ByteString)
P'.runPutM PutM WireSize
put'Fields)
               put'Size :: PutM WireSize
put'Size
                = do
                    WireSize -> Put
P'.putSize WireSize
size'
                    WireSize -> PutM WireSize
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (WireSize -> WireSize
P'.size'WireSize WireSize
size')
            in [PutM WireSize] -> PutM WireSize
forall (f :: * -> *).
Foldable f =>
f (PutM WireSize) -> PutM WireSize
P'.sequencePutWithSize [PutM WireSize
put'Size, PutM WireSize
put'Fields]
  wireGet :: FieldType -> Get FieldDescriptorProto
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> FieldDescriptorProto -> Get FieldDescriptorProto)
-> Get FieldDescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> FieldDescriptorProto -> Get FieldDescriptorProto)
-> WireTag -> FieldDescriptorProto -> Get FieldDescriptorProto
forall a.
UnknownMessage a =>
(WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown WireTag -> FieldDescriptorProto -> Get FieldDescriptorProto
update'Self)
       FieldType
11 -> (WireTag -> FieldDescriptorProto -> Get FieldDescriptorProto)
-> Get FieldDescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> FieldDescriptorProto -> Get FieldDescriptorProto)
-> WireTag -> FieldDescriptorProto -> Get FieldDescriptorProto
forall a.
UnknownMessage a =>
(WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown WireTag -> FieldDescriptorProto -> Get FieldDescriptorProto
update'Self)
       FieldType
_ -> FieldType -> Get FieldDescriptorProto
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> FieldDescriptorProto -> Get FieldDescriptorProto
update'Self WireTag
wire'Tag FieldDescriptorProto
old'Self
         = case WireTag
wire'Tag of
             WireTag
10 -> (Utf8 -> FieldDescriptorProto)
-> Get Utf8 -> Get FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> FieldDescriptorProto
old'Self{name :: Maybe Utf8
name = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field}) (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
24 -> (Int32 -> FieldDescriptorProto)
-> Get Int32 -> Get FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Int32
new'Field -> FieldDescriptorProto
old'Self{number :: Maybe Int32
number = Int32 -> Maybe Int32
forall a. a -> Maybe a
Prelude'.Just Int32
new'Field}) (FieldType -> Get Int32
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
5)
             WireTag
32 -> (Label -> FieldDescriptorProto)
-> Get Label -> Get FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Label
new'Field -> FieldDescriptorProto
old'Self{label :: Maybe Label
label = Label -> Maybe Label
forall a. a -> Maybe a
Prelude'.Just Label
new'Field}) (FieldType -> Get Label
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
14)
             WireTag
40 -> (Type -> FieldDescriptorProto)
-> Get Type -> Get FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Type
new'Field -> FieldDescriptorProto
old'Self{type' :: Maybe Type
type' = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
new'Field}) (FieldType -> Get Type
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
14)
             WireTag
50 -> (Utf8 -> FieldDescriptorProto)
-> Get Utf8 -> Get FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> FieldDescriptorProto
old'Self{type_name :: Maybe Utf8
type_name = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field}) (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
18 -> (Utf8 -> FieldDescriptorProto)
-> Get Utf8 -> Get FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> FieldDescriptorProto
old'Self{extendee :: Maybe Utf8
extendee = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field}) (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
58 -> (Utf8 -> FieldDescriptorProto)
-> Get Utf8 -> Get FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> FieldDescriptorProto
old'Self{default_value :: Maybe Utf8
default_value = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field}) (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
72 -> (Int32 -> FieldDescriptorProto)
-> Get Int32 -> Get FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Int32
new'Field -> FieldDescriptorProto
old'Self{oneof_index :: Maybe Int32
oneof_index = Int32 -> Maybe Int32
forall a. a -> Maybe a
Prelude'.Just Int32
new'Field}) (FieldType -> Get Int32
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
5)
             WireTag
82 -> (Utf8 -> FieldDescriptorProto)
-> Get Utf8 -> Get FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> FieldDescriptorProto
old'Self{json_name :: Maybe Utf8
json_name = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field}) (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
66 -> (FieldOptions -> FieldDescriptorProto)
-> Get FieldOptions -> Get FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !FieldOptions
new'Field -> FieldDescriptorProto
old'Self{options :: Maybe FieldOptions
options = Maybe FieldOptions -> Maybe FieldOptions -> Maybe FieldOptions
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (FieldDescriptorProto -> Maybe FieldOptions
options FieldDescriptorProto
old'Self) (FieldOptions -> Maybe FieldOptions
forall a. a -> Maybe a
Prelude'.Just FieldOptions
new'Field)})
                    (FieldType -> Get FieldOptions
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
_ -> let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag in FieldId
-> WireType -> FieldDescriptorProto -> Get FieldDescriptorProto
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type FieldDescriptorProto
old'Self

instance P'.MessageAPI msg' (msg' -> FieldDescriptorProto) FieldDescriptorProto where
  getVal :: msg' -> (msg' -> FieldDescriptorProto) -> FieldDescriptorProto
getVal msg'
m' msg' -> FieldDescriptorProto
f' = msg' -> FieldDescriptorProto
f' msg'
m'

instance P'.GPB FieldDescriptorProto

instance P'.ReflectDescriptor FieldDescriptorProto where
  getMessageInfo :: FieldDescriptorProto -> GetMessageInfo
getMessageInfo FieldDescriptorProto
_ = Set WireTag -> Set WireTag -> GetMessageInfo
P'.GetMessageInfo ([WireTag] -> Set WireTag
forall a. [a] -> Set a
P'.fromDistinctAscList []) ([WireTag] -> Set WireTag
forall a. [a] -> Set a
P'.fromDistinctAscList [WireTag
10, WireTag
18, WireTag
24, WireTag
32, WireTag
40, WireTag
50, WireTag
58, WireTag
66, WireTag
72, WireTag
82])
  reflectDescriptorInfo :: FieldDescriptorProto -> DescriptorInfo
reflectDescriptorInfo FieldDescriptorProto
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.FieldDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"FieldDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FieldDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldDescriptorProto.name\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName' = FName \"name\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldDescriptorProto.number\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName' = FName \"number\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldDescriptorProto.label\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName' = FName \"label\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.FieldDescriptorProto.Label\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName = MName \"Label\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldDescriptorProto.type\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName' = FName \"type'\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.FieldDescriptorProto.Type\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName = MName \"Type\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldDescriptorProto.type_name\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName' = FName \"type_name\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldDescriptorProto.extendee\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName' = FName \"extendee\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldDescriptorProto.default_value\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName' = FName \"default_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldDescriptorProto.oneof_index\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName' = FName \"oneof_index\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 72}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldDescriptorProto.json_name\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName' = FName \"json_name\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 82}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldDescriptorProto.options\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldDescriptorProto\"], baseName' = FName \"options\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.FieldOptions\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"FieldOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = True, lazyFields = False, makeLenses = False}"

instance P'.TextType FieldDescriptorProto where
  tellT :: String -> FieldDescriptorProto -> Output
tellT = String -> FieldDescriptorProto -> Output
forall a. TextMsg a => String -> a -> Output
P'.tellSubMessage
  getT :: String -> Parsec s () FieldDescriptorProto
getT = String -> Parsec s () FieldDescriptorProto
forall s a.
(Stream s Identity Char, TextMsg a) =>
String -> Parsec s () a
P'.getSubMessage

instance P'.TextMsg FieldDescriptorProto where
  textPut :: FieldDescriptorProto -> Output
textPut FieldDescriptorProto
msg
   = do
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"name" (FieldDescriptorProto -> Maybe Utf8
name FieldDescriptorProto
msg)
       String -> Maybe Int32 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"number" (FieldDescriptorProto -> Maybe Int32
number FieldDescriptorProto
msg)
       String -> Maybe Label -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"label" (FieldDescriptorProto -> Maybe Label
label FieldDescriptorProto
msg)
       String -> Maybe Type -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"type" (FieldDescriptorProto -> Maybe Type
type' FieldDescriptorProto
msg)
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"type_name" (FieldDescriptorProto -> Maybe Utf8
type_name FieldDescriptorProto
msg)
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"extendee" (FieldDescriptorProto -> Maybe Utf8
extendee FieldDescriptorProto
msg)
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"default_value" (FieldDescriptorProto -> Maybe Utf8
default_value FieldDescriptorProto
msg)
       String -> Maybe Int32 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"oneof_index" (FieldDescriptorProto -> Maybe Int32
oneof_index FieldDescriptorProto
msg)
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"json_name" (FieldDescriptorProto -> Maybe Utf8
json_name FieldDescriptorProto
msg)
       String -> Maybe FieldOptions -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"options" (FieldDescriptorProto -> Maybe FieldOptions
options FieldDescriptorProto
msg)
  textGet :: Parsec s () FieldDescriptorProto
textGet
   = do
       [FieldDescriptorProto -> FieldDescriptorProto]
mods <- ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT s () Identity ()
-> ParsecT
     s () Identity [FieldDescriptorProto -> FieldDescriptorProto]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P'.sepEndBy
                ([ParsecT
   s () Identity (FieldDescriptorProto -> FieldDescriptorProto)]
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
P'.choice
                  [ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'name, ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'number, ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'label, ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'type', ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'type_name, ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'extendee, ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'default_value,
                   ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'oneof_index, ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'json_name, ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'options])
                ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
       FieldDescriptorProto -> Parsec s () FieldDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((FieldDescriptorProto
 -> (FieldDescriptorProto -> FieldDescriptorProto)
 -> FieldDescriptorProto)
-> FieldDescriptorProto
-> [FieldDescriptorProto -> FieldDescriptorProto]
-> FieldDescriptorProto
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl (\ FieldDescriptorProto
v FieldDescriptorProto -> FieldDescriptorProto
f -> FieldDescriptorProto -> FieldDescriptorProto
f FieldDescriptorProto
v) FieldDescriptorProto
forall a. Default a => a
P'.defaultValue [FieldDescriptorProto -> FieldDescriptorProto]
mods)
    where
        parse'name :: ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'name
         = ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Maybe Utf8
v <- String -> Parsec s () (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"name"
               (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ FieldDescriptorProto
o -> FieldDescriptorProto
o{name :: Maybe Utf8
name = Maybe Utf8
v}))
        parse'number :: ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'number
         = ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Maybe Int32
v <- String -> Parsec s () (Maybe Int32)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"number"
               (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ FieldDescriptorProto
o -> FieldDescriptorProto
o{number :: Maybe Int32
number = Maybe Int32
v}))
        parse'label :: ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'label
         = ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Maybe Label
v <- String -> Parsec s () (Maybe Label)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"label"
               (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ FieldDescriptorProto
o -> FieldDescriptorProto
o{label :: Maybe Label
label = Maybe Label
v}))
        parse'type' :: ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'type'
         = ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Maybe Type
v <- String -> Parsec s () (Maybe Type)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"type"
               (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ FieldDescriptorProto
o -> FieldDescriptorProto
o{type' :: Maybe Type
type' = Maybe Type
v}))
        parse'type_name :: ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'type_name
         = ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Maybe Utf8
v <- String -> Parsec s () (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"type_name"
               (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ FieldDescriptorProto
o -> FieldDescriptorProto
o{type_name :: Maybe Utf8
type_name = Maybe Utf8
v}))
        parse'extendee :: ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'extendee
         = ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Maybe Utf8
v <- String -> Parsec s () (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"extendee"
               (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ FieldDescriptorProto
o -> FieldDescriptorProto
o{extendee :: Maybe Utf8
extendee = Maybe Utf8
v}))
        parse'default_value :: ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'default_value
         = ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Maybe Utf8
v <- String -> Parsec s () (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"default_value"
               (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ FieldDescriptorProto
o -> FieldDescriptorProto
o{default_value :: Maybe Utf8
default_value = Maybe Utf8
v}))
        parse'oneof_index :: ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'oneof_index
         = ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Maybe Int32
v <- String -> Parsec s () (Maybe Int32)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"oneof_index"
               (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ FieldDescriptorProto
o -> FieldDescriptorProto
o{oneof_index :: Maybe Int32
oneof_index = Maybe Int32
v}))
        parse'json_name :: ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'json_name
         = ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Maybe Utf8
v <- String -> Parsec s () (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"json_name"
               (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ FieldDescriptorProto
o -> FieldDescriptorProto
o{json_name :: Maybe Utf8
json_name = Maybe Utf8
v}))
        parse'options :: ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
parse'options
         = ParsecT
  s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Maybe FieldOptions
v <- String -> Parsec s () (Maybe FieldOptions)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"options"
               (FieldDescriptorProto -> FieldDescriptorProto)
-> ParsecT
     s () Identity (FieldDescriptorProto -> FieldDescriptorProto)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ FieldDescriptorProto
o -> FieldDescriptorProto
o{options :: Maybe FieldOptions
options = Maybe FieldOptions
v}))