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

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

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

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

instance P'.Mergeable EnumOptions where
  mergeAppend :: EnumOptions -> EnumOptions -> EnumOptions
mergeAppend (EnumOptions Maybe Bool
x'1 Maybe Bool
x'2 Seq UninterpretedOption
x'3 ExtField
x'4 UnknownField
x'5) (EnumOptions Maybe Bool
y'1 Maybe Bool
y'2 Seq UninterpretedOption
y'3 ExtField
y'4 UnknownField
y'5)
   = Maybe Bool
-> Maybe Bool
-> Seq UninterpretedOption
-> ExtField
-> UnknownField
-> EnumOptions
EnumOptions (Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Bool
x'1 Maybe Bool
y'1) (Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Bool
x'2 Maybe Bool
y'2) (Seq UninterpretedOption
-> Seq UninterpretedOption -> Seq UninterpretedOption
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq UninterpretedOption
x'3 Seq UninterpretedOption
y'3) (ExtField -> ExtField -> ExtField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend ExtField
x'4 ExtField
y'4)
      (UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'5 UnknownField
y'5)

instance P'.Default EnumOptions where
  defaultValue :: EnumOptions
defaultValue = Maybe Bool
-> Maybe Bool
-> Seq UninterpretedOption
-> ExtField
-> UnknownField
-> EnumOptions
EnumOptions Maybe Bool
forall a. Default a => a
P'.defaultValue (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 EnumOptions where
  wireSize :: FieldType -> EnumOptions -> WireSize
wireSize FieldType
ft' self' :: EnumOptions
self'@(EnumOptions Maybe Bool
x'1 Maybe Bool
x'2 Seq UninterpretedOption
x'3 ExtField
x'4 UnknownField
x'5)
   = case FieldType
ft' of
       FieldType
10 -> WireSize
calc'Size
       FieldType
11 -> WireSize -> WireSize
P'.prependMessageSize WireSize
calc'Size
       FieldType
_ -> FieldType -> EnumOptions -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' EnumOptions
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 -> Maybe Bool -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
8 Maybe Bool
x'2 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'3 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ ExtField -> WireSize
P'.wireSizeExtField ExtField
x'4 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+
             UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'5)
  wirePutWithSize :: FieldType -> EnumOptions -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: EnumOptions
self'@(EnumOptions Maybe Bool
x'1 Maybe Bool
x'2 Seq UninterpretedOption
x'3 ExtField
x'4 UnknownField
x'5)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> EnumOptions -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' EnumOptions
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
16 FieldType
8 Maybe Bool
x'1, WireTag -> FieldType -> Maybe Bool -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
24 FieldType
8 Maybe Bool
x'2, 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'3,
             ExtField -> PutM WireSize
P'.wirePutExtFieldWithSize ExtField
x'4, UnknownField -> PutM WireSize
P'.wirePutUnknownFieldWithSize UnknownField
x'5]
        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 EnumOptions
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> EnumOptions -> Get EnumOptions) -> Get EnumOptions
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> EnumOptions -> Get EnumOptions)
-> WireTag -> EnumOptions -> Get EnumOptions
forall a.
UnknownMessage a =>
(WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown WireTag -> EnumOptions -> Get EnumOptions
update'Self)
       FieldType
11 -> (WireTag -> EnumOptions -> Get EnumOptions) -> Get EnumOptions
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> EnumOptions -> Get EnumOptions)
-> WireTag -> EnumOptions -> Get EnumOptions
forall a.
UnknownMessage a =>
(WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown WireTag -> EnumOptions -> Get EnumOptions
update'Self)
       FieldType
_ -> FieldType -> Get EnumOptions
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> EnumOptions -> Get EnumOptions
update'Self WireTag
wire'Tag EnumOptions
old'Self
         = case WireTag
wire'Tag of
             WireTag
16 -> (Bool -> EnumOptions) -> Get Bool -> Get EnumOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Bool
new'Field -> EnumOptions
old'Self{allow_alias :: Maybe Bool
allow_alias = 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
24 -> (Bool -> EnumOptions) -> Get Bool -> Get EnumOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Bool
new'Field -> EnumOptions
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 -> EnumOptions)
-> Get UninterpretedOption -> Get EnumOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
                      (\ !UninterpretedOption
new'Field -> EnumOptions
old'Self{uninterpreted_option :: Seq UninterpretedOption
uninterpreted_option = Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
P'.append (EnumOptions -> Seq UninterpretedOption
uninterpreted_option EnumOptions
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 -> EnumOptions -> Get EnumOptions
forall a.
(ReflectDescriptor a, ExtendMessage a) =>
FieldId -> WireType -> a -> Get a
P'.loadExtension FieldId
field'Number WireType
wire'Type EnumOptions
old'Self else FieldId -> WireType -> EnumOptions -> Get EnumOptions
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type EnumOptions
old'Self

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

instance P'.GPB EnumOptions

instance P'.ReflectDescriptor EnumOptions where
  getMessageInfo :: EnumOptions -> GetMessageInfo
getMessageInfo EnumOptions
_ = 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
16, WireTag
24, WireTag
7994])
  reflectDescriptorInfo :: EnumOptions -> DescriptorInfo
reflectDescriptorInfo EnumOptions
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.EnumOptions\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"EnumOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"EnumOptions.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.EnumOptions.allow_alias\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"EnumOptions\"], baseName' = FName \"allow_alias\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.EnumOptions.deprecated\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"EnumOptions\"], baseName' = FName \"deprecated\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, 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.EnumOptions.uninterpreted_option\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"EnumOptions\"], 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}"

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

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