{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-} {-# OPTIONS_GHC -w #-} module Text.DescriptorProtos.FieldDescriptorProto.Label (Label(..)) 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 Label = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED deriving (ReadPrec [Label] ReadPrec Label Int -> ReadS Label ReadS [Label] (Int -> ReadS Label) -> ReadS [Label] -> ReadPrec Label -> ReadPrec [Label] -> Read Label forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Label] $creadListPrec :: ReadPrec [Label] readPrec :: ReadPrec Label $creadPrec :: ReadPrec Label readList :: ReadS [Label] $creadList :: ReadS [Label] readsPrec :: Int -> ReadS Label $creadsPrec :: Int -> ReadS Label Prelude'.Read, Int -> Label -> ShowS [Label] -> ShowS Label -> String (Int -> Label -> ShowS) -> (Label -> String) -> ([Label] -> ShowS) -> Show Label forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Label] -> ShowS $cshowList :: [Label] -> ShowS show :: Label -> String $cshow :: Label -> String showsPrec :: Int -> Label -> ShowS $cshowsPrec :: Int -> Label -> ShowS Prelude'.Show, Label -> Label -> Bool (Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Label -> Label -> Bool $c/= :: Label -> Label -> Bool == :: Label -> Label -> Bool $c== :: Label -> Label -> Bool Prelude'.Eq, Eq Label Eq Label -> (Label -> Label -> Ordering) -> (Label -> Label -> Bool) -> (Label -> Label -> Bool) -> (Label -> Label -> Bool) -> (Label -> Label -> Bool) -> (Label -> Label -> Label) -> (Label -> Label -> Label) -> Ord Label Label -> Label -> Bool Label -> Label -> Ordering Label -> Label -> Label 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 :: Label -> Label -> Label $cmin :: Label -> Label -> Label max :: Label -> Label -> Label $cmax :: Label -> Label -> Label >= :: Label -> Label -> Bool $c>= :: Label -> Label -> Bool > :: Label -> Label -> Bool $c> :: Label -> Label -> Bool <= :: Label -> Label -> Bool $c<= :: Label -> Label -> Bool < :: Label -> Label -> Bool $c< :: Label -> Label -> Bool compare :: Label -> Label -> Ordering $ccompare :: Label -> Label -> Ordering $cp1Ord :: Eq Label Prelude'.Ord, Prelude'.Typeable, Typeable Label DataType Constr Typeable Label -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Label -> c Label) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Label) -> (Label -> Constr) -> (Label -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Label)) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label)) -> ((forall b. Data b => b -> b) -> Label -> Label) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r) -> (forall u. (forall d. Data d => d -> u) -> Label -> [u]) -> (forall u. Int -> (forall d. Data d => d -> u) -> Label -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Label -> m Label) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Label -> m Label) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Label -> m Label) -> Data Label Label -> DataType Label -> Constr (forall b. Data b => b -> b) -> Label -> Label (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Label -> c Label (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Label 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) -> Label -> u forall u. (forall d. Data d => d -> u) -> Label -> [u] forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Label -> m Label forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Label -> m Label forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Label forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Label -> c Label forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Label) forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label) $cLABEL_REPEATED :: Constr $cLABEL_REQUIRED :: Constr $cLABEL_OPTIONAL :: Constr $tLabel :: DataType gmapMo :: (forall d. Data d => d -> m d) -> Label -> m Label $cgmapMo :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Label -> m Label gmapMp :: (forall d. Data d => d -> m d) -> Label -> m Label $cgmapMp :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Label -> m Label gmapM :: (forall d. Data d => d -> m d) -> Label -> m Label $cgmapM :: forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Label -> m Label gmapQi :: Int -> (forall d. Data d => d -> u) -> Label -> u $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Label -> u gmapQ :: (forall d. Data d => d -> u) -> Label -> [u] $cgmapQ :: forall u. (forall d. Data d => d -> u) -> Label -> [u] gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r $cgmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r $cgmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r gmapT :: (forall b. Data b => b -> b) -> Label -> Label $cgmapT :: (forall b. Data b => b -> b) -> Label -> Label dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label) $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label) dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Label) $cdataCast1 :: forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Label) dataTypeOf :: Label -> DataType $cdataTypeOf :: Label -> DataType toConstr :: Label -> Constr $ctoConstr :: Label -> Constr gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Label $cgunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Label gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Label -> c Label $cgfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Label -> c Label $cp1Data :: Typeable Label Prelude'.Data, (forall x. Label -> Rep Label x) -> (forall x. Rep Label x -> Label) -> Generic Label forall x. Rep Label x -> Label forall x. Label -> Rep Label x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Label x -> Label $cfrom :: forall x. Label -> Rep Label x Prelude'.Generic) instance P'.Mergeable Label instance Prelude'.Bounded Label where minBound :: Label minBound = Label LABEL_OPTIONAL maxBound :: Label maxBound = Label LABEL_REPEATED instance P'.Default Label where defaultValue :: Label defaultValue = Label LABEL_OPTIONAL toMaybe'Enum :: Prelude'.Int -> P'.Maybe Label toMaybe'Enum :: Int -> Maybe Label toMaybe'Enum Int 1 = Label -> Maybe Label forall a. a -> Maybe a Prelude'.Just Label LABEL_OPTIONAL toMaybe'Enum Int 2 = Label -> Maybe Label forall a. a -> Maybe a Prelude'.Just Label LABEL_REQUIRED toMaybe'Enum Int 3 = Label -> Maybe Label forall a. a -> Maybe a Prelude'.Just Label LABEL_REPEATED toMaybe'Enum Int _ = Maybe Label forall a. Maybe a Prelude'.Nothing instance Prelude'.Enum Label where fromEnum :: Label -> Int fromEnum Label LABEL_OPTIONAL = Int 1 fromEnum Label LABEL_REQUIRED = Int 2 fromEnum Label LABEL_REPEATED = Int 3 toEnum :: Int -> Label toEnum = Label -> Maybe Label -> Label forall a. a -> Maybe a -> a P'.fromMaybe (String -> Label forall a. HasCallStack => String -> a Prelude'.error String "hprotoc generated code: toEnum failure for type Text.DescriptorProtos.FieldDescriptorProto.Label") (Maybe Label -> Label) -> (Int -> Maybe Label) -> Int -> Label forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Maybe Label toMaybe'Enum succ :: Label -> Label succ Label LABEL_OPTIONAL = Label LABEL_REQUIRED succ Label LABEL_REQUIRED = Label LABEL_REPEATED succ Label _ = String -> Label forall a. HasCallStack => String -> a Prelude'.error String "hprotoc generated code: succ failure for type Text.DescriptorProtos.FieldDescriptorProto.Label" pred :: Label -> Label pred Label LABEL_REQUIRED = Label LABEL_OPTIONAL pred Label LABEL_REPEATED = Label LABEL_REQUIRED pred Label _ = String -> Label forall a. HasCallStack => String -> a Prelude'.error String "hprotoc generated code: pred failure for type Text.DescriptorProtos.FieldDescriptorProto.Label" instance P'.Wire Label where wireSize :: FieldType -> Label -> WireSize wireSize FieldType ft' Label enum = FieldType -> Int -> WireSize forall b. Wire b => FieldType -> b -> WireSize P'.wireSize FieldType ft' (Label -> Int forall a. Enum a => a -> Int Prelude'.fromEnum Label enum) wirePut :: FieldType -> Label -> Put wirePut FieldType ft' Label enum = FieldType -> Int -> Put forall b. Wire b => FieldType -> b -> Put P'.wirePut FieldType ft' (Label -> Int forall a. Enum a => a -> Int Prelude'.fromEnum Label enum) wireGet :: FieldType -> Get Label wireGet FieldType 14 = (Int -> Maybe Label) -> Get Label forall e. (Typeable e, Enum e) => (Int -> Maybe e) -> Get e P'.wireGetEnum Int -> Maybe Label toMaybe'Enum wireGet FieldType ft' = FieldType -> Get Label forall a. Typeable a => FieldType -> Get a P'.wireGetErr FieldType ft' wireGetPacked :: FieldType -> Get (Seq Label) wireGetPacked FieldType 14 = (Int -> Maybe Label) -> Get (Seq Label) forall e. (Typeable e, Enum e) => (Int -> Maybe e) -> Get (Seq e) P'.wireGetPackedEnum Int -> Maybe Label toMaybe'Enum wireGetPacked FieldType ft' = FieldType -> Get (Seq Label) forall a. Typeable a => FieldType -> Get a P'.wireGetErr FieldType ft' instance P'.GPB Label instance P'.MessageAPI msg' (msg' -> Label) Label where getVal :: msg' -> (msg' -> Label) -> Label getVal msg' m' msg' -> Label f' = msg' -> Label f' msg' m' instance P'.ReflectEnum Label where reflectEnum :: EnumInfoApp Label reflectEnum = [(EnumCode 1, String "LABEL_OPTIONAL", Label LABEL_OPTIONAL), (EnumCode 2, String "LABEL_REQUIRED", Label LABEL_REQUIRED), (EnumCode 3, String "LABEL_REPEATED", Label LABEL_REPEATED)] reflectEnumInfo :: Label -> EnumInfo reflectEnumInfo Label _ = ProtoName -> [String] -> [(EnumCode, String)] -> Bool -> EnumInfo P'.EnumInfo (ByteString -> [String] -> [String] -> String -> ProtoName P'.makePNF (String -> ByteString P'.pack String ".google.protobuf.FieldDescriptorProto.Label") [String "Text"] [String "DescriptorProtos", String "FieldDescriptorProto"] String "Label") [String "Text", String "DescriptorProtos", String "FieldDescriptorProto", String "Label.hs"] [(EnumCode 1, String "LABEL_OPTIONAL"), (EnumCode 2, String "LABEL_REQUIRED"), (EnumCode 3, String "LABEL_REPEATED")] Bool Prelude'.False instance P'.TextType Label where tellT :: String -> Label -> Output tellT = String -> Label -> Output forall a. Show a => String -> a -> Output P'.tellShow getT :: String -> Parsec s () Label getT = String -> Parsec s () Label forall a s. (Read a, Stream s Identity Char) => String -> Parsec s () a P'.getRead