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

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

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

instance P'.Mergeable UninterpretedOption where
  mergeAppend :: UninterpretedOption -> UninterpretedOption -> UninterpretedOption
mergeAppend (UninterpretedOption Seq NamePart
x'1 Maybe Utf8
x'2 Maybe Word64
x'3 Maybe Int64
x'4 Maybe Double
x'5 Maybe ByteString
x'6 Maybe Utf8
x'7 UnknownField
x'8) (UninterpretedOption Seq NamePart
y'1 Maybe Utf8
y'2 Maybe Word64
y'3 Maybe Int64
y'4 Maybe Double
y'5 Maybe ByteString
y'6 Maybe Utf8
y'7 UnknownField
y'8)
   = let !z'1 :: Seq NamePart
z'1 = Seq NamePart -> Seq NamePart -> Seq NamePart
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq NamePart
x'1 Seq NamePart
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 Word64
z'3 = Maybe Word64 -> Maybe Word64 -> Maybe Word64
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Word64
x'3 Maybe Word64
y'3
         !z'4 :: Maybe Int64
z'4 = Maybe Int64 -> Maybe Int64 -> Maybe Int64
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Int64
x'4 Maybe Int64
y'4
         !z'5 :: Maybe Double
z'5 = Maybe Double -> Maybe Double -> Maybe Double
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Double
x'5 Maybe Double
y'5
         !z'6 :: Maybe ByteString
z'6 = Maybe ByteString -> Maybe ByteString -> Maybe ByteString
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe ByteString
x'6 Maybe ByteString
y'6
         !z'7 :: Maybe Utf8
z'7 = Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'7 Maybe Utf8
y'7
         !z'8 :: UnknownField
z'8 = UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'8 UnknownField
y'8
      in Seq NamePart
-> Maybe Utf8
-> Maybe Word64
-> Maybe Int64
-> Maybe Double
-> Maybe ByteString
-> Maybe Utf8
-> UnknownField
-> UninterpretedOption
UninterpretedOption Seq NamePart
z'1 Maybe Utf8
z'2 Maybe Word64
z'3 Maybe Int64
z'4 Maybe Double
z'5 Maybe ByteString
z'6 Maybe Utf8
z'7 UnknownField
z'8

instance P'.Default UninterpretedOption where
  defaultValue :: UninterpretedOption
defaultValue
   = Seq NamePart
-> Maybe Utf8
-> Maybe Word64
-> Maybe Int64
-> Maybe Double
-> Maybe ByteString
-> Maybe Utf8
-> UnknownField
-> UninterpretedOption
UninterpretedOption Seq NamePart
forall a. Default a => a
P'.defaultValue Maybe Utf8
forall a. Default a => a
P'.defaultValue Maybe Word64
forall a. Default a => a
P'.defaultValue Maybe Int64
forall a. Default a => a
P'.defaultValue Maybe Double
forall a. Default a => a
P'.defaultValue Maybe ByteString
forall a. Default a => a
P'.defaultValue
      Maybe Utf8
forall a. Default a => a
P'.defaultValue
      UnknownField
forall a. Default a => a
P'.defaultValue

instance P'.Wire UninterpretedOption where
  wireSize :: FieldType -> UninterpretedOption -> Int64
wireSize FieldType
ft' self' :: UninterpretedOption
self'@(UninterpretedOption Seq NamePart
x'1 Maybe Utf8
x'2 Maybe Word64
x'3 Maybe Int64
x'4 Maybe Double
x'5 Maybe ByteString
x'6 Maybe Utf8
x'7 UnknownField
x'8)
   = case FieldType
ft' of
       FieldType
10 -> Int64
calc'Size
       FieldType
11 -> Int64 -> Int64
P'.prependMessageSize Int64
calc'Size
       FieldType
_ -> FieldType -> UninterpretedOption -> Int64
forall a. Typeable a => FieldType -> a -> Int64
P'.wireSizeErr FieldType
ft' UninterpretedOption
self'
    where
        calc'Size :: Int64
calc'Size
         = (Int64 -> FieldType -> Seq NamePart -> Int64
forall v. Wire v => Int64 -> FieldType -> Seq v -> Int64
P'.wireSizeRep Int64
1 FieldType
11 Seq NamePart
x'1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> FieldType -> Maybe Utf8 -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
9 Maybe Utf8
x'2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> FieldType -> Maybe Word64 -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
4 Maybe Word64
x'3 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> FieldType -> Maybe Int64 -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
3 Maybe Int64
x'4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
             Int64 -> FieldType -> Maybe Double -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
1 Maybe Double
x'5
             Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> FieldType -> Maybe ByteString -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
12 Maybe ByteString
x'6
             Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> FieldType -> Maybe Utf8 -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
9 Maybe Utf8
x'7
             Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ UnknownField -> Int64
P'.wireSizeUnknownField UnknownField
x'8)
  wirePutWithSize :: FieldType -> UninterpretedOption -> PutM Int64
wirePutWithSize FieldType
ft' self' :: UninterpretedOption
self'@(UninterpretedOption Seq NamePart
x'1 Maybe Utf8
x'2 Maybe Word64
x'3 Maybe Int64
x'4 Maybe Double
x'5 Maybe ByteString
x'6 Maybe Utf8
x'7 UnknownField
x'8)
   = case FieldType
ft' of
       FieldType
10 -> PutM Int64
put'Fields
       FieldType
11 -> PutM Int64
put'FieldsSized
       FieldType
_ -> FieldType -> UninterpretedOption -> PutM Int64
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' UninterpretedOption
self'
    where
        put'Fields :: PutM Int64
put'Fields
         = [PutM Int64] -> PutM Int64
forall (f :: * -> *). Foldable f => f (PutM Int64) -> PutM Int64
P'.sequencePutWithSize
            [WireTag -> FieldType -> Seq NamePart -> PutM Int64
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM Int64
P'.wirePutRepWithSize WireTag
18 FieldType
11 Seq NamePart
x'1, WireTag -> FieldType -> Maybe Utf8 -> PutM Int64
forall v. Wire v => WireTag -> FieldType -> Maybe v -> PutM Int64
P'.wirePutOptWithSize WireTag
26 FieldType
9 Maybe Utf8
x'2, WireTag -> FieldType -> Maybe Word64 -> PutM Int64
forall v. Wire v => WireTag -> FieldType -> Maybe v -> PutM Int64
P'.wirePutOptWithSize WireTag
32 FieldType
4 Maybe Word64
x'3,
             WireTag -> FieldType -> Maybe Int64 -> PutM Int64
forall v. Wire v => WireTag -> FieldType -> Maybe v -> PutM Int64
P'.wirePutOptWithSize WireTag
40 FieldType
3 Maybe Int64
x'4, WireTag -> FieldType -> Maybe Double -> PutM Int64
forall v. Wire v => WireTag -> FieldType -> Maybe v -> PutM Int64
P'.wirePutOptWithSize WireTag
49 FieldType
1 Maybe Double
x'5, WireTag -> FieldType -> Maybe ByteString -> PutM Int64
forall v. Wire v => WireTag -> FieldType -> Maybe v -> PutM Int64
P'.wirePutOptWithSize WireTag
58 FieldType
12 Maybe ByteString
x'6,
             WireTag -> FieldType -> Maybe Utf8 -> PutM Int64
forall v. Wire v => WireTag -> FieldType -> Maybe v -> PutM Int64
P'.wirePutOptWithSize WireTag
66 FieldType
9 Maybe Utf8
x'7, UnknownField -> PutM Int64
P'.wirePutUnknownFieldWithSize UnknownField
x'8]
        put'FieldsSized :: PutM Int64
put'FieldsSized
         = let size' :: Int64
size' = (Int64, ByteString) -> Int64
forall a b. (a, b) -> a
Prelude'.fst (PutM Int64 -> (Int64, ByteString)
forall a. PutM a -> (a, ByteString)
P'.runPutM PutM Int64
put'Fields)
               put'Size :: PutM Int64
put'Size
                = do
                    Int64 -> Put
P'.putSize Int64
size'
                    Int64 -> PutM Int64
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (Int64 -> Int64
P'.size'WireSize Int64
size')
            in [PutM Int64] -> PutM Int64
forall (f :: * -> *). Foldable f => f (PutM Int64) -> PutM Int64
P'.sequencePutWithSize [PutM Int64
put'Size, PutM Int64
put'Fields]
  wireGet :: FieldType -> Get UninterpretedOption
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> UninterpretedOption -> Get UninterpretedOption)
-> Get UninterpretedOption
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> UninterpretedOption -> Get UninterpretedOption)
-> (WireTag -> UninterpretedOption -> Get UninterpretedOption)
-> WireTag
-> UninterpretedOption
-> Get UninterpretedOption
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> UninterpretedOption -> Get UninterpretedOption
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> UninterpretedOption -> Get UninterpretedOption
update'Self)
       FieldType
11 -> (WireTag -> UninterpretedOption -> Get UninterpretedOption)
-> Get UninterpretedOption
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> UninterpretedOption -> Get UninterpretedOption)
-> (WireTag -> UninterpretedOption -> Get UninterpretedOption)
-> WireTag
-> UninterpretedOption
-> Get UninterpretedOption
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> UninterpretedOption -> Get UninterpretedOption
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> UninterpretedOption -> Get UninterpretedOption
update'Self)
       FieldType
_ -> FieldType -> Get UninterpretedOption
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> UninterpretedOption -> Get UninterpretedOption
update'Self WireTag
wire'Tag UninterpretedOption
old'Self
         = case WireTag
wire'Tag of
             WireTag
18 -> (NamePart -> UninterpretedOption)
-> Get NamePart -> Get UninterpretedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !NamePart
new'Field -> UninterpretedOption
old'Self{name :: Seq NamePart
name = Seq NamePart -> NamePart -> Seq NamePart
forall a. Seq a -> a -> Seq a
P'.append (UninterpretedOption -> Seq NamePart
name UninterpretedOption
old'Self) NamePart
new'Field}) (FieldType -> Get NamePart
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
26 -> (Utf8 -> UninterpretedOption)
-> Get Utf8 -> Get UninterpretedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> UninterpretedOption
old'Self{identifier_value :: Maybe Utf8
identifier_value = 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
32 -> (Word64 -> UninterpretedOption)
-> Get Word64 -> Get UninterpretedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Word64
new'Field -> UninterpretedOption
old'Self{positive_int_value :: Maybe Word64
positive_int_value = Word64 -> Maybe Word64
forall a. a -> Maybe a
Prelude'.Just Word64
new'Field}) (FieldType -> Get Word64
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
4)
             WireTag
40 -> (Int64 -> UninterpretedOption)
-> Get Int64 -> Get UninterpretedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Int64
new'Field -> UninterpretedOption
old'Self{negative_int_value :: Maybe Int64
negative_int_value = Int64 -> Maybe Int64
forall a. a -> Maybe a
Prelude'.Just Int64
new'Field}) (FieldType -> Get Int64
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
3)
             WireTag
49 -> (Double -> UninterpretedOption)
-> Get Double -> Get UninterpretedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Double
new'Field -> UninterpretedOption
old'Self{double_value :: Maybe Double
double_value = Double -> Maybe Double
forall a. a -> Maybe a
Prelude'.Just Double
new'Field}) (FieldType -> Get Double
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
1)
             WireTag
58 -> (ByteString -> UninterpretedOption)
-> Get ByteString -> Get UninterpretedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !ByteString
new'Field -> UninterpretedOption
old'Self{string_value :: Maybe ByteString
string_value = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Prelude'.Just ByteString
new'Field}) (FieldType -> Get ByteString
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
12)
             WireTag
66 -> (Utf8 -> UninterpretedOption)
-> Get Utf8 -> Get UninterpretedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> UninterpretedOption
old'Self{aggregate_value :: Maybe Utf8
aggregate_value = 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
_ -> let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag in FieldId
-> WireType -> UninterpretedOption -> Get UninterpretedOption
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type UninterpretedOption
old'Self

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

instance P'.GPB UninterpretedOption

instance P'.ReflectDescriptor UninterpretedOption where
  getMessageInfo :: UninterpretedOption -> GetMessageInfo
getMessageInfo UninterpretedOption
_ = 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
18, WireTag
26, WireTag
32, WireTag
40, WireTag
49, WireTag
58, WireTag
66])
  reflectDescriptorInfo :: UninterpretedOption -> DescriptorInfo
reflectDescriptorInfo UninterpretedOption
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.UninterpretedOption\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"UninterpretedOption\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"UninterpretedOption.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.UninterpretedOption.name\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"UninterpretedOption\"], baseName' = FName \"name\", 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.UninterpretedOption.NamePart\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\",MName \"UninterpretedOption\"], baseName = MName \"NamePart\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.UninterpretedOption.identifier_value\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"UninterpretedOption\"], baseName' = FName \"identifier_value\", 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.UninterpretedOption.positive_int_value\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"UninterpretedOption\"], baseName' = FName \"positive_int_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.UninterpretedOption.negative_int_value\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"UninterpretedOption\"], baseName' = FName \"negative_int_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.UninterpretedOption.double_value\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"UninterpretedOption\"], baseName' = FName \"double_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 49}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.UninterpretedOption.string_value\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"UninterpretedOption\"], baseName' = FName \"string_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.UninterpretedOption.aggregate_value\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"UninterpretedOption\"], baseName' = FName \"aggregate_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = True, lazyFields = False, makeLenses = False, jsonInstances = False}"

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

instance P'.TextMsg UninterpretedOption where
  textPut :: UninterpretedOption -> Output
textPut UninterpretedOption
msg
   = do
       String -> Seq NamePart -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"name" (UninterpretedOption -> Seq NamePart
name UninterpretedOption
msg)
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"identifier_value" (UninterpretedOption -> Maybe Utf8
identifier_value UninterpretedOption
msg)
       String -> Maybe Word64 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"positive_int_value" (UninterpretedOption -> Maybe Word64
positive_int_value UninterpretedOption
msg)
       String -> Maybe Int64 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"negative_int_value" (UninterpretedOption -> Maybe Int64
negative_int_value UninterpretedOption
msg)
       String -> Maybe Double -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"double_value" (UninterpretedOption -> Maybe Double
double_value UninterpretedOption
msg)
       String -> Maybe ByteString -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"string_value" (UninterpretedOption -> Maybe ByteString
string_value UninterpretedOption
msg)
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"aggregate_value" (UninterpretedOption -> Maybe Utf8
aggregate_value UninterpretedOption
msg)
  textGet :: Parsec s () UninterpretedOption
textGet
   = do
       [UninterpretedOption -> UninterpretedOption]
mods <- ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
-> ParsecT s () Identity ()
-> ParsecT
     s () Identity [UninterpretedOption -> UninterpretedOption]
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 (UninterpretedOption -> UninterpretedOption)]
-> ParsecT
     s () Identity (UninterpretedOption -> UninterpretedOption)
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 (UninterpretedOption -> UninterpretedOption)
parse'name, ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'identifier_value, ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'positive_int_value, ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'negative_int_value, ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'double_value,
                   ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'string_value, ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'aggregate_value])
                ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
       UninterpretedOption -> Parsec s () UninterpretedOption
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((UninterpretedOption
 -> (UninterpretedOption -> UninterpretedOption)
 -> UninterpretedOption)
-> UninterpretedOption
-> [UninterpretedOption -> UninterpretedOption]
-> UninterpretedOption
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl' (\ UninterpretedOption
v UninterpretedOption -> UninterpretedOption
f -> UninterpretedOption -> UninterpretedOption
f UninterpretedOption
v) UninterpretedOption
forall a. Default a => a
P'.defaultValue [UninterpretedOption -> UninterpretedOption]
mods)
    where
        parse'name :: ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'name = (NamePart -> UninterpretedOption -> UninterpretedOption)
-> ParsecT s () Identity NamePart
-> ParsecT
     s () Identity (UninterpretedOption -> UninterpretedOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ NamePart
v UninterpretedOption
o -> UninterpretedOption
o{name :: Seq NamePart
name = Seq NamePart -> NamePart -> Seq NamePart
forall a. Seq a -> a -> Seq a
P'.append (UninterpretedOption -> Seq NamePart
name UninterpretedOption
o) NamePart
v}) (ParsecT s () Identity NamePart -> ParsecT s () Identity NamePart
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity NamePart
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"name"))
        parse'identifier_value :: ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'identifier_value = (Maybe Utf8 -> UninterpretedOption -> UninterpretedOption)
-> ParsecT s () Identity (Maybe Utf8)
-> ParsecT
     s () Identity (UninterpretedOption -> UninterpretedOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Utf8
v UninterpretedOption
o -> UninterpretedOption
o{identifier_value :: Maybe Utf8
identifier_value = 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
"identifier_value"))
        parse'positive_int_value :: ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'positive_int_value = (Maybe Word64 -> UninterpretedOption -> UninterpretedOption)
-> ParsecT s () Identity (Maybe Word64)
-> ParsecT
     s () Identity (UninterpretedOption -> UninterpretedOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Word64
v UninterpretedOption
o -> UninterpretedOption
o{positive_int_value :: Maybe Word64
positive_int_value = Maybe Word64
v}) (ParsecT s () Identity (Maybe Word64)
-> ParsecT s () Identity (Maybe Word64)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe Word64)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"positive_int_value"))
        parse'negative_int_value :: ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'negative_int_value = (Maybe Int64 -> UninterpretedOption -> UninterpretedOption)
-> ParsecT s () Identity (Maybe Int64)
-> ParsecT
     s () Identity (UninterpretedOption -> UninterpretedOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Int64
v UninterpretedOption
o -> UninterpretedOption
o{negative_int_value :: Maybe Int64
negative_int_value = Maybe Int64
v}) (ParsecT s () Identity (Maybe Int64)
-> ParsecT s () Identity (Maybe Int64)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe Int64)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"negative_int_value"))
        parse'double_value :: ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'double_value = (Maybe Double -> UninterpretedOption -> UninterpretedOption)
-> ParsecT s () Identity (Maybe Double)
-> ParsecT
     s () Identity (UninterpretedOption -> UninterpretedOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Double
v UninterpretedOption
o -> UninterpretedOption
o{double_value :: Maybe Double
double_value = Maybe Double
v}) (ParsecT s () Identity (Maybe Double)
-> ParsecT s () Identity (Maybe Double)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe Double)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"double_value"))
        parse'string_value :: ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'string_value = (Maybe ByteString -> UninterpretedOption -> UninterpretedOption)
-> ParsecT s () Identity (Maybe ByteString)
-> ParsecT
     s () Identity (UninterpretedOption -> UninterpretedOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe ByteString
v UninterpretedOption
o -> UninterpretedOption
o{string_value :: Maybe ByteString
string_value = Maybe ByteString
v}) (ParsecT s () Identity (Maybe ByteString)
-> ParsecT s () Identity (Maybe ByteString)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe ByteString)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"string_value"))
        parse'aggregate_value :: ParsecT s () Identity (UninterpretedOption -> UninterpretedOption)
parse'aggregate_value = (Maybe Utf8 -> UninterpretedOption -> UninterpretedOption)
-> ParsecT s () Identity (Maybe Utf8)
-> ParsecT
     s () Identity (UninterpretedOption -> UninterpretedOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Utf8
v UninterpretedOption
o -> UninterpretedOption
o{aggregate_value :: Maybe Utf8
aggregate_value = 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
"aggregate_value"))