{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}
{-# OPTIONS_GHC  -w #-}
module Text.DescriptorProtos.DescriptorProto (DescriptorProto(..)) where
import Prelude ((+), (/), (++), (.))
import qualified Prelude as Prelude'
import qualified Data.List 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.DescriptorProto.ExtensionRange as DescriptorProtos.DescriptorProto (ExtensionRange)
import qualified Text.DescriptorProtos.DescriptorProto.ReservedRange as DescriptorProtos.DescriptorProto (ReservedRange)
import qualified Text.DescriptorProtos.EnumDescriptorProto as DescriptorProtos (EnumDescriptorProto)
import qualified Text.DescriptorProtos.FieldDescriptorProto as DescriptorProtos (FieldDescriptorProto)
import qualified Text.DescriptorProtos.MessageOptions as DescriptorProtos (MessageOptions)
import qualified Text.DescriptorProtos.OneofDescriptorProto as DescriptorProtos (OneofDescriptorProto)

data DescriptorProto = DescriptorProto{DescriptorProto -> Maybe Utf8
name :: !(P'.Maybe P'.Utf8), DescriptorProto -> Seq FieldDescriptorProto
field :: !(P'.Seq DescriptorProtos.FieldDescriptorProto),
                                       DescriptorProto -> Seq FieldDescriptorProto
extension :: !(P'.Seq DescriptorProtos.FieldDescriptorProto),
                                       DescriptorProto -> Seq DescriptorProto
nested_type :: !(P'.Seq DescriptorProto),
                                       DescriptorProto -> Seq EnumDescriptorProto
enum_type :: !(P'.Seq DescriptorProtos.EnumDescriptorProto),
                                       DescriptorProto -> Seq ExtensionRange
extension_range :: !(P'.Seq DescriptorProtos.DescriptorProto.ExtensionRange),
                                       DescriptorProto -> Seq OneofDescriptorProto
oneof_decl :: !(P'.Seq DescriptorProtos.OneofDescriptorProto),
                                       DescriptorProto -> Maybe MessageOptions
options :: !(P'.Maybe DescriptorProtos.MessageOptions),
                                       DescriptorProto -> Seq ReservedRange
reserved_range :: !(P'.Seq DescriptorProtos.DescriptorProto.ReservedRange),
                                       DescriptorProto -> Seq Utf8
reserved_name :: !(P'.Seq P'.Utf8), DescriptorProto -> UnknownField
unknown'field :: !(P'.UnknownField)}
                       deriving (Int -> DescriptorProto -> ShowS
[DescriptorProto] -> ShowS
DescriptorProto -> String
(Int -> DescriptorProto -> ShowS)
-> (DescriptorProto -> String)
-> ([DescriptorProto] -> ShowS)
-> Show DescriptorProto
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescriptorProto] -> ShowS
$cshowList :: [DescriptorProto] -> ShowS
show :: DescriptorProto -> String
$cshow :: DescriptorProto -> String
showsPrec :: Int -> DescriptorProto -> ShowS
$cshowsPrec :: Int -> DescriptorProto -> ShowS
Prelude'.Show, DescriptorProto -> DescriptorProto -> Bool
(DescriptorProto -> DescriptorProto -> Bool)
-> (DescriptorProto -> DescriptorProto -> Bool)
-> Eq DescriptorProto
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescriptorProto -> DescriptorProto -> Bool
$c/= :: DescriptorProto -> DescriptorProto -> Bool
== :: DescriptorProto -> DescriptorProto -> Bool
$c== :: DescriptorProto -> DescriptorProto -> Bool
Prelude'.Eq, Eq DescriptorProto
Eq DescriptorProto
-> (DescriptorProto -> DescriptorProto -> Ordering)
-> (DescriptorProto -> DescriptorProto -> Bool)
-> (DescriptorProto -> DescriptorProto -> Bool)
-> (DescriptorProto -> DescriptorProto -> Bool)
-> (DescriptorProto -> DescriptorProto -> Bool)
-> (DescriptorProto -> DescriptorProto -> DescriptorProto)
-> (DescriptorProto -> DescriptorProto -> DescriptorProto)
-> Ord DescriptorProto
DescriptorProto -> DescriptorProto -> Bool
DescriptorProto -> DescriptorProto -> Ordering
DescriptorProto -> DescriptorProto -> DescriptorProto
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 :: DescriptorProto -> DescriptorProto -> DescriptorProto
$cmin :: DescriptorProto -> DescriptorProto -> DescriptorProto
max :: DescriptorProto -> DescriptorProto -> DescriptorProto
$cmax :: DescriptorProto -> DescriptorProto -> DescriptorProto
>= :: DescriptorProto -> DescriptorProto -> Bool
$c>= :: DescriptorProto -> DescriptorProto -> Bool
> :: DescriptorProto -> DescriptorProto -> Bool
$c> :: DescriptorProto -> DescriptorProto -> Bool
<= :: DescriptorProto -> DescriptorProto -> Bool
$c<= :: DescriptorProto -> DescriptorProto -> Bool
< :: DescriptorProto -> DescriptorProto -> Bool
$c< :: DescriptorProto -> DescriptorProto -> Bool
compare :: DescriptorProto -> DescriptorProto -> Ordering
$ccompare :: DescriptorProto -> DescriptorProto -> Ordering
$cp1Ord :: Eq DescriptorProto
Prelude'.Ord, Prelude'.Typeable, Typeable DescriptorProto
DataType
Constr
Typeable DescriptorProto
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DescriptorProto -> c DescriptorProto)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DescriptorProto)
-> (DescriptorProto -> Constr)
-> (DescriptorProto -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DescriptorProto))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DescriptorProto))
-> ((forall b. Data b => b -> b)
    -> DescriptorProto -> DescriptorProto)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DescriptorProto -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DescriptorProto -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DescriptorProto -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DescriptorProto -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DescriptorProto -> m DescriptorProto)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DescriptorProto -> m DescriptorProto)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DescriptorProto -> m DescriptorProto)
-> Data DescriptorProto
DescriptorProto -> DataType
DescriptorProto -> Constr
(forall b. Data b => b -> b) -> DescriptorProto -> DescriptorProto
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DescriptorProto -> c DescriptorProto
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DescriptorProto
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) -> DescriptorProto -> u
forall u. (forall d. Data d => d -> u) -> DescriptorProto -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DescriptorProto -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DescriptorProto -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DescriptorProto -> m DescriptorProto
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DescriptorProto -> m DescriptorProto
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DescriptorProto
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DescriptorProto -> c DescriptorProto
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DescriptorProto)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DescriptorProto)
$cDescriptorProto :: Constr
$tDescriptorProto :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DescriptorProto -> m DescriptorProto
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DescriptorProto -> m DescriptorProto
gmapMp :: (forall d. Data d => d -> m d)
-> DescriptorProto -> m DescriptorProto
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DescriptorProto -> m DescriptorProto
gmapM :: (forall d. Data d => d -> m d)
-> DescriptorProto -> m DescriptorProto
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DescriptorProto -> m DescriptorProto
gmapQi :: Int -> (forall d. Data d => d -> u) -> DescriptorProto -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DescriptorProto -> u
gmapQ :: (forall d. Data d => d -> u) -> DescriptorProto -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DescriptorProto -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DescriptorProto -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DescriptorProto -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DescriptorProto -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DescriptorProto -> r
gmapT :: (forall b. Data b => b -> b) -> DescriptorProto -> DescriptorProto
$cgmapT :: (forall b. Data b => b -> b) -> DescriptorProto -> DescriptorProto
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DescriptorProto)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DescriptorProto)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DescriptorProto)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DescriptorProto)
dataTypeOf :: DescriptorProto -> DataType
$cdataTypeOf :: DescriptorProto -> DataType
toConstr :: DescriptorProto -> Constr
$ctoConstr :: DescriptorProto -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DescriptorProto
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DescriptorProto
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DescriptorProto -> c DescriptorProto
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DescriptorProto -> c DescriptorProto
$cp1Data :: Typeable DescriptorProto
Prelude'.Data, (forall x. DescriptorProto -> Rep DescriptorProto x)
-> (forall x. Rep DescriptorProto x -> DescriptorProto)
-> Generic DescriptorProto
forall x. Rep DescriptorProto x -> DescriptorProto
forall x. DescriptorProto -> Rep DescriptorProto x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescriptorProto x -> DescriptorProto
$cfrom :: forall x. DescriptorProto -> Rep DescriptorProto x
Prelude'.Generic)

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

instance P'.Mergeable DescriptorProto where
  mergeAppend :: DescriptorProto -> DescriptorProto -> DescriptorProto
mergeAppend (DescriptorProto Maybe Utf8
x'1 Seq FieldDescriptorProto
x'2 Seq FieldDescriptorProto
x'3 Seq DescriptorProto
x'4 Seq EnumDescriptorProto
x'5 Seq ExtensionRange
x'6 Seq OneofDescriptorProto
x'7 Maybe MessageOptions
x'8 Seq ReservedRange
x'9 Seq Utf8
x'10 UnknownField
x'11)
   (DescriptorProto Maybe Utf8
y'1 Seq FieldDescriptorProto
y'2 Seq FieldDescriptorProto
y'3 Seq DescriptorProto
y'4 Seq EnumDescriptorProto
y'5 Seq ExtensionRange
y'6 Seq OneofDescriptorProto
y'7 Maybe MessageOptions
y'8 Seq ReservedRange
y'9 Seq Utf8
y'10 UnknownField
y'11)
   = let !z'1 :: Maybe Utf8
z'1 = Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'1 Maybe Utf8
y'1
         !z'2 :: Seq FieldDescriptorProto
z'2 = Seq FieldDescriptorProto
-> Seq FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq FieldDescriptorProto
x'2 Seq FieldDescriptorProto
y'2
         !z'3 :: Seq FieldDescriptorProto
z'3 = Seq FieldDescriptorProto
-> Seq FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq FieldDescriptorProto
x'3 Seq FieldDescriptorProto
y'3
         !z'4 :: Seq DescriptorProto
z'4 = Seq DescriptorProto -> Seq DescriptorProto -> Seq DescriptorProto
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq DescriptorProto
x'4 Seq DescriptorProto
y'4
         !z'5 :: Seq EnumDescriptorProto
z'5 = Seq EnumDescriptorProto
-> Seq EnumDescriptorProto -> Seq EnumDescriptorProto
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq EnumDescriptorProto
x'5 Seq EnumDescriptorProto
y'5
         !z'6 :: Seq ExtensionRange
z'6 = Seq ExtensionRange -> Seq ExtensionRange -> Seq ExtensionRange
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq ExtensionRange
x'6 Seq ExtensionRange
y'6
         !z'7 :: Seq OneofDescriptorProto
z'7 = Seq OneofDescriptorProto
-> Seq OneofDescriptorProto -> Seq OneofDescriptorProto
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq OneofDescriptorProto
x'7 Seq OneofDescriptorProto
y'7
         !z'8 :: Maybe MessageOptions
z'8 = Maybe MessageOptions
-> Maybe MessageOptions -> Maybe MessageOptions
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe MessageOptions
x'8 Maybe MessageOptions
y'8
         !z'9 :: Seq ReservedRange
z'9 = Seq ReservedRange -> Seq ReservedRange -> Seq ReservedRange
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq ReservedRange
x'9 Seq ReservedRange
y'9
         !z'10 :: Seq Utf8
z'10 = Seq Utf8 -> Seq Utf8 -> Seq Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Utf8
x'10 Seq Utf8
y'10
         !z'11 :: UnknownField
z'11 = UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'11 UnknownField
y'11
      in Maybe Utf8
-> Seq FieldDescriptorProto
-> Seq FieldDescriptorProto
-> Seq DescriptorProto
-> Seq EnumDescriptorProto
-> Seq ExtensionRange
-> Seq OneofDescriptorProto
-> Maybe MessageOptions
-> Seq ReservedRange
-> Seq Utf8
-> UnknownField
-> DescriptorProto
DescriptorProto Maybe Utf8
z'1 Seq FieldDescriptorProto
z'2 Seq FieldDescriptorProto
z'3 Seq DescriptorProto
z'4 Seq EnumDescriptorProto
z'5 Seq ExtensionRange
z'6 Seq OneofDescriptorProto
z'7 Maybe MessageOptions
z'8 Seq ReservedRange
z'9 Seq Utf8
z'10 UnknownField
z'11

instance P'.Default DescriptorProto where
  defaultValue :: DescriptorProto
defaultValue
   = Maybe Utf8
-> Seq FieldDescriptorProto
-> Seq FieldDescriptorProto
-> Seq DescriptorProto
-> Seq EnumDescriptorProto
-> Seq ExtensionRange
-> Seq OneofDescriptorProto
-> Maybe MessageOptions
-> Seq ReservedRange
-> Seq Utf8
-> UnknownField
-> DescriptorProto
DescriptorProto Maybe Utf8
forall a. Default a => a
P'.defaultValue Seq FieldDescriptorProto
forall a. Default a => a
P'.defaultValue Seq FieldDescriptorProto
forall a. Default a => a
P'.defaultValue Seq DescriptorProto
forall a. Default a => a
P'.defaultValue Seq EnumDescriptorProto
forall a. Default a => a
P'.defaultValue Seq ExtensionRange
forall a. Default a => a
P'.defaultValue Seq OneofDescriptorProto
forall a. Default a => a
P'.defaultValue
      Maybe MessageOptions
forall a. Default a => a
P'.defaultValue
      Seq ReservedRange
forall a. Default a => a
P'.defaultValue
      Seq Utf8
forall a. Default a => a
P'.defaultValue
      UnknownField
forall a. Default a => a
P'.defaultValue

instance P'.Wire DescriptorProto where
  wireSize :: FieldType -> DescriptorProto -> WireSize
wireSize FieldType
ft' self' :: DescriptorProto
self'@(DescriptorProto Maybe Utf8
x'1 Seq FieldDescriptorProto
x'2 Seq FieldDescriptorProto
x'3 Seq DescriptorProto
x'4 Seq EnumDescriptorProto
x'5 Seq ExtensionRange
x'6 Seq OneofDescriptorProto
x'7 Maybe MessageOptions
x'8 Seq ReservedRange
x'9 Seq Utf8
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 -> DescriptorProto -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' DescriptorProto
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 -> Seq FieldDescriptorProto -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq FieldDescriptorProto
x'2 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq FieldDescriptorProto -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq FieldDescriptorProto
x'3 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq DescriptorProto -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq DescriptorProto
x'4 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+
             WireSize -> FieldType -> Seq EnumDescriptorProto -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq EnumDescriptorProto
x'5
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq ExtensionRange -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq ExtensionRange
x'6
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq OneofDescriptorProto -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq OneofDescriptorProto
x'7
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe MessageOptions -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
11 Maybe MessageOptions
x'8
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq ReservedRange -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq ReservedRange
x'9
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
9 Seq Utf8
x'10
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'11)
  wirePutWithSize :: FieldType -> DescriptorProto -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: DescriptorProto
self'@(DescriptorProto Maybe Utf8
x'1 Seq FieldDescriptorProto
x'2 Seq FieldDescriptorProto
x'3 Seq DescriptorProto
x'4 Seq EnumDescriptorProto
x'5 Seq ExtensionRange
x'6 Seq OneofDescriptorProto
x'7 Maybe MessageOptions
x'8 Seq ReservedRange
x'9 Seq Utf8
x'10 UnknownField
x'11)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> DescriptorProto -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' DescriptorProto
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 -> Seq FieldDescriptorProto -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
18 FieldType
11 Seq FieldDescriptorProto
x'2, WireTag -> FieldType -> Seq DescriptorProto -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
26 FieldType
11 Seq DescriptorProto
x'4,
             WireTag -> FieldType -> Seq EnumDescriptorProto -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
34 FieldType
11 Seq EnumDescriptorProto
x'5, WireTag -> FieldType -> Seq ExtensionRange -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
42 FieldType
11 Seq ExtensionRange
x'6, WireTag -> FieldType -> Seq FieldDescriptorProto -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
50 FieldType
11 Seq FieldDescriptorProto
x'3,
             WireTag -> FieldType -> Maybe MessageOptions -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
58 FieldType
11 Maybe MessageOptions
x'8, WireTag -> FieldType -> Seq OneofDescriptorProto -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
66 FieldType
11 Seq OneofDescriptorProto
x'7, WireTag -> FieldType -> Seq ReservedRange -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
74 FieldType
11 Seq ReservedRange
x'9,
             WireTag -> FieldType -> Seq Utf8 -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
82 FieldType
9 Seq Utf8
x'10, 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 DescriptorProto
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> DescriptorProto -> Get DescriptorProto)
-> Get DescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> DescriptorProto -> Get DescriptorProto)
-> (WireTag -> DescriptorProto -> Get DescriptorProto)
-> WireTag
-> DescriptorProto
-> Get DescriptorProto
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> DescriptorProto -> Get DescriptorProto
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> DescriptorProto -> Get DescriptorProto
update'Self)
       FieldType
11 -> (WireTag -> DescriptorProto -> Get DescriptorProto)
-> Get DescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> DescriptorProto -> Get DescriptorProto)
-> (WireTag -> DescriptorProto -> Get DescriptorProto)
-> WireTag
-> DescriptorProto
-> Get DescriptorProto
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> DescriptorProto -> Get DescriptorProto
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> DescriptorProto -> Get DescriptorProto
update'Self)
       FieldType
_ -> FieldType -> Get DescriptorProto
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> DescriptorProto -> Get DescriptorProto
update'Self WireTag
wire'Tag DescriptorProto
old'Self
         = case WireTag
wire'Tag of
             WireTag
10 -> (Utf8 -> DescriptorProto) -> Get Utf8 -> Get DescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> DescriptorProto
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
18 -> (FieldDescriptorProto -> DescriptorProto)
-> Get FieldDescriptorProto -> Get DescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !FieldDescriptorProto
new'Field -> DescriptorProto
old'Self{field :: Seq FieldDescriptorProto
field = Seq FieldDescriptorProto
-> FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq FieldDescriptorProto
field DescriptorProto
old'Self) FieldDescriptorProto
new'Field}) (FieldType -> Get FieldDescriptorProto
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
50 -> (FieldDescriptorProto -> DescriptorProto)
-> Get FieldDescriptorProto -> Get DescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !FieldDescriptorProto
new'Field -> DescriptorProto
old'Self{extension :: Seq FieldDescriptorProto
extension = Seq FieldDescriptorProto
-> FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq FieldDescriptorProto
extension DescriptorProto
old'Self) FieldDescriptorProto
new'Field}) (FieldType -> Get FieldDescriptorProto
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
26 -> (DescriptorProto -> DescriptorProto)
-> Get DescriptorProto -> Get DescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !DescriptorProto
new'Field -> DescriptorProto
old'Self{nested_type :: Seq DescriptorProto
nested_type = Seq DescriptorProto -> DescriptorProto -> Seq DescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq DescriptorProto
nested_type DescriptorProto
old'Self) DescriptorProto
new'Field})
                    (FieldType -> Get DescriptorProto
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
34 -> (EnumDescriptorProto -> DescriptorProto)
-> Get EnumDescriptorProto -> Get DescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !EnumDescriptorProto
new'Field -> DescriptorProto
old'Self{enum_type :: Seq EnumDescriptorProto
enum_type = Seq EnumDescriptorProto
-> EnumDescriptorProto -> Seq EnumDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq EnumDescriptorProto
enum_type DescriptorProto
old'Self) EnumDescriptorProto
new'Field}) (FieldType -> Get EnumDescriptorProto
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
42 -> (ExtensionRange -> DescriptorProto)
-> Get ExtensionRange -> Get DescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !ExtensionRange
new'Field -> DescriptorProto
old'Self{extension_range :: Seq ExtensionRange
extension_range = Seq ExtensionRange -> ExtensionRange -> Seq ExtensionRange
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq ExtensionRange
extension_range DescriptorProto
old'Self) ExtensionRange
new'Field})
                    (FieldType -> Get ExtensionRange
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
66 -> (OneofDescriptorProto -> DescriptorProto)
-> Get OneofDescriptorProto -> Get DescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !OneofDescriptorProto
new'Field -> DescriptorProto
old'Self{oneof_decl :: Seq OneofDescriptorProto
oneof_decl = Seq OneofDescriptorProto
-> OneofDescriptorProto -> Seq OneofDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq OneofDescriptorProto
oneof_decl DescriptorProto
old'Self) OneofDescriptorProto
new'Field}) (FieldType -> Get OneofDescriptorProto
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
58 -> (MessageOptions -> DescriptorProto)
-> Get MessageOptions -> Get DescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !MessageOptions
new'Field -> DescriptorProto
old'Self{options :: Maybe MessageOptions
options = Maybe MessageOptions
-> Maybe MessageOptions -> Maybe MessageOptions
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (DescriptorProto -> Maybe MessageOptions
options DescriptorProto
old'Self) (MessageOptions -> Maybe MessageOptions
forall a. a -> Maybe a
Prelude'.Just MessageOptions
new'Field)})
                    (FieldType -> Get MessageOptions
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
74 -> (ReservedRange -> DescriptorProto)
-> Get ReservedRange -> Get DescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !ReservedRange
new'Field -> DescriptorProto
old'Self{reserved_range :: Seq ReservedRange
reserved_range = Seq ReservedRange -> ReservedRange -> Seq ReservedRange
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq ReservedRange
reserved_range DescriptorProto
old'Self) ReservedRange
new'Field})
                    (FieldType -> Get ReservedRange
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
82 -> (Utf8 -> DescriptorProto) -> Get Utf8 -> Get DescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> DescriptorProto
old'Self{reserved_name :: Seq Utf8
reserved_name = Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq Utf8
reserved_name DescriptorProto
old'Self) Utf8
new'Field})
                    (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
_ -> let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag in FieldId -> WireType -> DescriptorProto -> Get DescriptorProto
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type DescriptorProto
old'Self

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

instance P'.GPB DescriptorProto

instance P'.ReflectDescriptor DescriptorProto where
  getMessageInfo :: DescriptorProto -> GetMessageInfo
getMessageInfo DescriptorProto
_ = 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
26, WireTag
34, WireTag
42, WireTag
50, WireTag
58, WireTag
66, WireTag
74, WireTag
82])
  reflectDescriptorInfo :: DescriptorProto -> DescriptorInfo
reflectDescriptorInfo DescriptorProto
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.DescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"DescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"DescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.DescriptorProto.name\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], 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.DescriptorProto.field\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName' = FName \"field\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.FieldDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"FieldDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.DescriptorProto.extension\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName' = FName \"extension\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.FieldDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"FieldDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.DescriptorProto.nested_type\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName' = FName \"nested_type\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.DescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"DescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.DescriptorProto.enum_type\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName' = FName \"enum_type\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.EnumDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"EnumDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.DescriptorProto.extension_range\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName' = FName \"extension_range\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.DescriptorProto.ExtensionRange\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName = MName \"ExtensionRange\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.DescriptorProto.oneof_decl\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName' = FName \"oneof_decl\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.OneofDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"OneofDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.DescriptorProto.options\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName' = FName \"options\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.MessageOptions\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"MessageOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.DescriptorProto.reserved_range\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName' = FName \"reserved_range\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 74}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.DescriptorProto.ReservedRange\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName = MName \"ReservedRange\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.DescriptorProto.reserved_name\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"DescriptorProto\"], baseName' = FName \"reserved_name\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 82}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = True, lazyFields = False, makeLenses = False, jsonInstances = False}"

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

instance P'.TextMsg DescriptorProto where
  textPut :: DescriptorProto -> Output
textPut DescriptorProto
msg
   = do
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"name" (DescriptorProto -> Maybe Utf8
name DescriptorProto
msg)
       String -> Seq FieldDescriptorProto -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"field" (DescriptorProto -> Seq FieldDescriptorProto
field DescriptorProto
msg)
       String -> Seq FieldDescriptorProto -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"extension" (DescriptorProto -> Seq FieldDescriptorProto
extension DescriptorProto
msg)
       String -> Seq DescriptorProto -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"nested_type" (DescriptorProto -> Seq DescriptorProto
nested_type DescriptorProto
msg)
       String -> Seq EnumDescriptorProto -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"enum_type" (DescriptorProto -> Seq EnumDescriptorProto
enum_type DescriptorProto
msg)
       String -> Seq ExtensionRange -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"extension_range" (DescriptorProto -> Seq ExtensionRange
extension_range DescriptorProto
msg)
       String -> Seq OneofDescriptorProto -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"oneof_decl" (DescriptorProto -> Seq OneofDescriptorProto
oneof_decl DescriptorProto
msg)
       String -> Maybe MessageOptions -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"options" (DescriptorProto -> Maybe MessageOptions
options DescriptorProto
msg)
       String -> Seq ReservedRange -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"reserved_range" (DescriptorProto -> Seq ReservedRange
reserved_range DescriptorProto
msg)
       String -> Seq Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"reserved_name" (DescriptorProto -> Seq Utf8
reserved_name DescriptorProto
msg)
  textGet :: Parsec s () DescriptorProto
textGet
   = do
       [DescriptorProto -> DescriptorProto]
mods <- ParsecT s () Identity (DescriptorProto -> DescriptorProto)
-> ParsecT s () Identity ()
-> ParsecT s () Identity [DescriptorProto -> DescriptorProto]
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 (DescriptorProto -> DescriptorProto)]
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
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 (DescriptorProto -> DescriptorProto)
parse'name, ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'field, ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'extension, ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'nested_type, ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'enum_type, ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'extension_range,
                   ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'oneof_decl, ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'options, ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'reserved_range, ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'reserved_name])
                ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
       DescriptorProto -> Parsec s () DescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((DescriptorProto
 -> (DescriptorProto -> DescriptorProto) -> DescriptorProto)
-> DescriptorProto
-> [DescriptorProto -> DescriptorProto]
-> DescriptorProto
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl' (\ DescriptorProto
v DescriptorProto -> DescriptorProto
f -> DescriptorProto -> DescriptorProto
f DescriptorProto
v) DescriptorProto
forall a. Default a => a
P'.defaultValue [DescriptorProto -> DescriptorProto]
mods)
    where
        parse'name :: ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'name = (Maybe Utf8 -> DescriptorProto -> DescriptorProto)
-> ParsecT s () Identity (Maybe Utf8)
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Utf8
v DescriptorProto
o -> DescriptorProto
o{name :: Maybe Utf8
name = Maybe Utf8
v}) (ParsecT s () Identity (Maybe Utf8)
-> ParsecT s () Identity (Maybe Utf8)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"name"))
        parse'field :: ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'field = (FieldDescriptorProto -> DescriptorProto -> DescriptorProto)
-> ParsecT s () Identity FieldDescriptorProto
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ FieldDescriptorProto
v DescriptorProto
o -> DescriptorProto
o{field :: Seq FieldDescriptorProto
field = Seq FieldDescriptorProto
-> FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq FieldDescriptorProto
field DescriptorProto
o) FieldDescriptorProto
v}) (ParsecT s () Identity FieldDescriptorProto
-> ParsecT s () Identity FieldDescriptorProto
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity FieldDescriptorProto
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"field"))
        parse'extension :: ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'extension = (FieldDescriptorProto -> DescriptorProto -> DescriptorProto)
-> ParsecT s () Identity FieldDescriptorProto
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ FieldDescriptorProto
v DescriptorProto
o -> DescriptorProto
o{extension :: Seq FieldDescriptorProto
extension = Seq FieldDescriptorProto
-> FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq FieldDescriptorProto
extension DescriptorProto
o) FieldDescriptorProto
v}) (ParsecT s () Identity FieldDescriptorProto
-> ParsecT s () Identity FieldDescriptorProto
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity FieldDescriptorProto
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"extension"))
        parse'nested_type :: ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'nested_type = (DescriptorProto -> DescriptorProto -> DescriptorProto)
-> Parsec s () DescriptorProto
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ DescriptorProto
v DescriptorProto
o -> DescriptorProto
o{nested_type :: Seq DescriptorProto
nested_type = Seq DescriptorProto -> DescriptorProto -> Seq DescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq DescriptorProto
nested_type DescriptorProto
o) DescriptorProto
v}) (Parsec s () DescriptorProto -> Parsec s () DescriptorProto
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> Parsec s () DescriptorProto
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"nested_type"))
        parse'enum_type :: ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'enum_type = (EnumDescriptorProto -> DescriptorProto -> DescriptorProto)
-> ParsecT s () Identity EnumDescriptorProto
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ EnumDescriptorProto
v DescriptorProto
o -> DescriptorProto
o{enum_type :: Seq EnumDescriptorProto
enum_type = Seq EnumDescriptorProto
-> EnumDescriptorProto -> Seq EnumDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq EnumDescriptorProto
enum_type DescriptorProto
o) EnumDescriptorProto
v}) (ParsecT s () Identity EnumDescriptorProto
-> ParsecT s () Identity EnumDescriptorProto
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity EnumDescriptorProto
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"enum_type"))
        parse'extension_range :: ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'extension_range
         = (ExtensionRange -> DescriptorProto -> DescriptorProto)
-> ParsecT s () Identity ExtensionRange
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ ExtensionRange
v DescriptorProto
o -> DescriptorProto
o{extension_range :: Seq ExtensionRange
extension_range = Seq ExtensionRange -> ExtensionRange -> Seq ExtensionRange
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq ExtensionRange
extension_range DescriptorProto
o) ExtensionRange
v}) (ParsecT s () Identity ExtensionRange
-> ParsecT s () Identity ExtensionRange
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity ExtensionRange
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"extension_range"))
        parse'oneof_decl :: ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'oneof_decl = (OneofDescriptorProto -> DescriptorProto -> DescriptorProto)
-> ParsecT s () Identity OneofDescriptorProto
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ OneofDescriptorProto
v DescriptorProto
o -> DescriptorProto
o{oneof_decl :: Seq OneofDescriptorProto
oneof_decl = Seq OneofDescriptorProto
-> OneofDescriptorProto -> Seq OneofDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq OneofDescriptorProto
oneof_decl DescriptorProto
o) OneofDescriptorProto
v}) (ParsecT s () Identity OneofDescriptorProto
-> ParsecT s () Identity OneofDescriptorProto
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity OneofDescriptorProto
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"oneof_decl"))
        parse'options :: ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'options = (Maybe MessageOptions -> DescriptorProto -> DescriptorProto)
-> ParsecT s () Identity (Maybe MessageOptions)
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe MessageOptions
v DescriptorProto
o -> DescriptorProto
o{options :: Maybe MessageOptions
options = Maybe MessageOptions
v}) (ParsecT s () Identity (Maybe MessageOptions)
-> ParsecT s () Identity (Maybe MessageOptions)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe MessageOptions)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"options"))
        parse'reserved_range :: ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'reserved_range
         = (ReservedRange -> DescriptorProto -> DescriptorProto)
-> ParsecT s () Identity ReservedRange
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ ReservedRange
v DescriptorProto
o -> DescriptorProto
o{reserved_range :: Seq ReservedRange
reserved_range = Seq ReservedRange -> ReservedRange -> Seq ReservedRange
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq ReservedRange
reserved_range DescriptorProto
o) ReservedRange
v}) (ParsecT s () Identity ReservedRange
-> ParsecT s () Identity ReservedRange
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity ReservedRange
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"reserved_range"))
        parse'reserved_name :: ParsecT s () Identity (DescriptorProto -> DescriptorProto)
parse'reserved_name
         = (Utf8 -> DescriptorProto -> DescriptorProto)
-> ParsecT s () Identity Utf8
-> ParsecT s () Identity (DescriptorProto -> DescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Utf8
v DescriptorProto
o -> DescriptorProto
o{reserved_name :: Seq Utf8
reserved_name = Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
P'.append (DescriptorProto -> Seq Utf8
reserved_name DescriptorProto
o) Utf8
v}) (ParsecT s () Identity Utf8 -> ParsecT s () Identity Utf8
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity Utf8
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"reserved_name"))