{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS_GHC  -fno-warn-unused-imports #-}
module Text.DescriptorProtos.ServiceDescriptorProto (ServiceDescriptorProto(..)) 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.MethodDescriptorProto as DescriptorProtos (MethodDescriptorProto)
import qualified Text.DescriptorProtos.ServiceOptions as DescriptorProtos (ServiceOptions)

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

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

instance P'.Mergeable ServiceDescriptorProto where
  mergeAppend :: ServiceDescriptorProto
-> ServiceDescriptorProto -> ServiceDescriptorProto
mergeAppend (ServiceDescriptorProto Maybe Utf8
x'1 Seq MethodDescriptorProto
x'2 Maybe ServiceOptions
x'3 UnknownField
x'4) (ServiceDescriptorProto Maybe Utf8
y'1 Seq MethodDescriptorProto
y'2 Maybe ServiceOptions
y'3 UnknownField
y'4)
   = Maybe Utf8
-> Seq MethodDescriptorProto
-> Maybe ServiceOptions
-> UnknownField
-> ServiceDescriptorProto
ServiceDescriptorProto (Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'1 Maybe Utf8
y'1) (Seq MethodDescriptorProto
-> Seq MethodDescriptorProto -> Seq MethodDescriptorProto
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq MethodDescriptorProto
x'2 Seq MethodDescriptorProto
y'2) (Maybe ServiceOptions
-> Maybe ServiceOptions -> Maybe ServiceOptions
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe ServiceOptions
x'3 Maybe ServiceOptions
y'3) (UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'4 UnknownField
y'4)

instance P'.Default ServiceDescriptorProto where
  defaultValue :: ServiceDescriptorProto
defaultValue = Maybe Utf8
-> Seq MethodDescriptorProto
-> Maybe ServiceOptions
-> UnknownField
-> ServiceDescriptorProto
ServiceDescriptorProto Maybe Utf8
forall a. Default a => a
P'.defaultValue Seq MethodDescriptorProto
forall a. Default a => a
P'.defaultValue Maybe ServiceOptions
forall a. Default a => a
P'.defaultValue UnknownField
forall a. Default a => a
P'.defaultValue

instance P'.Wire ServiceDescriptorProto where
  wireSize :: FieldType -> ServiceDescriptorProto -> WireSize
wireSize FieldType
ft' self' :: ServiceDescriptorProto
self'@(ServiceDescriptorProto Maybe Utf8
x'1 Seq MethodDescriptorProto
x'2 Maybe ServiceOptions
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 -> ServiceDescriptorProto -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' ServiceDescriptorProto
self'
    where
        calc'Size :: WireSize
calc'Size = (WireSize -> FieldType -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'1 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq MethodDescriptorProto -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq MethodDescriptorProto
x'2 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe ServiceOptions -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
11 Maybe ServiceOptions
x'3 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'4)
  wirePutWithSize :: FieldType -> ServiceDescriptorProto -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: ServiceDescriptorProto
self'@(ServiceDescriptorProto Maybe Utf8
x'1 Seq MethodDescriptorProto
x'2 Maybe ServiceOptions
x'3 UnknownField
x'4)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> ServiceDescriptorProto -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' ServiceDescriptorProto
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 Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
10 FieldType
9 Maybe Utf8
x'1, WireTag -> FieldType -> Seq MethodDescriptorProto -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
18 FieldType
11 Seq MethodDescriptorProto
x'2, WireTag -> FieldType -> Maybe ServiceOptions -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
26 FieldType
11 Maybe ServiceOptions
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 ServiceDescriptorProto
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> ServiceDescriptorProto -> Get ServiceDescriptorProto)
-> Get ServiceDescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> ServiceDescriptorProto -> Get ServiceDescriptorProto)
-> WireTag -> ServiceDescriptorProto -> Get ServiceDescriptorProto
forall a.
UnknownMessage a =>
(WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown WireTag -> ServiceDescriptorProto -> Get ServiceDescriptorProto
update'Self)
       FieldType
11 -> (WireTag -> ServiceDescriptorProto -> Get ServiceDescriptorProto)
-> Get ServiceDescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> ServiceDescriptorProto -> Get ServiceDescriptorProto)
-> WireTag -> ServiceDescriptorProto -> Get ServiceDescriptorProto
forall a.
UnknownMessage a =>
(WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown WireTag -> ServiceDescriptorProto -> Get ServiceDescriptorProto
update'Self)
       FieldType
_ -> FieldType -> Get ServiceDescriptorProto
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> ServiceDescriptorProto -> Get ServiceDescriptorProto
update'Self WireTag
wire'Tag ServiceDescriptorProto
old'Self
         = case WireTag
wire'Tag of
             WireTag
10 -> (Utf8 -> ServiceDescriptorProto)
-> Get Utf8 -> Get ServiceDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> ServiceDescriptorProto
old'Self{name :: Maybe Utf8
name = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field}) (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
18 -> (MethodDescriptorProto -> ServiceDescriptorProto)
-> Get MethodDescriptorProto -> Get ServiceDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !MethodDescriptorProto
new'Field -> ServiceDescriptorProto
old'Self{method :: Seq MethodDescriptorProto
method = Seq MethodDescriptorProto
-> MethodDescriptorProto -> Seq MethodDescriptorProto
forall a. Seq a -> a -> Seq a
P'.append (ServiceDescriptorProto -> Seq MethodDescriptorProto
method ServiceDescriptorProto
old'Self) MethodDescriptorProto
new'Field}) (FieldType -> Get MethodDescriptorProto
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
26 -> (ServiceOptions -> ServiceDescriptorProto)
-> Get ServiceOptions -> Get ServiceDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !ServiceOptions
new'Field -> ServiceDescriptorProto
old'Self{options :: Maybe ServiceOptions
options = Maybe ServiceOptions
-> Maybe ServiceOptions -> Maybe ServiceOptions
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (ServiceDescriptorProto -> Maybe ServiceOptions
options ServiceDescriptorProto
old'Self) (ServiceOptions -> Maybe ServiceOptions
forall a. a -> Maybe a
Prelude'.Just ServiceOptions
new'Field)})
                    (FieldType -> Get ServiceOptions
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 FieldId
-> WireType -> ServiceDescriptorProto -> Get ServiceDescriptorProto
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type ServiceDescriptorProto
old'Self

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

instance P'.GPB ServiceDescriptorProto

instance P'.ReflectDescriptor ServiceDescriptorProto where
  getMessageInfo :: ServiceDescriptorProto -> GetMessageInfo
getMessageInfo ServiceDescriptorProto
_ = 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
10, WireTag
18, WireTag
26])
  reflectDescriptorInfo :: ServiceDescriptorProto -> DescriptorInfo
reflectDescriptorInfo ServiceDescriptorProto
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.ServiceDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"ServiceDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"ServiceDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.ServiceDescriptorProto.name\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"ServiceDescriptorProto\"], baseName' = FName \"name\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.ServiceDescriptorProto.method\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"ServiceDescriptorProto\"], baseName' = FName \"method\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.MethodDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"MethodDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.ServiceDescriptorProto.options\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"ServiceDescriptorProto\"], baseName' = FName \"options\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.ServiceOptions\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"ServiceOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = True, lazyFields = False, makeLenses = False}"

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

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