{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-} {-# OPTIONS_GHC -w #-} module Text.DescriptorProtos.OneofDescriptorProto (OneofDescriptorProto(..)) 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' data OneofDescriptorProto = OneofDescriptorProto{OneofDescriptorProto -> Maybe Utf8 name :: !(P'.Maybe P'.Utf8), OneofDescriptorProto -> UnknownField unknown'field :: !(P'.UnknownField)} deriving (Int -> OneofDescriptorProto -> ShowS [OneofDescriptorProto] -> ShowS OneofDescriptorProto -> String (Int -> OneofDescriptorProto -> ShowS) -> (OneofDescriptorProto -> String) -> ([OneofDescriptorProto] -> ShowS) -> Show OneofDescriptorProto forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [OneofDescriptorProto] -> ShowS $cshowList :: [OneofDescriptorProto] -> ShowS show :: OneofDescriptorProto -> String $cshow :: OneofDescriptorProto -> String showsPrec :: Int -> OneofDescriptorProto -> ShowS $cshowsPrec :: Int -> OneofDescriptorProto -> ShowS Prelude'.Show, OneofDescriptorProto -> OneofDescriptorProto -> Bool (OneofDescriptorProto -> OneofDescriptorProto -> Bool) -> (OneofDescriptorProto -> OneofDescriptorProto -> Bool) -> Eq OneofDescriptorProto forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: OneofDescriptorProto -> OneofDescriptorProto -> Bool $c/= :: OneofDescriptorProto -> OneofDescriptorProto -> Bool == :: OneofDescriptorProto -> OneofDescriptorProto -> Bool $c== :: OneofDescriptorProto -> OneofDescriptorProto -> Bool Prelude'.Eq, Eq OneofDescriptorProto Eq OneofDescriptorProto -> (OneofDescriptorProto -> OneofDescriptorProto -> Ordering) -> (OneofDescriptorProto -> OneofDescriptorProto -> Bool) -> (OneofDescriptorProto -> OneofDescriptorProto -> Bool) -> (OneofDescriptorProto -> OneofDescriptorProto -> Bool) -> (OneofDescriptorProto -> OneofDescriptorProto -> Bool) -> (OneofDescriptorProto -> OneofDescriptorProto -> OneofDescriptorProto) -> (OneofDescriptorProto -> OneofDescriptorProto -> OneofDescriptorProto) -> Ord OneofDescriptorProto OneofDescriptorProto -> OneofDescriptorProto -> Bool OneofDescriptorProto -> OneofDescriptorProto -> Ordering OneofDescriptorProto -> OneofDescriptorProto -> OneofDescriptorProto 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 :: OneofDescriptorProto -> OneofDescriptorProto -> OneofDescriptorProto $cmin :: OneofDescriptorProto -> OneofDescriptorProto -> OneofDescriptorProto max :: OneofDescriptorProto -> OneofDescriptorProto -> OneofDescriptorProto $cmax :: OneofDescriptorProto -> OneofDescriptorProto -> OneofDescriptorProto >= :: OneofDescriptorProto -> OneofDescriptorProto -> Bool $c>= :: OneofDescriptorProto -> OneofDescriptorProto -> Bool > :: OneofDescriptorProto -> OneofDescriptorProto -> Bool $c> :: OneofDescriptorProto -> OneofDescriptorProto -> Bool <= :: OneofDescriptorProto -> OneofDescriptorProto -> Bool $c<= :: OneofDescriptorProto -> OneofDescriptorProto -> Bool < :: OneofDescriptorProto -> OneofDescriptorProto -> Bool $c< :: OneofDescriptorProto -> OneofDescriptorProto -> Bool compare :: OneofDescriptorProto -> OneofDescriptorProto -> Ordering $ccompare :: OneofDescriptorProto -> OneofDescriptorProto -> Ordering $cp1Ord :: Eq OneofDescriptorProto Prelude'.Ord, Prelude'.Typeable, Typeable OneofDescriptorProto DataType Constr Typeable OneofDescriptorProto -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> OneofDescriptorProto -> c OneofDescriptorProto) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c OneofDescriptorProto) -> (OneofDescriptorProto -> Constr) -> (OneofDescriptorProto -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c OneofDescriptorProto)) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OneofDescriptorProto)) -> ((forall b. Data b => b -> b) -> OneofDescriptorProto -> OneofDescriptorProto) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OneofDescriptorProto -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OneofDescriptorProto -> r) -> (forall u. (forall d. Data d => d -> u) -> OneofDescriptorProto -> [u]) -> (forall u. Int -> (forall d. Data d => d -> u) -> OneofDescriptorProto -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto) -> Data OneofDescriptorProto OneofDescriptorProto -> DataType OneofDescriptorProto -> Constr (forall b. Data b => b -> b) -> OneofDescriptorProto -> OneofDescriptorProto (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> OneofDescriptorProto -> c OneofDescriptorProto (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c OneofDescriptorProto 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) -> OneofDescriptorProto -> u forall u. (forall d. Data d => d -> u) -> OneofDescriptorProto -> [u] forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OneofDescriptorProto -> r forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OneofDescriptorProto -> r forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c OneofDescriptorProto forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> OneofDescriptorProto -> c OneofDescriptorProto forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c OneofDescriptorProto) forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OneofDescriptorProto) $cOneofDescriptorProto :: Constr $tOneofDescriptorProto :: DataType gmapMo :: (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto $cgmapMo :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto gmapMp :: (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto $cgmapMp :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto gmapM :: (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto $cgmapM :: forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> OneofDescriptorProto -> m OneofDescriptorProto gmapQi :: Int -> (forall d. Data d => d -> u) -> OneofDescriptorProto -> u $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OneofDescriptorProto -> u gmapQ :: (forall d. Data d => d -> u) -> OneofDescriptorProto -> [u] $cgmapQ :: forall u. (forall d. Data d => d -> u) -> OneofDescriptorProto -> [u] gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OneofDescriptorProto -> r $cgmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OneofDescriptorProto -> r gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OneofDescriptorProto -> r $cgmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OneofDescriptorProto -> r gmapT :: (forall b. Data b => b -> b) -> OneofDescriptorProto -> OneofDescriptorProto $cgmapT :: (forall b. Data b => b -> b) -> OneofDescriptorProto -> OneofDescriptorProto dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OneofDescriptorProto) $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OneofDescriptorProto) dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OneofDescriptorProto) $cdataCast1 :: forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c OneofDescriptorProto) dataTypeOf :: OneofDescriptorProto -> DataType $cdataTypeOf :: OneofDescriptorProto -> DataType toConstr :: OneofDescriptorProto -> Constr $ctoConstr :: OneofDescriptorProto -> Constr gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c OneofDescriptorProto $cgunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c OneofDescriptorProto gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> OneofDescriptorProto -> c OneofDescriptorProto $cgfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> OneofDescriptorProto -> c OneofDescriptorProto $cp1Data :: Typeable OneofDescriptorProto Prelude'.Data, (forall x. OneofDescriptorProto -> Rep OneofDescriptorProto x) -> (forall x. Rep OneofDescriptorProto x -> OneofDescriptorProto) -> Generic OneofDescriptorProto forall x. Rep OneofDescriptorProto x -> OneofDescriptorProto forall x. OneofDescriptorProto -> Rep OneofDescriptorProto x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep OneofDescriptorProto x -> OneofDescriptorProto $cfrom :: forall x. OneofDescriptorProto -> Rep OneofDescriptorProto x Prelude'.Generic) instance P'.UnknownMessage OneofDescriptorProto where getUnknownField :: OneofDescriptorProto -> UnknownField getUnknownField = OneofDescriptorProto -> UnknownField unknown'field putUnknownField :: UnknownField -> OneofDescriptorProto -> OneofDescriptorProto putUnknownField UnknownField u'f OneofDescriptorProto msg = OneofDescriptorProto msg{unknown'field :: UnknownField unknown'field = UnknownField u'f} instance P'.Mergeable OneofDescriptorProto where mergeAppend :: OneofDescriptorProto -> OneofDescriptorProto -> OneofDescriptorProto mergeAppend (OneofDescriptorProto Maybe Utf8 x'1 UnknownField x'2) (OneofDescriptorProto Maybe Utf8 y'1 UnknownField y'2) = 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 :: UnknownField z'2 = UnknownField -> UnknownField -> UnknownField forall a. Mergeable a => a -> a -> a P'.mergeAppend UnknownField x'2 UnknownField y'2 in Maybe Utf8 -> UnknownField -> OneofDescriptorProto OneofDescriptorProto Maybe Utf8 z'1 UnknownField z'2 instance P'.Default OneofDescriptorProto where defaultValue :: OneofDescriptorProto defaultValue = Maybe Utf8 -> UnknownField -> OneofDescriptorProto OneofDescriptorProto Maybe Utf8 forall a. Default a => a P'.defaultValue UnknownField forall a. Default a => a P'.defaultValue instance P'.Wire OneofDescriptorProto where wireSize :: FieldType -> OneofDescriptorProto -> WireSize wireSize FieldType ft' self' :: OneofDescriptorProto self'@(OneofDescriptorProto Maybe Utf8 x'1 UnknownField x'2) = case FieldType ft' of FieldType 10 -> WireSize calc'Size FieldType 11 -> WireSize -> WireSize P'.prependMessageSize WireSize calc'Size FieldType _ -> FieldType -> OneofDescriptorProto -> WireSize forall a. Typeable a => FieldType -> a -> WireSize P'.wireSizeErr FieldType ft' OneofDescriptorProto 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 + UnknownField -> WireSize P'.wireSizeUnknownField UnknownField x'2) wirePutWithSize :: FieldType -> OneofDescriptorProto -> PutM WireSize wirePutWithSize FieldType ft' self' :: OneofDescriptorProto self'@(OneofDescriptorProto Maybe Utf8 x'1 UnknownField x'2) = case FieldType ft' of FieldType 10 -> PutM WireSize put'Fields FieldType 11 -> PutM WireSize put'FieldsSized FieldType _ -> FieldType -> OneofDescriptorProto -> PutM WireSize forall a b. Typeable a => FieldType -> a -> PutM b P'.wirePutErr FieldType ft' OneofDescriptorProto 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, UnknownField -> PutM WireSize P'.wirePutUnknownFieldWithSize UnknownField x'2] 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 OneofDescriptorProto wireGet FieldType ft' = case FieldType ft' of FieldType 10 -> (WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto) -> Get OneofDescriptorProto forall message. (Default message, ReflectDescriptor message) => (WireTag -> message -> Get message) -> Get message P'.getBareMessageWith ((WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto) -> (WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto) -> WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto forall a. (WireTag -> a -> Get a) -> (WireTag -> a -> Get a) -> WireTag -> a -> Get a P'.catch'Unknown' WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto forall a. UnknownMessage a => WireTag -> a -> Get a P'.loadUnknown WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto update'Self) FieldType 11 -> (WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto) -> Get OneofDescriptorProto forall message. (Default message, ReflectDescriptor message) => (WireTag -> message -> Get message) -> Get message P'.getMessageWith ((WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto) -> (WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto) -> WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto forall a. (WireTag -> a -> Get a) -> (WireTag -> a -> Get a) -> WireTag -> a -> Get a P'.catch'Unknown' WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto forall a. UnknownMessage a => WireTag -> a -> Get a P'.loadUnknown WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto update'Self) FieldType _ -> FieldType -> Get OneofDescriptorProto forall a. Typeable a => FieldType -> Get a P'.wireGetErr FieldType ft' where update'Self :: WireTag -> OneofDescriptorProto -> Get OneofDescriptorProto update'Self WireTag wire'Tag OneofDescriptorProto old'Self = case WireTag wire'Tag of WireTag 10 -> (Utf8 -> OneofDescriptorProto) -> Get Utf8 -> Get OneofDescriptorProto forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b Prelude'.fmap (\ !Utf8 new'Field -> OneofDescriptorProto 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 _ -> let (FieldId field'Number, WireType wire'Type) = WireTag -> (FieldId, WireType) P'.splitWireTag WireTag wire'Tag in FieldId -> WireType -> OneofDescriptorProto -> Get OneofDescriptorProto forall a. (Typeable a, ReflectDescriptor a) => FieldId -> WireType -> a -> Get a P'.unknown FieldId field'Number WireType wire'Type OneofDescriptorProto old'Self instance P'.MessageAPI msg' (msg' -> OneofDescriptorProto) OneofDescriptorProto where getVal :: msg' -> (msg' -> OneofDescriptorProto) -> OneofDescriptorProto getVal msg' m' msg' -> OneofDescriptorProto f' = msg' -> OneofDescriptorProto f' msg' m' instance P'.GPB OneofDescriptorProto instance P'.ReflectDescriptor OneofDescriptorProto where getMessageInfo :: OneofDescriptorProto -> GetMessageInfo getMessageInfo OneofDescriptorProto _ = 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]) reflectDescriptorInfo :: OneofDescriptorProto -> DescriptorInfo reflectDescriptorInfo OneofDescriptorProto _ = String -> DescriptorInfo forall a. Read a => String -> a Prelude'.read String "DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.OneofDescriptorProto\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"OneofDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"OneofDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.OneofDescriptorProto.name\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"OneofDescriptorProto\"], 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}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = True, lazyFields = False, makeLenses = False, jsonInstances = False}" instance P'.TextType OneofDescriptorProto where tellT :: String -> OneofDescriptorProto -> Output tellT = String -> OneofDescriptorProto -> Output forall a. TextMsg a => String -> a -> Output P'.tellSubMessage getT :: String -> Parsec s () OneofDescriptorProto getT = String -> Parsec s () OneofDescriptorProto forall s a. (Stream s Identity Char, TextMsg a) => String -> Parsec s () a P'.getSubMessage instance P'.TextMsg OneofDescriptorProto where textPut :: OneofDescriptorProto -> Output textPut OneofDescriptorProto msg = do String -> Maybe Utf8 -> Output forall a. TextType a => String -> a -> Output P'.tellT String "name" (OneofDescriptorProto -> Maybe Utf8 name OneofDescriptorProto msg) textGet :: Parsec s () OneofDescriptorProto textGet = do [OneofDescriptorProto -> OneofDescriptorProto] mods <- ParsecT s () Identity (OneofDescriptorProto -> OneofDescriptorProto) -> ParsecT s () Identity () -> ParsecT s () Identity [OneofDescriptorProto -> OneofDescriptorProto] 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 (OneofDescriptorProto -> OneofDescriptorProto)] -> ParsecT s () Identity (OneofDescriptorProto -> OneofDescriptorProto) 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 (OneofDescriptorProto -> OneofDescriptorProto) parse'name]) ParsecT s () Identity () forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m () P'.spaces OneofDescriptorProto -> Parsec s () OneofDescriptorProto forall (m :: * -> *) a. Monad m => a -> m a Prelude'.return ((OneofDescriptorProto -> (OneofDescriptorProto -> OneofDescriptorProto) -> OneofDescriptorProto) -> OneofDescriptorProto -> [OneofDescriptorProto -> OneofDescriptorProto] -> OneofDescriptorProto forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b Prelude'.foldl' (\ OneofDescriptorProto v OneofDescriptorProto -> OneofDescriptorProto f -> OneofDescriptorProto -> OneofDescriptorProto f OneofDescriptorProto v) OneofDescriptorProto forall a. Default a => a P'.defaultValue [OneofDescriptorProto -> OneofDescriptorProto] mods) where parse'name :: ParsecT s () Identity (OneofDescriptorProto -> OneofDescriptorProto) parse'name = (Maybe Utf8 -> OneofDescriptorProto -> OneofDescriptorProto) -> ParsecT s () Identity (Maybe Utf8) -> ParsecT s () Identity (OneofDescriptorProto -> OneofDescriptorProto) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b Prelude'.fmap (\ Maybe Utf8 v OneofDescriptorProto o -> OneofDescriptorProto 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"))