{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}
{-# OPTIONS_GHC  -w #-}
module Text.DescriptorProtos.FieldOptions.CType (CType(..)) 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 CType = STRING
           | CORD
           | STRING_PIECE
             deriving (ReadPrec [CType]
ReadPrec CType
Int -> ReadS CType
ReadS [CType]
(Int -> ReadS CType)
-> ReadS [CType]
-> ReadPrec CType
-> ReadPrec [CType]
-> Read CType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CType]
$creadListPrec :: ReadPrec [CType]
readPrec :: ReadPrec CType
$creadPrec :: ReadPrec CType
readList :: ReadS [CType]
$creadList :: ReadS [CType]
readsPrec :: Int -> ReadS CType
$creadsPrec :: Int -> ReadS CType
Prelude'.Read, Int -> CType -> ShowS
[CType] -> ShowS
CType -> String
(Int -> CType -> ShowS)
-> (CType -> String) -> ([CType] -> ShowS) -> Show CType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CType] -> ShowS
$cshowList :: [CType] -> ShowS
show :: CType -> String
$cshow :: CType -> String
showsPrec :: Int -> CType -> ShowS
$cshowsPrec :: Int -> CType -> ShowS
Prelude'.Show, CType -> CType -> Bool
(CType -> CType -> Bool) -> (CType -> CType -> Bool) -> Eq CType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CType -> CType -> Bool
$c/= :: CType -> CType -> Bool
== :: CType -> CType -> Bool
$c== :: CType -> CType -> Bool
Prelude'.Eq, Eq CType
Eq CType
-> (CType -> CType -> Ordering)
-> (CType -> CType -> Bool)
-> (CType -> CType -> Bool)
-> (CType -> CType -> Bool)
-> (CType -> CType -> Bool)
-> (CType -> CType -> CType)
-> (CType -> CType -> CType)
-> Ord CType
CType -> CType -> Bool
CType -> CType -> Ordering
CType -> CType -> CType
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 :: CType -> CType -> CType
$cmin :: CType -> CType -> CType
max :: CType -> CType -> CType
$cmax :: CType -> CType -> CType
>= :: CType -> CType -> Bool
$c>= :: CType -> CType -> Bool
> :: CType -> CType -> Bool
$c> :: CType -> CType -> Bool
<= :: CType -> CType -> Bool
$c<= :: CType -> CType -> Bool
< :: CType -> CType -> Bool
$c< :: CType -> CType -> Bool
compare :: CType -> CType -> Ordering
$ccompare :: CType -> CType -> Ordering
$cp1Ord :: Eq CType
Prelude'.Ord, Prelude'.Typeable, Typeable CType
DataType
Constr
Typeable CType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CType -> c CType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CType)
-> (CType -> Constr)
-> (CType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CType))
-> ((forall b. Data b => b -> b) -> CType -> CType)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r)
-> (forall u. (forall d. Data d => d -> u) -> CType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> CType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CType -> m CType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CType -> m CType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CType -> m CType)
-> Data CType
CType -> DataType
CType -> Constr
(forall b. Data b => b -> b) -> CType -> CType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CType -> c CType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CType
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) -> CType -> u
forall u. (forall d. Data d => d -> u) -> CType -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CType -> m CType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CType -> m CType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CType -> c CType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CType)
$cSTRING_PIECE :: Constr
$cCORD :: Constr
$cSTRING :: Constr
$tCType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CType -> m CType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CType -> m CType
gmapMp :: (forall d. Data d => d -> m d) -> CType -> m CType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CType -> m CType
gmapM :: (forall d. Data d => d -> m d) -> CType -> m CType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CType -> m CType
gmapQi :: Int -> (forall d. Data d => d -> u) -> CType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CType -> u
gmapQ :: (forall d. Data d => d -> u) -> CType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CType -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
gmapT :: (forall b. Data b => b -> b) -> CType -> CType
$cgmapT :: (forall b. Data b => b -> b) -> CType -> CType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CType)
dataTypeOf :: CType -> DataType
$cdataTypeOf :: CType -> DataType
toConstr :: CType -> Constr
$ctoConstr :: CType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CType -> c CType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CType -> c CType
$cp1Data :: Typeable CType
Prelude'.Data, (forall x. CType -> Rep CType x)
-> (forall x. Rep CType x -> CType) -> Generic CType
forall x. Rep CType x -> CType
forall x. CType -> Rep CType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CType x -> CType
$cfrom :: forall x. CType -> Rep CType x
Prelude'.Generic)

instance P'.Mergeable CType

instance Prelude'.Bounded CType where
  minBound :: CType
minBound = CType
STRING
  maxBound :: CType
maxBound = CType
STRING_PIECE

instance P'.Default CType where
  defaultValue :: CType
defaultValue = CType
STRING

toMaybe'Enum :: Prelude'.Int -> P'.Maybe CType
toMaybe'Enum :: Int -> Maybe CType
toMaybe'Enum Int
0 = CType -> Maybe CType
forall a. a -> Maybe a
Prelude'.Just CType
STRING
toMaybe'Enum Int
1 = CType -> Maybe CType
forall a. a -> Maybe a
Prelude'.Just CType
CORD
toMaybe'Enum Int
2 = CType -> Maybe CType
forall a. a -> Maybe a
Prelude'.Just CType
STRING_PIECE
toMaybe'Enum Int
_ = Maybe CType
forall a. Maybe a
Prelude'.Nothing

instance Prelude'.Enum CType where
  fromEnum :: CType -> Int
fromEnum CType
STRING = Int
0
  fromEnum CType
CORD = Int
1
  fromEnum CType
STRING_PIECE = Int
2
  toEnum :: Int -> CType
toEnum
   = CType -> Maybe CType -> CType
forall a. a -> Maybe a -> a
P'.fromMaybe (String -> CType
forall a. HasCallStack => String -> a
Prelude'.error String
"hprotoc generated code: toEnum failure for type Text.DescriptorProtos.FieldOptions.CType") (Maybe CType -> CType) -> (Int -> Maybe CType) -> Int -> CType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> Maybe CType
toMaybe'Enum
  succ :: CType -> CType
succ CType
STRING = CType
CORD
  succ CType
CORD = CType
STRING_PIECE
  succ CType
_ = String -> CType
forall a. HasCallStack => String -> a
Prelude'.error String
"hprotoc generated code: succ failure for type Text.DescriptorProtos.FieldOptions.CType"
  pred :: CType -> CType
pred CType
CORD = CType
STRING
  pred CType
STRING_PIECE = CType
CORD
  pred CType
_ = String -> CType
forall a. HasCallStack => String -> a
Prelude'.error String
"hprotoc generated code: pred failure for type Text.DescriptorProtos.FieldOptions.CType"

instance P'.Wire CType where
  wireSize :: FieldType -> CType -> WireSize
wireSize FieldType
ft' CType
enum = FieldType -> Int -> WireSize
forall b. Wire b => FieldType -> b -> WireSize
P'.wireSize FieldType
ft' (CType -> Int
forall a. Enum a => a -> Int
Prelude'.fromEnum CType
enum)
  wirePut :: FieldType -> CType -> Put
wirePut FieldType
ft' CType
enum = FieldType -> Int -> Put
forall b. Wire b => FieldType -> b -> Put
P'.wirePut FieldType
ft' (CType -> Int
forall a. Enum a => a -> Int
Prelude'.fromEnum CType
enum)
  wireGet :: FieldType -> Get CType
wireGet FieldType
14 = (Int -> Maybe CType) -> Get CType
forall e. (Typeable e, Enum e) => (Int -> Maybe e) -> Get e
P'.wireGetEnum Int -> Maybe CType
toMaybe'Enum
  wireGet FieldType
ft' = FieldType -> Get CType
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
  wireGetPacked :: FieldType -> Get (Seq CType)
wireGetPacked FieldType
14 = (Int -> Maybe CType) -> Get (Seq CType)
forall e. (Typeable e, Enum e) => (Int -> Maybe e) -> Get (Seq e)
P'.wireGetPackedEnum Int -> Maybe CType
toMaybe'Enum
  wireGetPacked FieldType
ft' = FieldType -> Get (Seq CType)
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'

instance P'.GPB CType

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

instance P'.ReflectEnum CType where
  reflectEnum :: EnumInfoApp CType
reflectEnum = [(EnumCode
0, String
"STRING", CType
STRING), (EnumCode
1, String
"CORD", CType
CORD), (EnumCode
2, String
"STRING_PIECE", CType
STRING_PIECE)]
  reflectEnumInfo :: CType -> EnumInfo
reflectEnumInfo CType
_
   = ProtoName -> [String] -> [(EnumCode, String)] -> Bool -> EnumInfo
P'.EnumInfo (ByteString -> [String] -> [String] -> String -> ProtoName
P'.makePNF (String -> ByteString
P'.pack String
".google.protobuf.FieldOptions.CType") [String
"Text"] [String
"DescriptorProtos", String
"FieldOptions"] String
"CType")
      [String
"Text", String
"DescriptorProtos", String
"FieldOptions", String
"CType.hs"]
      [(EnumCode
0, String
"STRING"), (EnumCode
1, String
"CORD"), (EnumCode
2, String
"STRING_PIECE")]
      Bool
Prelude'.False

instance P'.TextType CType where
  tellT :: String -> CType -> Output
tellT = String -> CType -> Output
forall a. Show a => String -> a -> Output
P'.tellShow
  getT :: String -> Parsec s () CType
getT = String -> Parsec s () CType
forall a s.
(Read a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getRead