{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS_GHC  -fno-warn-unused-imports #-}
module Text.DescriptorProtos.FieldDescriptorProto.Label (Label(..)) where
import Prelude ((+), (/), (.))
import qualified Prelude 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'.True

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