{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}
{-# OPTIONS_GHC  -w #-}
module Text.DescriptorProtos.FileDescriptorProto (FileDescriptorProto(..)) 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 as DescriptorProtos (DescriptorProto)
import qualified Text.DescriptorProtos.EnumDescriptorProto as DescriptorProtos (EnumDescriptorProto)
import qualified Text.DescriptorProtos.FieldDescriptorProto as DescriptorProtos (FieldDescriptorProto)
import qualified Text.DescriptorProtos.FileOptions as DescriptorProtos (FileOptions)
import qualified Text.DescriptorProtos.ServiceDescriptorProto as DescriptorProtos (ServiceDescriptorProto)
import qualified Text.DescriptorProtos.SourceCodeInfo as DescriptorProtos (SourceCodeInfo)

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

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

instance P'.Mergeable FileDescriptorProto where
  mergeAppend :: FileDescriptorProto -> FileDescriptorProto -> FileDescriptorProto
mergeAppend (FileDescriptorProto Maybe Utf8
x'1 Maybe Utf8
x'2 Seq Utf8
x'3 Seq Int32
x'4 Seq Int32
x'5 Seq DescriptorProto
x'6 Seq EnumDescriptorProto
x'7 Seq ServiceDescriptorProto
x'8 Seq FieldDescriptorProto
x'9 Maybe FileOptions
x'10 Maybe SourceCodeInfo
x'11 Maybe Utf8
x'12 UnknownField
x'13)
   (FileDescriptorProto Maybe Utf8
y'1 Maybe Utf8
y'2 Seq Utf8
y'3 Seq Int32
y'4 Seq Int32
y'5 Seq DescriptorProto
y'6 Seq EnumDescriptorProto
y'7 Seq ServiceDescriptorProto
y'8 Seq FieldDescriptorProto
y'9 Maybe FileOptions
y'10 Maybe SourceCodeInfo
y'11 Maybe Utf8
y'12 UnknownField
y'13)
   = 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 :: Maybe Utf8
z'2 = Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'2 Maybe Utf8
y'2
         !z'3 :: Seq Utf8
z'3 = Seq Utf8 -> Seq Utf8 -> Seq Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Utf8
x'3 Seq Utf8
y'3
         !z'4 :: Seq Int32
z'4 = Seq Int32 -> Seq Int32 -> Seq Int32
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Int32
x'4 Seq Int32
y'4
         !z'5 :: Seq Int32
z'5 = Seq Int32 -> Seq Int32 -> Seq Int32
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Int32
x'5 Seq Int32
y'5
         !z'6 :: Seq DescriptorProto
z'6 = Seq DescriptorProto -> Seq DescriptorProto -> Seq DescriptorProto
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq DescriptorProto
x'6 Seq DescriptorProto
y'6
         !z'7 :: Seq EnumDescriptorProto
z'7 = Seq EnumDescriptorProto
-> Seq EnumDescriptorProto -> Seq EnumDescriptorProto
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq EnumDescriptorProto
x'7 Seq EnumDescriptorProto
y'7
         !z'8 :: Seq ServiceDescriptorProto
z'8 = Seq ServiceDescriptorProto
-> Seq ServiceDescriptorProto -> Seq ServiceDescriptorProto
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq ServiceDescriptorProto
x'8 Seq ServiceDescriptorProto
y'8
         !z'9 :: Seq FieldDescriptorProto
z'9 = Seq FieldDescriptorProto
-> Seq FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq FieldDescriptorProto
x'9 Seq FieldDescriptorProto
y'9
         !z'10 :: Maybe FileOptions
z'10 = Maybe FileOptions -> Maybe FileOptions -> Maybe FileOptions
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe FileOptions
x'10 Maybe FileOptions
y'10
         !z'11 :: Maybe SourceCodeInfo
z'11 = Maybe SourceCodeInfo
-> Maybe SourceCodeInfo -> Maybe SourceCodeInfo
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe SourceCodeInfo
x'11 Maybe SourceCodeInfo
y'11
         !z'12 :: Maybe Utf8
z'12 = Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'12 Maybe Utf8
y'12
         !z'13 :: UnknownField
z'13 = UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'13 UnknownField
y'13
      in Maybe Utf8
-> Maybe Utf8
-> Seq Utf8
-> Seq Int32
-> Seq Int32
-> Seq DescriptorProto
-> Seq EnumDescriptorProto
-> Seq ServiceDescriptorProto
-> Seq FieldDescriptorProto
-> Maybe FileOptions
-> Maybe SourceCodeInfo
-> Maybe Utf8
-> UnknownField
-> FileDescriptorProto
FileDescriptorProto Maybe Utf8
z'1 Maybe Utf8
z'2 Seq Utf8
z'3 Seq Int32
z'4 Seq Int32
z'5 Seq DescriptorProto
z'6 Seq EnumDescriptorProto
z'7 Seq ServiceDescriptorProto
z'8 Seq FieldDescriptorProto
z'9 Maybe FileOptions
z'10 Maybe SourceCodeInfo
z'11 Maybe Utf8
z'12 UnknownField
z'13

instance P'.Default FileDescriptorProto where
  defaultValue :: FileDescriptorProto
defaultValue
   = Maybe Utf8
-> Maybe Utf8
-> Seq Utf8
-> Seq Int32
-> Seq Int32
-> Seq DescriptorProto
-> Seq EnumDescriptorProto
-> Seq ServiceDescriptorProto
-> Seq FieldDescriptorProto
-> Maybe FileOptions
-> Maybe SourceCodeInfo
-> Maybe Utf8
-> UnknownField
-> FileDescriptorProto
FileDescriptorProto Maybe Utf8
forall a. Default a => a
P'.defaultValue Maybe Utf8
forall a. Default a => a
P'.defaultValue Seq Utf8
forall a. Default a => a
P'.defaultValue Seq Int32
forall a. Default a => a
P'.defaultValue Seq Int32
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 ServiceDescriptorProto
forall a. Default a => a
P'.defaultValue
      Seq FieldDescriptorProto
forall a. Default a => a
P'.defaultValue
      Maybe FileOptions
forall a. Default a => a
P'.defaultValue
      Maybe SourceCodeInfo
forall a. Default a => a
P'.defaultValue
      Maybe Utf8
forall a. Default a => a
P'.defaultValue
      UnknownField
forall a. Default a => a
P'.defaultValue

instance P'.Wire FileDescriptorProto where
  wireSize :: FieldType -> FileDescriptorProto -> WireSize
wireSize FieldType
ft' self' :: FileDescriptorProto
self'@(FileDescriptorProto Maybe Utf8
x'1 Maybe Utf8
x'2 Seq Utf8
x'3 Seq Int32
x'4 Seq Int32
x'5 Seq DescriptorProto
x'6 Seq EnumDescriptorProto
x'7 Seq ServiceDescriptorProto
x'8 Seq FieldDescriptorProto
x'9 Maybe FileOptions
x'10 Maybe SourceCodeInfo
x'11 Maybe Utf8
x'12 UnknownField
x'13)
   = case FieldType
ft' of
       FieldType
10 -> WireSize
calc'Size
       FieldType
11 -> WireSize -> WireSize
P'.prependMessageSize WireSize
calc'Size
       FieldType
_ -> FieldType -> FileDescriptorProto -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' FileDescriptorProto
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 Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'2 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'3 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq Int32 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
5 Seq Int32
x'4 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+
             WireSize -> FieldType -> Seq Int32 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
5 Seq Int32
x'5
             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'6
             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'7
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq ServiceDescriptorProto -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq ServiceDescriptorProto
x'8
             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'9
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe FileOptions -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
11 Maybe FileOptions
x'10
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe SourceCodeInfo -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
11 Maybe SourceCodeInfo
x'11
             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'12
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'13)
  wirePutWithSize :: FieldType -> FileDescriptorProto -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: FileDescriptorProto
self'@(FileDescriptorProto Maybe Utf8
x'1 Maybe Utf8
x'2 Seq Utf8
x'3 Seq Int32
x'4 Seq Int32
x'5 Seq DescriptorProto
x'6 Seq EnumDescriptorProto
x'7 Seq ServiceDescriptorProto
x'8 Seq FieldDescriptorProto
x'9 Maybe FileOptions
x'10 Maybe SourceCodeInfo
x'11 Maybe Utf8
x'12 UnknownField
x'13)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> FileDescriptorProto -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' FileDescriptorProto
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'2, WireTag -> FieldType -> Seq Utf8 -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
26 FieldType
9 Seq Utf8
x'3,
             WireTag -> FieldType -> Seq DescriptorProto -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
34 FieldType
11 Seq DescriptorProto
x'6, WireTag -> FieldType -> Seq EnumDescriptorProto -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
42 FieldType
11 Seq EnumDescriptorProto
x'7, WireTag -> FieldType -> Seq ServiceDescriptorProto -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
50 FieldType
11 Seq ServiceDescriptorProto
x'8,
             WireTag -> FieldType -> Seq FieldDescriptorProto -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
58 FieldType
11 Seq FieldDescriptorProto
x'9, WireTag -> FieldType -> Maybe FileOptions -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
66 FieldType
11 Maybe FileOptions
x'10, WireTag -> FieldType -> Maybe SourceCodeInfo -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
74 FieldType
11 Maybe SourceCodeInfo
x'11,
             WireTag -> FieldType -> Seq Int32 -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
80 FieldType
5 Seq Int32
x'4, WireTag -> FieldType -> Seq Int32 -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
88 FieldType
5 Seq Int32
x'5, WireTag -> FieldType -> Maybe Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
98 FieldType
9 Maybe Utf8
x'12,
             UnknownField -> PutM WireSize
P'.wirePutUnknownFieldWithSize UnknownField
x'13]
        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 FileDescriptorProto
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> FileDescriptorProto -> Get FileDescriptorProto)
-> Get FileDescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> FileDescriptorProto -> Get FileDescriptorProto)
-> (WireTag -> FileDescriptorProto -> Get FileDescriptorProto)
-> WireTag
-> FileDescriptorProto
-> Get FileDescriptorProto
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> FileDescriptorProto -> Get FileDescriptorProto
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> FileDescriptorProto -> Get FileDescriptorProto
update'Self)
       FieldType
11 -> (WireTag -> FileDescriptorProto -> Get FileDescriptorProto)
-> Get FileDescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> FileDescriptorProto -> Get FileDescriptorProto)
-> (WireTag -> FileDescriptorProto -> Get FileDescriptorProto)
-> WireTag
-> FileDescriptorProto
-> Get FileDescriptorProto
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> FileDescriptorProto -> Get FileDescriptorProto
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> FileDescriptorProto -> Get FileDescriptorProto
update'Self)
       FieldType
_ -> FieldType -> Get FileDescriptorProto
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> FileDescriptorProto -> Get FileDescriptorProto
update'Self WireTag
wire'Tag FileDescriptorProto
old'Self
         = case WireTag
wire'Tag of
             WireTag
10 -> (Utf8 -> FileDescriptorProto)
-> Get Utf8 -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> FileDescriptorProto
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 -> (Utf8 -> FileDescriptorProto)
-> Get Utf8 -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> FileDescriptorProto
old'Self{package :: Maybe Utf8
package = 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
26 -> (Utf8 -> FileDescriptorProto)
-> Get Utf8 -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> FileDescriptorProto
old'Self{dependency :: Seq Utf8
dependency = Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq Utf8
dependency FileDescriptorProto
old'Self) Utf8
new'Field}) (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
80 -> (Int32 -> FileDescriptorProto)
-> Get Int32 -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Int32
new'Field -> FileDescriptorProto
old'Self{public_dependency :: Seq Int32
public_dependency = Seq Int32 -> Int32 -> Seq Int32
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq Int32
public_dependency FileDescriptorProto
old'Self) Int32
new'Field})
                    (FieldType -> Get Int32
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
5)
             WireTag
82 -> (Seq Int32 -> FileDescriptorProto)
-> Get (Seq Int32) -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
                    (\ !Seq Int32
new'Field -> FileDescriptorProto
old'Self{public_dependency :: Seq Int32
public_dependency = Seq Int32 -> Seq Int32 -> Seq Int32
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (FileDescriptorProto -> Seq Int32
public_dependency FileDescriptorProto
old'Self) Seq Int32
new'Field})
                    (FieldType -> Get (Seq Int32)
forall b. Wire b => FieldType -> Get (Seq b)
P'.wireGetPacked FieldType
5)
             WireTag
88 -> (Int32 -> FileDescriptorProto)
-> Get Int32 -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Int32
new'Field -> FileDescriptorProto
old'Self{weak_dependency :: Seq Int32
weak_dependency = Seq Int32 -> Int32 -> Seq Int32
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq Int32
weak_dependency FileDescriptorProto
old'Self) Int32
new'Field})
                    (FieldType -> Get Int32
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
5)
             WireTag
90 -> (Seq Int32 -> FileDescriptorProto)
-> Get (Seq Int32) -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Seq Int32
new'Field -> FileDescriptorProto
old'Self{weak_dependency :: Seq Int32
weak_dependency = Seq Int32 -> Seq Int32 -> Seq Int32
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (FileDescriptorProto -> Seq Int32
weak_dependency FileDescriptorProto
old'Self) Seq Int32
new'Field})
                    (FieldType -> Get (Seq Int32)
forall b. Wire b => FieldType -> Get (Seq b)
P'.wireGetPacked FieldType
5)
             WireTag
34 -> (DescriptorProto -> FileDescriptorProto)
-> Get DescriptorProto -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !DescriptorProto
new'Field -> FileDescriptorProto
old'Self{message_type :: Seq DescriptorProto
message_type = Seq DescriptorProto -> DescriptorProto -> Seq DescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq DescriptorProto
message_type FileDescriptorProto
old'Self) DescriptorProto
new'Field})
                    (FieldType -> Get DescriptorProto
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
42 -> (EnumDescriptorProto -> FileDescriptorProto)
-> Get EnumDescriptorProto -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !EnumDescriptorProto
new'Field -> FileDescriptorProto
old'Self{enum_type :: Seq EnumDescriptorProto
enum_type = Seq EnumDescriptorProto
-> EnumDescriptorProto -> Seq EnumDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq EnumDescriptorProto
enum_type FileDescriptorProto
old'Self) EnumDescriptorProto
new'Field}) (FieldType -> Get EnumDescriptorProto
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
50 -> (ServiceDescriptorProto -> FileDescriptorProto)
-> Get ServiceDescriptorProto -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !ServiceDescriptorProto
new'Field -> FileDescriptorProto
old'Self{service :: Seq ServiceDescriptorProto
service = Seq ServiceDescriptorProto
-> ServiceDescriptorProto -> Seq ServiceDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq ServiceDescriptorProto
service FileDescriptorProto
old'Self) ServiceDescriptorProto
new'Field}) (FieldType -> Get ServiceDescriptorProto
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
58 -> (FieldDescriptorProto -> FileDescriptorProto)
-> Get FieldDescriptorProto -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !FieldDescriptorProto
new'Field -> FileDescriptorProto
old'Self{extension :: Seq FieldDescriptorProto
extension = Seq FieldDescriptorProto
-> FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq FieldDescriptorProto
extension FileDescriptorProto
old'Self) FieldDescriptorProto
new'Field}) (FieldType -> Get FieldDescriptorProto
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
66 -> (FileOptions -> FileDescriptorProto)
-> Get FileOptions -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !FileOptions
new'Field -> FileDescriptorProto
old'Self{options :: Maybe FileOptions
options = Maybe FileOptions -> Maybe FileOptions -> Maybe FileOptions
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (FileDescriptorProto -> Maybe FileOptions
options FileDescriptorProto
old'Self) (FileOptions -> Maybe FileOptions
forall a. a -> Maybe a
Prelude'.Just FileOptions
new'Field)})
                    (FieldType -> Get FileOptions
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
74 -> (SourceCodeInfo -> FileDescriptorProto)
-> Get SourceCodeInfo -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
                    (\ !SourceCodeInfo
new'Field ->
                      FileDescriptorProto
old'Self{source_code_info :: Maybe SourceCodeInfo
source_code_info = Maybe SourceCodeInfo
-> Maybe SourceCodeInfo -> Maybe SourceCodeInfo
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (FileDescriptorProto -> Maybe SourceCodeInfo
source_code_info FileDescriptorProto
old'Self) (SourceCodeInfo -> Maybe SourceCodeInfo
forall a. a -> Maybe a
Prelude'.Just SourceCodeInfo
new'Field)})
                    (FieldType -> Get SourceCodeInfo
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
98 -> (Utf8 -> FileDescriptorProto)
-> Get Utf8 -> Get FileDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> FileDescriptorProto
old'Self{syntax :: Maybe Utf8
syntax = 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
_ -> let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag in FieldId
-> WireType -> FileDescriptorProto -> Get FileDescriptorProto
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type FileDescriptorProto
old'Self

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

instance P'.GPB FileDescriptorProto

instance P'.ReflectDescriptor FileDescriptorProto where
  getMessageInfo :: FileDescriptorProto -> GetMessageInfo
getMessageInfo FileDescriptorProto
_
   = 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
80, WireTag
82, WireTag
88, WireTag
90, WireTag
98])
  reflectDescriptorInfo :: FileDescriptorProto -> DescriptorInfo
reflectDescriptorInfo FileDescriptorProto
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.FileDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"FileDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FileDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FileDescriptorProto.name\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], 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.FileDescriptorProto.package\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], baseName' = FName \"package\", 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.FileDescriptorProto.dependency\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], baseName' = FName \"dependency\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FileDescriptorProto.public_dependency\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], baseName' = FName \"public_dependency\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 80}, packedTag = Just (WireTag {getWireTag = 80},WireTag {getWireTag = 82}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FileDescriptorProto.weak_dependency\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], baseName' = FName \"weak_dependency\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 11}, wireTag = WireTag {getWireTag = 88}, packedTag = Just (WireTag {getWireTag = 88},WireTag {getWireTag = 90}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FileDescriptorProto.message_type\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], baseName' = FName \"message_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.DescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"DescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FileDescriptorProto.enum_type\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], baseName' = FName \"enum_type\", 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.EnumDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"EnumDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FileDescriptorProto.service\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], baseName' = FName \"service\", 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.ServiceDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"ServiceDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FileDescriptorProto.extension\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], baseName' = FName \"extension\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, 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.FileDescriptorProto.options\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], 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.FileOptions\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"FileOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FileDescriptorProto.source_code_info\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], baseName' = FName \"source_code_info\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 74}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.SourceCodeInfo\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"SourceCodeInfo\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FileDescriptorProto.syntax\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FileDescriptorProto\"], baseName' = FName \"syntax\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 12}, wireTag = WireTag {getWireTag = 98}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, 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 FileDescriptorProto where
  tellT :: String -> FileDescriptorProto -> Output
tellT = String -> FileDescriptorProto -> Output
forall a. TextMsg a => String -> a -> Output
P'.tellSubMessage
  getT :: String -> Parsec s () FileDescriptorProto
getT = String -> Parsec s () FileDescriptorProto
forall s a.
(Stream s Identity Char, TextMsg a) =>
String -> Parsec s () a
P'.getSubMessage

instance P'.TextMsg FileDescriptorProto where
  textPut :: FileDescriptorProto -> Output
textPut FileDescriptorProto
msg
   = do
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"name" (FileDescriptorProto -> Maybe Utf8
name FileDescriptorProto
msg)
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"package" (FileDescriptorProto -> Maybe Utf8
package FileDescriptorProto
msg)
       String -> Seq Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"dependency" (FileDescriptorProto -> Seq Utf8
dependency FileDescriptorProto
msg)
       String -> Seq Int32 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"public_dependency" (FileDescriptorProto -> Seq Int32
public_dependency FileDescriptorProto
msg)
       String -> Seq Int32 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"weak_dependency" (FileDescriptorProto -> Seq Int32
weak_dependency FileDescriptorProto
msg)
       String -> Seq DescriptorProto -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"message_type" (FileDescriptorProto -> Seq DescriptorProto
message_type FileDescriptorProto
msg)
       String -> Seq EnumDescriptorProto -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"enum_type" (FileDescriptorProto -> Seq EnumDescriptorProto
enum_type FileDescriptorProto
msg)
       String -> Seq ServiceDescriptorProto -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"service" (FileDescriptorProto -> Seq ServiceDescriptorProto
service FileDescriptorProto
msg)
       String -> Seq FieldDescriptorProto -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"extension" (FileDescriptorProto -> Seq FieldDescriptorProto
extension FileDescriptorProto
msg)
       String -> Maybe FileOptions -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"options" (FileDescriptorProto -> Maybe FileOptions
options FileDescriptorProto
msg)
       String -> Maybe SourceCodeInfo -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"source_code_info" (FileDescriptorProto -> Maybe SourceCodeInfo
source_code_info FileDescriptorProto
msg)
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"syntax" (FileDescriptorProto -> Maybe Utf8
syntax FileDescriptorProto
msg)
  textGet :: Parsec s () FileDescriptorProto
textGet
   = do
       [FileDescriptorProto -> FileDescriptorProto]
mods <- ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity ()
-> ParsecT
     s () Identity [FileDescriptorProto -> FileDescriptorProto]
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 (FileDescriptorProto -> FileDescriptorProto)]
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
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 (FileDescriptorProto -> FileDescriptorProto)
parse'name, ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'package, ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'dependency, ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'public_dependency, ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'weak_dependency, ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'message_type,
                   ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'enum_type, ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'service, ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'extension, ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'options, ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'source_code_info, ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'syntax])
                ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
       FileDescriptorProto -> Parsec s () FileDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((FileDescriptorProto
 -> (FileDescriptorProto -> FileDescriptorProto)
 -> FileDescriptorProto)
-> FileDescriptorProto
-> [FileDescriptorProto -> FileDescriptorProto]
-> FileDescriptorProto
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl' (\ FileDescriptorProto
v FileDescriptorProto -> FileDescriptorProto
f -> FileDescriptorProto -> FileDescriptorProto
f FileDescriptorProto
v) FileDescriptorProto
forall a. Default a => a
P'.defaultValue [FileDescriptorProto -> FileDescriptorProto]
mods)
    where
        parse'name :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'name = (Maybe Utf8 -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity (Maybe Utf8)
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Utf8
v FileDescriptorProto
o -> FileDescriptorProto
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'package :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'package = (Maybe Utf8 -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity (Maybe Utf8)
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Utf8
v FileDescriptorProto
o -> FileDescriptorProto
o{package :: Maybe Utf8
package = 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
"package"))
        parse'dependency :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'dependency = (Utf8 -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity Utf8
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Utf8
v FileDescriptorProto
o -> FileDescriptorProto
o{dependency :: Seq Utf8
dependency = Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq Utf8
dependency FileDescriptorProto
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
"dependency"))
        parse'public_dependency :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'public_dependency
         = (Int32 -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity Int32
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Int32
v FileDescriptorProto
o -> FileDescriptorProto
o{public_dependency :: Seq Int32
public_dependency = Seq Int32 -> Int32 -> Seq Int32
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq Int32
public_dependency FileDescriptorProto
o) Int32
v}) (ParsecT s () Identity Int32 -> ParsecT s () Identity Int32
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity Int32
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"public_dependency"))
        parse'weak_dependency :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'weak_dependency
         = (Int32 -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity Int32
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Int32
v FileDescriptorProto
o -> FileDescriptorProto
o{weak_dependency :: Seq Int32
weak_dependency = Seq Int32 -> Int32 -> Seq Int32
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq Int32
weak_dependency FileDescriptorProto
o) Int32
v}) (ParsecT s () Identity Int32 -> ParsecT s () Identity Int32
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity Int32
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"weak_dependency"))
        parse'message_type :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'message_type
         = (DescriptorProto -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity DescriptorProto
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ DescriptorProto
v FileDescriptorProto
o -> FileDescriptorProto
o{message_type :: Seq DescriptorProto
message_type = Seq DescriptorProto -> DescriptorProto -> Seq DescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq DescriptorProto
message_type FileDescriptorProto
o) DescriptorProto
v}) (ParsecT s () Identity DescriptorProto
-> ParsecT s () Identity DescriptorProto
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity DescriptorProto
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"message_type"))
        parse'enum_type :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'enum_type = (EnumDescriptorProto -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity EnumDescriptorProto
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ EnumDescriptorProto
v FileDescriptorProto
o -> FileDescriptorProto
o{enum_type :: Seq EnumDescriptorProto
enum_type = Seq EnumDescriptorProto
-> EnumDescriptorProto -> Seq EnumDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq EnumDescriptorProto
enum_type FileDescriptorProto
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'service :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'service = (ServiceDescriptorProto
 -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity ServiceDescriptorProto
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ ServiceDescriptorProto
v FileDescriptorProto
o -> FileDescriptorProto
o{service :: Seq ServiceDescriptorProto
service = Seq ServiceDescriptorProto
-> ServiceDescriptorProto -> Seq ServiceDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq ServiceDescriptorProto
service FileDescriptorProto
o) ServiceDescriptorProto
v}) (ParsecT s () Identity ServiceDescriptorProto
-> ParsecT s () Identity ServiceDescriptorProto
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity ServiceDescriptorProto
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"service"))
        parse'extension :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'extension = (FieldDescriptorProto
 -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity FieldDescriptorProto
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ FieldDescriptorProto
v FileDescriptorProto
o -> FileDescriptorProto
o{extension :: Seq FieldDescriptorProto
extension = Seq FieldDescriptorProto
-> FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (FileDescriptorProto -> Seq FieldDescriptorProto
extension FileDescriptorProto
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'options :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'options = (Maybe FileOptions -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity (Maybe FileOptions)
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe FileOptions
v FileDescriptorProto
o -> FileDescriptorProto
o{options :: Maybe FileOptions
options = Maybe FileOptions
v}) (ParsecT s () Identity (Maybe FileOptions)
-> ParsecT s () Identity (Maybe FileOptions)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe FileOptions)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"options"))
        parse'source_code_info :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'source_code_info = (Maybe SourceCodeInfo
 -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity (Maybe SourceCodeInfo)
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe SourceCodeInfo
v FileDescriptorProto
o -> FileDescriptorProto
o{source_code_info :: Maybe SourceCodeInfo
source_code_info = Maybe SourceCodeInfo
v}) (ParsecT s () Identity (Maybe SourceCodeInfo)
-> ParsecT s () Identity (Maybe SourceCodeInfo)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe SourceCodeInfo)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"source_code_info"))
        parse'syntax :: ParsecT s () Identity (FileDescriptorProto -> FileDescriptorProto)
parse'syntax = (Maybe Utf8 -> FileDescriptorProto -> FileDescriptorProto)
-> ParsecT s () Identity (Maybe Utf8)
-> ParsecT
     s () Identity (FileDescriptorProto -> FileDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Utf8
v FileDescriptorProto
o -> FileDescriptorProto
o{syntax :: Maybe Utf8
syntax = 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
"syntax"))