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

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

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

instance P'.Mergeable MethodOptions where
  mergeAppend :: MethodOptions -> MethodOptions -> MethodOptions
mergeAppend (MethodOptions Maybe Bool
x'1 Seq UninterpretedOption
x'2 ExtField
x'3 UnknownField
x'4) (MethodOptions 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
-> MethodOptions
MethodOptions Maybe Bool
z'1 Seq UninterpretedOption
z'2 ExtField
z'3 UnknownField
z'4

instance P'.Default MethodOptions where
  defaultValue :: MethodOptions
defaultValue = Maybe Bool
-> Seq UninterpretedOption
-> ExtField
-> UnknownField
-> MethodOptions
MethodOptions (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 MethodOptions where
  wireSize :: FieldType -> MethodOptions -> WireSize
wireSize FieldType
ft' self' :: MethodOptions
self'@(MethodOptions 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 -> MethodOptions -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' MethodOptions
self'
    where
        calc'Size :: WireSize
calc'Size = (WireSize -> FieldType -> Maybe Bool -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
2 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 -> MethodOptions -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: MethodOptions
self'@(MethodOptions 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 -> MethodOptions -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' MethodOptions
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
264 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 MethodOptions
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> MethodOptions -> Get MethodOptions)
-> Get MethodOptions
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> MethodOptions -> Get MethodOptions)
-> (WireTag -> MethodOptions -> Get MethodOptions)
-> WireTag
-> MethodOptions
-> Get MethodOptions
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> MethodOptions -> Get MethodOptions
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> MethodOptions -> Get MethodOptions
update'Self)
       FieldType
11 -> (WireTag -> MethodOptions -> Get MethodOptions)
-> Get MethodOptions
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> MethodOptions -> Get MethodOptions)
-> (WireTag -> MethodOptions -> Get MethodOptions)
-> WireTag
-> MethodOptions
-> Get MethodOptions
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> MethodOptions -> Get MethodOptions
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> MethodOptions -> Get MethodOptions
update'Self)
       FieldType
_ -> FieldType -> Get MethodOptions
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> MethodOptions -> Get MethodOptions
update'Self WireTag
wire'Tag MethodOptions
old'Self
         = case WireTag
wire'Tag of
             WireTag
264 -> (Bool -> MethodOptions) -> Get Bool -> Get MethodOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Bool
new'Field -> MethodOptions
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 -> MethodOptions)
-> Get UninterpretedOption -> Get MethodOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
                      (\ !UninterpretedOption
new'Field -> MethodOptions
old'Self{uninterpreted_option :: Seq UninterpretedOption
uninterpreted_option = Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
P'.append (MethodOptions -> Seq UninterpretedOption
uninterpreted_option MethodOptions
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 -> MethodOptions -> Get MethodOptions
forall a.
(ReflectDescriptor a, ExtendMessage a) =>
FieldId -> WireType -> a -> Get a
P'.loadExtension FieldId
field'Number WireType
wire'Type MethodOptions
old'Self else FieldId -> WireType -> MethodOptions -> Get MethodOptions
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type MethodOptions
old'Self

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

instance P'.GPB MethodOptions

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

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