{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}
{-# OPTIONS_GHC  -w #-}
module Text.DescriptorProtos.FieldDescriptorProto.Type (Type(..)) 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 Type = TYPE_DOUBLE
          | TYPE_FLOAT
          | TYPE_INT64
          | TYPE_UINT64
          | TYPE_INT32
          | TYPE_FIXED64
          | TYPE_FIXED32
          | TYPE_BOOL
          | TYPE_STRING
          | TYPE_GROUP
          | TYPE_MESSAGE
          | TYPE_BYTES
          | TYPE_UINT32
          | TYPE_ENUM
          | TYPE_SFIXED32
          | TYPE_SFIXED64
          | TYPE_SINT32
          | TYPE_SINT64
            deriving (ReadPrec [Type]
ReadPrec Type
Int -> ReadS Type
ReadS [Type]
(Int -> ReadS Type)
-> ReadS [Type] -> ReadPrec Type -> ReadPrec [Type] -> Read Type
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Type]
$creadListPrec :: ReadPrec [Type]
readPrec :: ReadPrec Type
$creadPrec :: ReadPrec Type
readList :: ReadS [Type]
$creadList :: ReadS [Type]
readsPrec :: Int -> ReadS Type
$creadsPrec :: Int -> ReadS Type
Prelude'.Read, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Prelude'.Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Prelude'.Eq, Eq Type
Eq Type
-> (Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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 :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Prelude'.Ord, Prelude'.Typeable, Typeable Type
DataType
Constr
Typeable Type
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Type -> c Type)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Type)
-> (Type -> Constr)
-> (Type -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Type))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type))
-> ((forall b. Data b => b -> b) -> Type -> Type)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r)
-> (forall u. (forall d. Data d => d -> u) -> Type -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Type -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Type -> m Type)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Type -> m Type)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Type -> m Type)
-> Data Type
Type -> DataType
Type -> Constr
(forall b. Data b => b -> b) -> Type -> Type
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
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) -> Type -> u
forall u. (forall d. Data d => d -> u) -> Type -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Type -> m Type
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Type)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type)
$cTYPE_SINT64 :: Constr
$cTYPE_SINT32 :: Constr
$cTYPE_SFIXED64 :: Constr
$cTYPE_SFIXED32 :: Constr
$cTYPE_ENUM :: Constr
$cTYPE_UINT32 :: Constr
$cTYPE_BYTES :: Constr
$cTYPE_MESSAGE :: Constr
$cTYPE_GROUP :: Constr
$cTYPE_STRING :: Constr
$cTYPE_BOOL :: Constr
$cTYPE_FIXED32 :: Constr
$cTYPE_FIXED64 :: Constr
$cTYPE_INT32 :: Constr
$cTYPE_UINT64 :: Constr
$cTYPE_INT64 :: Constr
$cTYPE_FLOAT :: Constr
$cTYPE_DOUBLE :: Constr
$tType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Type -> m Type
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
gmapMp :: (forall d. Data d => d -> m d) -> Type -> m Type
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
gmapM :: (forall d. Data d => d -> m d) -> Type -> m Type
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Type -> m Type
gmapQi :: Int -> (forall d. Data d => d -> u) -> Type -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Type -> u
gmapQ :: (forall d. Data d => d -> u) -> Type -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Type -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
gmapT :: (forall b. Data b => b -> b) -> Type -> Type
$cgmapT :: (forall b. Data b => b -> b) -> Type -> Type
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Type)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Type)
dataTypeOf :: Type -> DataType
$cdataTypeOf :: Type -> DataType
toConstr :: Type -> Constr
$ctoConstr :: Type -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
$cp1Data :: Typeable Type
Prelude'.Data, (forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type x -> Type
$cfrom :: forall x. Type -> Rep Type x
Prelude'.Generic)

instance P'.Mergeable Type

instance Prelude'.Bounded Type where
  minBound :: Type
minBound = Type
TYPE_DOUBLE
  maxBound :: Type
maxBound = Type
TYPE_SINT64

instance P'.Default Type where
  defaultValue :: Type
defaultValue = Type
TYPE_DOUBLE

toMaybe'Enum :: Prelude'.Int -> P'.Maybe Type
toMaybe'Enum :: Int -> Maybe Type
toMaybe'Enum Int
1 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_DOUBLE
toMaybe'Enum Int
2 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_FLOAT
toMaybe'Enum Int
3 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_INT64
toMaybe'Enum Int
4 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_UINT64
toMaybe'Enum Int
5 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_INT32
toMaybe'Enum Int
6 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_FIXED64
toMaybe'Enum Int
7 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_FIXED32
toMaybe'Enum Int
8 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_BOOL
toMaybe'Enum Int
9 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_STRING
toMaybe'Enum Int
10 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_GROUP
toMaybe'Enum Int
11 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_MESSAGE
toMaybe'Enum Int
12 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_BYTES
toMaybe'Enum Int
13 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_UINT32
toMaybe'Enum Int
14 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_ENUM
toMaybe'Enum Int
15 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_SFIXED32
toMaybe'Enum Int
16 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_SFIXED64
toMaybe'Enum Int
17 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_SINT32
toMaybe'Enum Int
18 = Type -> Maybe Type
forall a. a -> Maybe a
Prelude'.Just Type
TYPE_SINT64
toMaybe'Enum Int
_ = Maybe Type
forall a. Maybe a
Prelude'.Nothing

instance Prelude'.Enum Type where
  fromEnum :: Type -> Int
fromEnum Type
TYPE_DOUBLE = Int
1
  fromEnum Type
TYPE_FLOAT = Int
2
  fromEnum Type
TYPE_INT64 = Int
3
  fromEnum Type
TYPE_UINT64 = Int
4
  fromEnum Type
TYPE_INT32 = Int
5
  fromEnum Type
TYPE_FIXED64 = Int
6
  fromEnum Type
TYPE_FIXED32 = Int
7
  fromEnum Type
TYPE_BOOL = Int
8
  fromEnum Type
TYPE_STRING = Int
9
  fromEnum Type
TYPE_GROUP = Int
10
  fromEnum Type
TYPE_MESSAGE = Int
11
  fromEnum Type
TYPE_BYTES = Int
12
  fromEnum Type
TYPE_UINT32 = Int
13
  fromEnum Type
TYPE_ENUM = Int
14
  fromEnum Type
TYPE_SFIXED32 = Int
15
  fromEnum Type
TYPE_SFIXED64 = Int
16
  fromEnum Type
TYPE_SINT32 = Int
17
  fromEnum Type
TYPE_SINT64 = Int
18
  toEnum :: Int -> Type
toEnum
   = Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
P'.fromMaybe (String -> Type
forall a. HasCallStack => String -> a
Prelude'.error String
"hprotoc generated code: toEnum failure for type Text.DescriptorProtos.FieldDescriptorProto.Type")
      (Maybe Type -> Type) -> (Int -> Maybe Type) -> Int -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Type
toMaybe'Enum
  succ :: Type -> Type
succ Type
TYPE_DOUBLE = Type
TYPE_FLOAT
  succ Type
TYPE_FLOAT = Type
TYPE_INT64
  succ Type
TYPE_INT64 = Type
TYPE_UINT64
  succ Type
TYPE_UINT64 = Type
TYPE_INT32
  succ Type
TYPE_INT32 = Type
TYPE_FIXED64
  succ Type
TYPE_FIXED64 = Type
TYPE_FIXED32
  succ Type
TYPE_FIXED32 = Type
TYPE_BOOL
  succ Type
TYPE_BOOL = Type
TYPE_STRING
  succ Type
TYPE_STRING = Type
TYPE_GROUP
  succ Type
TYPE_GROUP = Type
TYPE_MESSAGE
  succ Type
TYPE_MESSAGE = Type
TYPE_BYTES
  succ Type
TYPE_BYTES = Type
TYPE_UINT32
  succ Type
TYPE_UINT32 = Type
TYPE_ENUM
  succ Type
TYPE_ENUM = Type
TYPE_SFIXED32
  succ Type
TYPE_SFIXED32 = Type
TYPE_SFIXED64
  succ Type
TYPE_SFIXED64 = Type
TYPE_SINT32
  succ Type
TYPE_SINT32 = Type
TYPE_SINT64
  succ Type
_ = String -> Type
forall a. HasCallStack => String -> a
Prelude'.error String
"hprotoc generated code: succ failure for type Text.DescriptorProtos.FieldDescriptorProto.Type"
  pred :: Type -> Type
pred Type
TYPE_FLOAT = Type
TYPE_DOUBLE
  pred Type
TYPE_INT64 = Type
TYPE_FLOAT
  pred Type
TYPE_UINT64 = Type
TYPE_INT64
  pred Type
TYPE_INT32 = Type
TYPE_UINT64
  pred Type
TYPE_FIXED64 = Type
TYPE_INT32
  pred Type
TYPE_FIXED32 = Type
TYPE_FIXED64
  pred Type
TYPE_BOOL = Type
TYPE_FIXED32
  pred Type
TYPE_STRING = Type
TYPE_BOOL
  pred Type
TYPE_GROUP = Type
TYPE_STRING
  pred Type
TYPE_MESSAGE = Type
TYPE_GROUP
  pred Type
TYPE_BYTES = Type
TYPE_MESSAGE
  pred Type
TYPE_UINT32 = Type
TYPE_BYTES
  pred Type
TYPE_ENUM = Type
TYPE_UINT32
  pred Type
TYPE_SFIXED32 = Type
TYPE_ENUM
  pred Type
TYPE_SFIXED64 = Type
TYPE_SFIXED32
  pred Type
TYPE_SINT32 = Type
TYPE_SFIXED64
  pred Type
TYPE_SINT64 = Type
TYPE_SINT32
  pred Type
_ = String -> Type
forall a. HasCallStack => String -> a
Prelude'.error String
"hprotoc generated code: pred failure for type Text.DescriptorProtos.FieldDescriptorProto.Type"

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

instance P'.GPB Type

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

instance P'.ReflectEnum Type where
  reflectEnum :: EnumInfoApp Type
reflectEnum
   = [(EnumCode
1, String
"TYPE_DOUBLE", Type
TYPE_DOUBLE), (EnumCode
2, String
"TYPE_FLOAT", Type
TYPE_FLOAT), (EnumCode
3, String
"TYPE_INT64", Type
TYPE_INT64),
      (EnumCode
4, String
"TYPE_UINT64", Type
TYPE_UINT64), (EnumCode
5, String
"TYPE_INT32", Type
TYPE_INT32), (EnumCode
6, String
"TYPE_FIXED64", Type
TYPE_FIXED64),
      (EnumCode
7, String
"TYPE_FIXED32", Type
TYPE_FIXED32), (EnumCode
8, String
"TYPE_BOOL", Type
TYPE_BOOL), (EnumCode
9, String
"TYPE_STRING", Type
TYPE_STRING),
      (EnumCode
10, String
"TYPE_GROUP", Type
TYPE_GROUP), (EnumCode
11, String
"TYPE_MESSAGE", Type
TYPE_MESSAGE), (EnumCode
12, String
"TYPE_BYTES", Type
TYPE_BYTES),
      (EnumCode
13, String
"TYPE_UINT32", Type
TYPE_UINT32), (EnumCode
14, String
"TYPE_ENUM", Type
TYPE_ENUM), (EnumCode
15, String
"TYPE_SFIXED32", Type
TYPE_SFIXED32),
      (EnumCode
16, String
"TYPE_SFIXED64", Type
TYPE_SFIXED64), (EnumCode
17, String
"TYPE_SINT32", Type
TYPE_SINT32), (EnumCode
18, String
"TYPE_SINT64", Type
TYPE_SINT64)]
  reflectEnumInfo :: Type -> EnumInfo
reflectEnumInfo Type
_
   = ProtoName -> [String] -> [(EnumCode, String)] -> Bool -> EnumInfo
P'.EnumInfo
      (ByteString -> [String] -> [String] -> String -> ProtoName
P'.makePNF (String -> ByteString
P'.pack String
".google.protobuf.FieldDescriptorProto.Type") [String
"Text"] [String
"DescriptorProtos", String
"FieldDescriptorProto"]
        String
"Type")
      [String
"Text", String
"DescriptorProtos", String
"FieldDescriptorProto", String
"Type.hs"]
      [(EnumCode
1, String
"TYPE_DOUBLE"), (EnumCode
2, String
"TYPE_FLOAT"), (EnumCode
3, String
"TYPE_INT64"), (EnumCode
4, String
"TYPE_UINT64"), (EnumCode
5, String
"TYPE_INT32"), (EnumCode
6, String
"TYPE_FIXED64"),
       (EnumCode
7, String
"TYPE_FIXED32"), (EnumCode
8, String
"TYPE_BOOL"), (EnumCode
9, String
"TYPE_STRING"), (EnumCode
10, String
"TYPE_GROUP"), (EnumCode
11, String
"TYPE_MESSAGE"), (EnumCode
12, String
"TYPE_BYTES"),
       (EnumCode
13, String
"TYPE_UINT32"), (EnumCode
14, String
"TYPE_ENUM"), (EnumCode
15, String
"TYPE_SFIXED32"), (EnumCode
16, String
"TYPE_SFIXED64"), (EnumCode
17, String
"TYPE_SINT32"),
       (EnumCode
18, String
"TYPE_SINT64")]
      Bool
Prelude'.False

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