{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}
{-# OPTIONS_GHC  -w #-}
module Text.DescriptorProtos.OneofDescriptorProto (OneofDescriptorProto(..)) 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'

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

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

instance P'.Mergeable OneofDescriptorProto where
  mergeAppend :: OneofDescriptorProto
-> OneofDescriptorProto -> OneofDescriptorProto
mergeAppend (OneofDescriptorProto Maybe Utf8
x'1 UnknownField
x'2) (OneofDescriptorProto Maybe Utf8
y'1 UnknownField
y'2)
   = 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 :: UnknownField
z'2 = UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'2 UnknownField
y'2
      in Maybe Utf8 -> UnknownField -> OneofDescriptorProto
OneofDescriptorProto Maybe Utf8
z'1 UnknownField
z'2

instance P'.Default OneofDescriptorProto where
  defaultValue :: OneofDescriptorProto
defaultValue = Maybe Utf8 -> UnknownField -> OneofDescriptorProto
OneofDescriptorProto Maybe Utf8
forall a. Default a => a
P'.defaultValue UnknownField
forall a. Default a => a
P'.defaultValue

instance P'.Wire OneofDescriptorProto where
  wireSize :: FieldType -> OneofDescriptorProto -> WireSize
wireSize FieldType
ft' self' :: OneofDescriptorProto
self'@(OneofDescriptorProto Maybe Utf8
x'1 UnknownField
x'2)
   = case FieldType
ft' of
       FieldType
10 -> WireSize
calc'Size
       FieldType
11 -> WireSize -> WireSize
P'.prependMessageSize WireSize
calc'Size
       FieldType
_ -> FieldType -> OneofDescriptorProto -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' OneofDescriptorProto
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
+ UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'2)
  wirePutWithSize :: FieldType -> OneofDescriptorProto -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: OneofDescriptorProto
self'@(OneofDescriptorProto Maybe Utf8
x'1 UnknownField
x'2)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> OneofDescriptorProto -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' OneofDescriptorProto
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, UnknownField -> PutM WireSize
P'.wirePutUnknownFieldWithSize UnknownField
x'2]
        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 OneofDescriptorProto
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto)
-> Get OneofDescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto)
-> (WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto)
-> WireTag
-> OneofDescriptorProto
-> Get OneofDescriptorProto
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto
update'Self)
       FieldType
11 -> (WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto)
-> Get OneofDescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto)
-> (WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto)
-> WireTag
-> OneofDescriptorProto
-> Get OneofDescriptorProto
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto
update'Self)
       FieldType
_ -> FieldType -> Get OneofDescriptorProto
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto
update'Self WireTag
wire'Tag OneofDescriptorProto
old'Self
         = case WireTag
wire'Tag of
             WireTag
10 -> (Utf8 -> OneofDescriptorProto)
-> Get Utf8 -> Get OneofDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> OneofDescriptorProto
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
_ -> let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag in FieldId
-> WireType -> OneofDescriptorProto -> Get OneofDescriptorProto
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type OneofDescriptorProto
old'Self

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

instance P'.GPB OneofDescriptorProto

instance P'.ReflectDescriptor OneofDescriptorProto where
  getMessageInfo :: OneofDescriptorProto -> GetMessageInfo
getMessageInfo OneofDescriptorProto
_ = 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])
  reflectDescriptorInfo :: OneofDescriptorProto -> DescriptorInfo
reflectDescriptorInfo OneofDescriptorProto
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.OneofDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"OneofDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"OneofDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.OneofDescriptorProto.name\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"OneofDescriptorProto\"], 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}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = True, lazyFields = False, makeLenses = False, jsonInstances = False}"

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

instance P'.TextMsg OneofDescriptorProto where
  textPut :: OneofDescriptorProto -> Output
textPut OneofDescriptorProto
msg
   = do
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"name" (OneofDescriptorProto -> Maybe Utf8
name OneofDescriptorProto
msg)
  textGet :: Parsec s () OneofDescriptorProto
textGet
   = do
       [OneofDescriptorProto -> OneofDescriptorProto]
mods <- ParsecT
  s () Identity (OneofDescriptorProto -> OneofDescriptorProto)
-> ParsecT s () Identity ()
-> ParsecT
     s () Identity [OneofDescriptorProto -> OneofDescriptorProto]
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 (OneofDescriptorProto -> OneofDescriptorProto)]
-> ParsecT
     s () Identity (OneofDescriptorProto -> OneofDescriptorProto)
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 (OneofDescriptorProto -> OneofDescriptorProto)
parse'name]) ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
       OneofDescriptorProto -> Parsec s () OneofDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((OneofDescriptorProto
 -> (OneofDescriptorProto -> OneofDescriptorProto)
 -> OneofDescriptorProto)
-> OneofDescriptorProto
-> [OneofDescriptorProto -> OneofDescriptorProto]
-> OneofDescriptorProto
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl' (\ OneofDescriptorProto
v OneofDescriptorProto -> OneofDescriptorProto
f -> OneofDescriptorProto -> OneofDescriptorProto
f OneofDescriptorProto
v) OneofDescriptorProto
forall a. Default a => a
P'.defaultValue [OneofDescriptorProto -> OneofDescriptorProto]
mods)
    where
        parse'name :: ParsecT
  s () Identity (OneofDescriptorProto -> OneofDescriptorProto)
parse'name = (Maybe Utf8 -> OneofDescriptorProto -> OneofDescriptorProto)
-> ParsecT s () Identity (Maybe Utf8)
-> ParsecT
     s () Identity (OneofDescriptorProto -> OneofDescriptorProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Utf8
v OneofDescriptorProto
o -> OneofDescriptorProto
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"))