{-# 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