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

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

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

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

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

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

instance P'.GPB ServiceOptions

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

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