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

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

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

instance P'.Mergeable MessageOptions where
  mergeAppend :: MessageOptions -> MessageOptions -> MessageOptions
mergeAppend (MessageOptions Maybe Bool
x'1 Maybe Bool
x'2 Maybe Bool
x'3 Maybe Bool
x'4 Seq UninterpretedOption
x'5 ExtField
x'6 UnknownField
x'7) (MessageOptions Maybe Bool
y'1 Maybe Bool
y'2 Maybe Bool
y'3 Maybe Bool
y'4 Seq UninterpretedOption
y'5 ExtField
y'6 UnknownField
y'7)
   = Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Seq UninterpretedOption
-> ExtField
-> UnknownField
-> MessageOptions
MessageOptions (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) (Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Bool
x'3 Maybe Bool
y'3) (Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Bool
x'4 Maybe Bool
y'4)
      (Seq UninterpretedOption
-> Seq UninterpretedOption -> Seq UninterpretedOption
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq UninterpretedOption
x'5 Seq UninterpretedOption
y'5)
      (ExtField -> ExtField -> ExtField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend ExtField
x'6 ExtField
y'6)
      (UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'7 UnknownField
y'7)

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

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

instance P'.GPB MessageOptions

instance P'.ReflectDescriptor MessageOptions where
  getMessageInfo :: MessageOptions -> GetMessageInfo
getMessageInfo MessageOptions
_ = 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
16, WireTag
24, WireTag
56, WireTag
7994])
  reflectDescriptorInfo :: MessageOptions -> DescriptorInfo
reflectDescriptorInfo MessageOptions
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.MessageOptions\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"MessageOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"MessageOptions.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.MessageOptions.message_set_wire_format\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"MessageOptions\"], baseName' = FName \"message_set_wire_format\", 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.MessageOptions.no_standard_descriptor_accessor\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"MessageOptions\"], baseName' = FName \"no_standard_descriptor_accessor\", 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 = Just \"false\", hsDefault = Just (HsDef'Bool False)},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.MessageOptions.deprecated\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"MessageOptions\"], 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.MessageOptions.map_entry\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"MessageOptions\"], baseName' = FName \"map_entry\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 56}, 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.MessageOptions.uninterpreted_option\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"MessageOptions\"], 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 MessageOptions where
  tellT :: String -> MessageOptions -> Output
tellT = String -> MessageOptions -> Output
forall a. TextMsg a => String -> a -> Output
P'.tellSubMessage
  getT :: String -> Parsec s () MessageOptions
getT = String -> Parsec s () MessageOptions
forall s a.
(Stream s Identity Char, TextMsg a) =>
String -> Parsec s () a
P'.getSubMessage

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