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

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

instance P'.ExtendMessage EnumValueOptions where
  getExtField :: EnumValueOptions -> ExtField
getExtField = EnumValueOptions -> ExtField
ext'field
  putExtField :: ExtField -> EnumValueOptions -> EnumValueOptions
putExtField ExtField
e'f EnumValueOptions
msg = EnumValueOptions
msg{ext'field :: ExtField
ext'field = ExtField
e'f}
  validExtRanges :: EnumValueOptions -> [(FieldId, FieldId)]
validExtRanges EnumValueOptions
msg = DescriptorInfo -> [(FieldId, FieldId)]
P'.extRanges (EnumValueOptions -> DescriptorInfo
forall m. ReflectDescriptor m => m -> DescriptorInfo
P'.reflectDescriptorInfo EnumValueOptions
msg)

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

instance P'.Mergeable EnumValueOptions where
  mergeAppend :: EnumValueOptions -> EnumValueOptions -> EnumValueOptions
mergeAppend (EnumValueOptions Maybe Bool
x'1 Seq UninterpretedOption
x'2 ExtField
x'3 UnknownField
x'4) (EnumValueOptions Maybe Bool
y'1 Seq UninterpretedOption
y'2 ExtField
y'3 UnknownField
y'4)
   = let !z'1 :: Maybe Bool
z'1 = Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Bool
x'1 Maybe Bool
y'1
         !z'2 :: Seq UninterpretedOption
z'2 = Seq UninterpretedOption
-> Seq UninterpretedOption -> Seq UninterpretedOption
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq UninterpretedOption
x'2 Seq UninterpretedOption
y'2
         !z'3 :: ExtField
z'3 = ExtField -> ExtField -> ExtField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend ExtField
x'3 ExtField
y'3
         !z'4 :: UnknownField
z'4 = UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'4 UnknownField
y'4
      in Maybe Bool
-> Seq UninterpretedOption
-> ExtField
-> UnknownField
-> EnumValueOptions
EnumValueOptions Maybe Bool
z'1 Seq UninterpretedOption
z'2 ExtField
z'3 UnknownField
z'4

instance P'.Default EnumValueOptions where
  defaultValue :: EnumValueOptions
defaultValue = Maybe Bool
-> Seq UninterpretedOption
-> ExtField
-> UnknownField
-> EnumValueOptions
EnumValueOptions (Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude'.Just Bool
Prelude'.False) Seq UninterpretedOption
forall a. Default a => a
P'.defaultValue ExtField
forall a. Default a => a
P'.defaultValue UnknownField
forall a. Default a => a
P'.defaultValue

instance P'.Wire EnumValueOptions where
  wireSize :: FieldType -> EnumValueOptions -> WireSize
wireSize FieldType
ft' self' :: EnumValueOptions
self'@(EnumValueOptions Maybe Bool
x'1 Seq UninterpretedOption
x'2 ExtField
x'3 UnknownField
x'4)
   = case FieldType
ft' of
       FieldType
10 -> WireSize
calc'Size
       FieldType
11 -> WireSize -> WireSize
P'.prependMessageSize WireSize
calc'Size
       FieldType
_ -> FieldType -> EnumValueOptions -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' EnumValueOptions
self'
    where
        calc'Size :: WireSize
calc'Size = (WireSize -> FieldType -> Maybe Bool -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
8 Maybe Bool
x'1 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq UninterpretedOption -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
2 FieldType
11 Seq UninterpretedOption
x'2 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ ExtField -> WireSize
P'.wireSizeExtField ExtField
x'3 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'4)
  wirePutWithSize :: FieldType -> EnumValueOptions -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: EnumValueOptions
self'@(EnumValueOptions Maybe Bool
x'1 Seq UninterpretedOption
x'2 ExtField
x'3 UnknownField
x'4)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> EnumValueOptions -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' EnumValueOptions
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 Bool -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
8 FieldType
8 Maybe Bool
x'1, WireTag -> FieldType -> Seq UninterpretedOption -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
7994 FieldType
11 Seq UninterpretedOption
x'2, ExtField -> PutM WireSize
P'.wirePutExtFieldWithSize ExtField
x'3,
             UnknownField -> PutM WireSize
P'.wirePutUnknownFieldWithSize UnknownField
x'4]
        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 EnumValueOptions
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> EnumValueOptions -> Get EnumValueOptions)
-> Get EnumValueOptions
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> EnumValueOptions -> Get EnumValueOptions)
-> (WireTag -> EnumValueOptions -> Get EnumValueOptions)
-> WireTag
-> EnumValueOptions
-> Get EnumValueOptions
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> EnumValueOptions -> Get EnumValueOptions
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> EnumValueOptions -> Get EnumValueOptions
update'Self)
       FieldType
11 -> (WireTag -> EnumValueOptions -> Get EnumValueOptions)
-> Get EnumValueOptions
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> EnumValueOptions -> Get EnumValueOptions)
-> (WireTag -> EnumValueOptions -> Get EnumValueOptions)
-> WireTag
-> EnumValueOptions
-> Get EnumValueOptions
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> EnumValueOptions -> Get EnumValueOptions
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> EnumValueOptions -> Get EnumValueOptions
update'Self)
       FieldType
_ -> FieldType -> Get EnumValueOptions
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> EnumValueOptions -> Get EnumValueOptions
update'Self WireTag
wire'Tag EnumValueOptions
old'Self
         = case WireTag
wire'Tag of
             WireTag
8 -> (Bool -> EnumValueOptions) -> Get Bool -> Get EnumValueOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Bool
new'Field -> EnumValueOptions
old'Self{deprecated :: Maybe Bool
deprecated = Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude'.Just Bool
new'Field}) (FieldType -> Get Bool
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
8)
             WireTag
7994 -> (UninterpretedOption -> EnumValueOptions)
-> Get UninterpretedOption -> Get EnumValueOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
                      (\ !UninterpretedOption
new'Field -> EnumValueOptions
old'Self{uninterpreted_option :: Seq UninterpretedOption
uninterpreted_option = Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
P'.append (EnumValueOptions -> Seq UninterpretedOption
uninterpreted_option EnumValueOptions
old'Self) UninterpretedOption
new'Field})
                      (FieldType -> Get UninterpretedOption
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
_ -> let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag in
                   if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
Prelude'.or [FieldId
1000 FieldId -> FieldId -> Bool
forall a. Ord a => a -> a -> Bool
<= FieldId
field'Number Bool -> Bool -> Bool
&& FieldId
field'Number FieldId -> FieldId -> Bool
forall a. Ord a => a -> a -> Bool
<= FieldId
18999, FieldId
20000 FieldId -> FieldId -> Bool
forall a. Ord a => a -> a -> Bool
<= FieldId
field'Number] then
                    FieldId -> WireType -> EnumValueOptions -> Get EnumValueOptions
forall a.
(ReflectDescriptor a, ExtendMessage a) =>
FieldId -> WireType -> a -> Get a
P'.loadExtension FieldId
field'Number WireType
wire'Type EnumValueOptions
old'Self else FieldId -> WireType -> EnumValueOptions -> Get EnumValueOptions
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type EnumValueOptions
old'Self

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

instance P'.GPB EnumValueOptions

instance P'.ReflectDescriptor EnumValueOptions where
  getMessageInfo :: EnumValueOptions -> GetMessageInfo
getMessageInfo EnumValueOptions
_ = 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
8, WireTag
7994])
  reflectDescriptorInfo :: EnumValueOptions -> DescriptorInfo
reflectDescriptorInfo EnumValueOptions
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.EnumValueOptions\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"EnumValueOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"EnumValueOptions.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.EnumValueOptions.deprecated\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"EnumValueOptions\"], baseName' = FName \"deprecated\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just \"false\", hsDefault = Just (HsDef'Bool False)},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.EnumValueOptions.uninterpreted_option\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"EnumValueOptions\"], baseName' = FName \"uninterpreted_option\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 999}, wireTag = WireTag {getWireTag = 7994}, packedTag = Nothing, wireTagLength = 2, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.UninterpretedOption\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"UninterpretedOption\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [(FieldId {getFieldId = 1000},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 536870911})], knownKeys = fromList [], storeUnknown = True, lazyFields = False, makeLenses = False, jsonInstances = False}"

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

instance P'.TextMsg EnumValueOptions where
  textPut :: EnumValueOptions -> Output
textPut EnumValueOptions
msg
   = do
       String -> Maybe Bool -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"deprecated" (EnumValueOptions -> Maybe Bool
deprecated EnumValueOptions
msg)
       String -> Seq UninterpretedOption -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"uninterpreted_option" (EnumValueOptions -> Seq UninterpretedOption
uninterpreted_option EnumValueOptions
msg)
  textGet :: Parsec s () EnumValueOptions
textGet
   = do
       [EnumValueOptions -> EnumValueOptions]
mods <- ParsecT s () Identity (EnumValueOptions -> EnumValueOptions)
-> ParsecT s () Identity ()
-> ParsecT s () Identity [EnumValueOptions -> EnumValueOptions]
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 (EnumValueOptions -> EnumValueOptions)]
-> ParsecT s () Identity (EnumValueOptions -> EnumValueOptions)
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 (EnumValueOptions -> EnumValueOptions)
parse'deprecated, ParsecT s () Identity (EnumValueOptions -> EnumValueOptions)
parse'uninterpreted_option]) ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
       EnumValueOptions -> Parsec s () EnumValueOptions
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((EnumValueOptions
 -> (EnumValueOptions -> EnumValueOptions) -> EnumValueOptions)
-> EnumValueOptions
-> [EnumValueOptions -> EnumValueOptions]
-> EnumValueOptions
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl' (\ EnumValueOptions
v EnumValueOptions -> EnumValueOptions
f -> EnumValueOptions -> EnumValueOptions
f EnumValueOptions
v) EnumValueOptions
forall a. Default a => a
P'.defaultValue [EnumValueOptions -> EnumValueOptions]
mods)
    where
        parse'deprecated :: ParsecT s () Identity (EnumValueOptions -> EnumValueOptions)
parse'deprecated = (Maybe Bool -> EnumValueOptions -> EnumValueOptions)
-> ParsecT s () Identity (Maybe Bool)
-> ParsecT s () Identity (EnumValueOptions -> EnumValueOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Bool
v EnumValueOptions
o -> EnumValueOptions
o{deprecated :: Maybe Bool
deprecated = Maybe Bool
v}) (ParsecT s () Identity (Maybe Bool)
-> ParsecT s () Identity (Maybe Bool)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe Bool)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"deprecated"))
        parse'uninterpreted_option :: ParsecT s () Identity (EnumValueOptions -> EnumValueOptions)
parse'uninterpreted_option
         = (UninterpretedOption -> EnumValueOptions -> EnumValueOptions)
-> ParsecT s () Identity UninterpretedOption
-> ParsecT s () Identity (EnumValueOptions -> EnumValueOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ UninterpretedOption
v EnumValueOptions
o -> EnumValueOptions
o{uninterpreted_option :: Seq UninterpretedOption
uninterpreted_option = Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
P'.append (EnumValueOptions -> Seq UninterpretedOption
uninterpreted_option EnumValueOptions
o) UninterpretedOption
v})
            (ParsecT s () Identity UninterpretedOption
-> ParsecT s () Identity UninterpretedOption
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity UninterpretedOption
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"uninterpreted_option"))