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

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

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

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

instance P'.Mergeable FieldOptions where
  mergeAppend :: FieldOptions -> FieldOptions -> FieldOptions
mergeAppend (FieldOptions Maybe CType
x'1 Maybe Bool
x'2 Maybe JSType
x'3 Maybe Bool
x'4 Maybe Bool
x'5 Maybe Bool
x'6 Seq UninterpretedOption
x'7 ExtField
x'8 UnknownField
x'9) (FieldOptions Maybe CType
y'1 Maybe Bool
y'2 Maybe JSType
y'3 Maybe Bool
y'4 Maybe Bool
y'5 Maybe Bool
y'6 Seq UninterpretedOption
y'7 ExtField
y'8 UnknownField
y'9)
   = let !z'1 :: Maybe CType
z'1 = Maybe CType -> Maybe CType -> Maybe CType
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe CType
x'1 Maybe CType
y'1
         !z'2 :: Maybe Bool
z'2 = Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Bool
x'2 Maybe Bool
y'2
         !z'3 :: Maybe JSType
z'3 = Maybe JSType -> Maybe JSType -> Maybe JSType
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe JSType
x'3 Maybe JSType
y'3
         !z'4 :: Maybe Bool
z'4 = Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Bool
x'4 Maybe Bool
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 :: Seq UninterpretedOption
z'7 = Seq UninterpretedOption
-> Seq UninterpretedOption -> Seq UninterpretedOption
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq UninterpretedOption
x'7 Seq UninterpretedOption
y'7
         !z'8 :: ExtField
z'8 = ExtField -> ExtField -> ExtField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend ExtField
x'8 ExtField
y'8
         !z'9 :: UnknownField
z'9 = UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'9 UnknownField
y'9
      in Maybe CType
-> Maybe Bool
-> Maybe JSType
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Seq UninterpretedOption
-> ExtField
-> UnknownField
-> FieldOptions
FieldOptions Maybe CType
z'1 Maybe Bool
z'2 Maybe JSType
z'3 Maybe Bool
z'4 Maybe Bool
z'5 Maybe Bool
z'6 Seq UninterpretedOption
z'7 ExtField
z'8 UnknownField
z'9

instance P'.Default FieldOptions where
  defaultValue :: FieldOptions
defaultValue
   = Maybe CType
-> Maybe Bool
-> Maybe JSType
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Seq UninterpretedOption
-> ExtField
-> UnknownField
-> FieldOptions
FieldOptions (CType -> Maybe CType
forall a. a -> Maybe a
Prelude'.Just (String -> CType
forall a. Read a => String -> a
Prelude'.read String
"STRING")) Maybe Bool
forall a. Default a => a
P'.defaultValue (JSType -> Maybe JSType
forall a. a -> Maybe a
Prelude'.Just (String -> JSType
forall a. Read a => String -> a
Prelude'.read String
"JS_NORMAL"))
      (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)
      (Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude'.Just Bool
Prelude'.False)
      Seq UninterpretedOption
forall a. Default a => a
P'.defaultValue
      ExtField
forall a. Default a => a
P'.defaultValue
      UnknownField
forall a. Default a => a
P'.defaultValue

instance P'.Wire FieldOptions where
  wireSize :: FieldType -> FieldOptions -> WireSize
wireSize FieldType
ft' self' :: FieldOptions
self'@(FieldOptions Maybe CType
x'1 Maybe Bool
x'2 Maybe JSType
x'3 Maybe Bool
x'4 Maybe Bool
x'5 Maybe Bool
x'6 Seq UninterpretedOption
x'7 ExtField
x'8 UnknownField
x'9)
   = case FieldType
ft' of
       FieldType
10 -> WireSize
calc'Size
       FieldType
11 -> WireSize -> WireSize
P'.prependMessageSize WireSize
calc'Size
       FieldType
_ -> FieldType -> FieldOptions -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' FieldOptions
self'
    where
        calc'Size :: WireSize
calc'Size
         = (WireSize -> FieldType -> Maybe CType -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
14 Maybe CType
x'1 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'2 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe JSType -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
14 Maybe JSType
x'3 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'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
+ WireSize -> FieldType -> Seq UninterpretedOption -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
2 FieldType
11 Seq UninterpretedOption
x'7
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ ExtField -> WireSize
P'.wireSizeExtField ExtField
x'8
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'9)
  wirePutWithSize :: FieldType -> FieldOptions -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: FieldOptions
self'@(FieldOptions Maybe CType
x'1 Maybe Bool
x'2 Maybe JSType
x'3 Maybe Bool
x'4 Maybe Bool
x'5 Maybe Bool
x'6 Seq UninterpretedOption
x'7 ExtField
x'8 UnknownField
x'9)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> FieldOptions -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' FieldOptions
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 CType -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
8 FieldType
14 Maybe CType
x'1, WireTag -> FieldType -> Maybe Bool -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
16 FieldType
8 Maybe Bool
x'2, WireTag -> FieldType -> Maybe Bool -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
24 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
40 FieldType
8 Maybe Bool
x'4, WireTag -> FieldType -> Maybe JSType -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
48 FieldType
14 Maybe JSType
x'3, WireTag -> FieldType -> Maybe Bool -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
80 FieldType
8 Maybe Bool
x'6,
             WireTag -> FieldType -> Seq UninterpretedOption -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
7994 FieldType
11 Seq UninterpretedOption
x'7, ExtField -> PutM WireSize
P'.wirePutExtFieldWithSize ExtField
x'8, UnknownField -> PutM WireSize
P'.wirePutUnknownFieldWithSize UnknownField
x'9]
        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 FieldOptions
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> FieldOptions -> Get FieldOptions) -> Get FieldOptions
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> FieldOptions -> Get FieldOptions)
-> (WireTag -> FieldOptions -> Get FieldOptions)
-> WireTag
-> FieldOptions
-> Get FieldOptions
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> FieldOptions -> Get FieldOptions
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> FieldOptions -> Get FieldOptions
update'Self)
       FieldType
11 -> (WireTag -> FieldOptions -> Get FieldOptions) -> Get FieldOptions
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> FieldOptions -> Get FieldOptions)
-> (WireTag -> FieldOptions -> Get FieldOptions)
-> WireTag
-> FieldOptions
-> Get FieldOptions
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> FieldOptions -> Get FieldOptions
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> FieldOptions -> Get FieldOptions
update'Self)
       FieldType
_ -> FieldType -> Get FieldOptions
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> FieldOptions -> Get FieldOptions
update'Self WireTag
wire'Tag FieldOptions
old'Self
         = case WireTag
wire'Tag of
             WireTag
8 -> (CType -> FieldOptions) -> Get CType -> Get FieldOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !CType
new'Field -> FieldOptions
old'Self{ctype :: Maybe CType
ctype = CType -> Maybe CType
forall a. a -> Maybe a
Prelude'.Just CType
new'Field}) (FieldType -> Get CType
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
14)
             WireTag
16 -> (Bool -> FieldOptions) -> Get Bool -> Get FieldOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Bool
new'Field -> FieldOptions
old'Self{packed :: Maybe Bool
packed = 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 -> (JSType -> FieldOptions) -> Get JSType -> Get FieldOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !JSType
new'Field -> FieldOptions
old'Self{jstype :: Maybe JSType
jstype = JSType -> Maybe JSType
forall a. a -> Maybe a
Prelude'.Just JSType
new'Field}) (FieldType -> Get JSType
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
14)
             WireTag
40 -> (Bool -> FieldOptions) -> Get Bool -> Get FieldOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Bool
new'Field -> FieldOptions
old'Self{lazy :: Maybe Bool
lazy = 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
24 -> (Bool -> FieldOptions) -> Get Bool -> Get FieldOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Bool
new'Field -> FieldOptions
old'Self{deprecated :: Maybe Bool
deprecated = Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude'.Just Bool
new'Field}) (FieldType -> Get Bool
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
8)
             WireTag
80 -> (Bool -> FieldOptions) -> Get Bool -> Get FieldOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Bool
new'Field -> FieldOptions
old'Self{weak :: Maybe Bool
weak = Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude'.Just Bool
new'Field}) (FieldType -> Get Bool
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
8)
             WireTag
7994 -> (UninterpretedOption -> FieldOptions)
-> Get UninterpretedOption -> Get FieldOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
                      (\ !UninterpretedOption
new'Field -> FieldOptions
old'Self{uninterpreted_option :: Seq UninterpretedOption
uninterpreted_option = Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
P'.append (FieldOptions -> Seq UninterpretedOption
uninterpreted_option FieldOptions
old'Self) UninterpretedOption
new'Field})
                      (FieldType -> Get UninterpretedOption
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
_ -> let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag in
                   if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
Prelude'.or [FieldId
1000 FieldId -> FieldId -> Bool
forall a. Ord a => a -> a -> Bool
<= FieldId
field'Number Bool -> Bool -> Bool
&& FieldId
field'Number FieldId -> FieldId -> Bool
forall a. Ord a => a -> a -> Bool
<= FieldId
18999, FieldId
20000 FieldId -> FieldId -> Bool
forall a. Ord a => a -> a -> Bool
<= FieldId
field'Number] then
                    FieldId -> WireType -> FieldOptions -> Get FieldOptions
forall a.
(ReflectDescriptor a, ExtendMessage a) =>
FieldId -> WireType -> a -> Get a
P'.loadExtension FieldId
field'Number WireType
wire'Type FieldOptions
old'Self else FieldId -> WireType -> FieldOptions -> Get FieldOptions
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type FieldOptions
old'Self

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

instance P'.GPB FieldOptions

instance P'.ReflectDescriptor FieldOptions where
  getMessageInfo :: FieldOptions -> GetMessageInfo
getMessageInfo FieldOptions
_ = 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
8, WireTag
16, WireTag
24, WireTag
40, WireTag
48, WireTag
80, WireTag
7994])
  reflectDescriptorInfo :: FieldOptions -> DescriptorInfo
reflectDescriptorInfo FieldOptions
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.FieldOptions\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"FieldOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FieldOptions.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldOptions.ctype\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldOptions\"], baseName' = FName \"ctype\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.FieldOptions.CType\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\",MName \"FieldOptions\"], baseName = MName \"CType\"}), hsRawDefault = Just \"STRING\", hsDefault = Just (HsDef'Enum \"STRING\")},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldOptions.packed\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldOptions\"], baseName' = FName \"packed\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldOptions.jstype\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldOptions\"], baseName' = FName \"jstype\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 48}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.FieldOptions.JSType\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\",MName \"FieldOptions\"], baseName = MName \"JSType\"}), hsRawDefault = Just \"JS_NORMAL\", hsDefault = Just (HsDef'Enum \"JS_NORMAL\")},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.FieldOptions.lazy\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldOptions\"], baseName' = FName \"lazy\", 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.FieldOptions.deprecated\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldOptions\"], baseName' = FName \"deprecated\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, 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.FieldOptions.weak\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldOptions\"], baseName' = FName \"weak\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 80}, 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.FieldOptions.uninterpreted_option\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"FieldOptions\"], baseName' = FName \"uninterpreted_option\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 999}, wireTag = WireTag {getWireTag = 7994}, packedTag = Nothing, wireTagLength = 2, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.UninterpretedOption\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"UninterpretedOption\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [(FieldId {getFieldId = 1000},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 536870911})], knownKeys = fromList [], storeUnknown = True, lazyFields = False, makeLenses = False, jsonInstances = False}"

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

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