{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}
{-# OPTIONS_GHC  -w #-}
module Text.DescriptorProtos.MethodDescriptorProto (MethodDescriptorProto(..)) 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.MethodOptions as DescriptorProtos (MethodOptions)

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

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

instance P'.Mergeable MethodDescriptorProto where
  mergeAppend :: MethodDescriptorProto
-> MethodDescriptorProto -> MethodDescriptorProto
mergeAppend (MethodDescriptorProto Maybe Utf8
x'1 Maybe Utf8
x'2 Maybe Utf8
x'3 Maybe MethodOptions
x'4 Maybe Bool
x'5 Maybe Bool
x'6 UnknownField
x'7) (MethodDescriptorProto Maybe Utf8
y'1 Maybe Utf8
y'2 Maybe Utf8
y'3 Maybe MethodOptions
y'4 Maybe Bool
y'5 Maybe Bool
y'6 UnknownField
y'7)
   = let !z'1 :: Maybe Utf8
z'1 = Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'1 Maybe Utf8
y'1
         !z'2 :: Maybe Utf8
z'2 = Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'2 Maybe Utf8
y'2
         !z'3 :: Maybe Utf8
z'3 = Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'3 Maybe Utf8
y'3
         !z'4 :: Maybe MethodOptions
z'4 = Maybe MethodOptions -> Maybe MethodOptions -> Maybe MethodOptions
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe MethodOptions
x'4 Maybe MethodOptions
y'4
         !z'5 :: Maybe Bool
z'5 = Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Bool
x'5 Maybe Bool
y'5
         !z'6 :: Maybe Bool
z'6 = Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Bool
x'6 Maybe Bool
y'6
         !z'7 :: UnknownField
z'7 = UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'7 UnknownField
y'7
      in Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe MethodOptions
-> Maybe Bool
-> Maybe Bool
-> UnknownField
-> MethodDescriptorProto
MethodDescriptorProto Maybe Utf8
z'1 Maybe Utf8
z'2 Maybe Utf8
z'3 Maybe MethodOptions
z'4 Maybe Bool
z'5 Maybe Bool
z'6 UnknownField
z'7

instance P'.Default MethodDescriptorProto where
  defaultValue :: MethodDescriptorProto
defaultValue
   = Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe MethodOptions
-> Maybe Bool
-> Maybe Bool
-> UnknownField
-> MethodDescriptorProto
MethodDescriptorProto Maybe Utf8
forall a. Default a => a
P'.defaultValue Maybe Utf8
forall a. Default a => a
P'.defaultValue Maybe Utf8
forall a. Default a => a
P'.defaultValue Maybe MethodOptions
forall a. Default a => a
P'.defaultValue (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)
      UnknownField
forall a. Default a => a
P'.defaultValue

instance P'.Wire MethodDescriptorProto where
  wireSize :: FieldType -> MethodDescriptorProto -> WireSize
wireSize FieldType
ft' self' :: MethodDescriptorProto
self'@(MethodDescriptorProto Maybe Utf8
x'1 Maybe Utf8
x'2 Maybe Utf8
x'3 Maybe MethodOptions
x'4 Maybe Bool
x'5 Maybe Bool
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 -> MethodDescriptorProto -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' MethodDescriptorProto
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 -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'2 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'3 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe MethodOptions -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
11 Maybe MethodOptions
x'4 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'5
             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'6
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'7)
  wirePutWithSize :: FieldType -> MethodDescriptorProto -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: MethodDescriptorProto
self'@(MethodDescriptorProto Maybe Utf8
x'1 Maybe Utf8
x'2 Maybe Utf8
x'3 Maybe MethodOptions
x'4 Maybe Bool
x'5 Maybe Bool
x'6 UnknownField
x'7)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> MethodDescriptorProto -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' MethodDescriptorProto
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 -> Maybe Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
18 FieldType
9 Maybe Utf8
x'2, WireTag -> FieldType -> Maybe Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
26 FieldType
9 Maybe Utf8
x'3,
             WireTag -> FieldType -> Maybe MethodOptions -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
34 FieldType
11 Maybe MethodOptions
x'4, WireTag -> FieldType -> Maybe Bool -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
40 FieldType
8 Maybe Bool
x'5, WireTag -> FieldType -> Maybe Bool -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
48 FieldType
8 Maybe Bool
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 MethodDescriptorProto
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto)
-> Get MethodDescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto)
-> (WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto)
-> WireTag
-> MethodDescriptorProto
-> Get MethodDescriptorProto
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto
update'Self)
       FieldType
11 -> (WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto)
-> Get MethodDescriptorProto
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto)
-> (WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto)
-> WireTag
-> MethodDescriptorProto
-> Get MethodDescriptorProto
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto
update'Self)
       FieldType
_ -> FieldType -> Get MethodDescriptorProto
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> MethodDescriptorProto -> Get MethodDescriptorProto
update'Self WireTag
wire'Tag MethodDescriptorProto
old'Self
         = case WireTag
wire'Tag of
             WireTag
10 -> (Utf8 -> MethodDescriptorProto)
-> Get Utf8 -> Get MethodDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> MethodDescriptorProto
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 -> (Utf8 -> MethodDescriptorProto)
-> Get Utf8 -> Get MethodDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> MethodDescriptorProto
old'Self{input_type :: Maybe Utf8
input_type = 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
26 -> (Utf8 -> MethodDescriptorProto)
-> Get Utf8 -> Get MethodDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> MethodDescriptorProto
old'Self{output_type :: Maybe Utf8
output_type = 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
34 -> (MethodOptions -> MethodDescriptorProto)
-> Get MethodOptions -> Get MethodDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !MethodOptions
new'Field -> MethodDescriptorProto
old'Self{options :: Maybe MethodOptions
options = Maybe MethodOptions -> Maybe MethodOptions -> Maybe MethodOptions
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (MethodDescriptorProto -> Maybe MethodOptions
options MethodDescriptorProto
old'Self) (MethodOptions -> Maybe MethodOptions
forall a. a -> Maybe a
Prelude'.Just MethodOptions
new'Field)})
                    (FieldType -> Get MethodOptions
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
40 -> (Bool -> MethodDescriptorProto)
-> Get Bool -> Get MethodDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Bool
new'Field -> MethodDescriptorProto
old'Self{client_streaming :: Maybe Bool
client_streaming = 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
48 -> (Bool -> MethodDescriptorProto)
-> Get Bool -> Get MethodDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Bool
new'Field -> MethodDescriptorProto
old'Self{server_streaming :: Maybe Bool
server_streaming = 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
_ -> let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag in FieldId
-> WireType -> MethodDescriptorProto -> Get MethodDescriptorProto
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type MethodDescriptorProto
old'Self

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

instance P'.GPB MethodDescriptorProto

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

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

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