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

instance P'.Mergeable JSType

instance Prelude'.Bounded JSType where
  minBound :: JSType
minBound = JSType
JS_NORMAL
  maxBound :: JSType
maxBound = JSType
JS_NUMBER

instance P'.Default JSType where
  defaultValue :: JSType
defaultValue = JSType
JS_NORMAL

toMaybe'Enum :: Prelude'.Int -> P'.Maybe JSType
toMaybe'Enum :: Int -> Maybe JSType
toMaybe'Enum Int
0 = JSType -> Maybe JSType
forall a. a -> Maybe a
Prelude'.Just JSType
JS_NORMAL
toMaybe'Enum Int
1 = JSType -> Maybe JSType
forall a. a -> Maybe a
Prelude'.Just JSType
JS_STRING
toMaybe'Enum Int
2 = JSType -> Maybe JSType
forall a. a -> Maybe a
Prelude'.Just JSType
JS_NUMBER
toMaybe'Enum Int
_ = Maybe JSType
forall a. Maybe a
Prelude'.Nothing

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

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

instance P'.GPB JSType

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

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

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