-- | A model for Protocol Buffers v3 enum and message types, designed as a target for transformations.This model is loosely based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/type.proto, as well as the proto3 reference documentation

module Hydra.Langs.Protobuf.Proto3 where

import qualified Hydra.Core as Core
import Data.Int
import Data.List as L
import Data.Map as M
import Data.Set as S

data Definition = 
  DefinitionEnum EnumDefinition |
  DefinitionMessage MessageDefinition
  deriving (Definition -> Definition -> Bool
(Definition -> Definition -> Bool)
-> (Definition -> Definition -> Bool) -> Eq Definition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Definition -> Definition -> Bool
== :: Definition -> Definition -> Bool
$c/= :: Definition -> Definition -> Bool
/= :: Definition -> Definition -> Bool
Eq, Eq Definition
Eq Definition =>
(Definition -> Definition -> Ordering)
-> (Definition -> Definition -> Bool)
-> (Definition -> Definition -> Bool)
-> (Definition -> Definition -> Bool)
-> (Definition -> Definition -> Bool)
-> (Definition -> Definition -> Definition)
-> (Definition -> Definition -> Definition)
-> Ord Definition
Definition -> Definition -> Bool
Definition -> Definition -> Ordering
Definition -> Definition -> Definition
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
$ccompare :: Definition -> Definition -> Ordering
compare :: Definition -> Definition -> Ordering
$c< :: Definition -> Definition -> Bool
< :: Definition -> Definition -> Bool
$c<= :: Definition -> Definition -> Bool
<= :: Definition -> Definition -> Bool
$c> :: Definition -> Definition -> Bool
> :: Definition -> Definition -> Bool
$c>= :: Definition -> Definition -> Bool
>= :: Definition -> Definition -> Bool
$cmax :: Definition -> Definition -> Definition
max :: Definition -> Definition -> Definition
$cmin :: Definition -> Definition -> Definition
min :: Definition -> Definition -> Definition
Ord, ReadPrec [Definition]
ReadPrec Definition
Int -> ReadS Definition
ReadS [Definition]
(Int -> ReadS Definition)
-> ReadS [Definition]
-> ReadPrec Definition
-> ReadPrec [Definition]
-> Read Definition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Definition
readsPrec :: Int -> ReadS Definition
$creadList :: ReadS [Definition]
readList :: ReadS [Definition]
$creadPrec :: ReadPrec Definition
readPrec :: ReadPrec Definition
$creadListPrec :: ReadPrec [Definition]
readListPrec :: ReadPrec [Definition]
Read, Int -> Definition -> ShowS
[Definition] -> ShowS
Definition -> String
(Int -> Definition -> ShowS)
-> (Definition -> String)
-> ([Definition] -> ShowS)
-> Show Definition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Definition -> ShowS
showsPrec :: Int -> Definition -> ShowS
$cshow :: Definition -> String
show :: Definition -> String
$cshowList :: [Definition] -> ShowS
showList :: [Definition] -> ShowS
Show)

_Definition :: Name
_Definition = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.Definition")

_Definition_enum :: Name
_Definition_enum = (String -> Name
Core.Name String
"enum")

_Definition_message :: Name
_Definition_message = (String -> Name
Core.Name String
"message")

-- | Enum type definition
data EnumDefinition = 
  EnumDefinition {
    -- | Enum type name
    EnumDefinition -> TypeName
enumDefinitionName :: TypeName,
    -- | Enum value definitions
    EnumDefinition -> [EnumValue]
enumDefinitionValues :: [EnumValue],
    -- | Protocol buffer options
    EnumDefinition -> [Option]
enumDefinitionOptions :: [Option]}
  deriving (EnumDefinition -> EnumDefinition -> Bool
(EnumDefinition -> EnumDefinition -> Bool)
-> (EnumDefinition -> EnumDefinition -> Bool) -> Eq EnumDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumDefinition -> EnumDefinition -> Bool
== :: EnumDefinition -> EnumDefinition -> Bool
$c/= :: EnumDefinition -> EnumDefinition -> Bool
/= :: EnumDefinition -> EnumDefinition -> Bool
Eq, Eq EnumDefinition
Eq EnumDefinition =>
(EnumDefinition -> EnumDefinition -> Ordering)
-> (EnumDefinition -> EnumDefinition -> Bool)
-> (EnumDefinition -> EnumDefinition -> Bool)
-> (EnumDefinition -> EnumDefinition -> Bool)
-> (EnumDefinition -> EnumDefinition -> Bool)
-> (EnumDefinition -> EnumDefinition -> EnumDefinition)
-> (EnumDefinition -> EnumDefinition -> EnumDefinition)
-> Ord EnumDefinition
EnumDefinition -> EnumDefinition -> Bool
EnumDefinition -> EnumDefinition -> Ordering
EnumDefinition -> EnumDefinition -> EnumDefinition
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
$ccompare :: EnumDefinition -> EnumDefinition -> Ordering
compare :: EnumDefinition -> EnumDefinition -> Ordering
$c< :: EnumDefinition -> EnumDefinition -> Bool
< :: EnumDefinition -> EnumDefinition -> Bool
$c<= :: EnumDefinition -> EnumDefinition -> Bool
<= :: EnumDefinition -> EnumDefinition -> Bool
$c> :: EnumDefinition -> EnumDefinition -> Bool
> :: EnumDefinition -> EnumDefinition -> Bool
$c>= :: EnumDefinition -> EnumDefinition -> Bool
>= :: EnumDefinition -> EnumDefinition -> Bool
$cmax :: EnumDefinition -> EnumDefinition -> EnumDefinition
max :: EnumDefinition -> EnumDefinition -> EnumDefinition
$cmin :: EnumDefinition -> EnumDefinition -> EnumDefinition
min :: EnumDefinition -> EnumDefinition -> EnumDefinition
Ord, ReadPrec [EnumDefinition]
ReadPrec EnumDefinition
Int -> ReadS EnumDefinition
ReadS [EnumDefinition]
(Int -> ReadS EnumDefinition)
-> ReadS [EnumDefinition]
-> ReadPrec EnumDefinition
-> ReadPrec [EnumDefinition]
-> Read EnumDefinition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EnumDefinition
readsPrec :: Int -> ReadS EnumDefinition
$creadList :: ReadS [EnumDefinition]
readList :: ReadS [EnumDefinition]
$creadPrec :: ReadPrec EnumDefinition
readPrec :: ReadPrec EnumDefinition
$creadListPrec :: ReadPrec [EnumDefinition]
readListPrec :: ReadPrec [EnumDefinition]
Read, Int -> EnumDefinition -> ShowS
[EnumDefinition] -> ShowS
EnumDefinition -> String
(Int -> EnumDefinition -> ShowS)
-> (EnumDefinition -> String)
-> ([EnumDefinition] -> ShowS)
-> Show EnumDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumDefinition -> ShowS
showsPrec :: Int -> EnumDefinition -> ShowS
$cshow :: EnumDefinition -> String
show :: EnumDefinition -> String
$cshowList :: [EnumDefinition] -> ShowS
showList :: [EnumDefinition] -> ShowS
Show)

_EnumDefinition :: Name
_EnumDefinition = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.EnumDefinition")

_EnumDefinition_name :: Name
_EnumDefinition_name = (String -> Name
Core.Name String
"name")

_EnumDefinition_values :: Name
_EnumDefinition_values = (String -> Name
Core.Name String
"values")

_EnumDefinition_options :: Name
_EnumDefinition_options = (String -> Name
Core.Name String
"options")

-- | Enum value definition
data EnumValue = 
  EnumValue {
    -- | Enum value name
    EnumValue -> EnumValueName
enumValueName :: EnumValueName,
    -- | Enum value number
    EnumValue -> Int
enumValueNumber :: Int,
    -- | Protocol buffer options
    EnumValue -> [Option]
enumValueOptions :: [Option]}
  deriving (EnumValue -> EnumValue -> Bool
(EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool) -> Eq EnumValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumValue -> EnumValue -> Bool
== :: EnumValue -> EnumValue -> Bool
$c/= :: EnumValue -> EnumValue -> Bool
/= :: EnumValue -> EnumValue -> Bool
Eq, Eq EnumValue
Eq EnumValue =>
(EnumValue -> EnumValue -> Ordering)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> EnumValue)
-> (EnumValue -> EnumValue -> EnumValue)
-> Ord EnumValue
EnumValue -> EnumValue -> Bool
EnumValue -> EnumValue -> Ordering
EnumValue -> EnumValue -> EnumValue
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
$ccompare :: EnumValue -> EnumValue -> Ordering
compare :: EnumValue -> EnumValue -> Ordering
$c< :: EnumValue -> EnumValue -> Bool
< :: EnumValue -> EnumValue -> Bool
$c<= :: EnumValue -> EnumValue -> Bool
<= :: EnumValue -> EnumValue -> Bool
$c> :: EnumValue -> EnumValue -> Bool
> :: EnumValue -> EnumValue -> Bool
$c>= :: EnumValue -> EnumValue -> Bool
>= :: EnumValue -> EnumValue -> Bool
$cmax :: EnumValue -> EnumValue -> EnumValue
max :: EnumValue -> EnumValue -> EnumValue
$cmin :: EnumValue -> EnumValue -> EnumValue
min :: EnumValue -> EnumValue -> EnumValue
Ord, ReadPrec [EnumValue]
ReadPrec EnumValue
Int -> ReadS EnumValue
ReadS [EnumValue]
(Int -> ReadS EnumValue)
-> ReadS [EnumValue]
-> ReadPrec EnumValue
-> ReadPrec [EnumValue]
-> Read EnumValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EnumValue
readsPrec :: Int -> ReadS EnumValue
$creadList :: ReadS [EnumValue]
readList :: ReadS [EnumValue]
$creadPrec :: ReadPrec EnumValue
readPrec :: ReadPrec EnumValue
$creadListPrec :: ReadPrec [EnumValue]
readListPrec :: ReadPrec [EnumValue]
Read, Int -> EnumValue -> ShowS
[EnumValue] -> ShowS
EnumValue -> String
(Int -> EnumValue -> ShowS)
-> (EnumValue -> String)
-> ([EnumValue] -> ShowS)
-> Show EnumValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumValue -> ShowS
showsPrec :: Int -> EnumValue -> ShowS
$cshow :: EnumValue -> String
show :: EnumValue -> String
$cshowList :: [EnumValue] -> ShowS
showList :: [EnumValue] -> ShowS
Show)

_EnumValue :: Name
_EnumValue = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.EnumValue")

_EnumValue_name :: Name
_EnumValue_name = (String -> Name
Core.Name String
"name")

_EnumValue_number :: Name
_EnumValue_number = (String -> Name
Core.Name String
"number")

_EnumValue_options :: Name
_EnumValue_options = (String -> Name
Core.Name String
"options")

newtype EnumValueName = 
  EnumValueName {
    EnumValueName -> String
unEnumValueName :: String}
  deriving (EnumValueName -> EnumValueName -> Bool
(EnumValueName -> EnumValueName -> Bool)
-> (EnumValueName -> EnumValueName -> Bool) -> Eq EnumValueName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumValueName -> EnumValueName -> Bool
== :: EnumValueName -> EnumValueName -> Bool
$c/= :: EnumValueName -> EnumValueName -> Bool
/= :: EnumValueName -> EnumValueName -> Bool
Eq, Eq EnumValueName
Eq EnumValueName =>
(EnumValueName -> EnumValueName -> Ordering)
-> (EnumValueName -> EnumValueName -> Bool)
-> (EnumValueName -> EnumValueName -> Bool)
-> (EnumValueName -> EnumValueName -> Bool)
-> (EnumValueName -> EnumValueName -> Bool)
-> (EnumValueName -> EnumValueName -> EnumValueName)
-> (EnumValueName -> EnumValueName -> EnumValueName)
-> Ord EnumValueName
EnumValueName -> EnumValueName -> Bool
EnumValueName -> EnumValueName -> Ordering
EnumValueName -> EnumValueName -> EnumValueName
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
$ccompare :: EnumValueName -> EnumValueName -> Ordering
compare :: EnumValueName -> EnumValueName -> Ordering
$c< :: EnumValueName -> EnumValueName -> Bool
< :: EnumValueName -> EnumValueName -> Bool
$c<= :: EnumValueName -> EnumValueName -> Bool
<= :: EnumValueName -> EnumValueName -> Bool
$c> :: EnumValueName -> EnumValueName -> Bool
> :: EnumValueName -> EnumValueName -> Bool
$c>= :: EnumValueName -> EnumValueName -> Bool
>= :: EnumValueName -> EnumValueName -> Bool
$cmax :: EnumValueName -> EnumValueName -> EnumValueName
max :: EnumValueName -> EnumValueName -> EnumValueName
$cmin :: EnumValueName -> EnumValueName -> EnumValueName
min :: EnumValueName -> EnumValueName -> EnumValueName
Ord, ReadPrec [EnumValueName]
ReadPrec EnumValueName
Int -> ReadS EnumValueName
ReadS [EnumValueName]
(Int -> ReadS EnumValueName)
-> ReadS [EnumValueName]
-> ReadPrec EnumValueName
-> ReadPrec [EnumValueName]
-> Read EnumValueName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EnumValueName
readsPrec :: Int -> ReadS EnumValueName
$creadList :: ReadS [EnumValueName]
readList :: ReadS [EnumValueName]
$creadPrec :: ReadPrec EnumValueName
readPrec :: ReadPrec EnumValueName
$creadListPrec :: ReadPrec [EnumValueName]
readListPrec :: ReadPrec [EnumValueName]
Read, Int -> EnumValueName -> ShowS
[EnumValueName] -> ShowS
EnumValueName -> String
(Int -> EnumValueName -> ShowS)
-> (EnumValueName -> String)
-> ([EnumValueName] -> ShowS)
-> Show EnumValueName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumValueName -> ShowS
showsPrec :: Int -> EnumValueName -> ShowS
$cshow :: EnumValueName -> String
show :: EnumValueName -> String
$cshowList :: [EnumValueName] -> ShowS
showList :: [EnumValueName] -> ShowS
Show)

_EnumValueName :: Name
_EnumValueName = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.EnumValueName")

-- | A single field of a message type
data Field = 
  Field {
    -- | The field name
    Field -> FieldName
fieldName :: FieldName,
    -- | The field JSON name
    Field -> Maybe String
fieldJsonName :: (Maybe String),
    -- | The datatype of the field
    Field -> FieldType
fieldType :: FieldType,
    -- | The field number
    Field -> Int
fieldNumber :: Int,
    -- | The protocol buffer options
    Field -> [Option]
fieldOptions :: [Option]}
  deriving (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
/= :: Field -> Field -> Bool
Eq, Eq Field
Eq Field =>
(Field -> Field -> Ordering)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Field)
-> (Field -> Field -> Field)
-> Ord Field
Field -> Field -> Bool
Field -> Field -> Ordering
Field -> Field -> Field
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
$ccompare :: Field -> Field -> Ordering
compare :: Field -> Field -> Ordering
$c< :: Field -> Field -> Bool
< :: Field -> Field -> Bool
$c<= :: Field -> Field -> Bool
<= :: Field -> Field -> Bool
$c> :: Field -> Field -> Bool
> :: Field -> Field -> Bool
$c>= :: Field -> Field -> Bool
>= :: Field -> Field -> Bool
$cmax :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
min :: Field -> Field -> Field
Ord, ReadPrec [Field]
ReadPrec Field
Int -> ReadS Field
ReadS [Field]
(Int -> ReadS Field)
-> ReadS [Field]
-> ReadPrec Field
-> ReadPrec [Field]
-> Read Field
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Field
readsPrec :: Int -> ReadS Field
$creadList :: ReadS [Field]
readList :: ReadS [Field]
$creadPrec :: ReadPrec Field
readPrec :: ReadPrec Field
$creadListPrec :: ReadPrec [Field]
readListPrec :: ReadPrec [Field]
Read, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Field -> ShowS
showsPrec :: Int -> Field -> ShowS
$cshow :: Field -> String
show :: Field -> String
$cshowList :: [Field] -> ShowS
showList :: [Field] -> ShowS
Show)

_Field :: Name
_Field = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.Field")

_Field_name :: Name
_Field_name = (String -> Name
Core.Name String
"name")

_Field_jsonName :: Name
_Field_jsonName = (String -> Name
Core.Name String
"jsonName")

_Field_type :: Name
_Field_type = (String -> Name
Core.Name String
"type")

_Field_number :: Name
_Field_number = (String -> Name
Core.Name String
"number")

_Field_options :: Name
_Field_options = (String -> Name
Core.Name String
"options")

-- | The name of a field
newtype FieldName = 
  FieldName {
    FieldName -> String
unFieldName :: String}
  deriving (FieldName -> FieldName -> Bool
(FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool) -> Eq FieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldName -> FieldName -> Bool
== :: FieldName -> FieldName -> Bool
$c/= :: FieldName -> FieldName -> Bool
/= :: FieldName -> FieldName -> Bool
Eq, Eq FieldName
Eq FieldName =>
(FieldName -> FieldName -> Ordering)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> FieldName)
-> (FieldName -> FieldName -> FieldName)
-> Ord FieldName
FieldName -> FieldName -> Bool
FieldName -> FieldName -> Ordering
FieldName -> FieldName -> FieldName
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
$ccompare :: FieldName -> FieldName -> Ordering
compare :: FieldName -> FieldName -> Ordering
$c< :: FieldName -> FieldName -> Bool
< :: FieldName -> FieldName -> Bool
$c<= :: FieldName -> FieldName -> Bool
<= :: FieldName -> FieldName -> Bool
$c> :: FieldName -> FieldName -> Bool
> :: FieldName -> FieldName -> Bool
$c>= :: FieldName -> FieldName -> Bool
>= :: FieldName -> FieldName -> Bool
$cmax :: FieldName -> FieldName -> FieldName
max :: FieldName -> FieldName -> FieldName
$cmin :: FieldName -> FieldName -> FieldName
min :: FieldName -> FieldName -> FieldName
Ord, ReadPrec [FieldName]
ReadPrec FieldName
Int -> ReadS FieldName
ReadS [FieldName]
(Int -> ReadS FieldName)
-> ReadS [FieldName]
-> ReadPrec FieldName
-> ReadPrec [FieldName]
-> Read FieldName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FieldName
readsPrec :: Int -> ReadS FieldName
$creadList :: ReadS [FieldName]
readList :: ReadS [FieldName]
$creadPrec :: ReadPrec FieldName
readPrec :: ReadPrec FieldName
$creadListPrec :: ReadPrec [FieldName]
readListPrec :: ReadPrec [FieldName]
Read, Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
(Int -> FieldName -> ShowS)
-> (FieldName -> String)
-> ([FieldName] -> ShowS)
-> Show FieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldName -> ShowS
showsPrec :: Int -> FieldName -> ShowS
$cshow :: FieldName -> String
show :: FieldName -> String
$cshowList :: [FieldName] -> ShowS
showList :: [FieldName] -> ShowS
Show)

_FieldName :: Name
_FieldName = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.FieldName")

data FieldType = 
  FieldTypeMap SimpleType |
  FieldTypeOneof [Field] |
  FieldTypeRepeated SimpleType |
  FieldTypeSimple SimpleType
  deriving (FieldType -> FieldType -> Bool
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldType -> FieldType -> Bool
== :: FieldType -> FieldType -> Bool
$c/= :: FieldType -> FieldType -> Bool
/= :: FieldType -> FieldType -> Bool
Eq, Eq FieldType
Eq FieldType =>
(FieldType -> FieldType -> Ordering)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> FieldType)
-> (FieldType -> FieldType -> FieldType)
-> Ord FieldType
FieldType -> FieldType -> Bool
FieldType -> FieldType -> Ordering
FieldType -> FieldType -> FieldType
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
$ccompare :: FieldType -> FieldType -> Ordering
compare :: FieldType -> FieldType -> Ordering
$c< :: FieldType -> FieldType -> Bool
< :: FieldType -> FieldType -> Bool
$c<= :: FieldType -> FieldType -> Bool
<= :: FieldType -> FieldType -> Bool
$c> :: FieldType -> FieldType -> Bool
> :: FieldType -> FieldType -> Bool
$c>= :: FieldType -> FieldType -> Bool
>= :: FieldType -> FieldType -> Bool
$cmax :: FieldType -> FieldType -> FieldType
max :: FieldType -> FieldType -> FieldType
$cmin :: FieldType -> FieldType -> FieldType
min :: FieldType -> FieldType -> FieldType
Ord, ReadPrec [FieldType]
ReadPrec FieldType
Int -> ReadS FieldType
ReadS [FieldType]
(Int -> ReadS FieldType)
-> ReadS [FieldType]
-> ReadPrec FieldType
-> ReadPrec [FieldType]
-> Read FieldType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FieldType
readsPrec :: Int -> ReadS FieldType
$creadList :: ReadS [FieldType]
readList :: ReadS [FieldType]
$creadPrec :: ReadPrec FieldType
readPrec :: ReadPrec FieldType
$creadListPrec :: ReadPrec [FieldType]
readListPrec :: ReadPrec [FieldType]
Read, Int -> FieldType -> ShowS
[FieldType] -> ShowS
FieldType -> String
(Int -> FieldType -> ShowS)
-> (FieldType -> String)
-> ([FieldType] -> ShowS)
-> Show FieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldType -> ShowS
showsPrec :: Int -> FieldType -> ShowS
$cshow :: FieldType -> String
show :: FieldType -> String
$cshowList :: [FieldType] -> ShowS
showList :: [FieldType] -> ShowS
Show)

_FieldType :: Name
_FieldType = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.FieldType")

_FieldType_map :: Name
_FieldType_map = (String -> Name
Core.Name String
"map")

_FieldType_oneof :: Name
_FieldType_oneof = (String -> Name
Core.Name String
"oneof")

_FieldType_repeated :: Name
_FieldType_repeated = (String -> Name
Core.Name String
"repeated")

_FieldType_simple :: Name
_FieldType_simple = (String -> Name
Core.Name String
"simple")

newtype FileReference = 
  FileReference {
    FileReference -> String
unFileReference :: String}
  deriving (FileReference -> FileReference -> Bool
(FileReference -> FileReference -> Bool)
-> (FileReference -> FileReference -> Bool) -> Eq FileReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileReference -> FileReference -> Bool
== :: FileReference -> FileReference -> Bool
$c/= :: FileReference -> FileReference -> Bool
/= :: FileReference -> FileReference -> Bool
Eq, Eq FileReference
Eq FileReference =>
(FileReference -> FileReference -> Ordering)
-> (FileReference -> FileReference -> Bool)
-> (FileReference -> FileReference -> Bool)
-> (FileReference -> FileReference -> Bool)
-> (FileReference -> FileReference -> Bool)
-> (FileReference -> FileReference -> FileReference)
-> (FileReference -> FileReference -> FileReference)
-> Ord FileReference
FileReference -> FileReference -> Bool
FileReference -> FileReference -> Ordering
FileReference -> FileReference -> FileReference
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
$ccompare :: FileReference -> FileReference -> Ordering
compare :: FileReference -> FileReference -> Ordering
$c< :: FileReference -> FileReference -> Bool
< :: FileReference -> FileReference -> Bool
$c<= :: FileReference -> FileReference -> Bool
<= :: FileReference -> FileReference -> Bool
$c> :: FileReference -> FileReference -> Bool
> :: FileReference -> FileReference -> Bool
$c>= :: FileReference -> FileReference -> Bool
>= :: FileReference -> FileReference -> Bool
$cmax :: FileReference -> FileReference -> FileReference
max :: FileReference -> FileReference -> FileReference
$cmin :: FileReference -> FileReference -> FileReference
min :: FileReference -> FileReference -> FileReference
Ord, ReadPrec [FileReference]
ReadPrec FileReference
Int -> ReadS FileReference
ReadS [FileReference]
(Int -> ReadS FileReference)
-> ReadS [FileReference]
-> ReadPrec FileReference
-> ReadPrec [FileReference]
-> Read FileReference
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FileReference
readsPrec :: Int -> ReadS FileReference
$creadList :: ReadS [FileReference]
readList :: ReadS [FileReference]
$creadPrec :: ReadPrec FileReference
readPrec :: ReadPrec FileReference
$creadListPrec :: ReadPrec [FileReference]
readListPrec :: ReadPrec [FileReference]
Read, Int -> FileReference -> ShowS
[FileReference] -> ShowS
FileReference -> String
(Int -> FileReference -> ShowS)
-> (FileReference -> String)
-> ([FileReference] -> ShowS)
-> Show FileReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileReference -> ShowS
showsPrec :: Int -> FileReference -> ShowS
$cshow :: FileReference -> String
show :: FileReference -> String
$cshowList :: [FileReference] -> ShowS
showList :: [FileReference] -> ShowS
Show)

_FileReference :: Name
_FileReference = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.FileReference")

-- | A protocol buffer message type
data MessageDefinition = 
  MessageDefinition {
    -- | The fully qualified message name
    MessageDefinition -> TypeName
messageDefinitionName :: TypeName,
    -- | The list of fields
    MessageDefinition -> [Field]
messageDefinitionFields :: [Field],
    -- | The protocol buffer options
    MessageDefinition -> [Option]
messageDefinitionOptions :: [Option]}
  deriving (MessageDefinition -> MessageDefinition -> Bool
(MessageDefinition -> MessageDefinition -> Bool)
-> (MessageDefinition -> MessageDefinition -> Bool)
-> Eq MessageDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageDefinition -> MessageDefinition -> Bool
== :: MessageDefinition -> MessageDefinition -> Bool
$c/= :: MessageDefinition -> MessageDefinition -> Bool
/= :: MessageDefinition -> MessageDefinition -> Bool
Eq, Eq MessageDefinition
Eq MessageDefinition =>
(MessageDefinition -> MessageDefinition -> Ordering)
-> (MessageDefinition -> MessageDefinition -> Bool)
-> (MessageDefinition -> MessageDefinition -> Bool)
-> (MessageDefinition -> MessageDefinition -> Bool)
-> (MessageDefinition -> MessageDefinition -> Bool)
-> (MessageDefinition -> MessageDefinition -> MessageDefinition)
-> (MessageDefinition -> MessageDefinition -> MessageDefinition)
-> Ord MessageDefinition
MessageDefinition -> MessageDefinition -> Bool
MessageDefinition -> MessageDefinition -> Ordering
MessageDefinition -> MessageDefinition -> MessageDefinition
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
$ccompare :: MessageDefinition -> MessageDefinition -> Ordering
compare :: MessageDefinition -> MessageDefinition -> Ordering
$c< :: MessageDefinition -> MessageDefinition -> Bool
< :: MessageDefinition -> MessageDefinition -> Bool
$c<= :: MessageDefinition -> MessageDefinition -> Bool
<= :: MessageDefinition -> MessageDefinition -> Bool
$c> :: MessageDefinition -> MessageDefinition -> Bool
> :: MessageDefinition -> MessageDefinition -> Bool
$c>= :: MessageDefinition -> MessageDefinition -> Bool
>= :: MessageDefinition -> MessageDefinition -> Bool
$cmax :: MessageDefinition -> MessageDefinition -> MessageDefinition
max :: MessageDefinition -> MessageDefinition -> MessageDefinition
$cmin :: MessageDefinition -> MessageDefinition -> MessageDefinition
min :: MessageDefinition -> MessageDefinition -> MessageDefinition
Ord, ReadPrec [MessageDefinition]
ReadPrec MessageDefinition
Int -> ReadS MessageDefinition
ReadS [MessageDefinition]
(Int -> ReadS MessageDefinition)
-> ReadS [MessageDefinition]
-> ReadPrec MessageDefinition
-> ReadPrec [MessageDefinition]
-> Read MessageDefinition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MessageDefinition
readsPrec :: Int -> ReadS MessageDefinition
$creadList :: ReadS [MessageDefinition]
readList :: ReadS [MessageDefinition]
$creadPrec :: ReadPrec MessageDefinition
readPrec :: ReadPrec MessageDefinition
$creadListPrec :: ReadPrec [MessageDefinition]
readListPrec :: ReadPrec [MessageDefinition]
Read, Int -> MessageDefinition -> ShowS
[MessageDefinition] -> ShowS
MessageDefinition -> String
(Int -> MessageDefinition -> ShowS)
-> (MessageDefinition -> String)
-> ([MessageDefinition] -> ShowS)
-> Show MessageDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageDefinition -> ShowS
showsPrec :: Int -> MessageDefinition -> ShowS
$cshow :: MessageDefinition -> String
show :: MessageDefinition -> String
$cshowList :: [MessageDefinition] -> ShowS
showList :: [MessageDefinition] -> ShowS
Show)

_MessageDefinition :: Name
_MessageDefinition = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.MessageDefinition")

_MessageDefinition_name :: Name
_MessageDefinition_name = (String -> Name
Core.Name String
"name")

_MessageDefinition_fields :: Name
_MessageDefinition_fields = (String -> Name
Core.Name String
"fields")

_MessageDefinition_options :: Name
_MessageDefinition_options = (String -> Name
Core.Name String
"options")

-- | A protocol buffer option, which can be attached to a message, field, enumeration, etc
data Option = 
  Option {
    -- | The option's name. For protobuf built-in options (options defined in descriptor.proto), this is the short name. For example, `"map_entry"`. For custom options, it should be the fully-qualified name. For example, `"google.api.http"`.
    Option -> String
optionName :: String,
    -- | The option's value
    Option -> Value
optionValue :: Value}
  deriving (Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
/= :: Option -> Option -> Bool
Eq, Eq Option
Eq Option =>
(Option -> Option -> Ordering)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Option)
-> (Option -> Option -> Option)
-> Ord Option
Option -> Option -> Bool
Option -> Option -> Ordering
Option -> Option -> Option
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
$ccompare :: Option -> Option -> Ordering
compare :: Option -> Option -> Ordering
$c< :: Option -> Option -> Bool
< :: Option -> Option -> Bool
$c<= :: Option -> Option -> Bool
<= :: Option -> Option -> Bool
$c> :: Option -> Option -> Bool
> :: Option -> Option -> Bool
$c>= :: Option -> Option -> Bool
>= :: Option -> Option -> Bool
$cmax :: Option -> Option -> Option
max :: Option -> Option -> Option
$cmin :: Option -> Option -> Option
min :: Option -> Option -> Option
Ord, ReadPrec [Option]
ReadPrec Option
Int -> ReadS Option
ReadS [Option]
(Int -> ReadS Option)
-> ReadS [Option]
-> ReadPrec Option
-> ReadPrec [Option]
-> Read Option
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Option
readsPrec :: Int -> ReadS Option
$creadList :: ReadS [Option]
readList :: ReadS [Option]
$creadPrec :: ReadPrec Option
readPrec :: ReadPrec Option
$creadListPrec :: ReadPrec [Option]
readListPrec :: ReadPrec [Option]
Read, Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Option -> ShowS
showsPrec :: Int -> Option -> ShowS
$cshow :: Option -> String
show :: Option -> String
$cshowList :: [Option] -> ShowS
showList :: [Option] -> ShowS
Show)

_Option :: Name
_Option = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.Option")

_Option_name :: Name
_Option_name = (String -> Name
Core.Name String
"name")

_Option_value :: Name
_Option_value = (String -> Name
Core.Name String
"value")

newtype PackageName = 
  PackageName {
    PackageName -> String
unPackageName :: String}
  deriving (PackageName -> PackageName -> Bool
(PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool) -> Eq PackageName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageName -> PackageName -> Bool
== :: PackageName -> PackageName -> Bool
$c/= :: PackageName -> PackageName -> Bool
/= :: PackageName -> PackageName -> Bool
Eq, Eq PackageName
Eq PackageName =>
(PackageName -> PackageName -> Ordering)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> PackageName)
-> (PackageName -> PackageName -> PackageName)
-> Ord PackageName
PackageName -> PackageName -> Bool
PackageName -> PackageName -> Ordering
PackageName -> PackageName -> PackageName
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
$ccompare :: PackageName -> PackageName -> Ordering
compare :: PackageName -> PackageName -> Ordering
$c< :: PackageName -> PackageName -> Bool
< :: PackageName -> PackageName -> Bool
$c<= :: PackageName -> PackageName -> Bool
<= :: PackageName -> PackageName -> Bool
$c> :: PackageName -> PackageName -> Bool
> :: PackageName -> PackageName -> Bool
$c>= :: PackageName -> PackageName -> Bool
>= :: PackageName -> PackageName -> Bool
$cmax :: PackageName -> PackageName -> PackageName
max :: PackageName -> PackageName -> PackageName
$cmin :: PackageName -> PackageName -> PackageName
min :: PackageName -> PackageName -> PackageName
Ord, ReadPrec [PackageName]
ReadPrec PackageName
Int -> ReadS PackageName
ReadS [PackageName]
(Int -> ReadS PackageName)
-> ReadS [PackageName]
-> ReadPrec PackageName
-> ReadPrec [PackageName]
-> Read PackageName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PackageName
readsPrec :: Int -> ReadS PackageName
$creadList :: ReadS [PackageName]
readList :: ReadS [PackageName]
$creadPrec :: ReadPrec PackageName
readPrec :: ReadPrec PackageName
$creadListPrec :: ReadPrec [PackageName]
readListPrec :: ReadPrec [PackageName]
Read, Int -> PackageName -> ShowS
[PackageName] -> ShowS
PackageName -> String
(Int -> PackageName -> ShowS)
-> (PackageName -> String)
-> ([PackageName] -> ShowS)
-> Show PackageName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageName -> ShowS
showsPrec :: Int -> PackageName -> ShowS
$cshow :: PackageName -> String
show :: PackageName -> String
$cshowList :: [PackageName] -> ShowS
showList :: [PackageName] -> ShowS
Show)

_PackageName :: Name
_PackageName = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.PackageName")

-- | A .proto file, usually containing one or more enum or message type definitions
data ProtoFile = 
  ProtoFile {
    ProtoFile -> PackageName
protoFilePackage :: PackageName,
    ProtoFile -> [FileReference]
protoFileImports :: [FileReference],
    ProtoFile -> [Definition]
protoFileTypes :: [Definition],
    ProtoFile -> [Option]
protoFileOptions :: [Option]}
  deriving (ProtoFile -> ProtoFile -> Bool
(ProtoFile -> ProtoFile -> Bool)
-> (ProtoFile -> ProtoFile -> Bool) -> Eq ProtoFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtoFile -> ProtoFile -> Bool
== :: ProtoFile -> ProtoFile -> Bool
$c/= :: ProtoFile -> ProtoFile -> Bool
/= :: ProtoFile -> ProtoFile -> Bool
Eq, Eq ProtoFile
Eq ProtoFile =>
(ProtoFile -> ProtoFile -> Ordering)
-> (ProtoFile -> ProtoFile -> Bool)
-> (ProtoFile -> ProtoFile -> Bool)
-> (ProtoFile -> ProtoFile -> Bool)
-> (ProtoFile -> ProtoFile -> Bool)
-> (ProtoFile -> ProtoFile -> ProtoFile)
-> (ProtoFile -> ProtoFile -> ProtoFile)
-> Ord ProtoFile
ProtoFile -> ProtoFile -> Bool
ProtoFile -> ProtoFile -> Ordering
ProtoFile -> ProtoFile -> ProtoFile
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
$ccompare :: ProtoFile -> ProtoFile -> Ordering
compare :: ProtoFile -> ProtoFile -> Ordering
$c< :: ProtoFile -> ProtoFile -> Bool
< :: ProtoFile -> ProtoFile -> Bool
$c<= :: ProtoFile -> ProtoFile -> Bool
<= :: ProtoFile -> ProtoFile -> Bool
$c> :: ProtoFile -> ProtoFile -> Bool
> :: ProtoFile -> ProtoFile -> Bool
$c>= :: ProtoFile -> ProtoFile -> Bool
>= :: ProtoFile -> ProtoFile -> Bool
$cmax :: ProtoFile -> ProtoFile -> ProtoFile
max :: ProtoFile -> ProtoFile -> ProtoFile
$cmin :: ProtoFile -> ProtoFile -> ProtoFile
min :: ProtoFile -> ProtoFile -> ProtoFile
Ord, ReadPrec [ProtoFile]
ReadPrec ProtoFile
Int -> ReadS ProtoFile
ReadS [ProtoFile]
(Int -> ReadS ProtoFile)
-> ReadS [ProtoFile]
-> ReadPrec ProtoFile
-> ReadPrec [ProtoFile]
-> Read ProtoFile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ProtoFile
readsPrec :: Int -> ReadS ProtoFile
$creadList :: ReadS [ProtoFile]
readList :: ReadS [ProtoFile]
$creadPrec :: ReadPrec ProtoFile
readPrec :: ReadPrec ProtoFile
$creadListPrec :: ReadPrec [ProtoFile]
readListPrec :: ReadPrec [ProtoFile]
Read, Int -> ProtoFile -> ShowS
[ProtoFile] -> ShowS
ProtoFile -> String
(Int -> ProtoFile -> ShowS)
-> (ProtoFile -> String)
-> ([ProtoFile] -> ShowS)
-> Show ProtoFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtoFile -> ShowS
showsPrec :: Int -> ProtoFile -> ShowS
$cshow :: ProtoFile -> String
show :: ProtoFile -> String
$cshowList :: [ProtoFile] -> ShowS
showList :: [ProtoFile] -> ShowS
Show)

_ProtoFile :: Name
_ProtoFile = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.ProtoFile")

_ProtoFile_package :: Name
_ProtoFile_package = (String -> Name
Core.Name String
"package")

_ProtoFile_imports :: Name
_ProtoFile_imports = (String -> Name
Core.Name String
"imports")

_ProtoFile_types :: Name
_ProtoFile_types = (String -> Name
Core.Name String
"types")

_ProtoFile_options :: Name
_ProtoFile_options = (String -> Name
Core.Name String
"options")

-- | One of several Proto3 scalar types
data ScalarType = 
  ScalarTypeBool  |
  ScalarTypeBytes  |
  ScalarTypeDouble  |
  ScalarTypeFixed32  |
  ScalarTypeFixed64  |
  ScalarTypeFloat  |
  ScalarTypeInt32  |
  ScalarTypeInt64  |
  ScalarTypeSfixed32  |
  ScalarTypeSfixed64  |
  ScalarTypeSint32  |
  ScalarTypeSint64  |
  ScalarTypeString  |
  ScalarTypeUint32  |
  ScalarTypeUint64 
  deriving (ScalarType -> ScalarType -> Bool
(ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> Bool) -> Eq ScalarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScalarType -> ScalarType -> Bool
== :: ScalarType -> ScalarType -> Bool
$c/= :: ScalarType -> ScalarType -> Bool
/= :: ScalarType -> ScalarType -> Bool
Eq, Eq ScalarType
Eq ScalarType =>
(ScalarType -> ScalarType -> Ordering)
-> (ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> ScalarType)
-> (ScalarType -> ScalarType -> ScalarType)
-> Ord ScalarType
ScalarType -> ScalarType -> Bool
ScalarType -> ScalarType -> Ordering
ScalarType -> ScalarType -> ScalarType
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
$ccompare :: ScalarType -> ScalarType -> Ordering
compare :: ScalarType -> ScalarType -> Ordering
$c< :: ScalarType -> ScalarType -> Bool
< :: ScalarType -> ScalarType -> Bool
$c<= :: ScalarType -> ScalarType -> Bool
<= :: ScalarType -> ScalarType -> Bool
$c> :: ScalarType -> ScalarType -> Bool
> :: ScalarType -> ScalarType -> Bool
$c>= :: ScalarType -> ScalarType -> Bool
>= :: ScalarType -> ScalarType -> Bool
$cmax :: ScalarType -> ScalarType -> ScalarType
max :: ScalarType -> ScalarType -> ScalarType
$cmin :: ScalarType -> ScalarType -> ScalarType
min :: ScalarType -> ScalarType -> ScalarType
Ord, ReadPrec [ScalarType]
ReadPrec ScalarType
Int -> ReadS ScalarType
ReadS [ScalarType]
(Int -> ReadS ScalarType)
-> ReadS [ScalarType]
-> ReadPrec ScalarType
-> ReadPrec [ScalarType]
-> Read ScalarType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ScalarType
readsPrec :: Int -> ReadS ScalarType
$creadList :: ReadS [ScalarType]
readList :: ReadS [ScalarType]
$creadPrec :: ReadPrec ScalarType
readPrec :: ReadPrec ScalarType
$creadListPrec :: ReadPrec [ScalarType]
readListPrec :: ReadPrec [ScalarType]
Read, Int -> ScalarType -> ShowS
[ScalarType] -> ShowS
ScalarType -> String
(Int -> ScalarType -> ShowS)
-> (ScalarType -> String)
-> ([ScalarType] -> ShowS)
-> Show ScalarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScalarType -> ShowS
showsPrec :: Int -> ScalarType -> ShowS
$cshow :: ScalarType -> String
show :: ScalarType -> String
$cshowList :: [ScalarType] -> ShowS
showList :: [ScalarType] -> ShowS
Show)

_ScalarType :: Name
_ScalarType = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.ScalarType")

_ScalarType_bool :: Name
_ScalarType_bool = (String -> Name
Core.Name String
"bool")

_ScalarType_bytes :: Name
_ScalarType_bytes = (String -> Name
Core.Name String
"bytes")

_ScalarType_double :: Name
_ScalarType_double = (String -> Name
Core.Name String
"double")

_ScalarType_fixed32 :: Name
_ScalarType_fixed32 = (String -> Name
Core.Name String
"fixed32")

_ScalarType_fixed64 :: Name
_ScalarType_fixed64 = (String -> Name
Core.Name String
"fixed64")

_ScalarType_float :: Name
_ScalarType_float = (String -> Name
Core.Name String
"float")

_ScalarType_int32 :: Name
_ScalarType_int32 = (String -> Name
Core.Name String
"int32")

_ScalarType_int64 :: Name
_ScalarType_int64 = (String -> Name
Core.Name String
"int64")

_ScalarType_sfixed32 :: Name
_ScalarType_sfixed32 = (String -> Name
Core.Name String
"sfixed32")

_ScalarType_sfixed64 :: Name
_ScalarType_sfixed64 = (String -> Name
Core.Name String
"sfixed64")

_ScalarType_sint32 :: Name
_ScalarType_sint32 = (String -> Name
Core.Name String
"sint32")

_ScalarType_sint64 :: Name
_ScalarType_sint64 = (String -> Name
Core.Name String
"sint64")

_ScalarType_string :: Name
_ScalarType_string = (String -> Name
Core.Name String
"string")

_ScalarType_uint32 :: Name
_ScalarType_uint32 = (String -> Name
Core.Name String
"uint32")

_ScalarType_uint64 :: Name
_ScalarType_uint64 = (String -> Name
Core.Name String
"uint64")

-- | A scalar type or a reference to an enum type or message type
data SimpleType = 
  SimpleTypeReference TypeName |
  SimpleTypeScalar ScalarType
  deriving (SimpleType -> SimpleType -> Bool
(SimpleType -> SimpleType -> Bool)
-> (SimpleType -> SimpleType -> Bool) -> Eq SimpleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleType -> SimpleType -> Bool
== :: SimpleType -> SimpleType -> Bool
$c/= :: SimpleType -> SimpleType -> Bool
/= :: SimpleType -> SimpleType -> Bool
Eq, Eq SimpleType
Eq SimpleType =>
(SimpleType -> SimpleType -> Ordering)
-> (SimpleType -> SimpleType -> Bool)
-> (SimpleType -> SimpleType -> Bool)
-> (SimpleType -> SimpleType -> Bool)
-> (SimpleType -> SimpleType -> Bool)
-> (SimpleType -> SimpleType -> SimpleType)
-> (SimpleType -> SimpleType -> SimpleType)
-> Ord SimpleType
SimpleType -> SimpleType -> Bool
SimpleType -> SimpleType -> Ordering
SimpleType -> SimpleType -> SimpleType
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
$ccompare :: SimpleType -> SimpleType -> Ordering
compare :: SimpleType -> SimpleType -> Ordering
$c< :: SimpleType -> SimpleType -> Bool
< :: SimpleType -> SimpleType -> Bool
$c<= :: SimpleType -> SimpleType -> Bool
<= :: SimpleType -> SimpleType -> Bool
$c> :: SimpleType -> SimpleType -> Bool
> :: SimpleType -> SimpleType -> Bool
$c>= :: SimpleType -> SimpleType -> Bool
>= :: SimpleType -> SimpleType -> Bool
$cmax :: SimpleType -> SimpleType -> SimpleType
max :: SimpleType -> SimpleType -> SimpleType
$cmin :: SimpleType -> SimpleType -> SimpleType
min :: SimpleType -> SimpleType -> SimpleType
Ord, ReadPrec [SimpleType]
ReadPrec SimpleType
Int -> ReadS SimpleType
ReadS [SimpleType]
(Int -> ReadS SimpleType)
-> ReadS [SimpleType]
-> ReadPrec SimpleType
-> ReadPrec [SimpleType]
-> Read SimpleType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SimpleType
readsPrec :: Int -> ReadS SimpleType
$creadList :: ReadS [SimpleType]
readList :: ReadS [SimpleType]
$creadPrec :: ReadPrec SimpleType
readPrec :: ReadPrec SimpleType
$creadListPrec :: ReadPrec [SimpleType]
readListPrec :: ReadPrec [SimpleType]
Read, Int -> SimpleType -> ShowS
[SimpleType] -> ShowS
SimpleType -> String
(Int -> SimpleType -> ShowS)
-> (SimpleType -> String)
-> ([SimpleType] -> ShowS)
-> Show SimpleType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleType -> ShowS
showsPrec :: Int -> SimpleType -> ShowS
$cshow :: SimpleType -> String
show :: SimpleType -> String
$cshowList :: [SimpleType] -> ShowS
showList :: [SimpleType] -> ShowS
Show)

_SimpleType :: Name
_SimpleType = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.SimpleType")

_SimpleType_reference :: Name
_SimpleType_reference = (String -> Name
Core.Name String
"reference")

_SimpleType_scalar :: Name
_SimpleType_scalar = (String -> Name
Core.Name String
"scalar")

-- | The local name of an enum type or message type
newtype TypeName = 
  TypeName {
    TypeName -> String
unTypeName :: String}
  deriving (TypeName -> TypeName -> Bool
(TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool) -> Eq TypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeName -> TypeName -> Bool
== :: TypeName -> TypeName -> Bool
$c/= :: TypeName -> TypeName -> Bool
/= :: TypeName -> TypeName -> Bool
Eq, Eq TypeName
Eq TypeName =>
(TypeName -> TypeName -> Ordering)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> TypeName)
-> (TypeName -> TypeName -> TypeName)
-> Ord TypeName
TypeName -> TypeName -> Bool
TypeName -> TypeName -> Ordering
TypeName -> TypeName -> TypeName
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
$ccompare :: TypeName -> TypeName -> Ordering
compare :: TypeName -> TypeName -> Ordering
$c< :: TypeName -> TypeName -> Bool
< :: TypeName -> TypeName -> Bool
$c<= :: TypeName -> TypeName -> Bool
<= :: TypeName -> TypeName -> Bool
$c> :: TypeName -> TypeName -> Bool
> :: TypeName -> TypeName -> Bool
$c>= :: TypeName -> TypeName -> Bool
>= :: TypeName -> TypeName -> Bool
$cmax :: TypeName -> TypeName -> TypeName
max :: TypeName -> TypeName -> TypeName
$cmin :: TypeName -> TypeName -> TypeName
min :: TypeName -> TypeName -> TypeName
Ord, ReadPrec [TypeName]
ReadPrec TypeName
Int -> ReadS TypeName
ReadS [TypeName]
(Int -> ReadS TypeName)
-> ReadS [TypeName]
-> ReadPrec TypeName
-> ReadPrec [TypeName]
-> Read TypeName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TypeName
readsPrec :: Int -> ReadS TypeName
$creadList :: ReadS [TypeName]
readList :: ReadS [TypeName]
$creadPrec :: ReadPrec TypeName
readPrec :: ReadPrec TypeName
$creadListPrec :: ReadPrec [TypeName]
readListPrec :: ReadPrec [TypeName]
Read, Int -> TypeName -> ShowS
[TypeName] -> ShowS
TypeName -> String
(Int -> TypeName -> ShowS)
-> (TypeName -> String) -> ([TypeName] -> ShowS) -> Show TypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeName -> ShowS
showsPrec :: Int -> TypeName -> ShowS
$cshow :: TypeName -> String
show :: TypeName -> String
$cshowList :: [TypeName] -> ShowS
showList :: [TypeName] -> ShowS
Show)

_TypeName :: Name
_TypeName = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.TypeName")

-- | A reference to an enum type or message type
newtype TypeReference = 
  TypeReference {
    TypeReference -> String
unTypeReference :: String}
  deriving (TypeReference -> TypeReference -> Bool
(TypeReference -> TypeReference -> Bool)
-> (TypeReference -> TypeReference -> Bool) -> Eq TypeReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeReference -> TypeReference -> Bool
== :: TypeReference -> TypeReference -> Bool
$c/= :: TypeReference -> TypeReference -> Bool
/= :: TypeReference -> TypeReference -> Bool
Eq, Eq TypeReference
Eq TypeReference =>
(TypeReference -> TypeReference -> Ordering)
-> (TypeReference -> TypeReference -> Bool)
-> (TypeReference -> TypeReference -> Bool)
-> (TypeReference -> TypeReference -> Bool)
-> (TypeReference -> TypeReference -> Bool)
-> (TypeReference -> TypeReference -> TypeReference)
-> (TypeReference -> TypeReference -> TypeReference)
-> Ord TypeReference
TypeReference -> TypeReference -> Bool
TypeReference -> TypeReference -> Ordering
TypeReference -> TypeReference -> TypeReference
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
$ccompare :: TypeReference -> TypeReference -> Ordering
compare :: TypeReference -> TypeReference -> Ordering
$c< :: TypeReference -> TypeReference -> Bool
< :: TypeReference -> TypeReference -> Bool
$c<= :: TypeReference -> TypeReference -> Bool
<= :: TypeReference -> TypeReference -> Bool
$c> :: TypeReference -> TypeReference -> Bool
> :: TypeReference -> TypeReference -> Bool
$c>= :: TypeReference -> TypeReference -> Bool
>= :: TypeReference -> TypeReference -> Bool
$cmax :: TypeReference -> TypeReference -> TypeReference
max :: TypeReference -> TypeReference -> TypeReference
$cmin :: TypeReference -> TypeReference -> TypeReference
min :: TypeReference -> TypeReference -> TypeReference
Ord, ReadPrec [TypeReference]
ReadPrec TypeReference
Int -> ReadS TypeReference
ReadS [TypeReference]
(Int -> ReadS TypeReference)
-> ReadS [TypeReference]
-> ReadPrec TypeReference
-> ReadPrec [TypeReference]
-> Read TypeReference
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TypeReference
readsPrec :: Int -> ReadS TypeReference
$creadList :: ReadS [TypeReference]
readList :: ReadS [TypeReference]
$creadPrec :: ReadPrec TypeReference
readPrec :: ReadPrec TypeReference
$creadListPrec :: ReadPrec [TypeReference]
readListPrec :: ReadPrec [TypeReference]
Read, Int -> TypeReference -> ShowS
[TypeReference] -> ShowS
TypeReference -> String
(Int -> TypeReference -> ShowS)
-> (TypeReference -> String)
-> ([TypeReference] -> ShowS)
-> Show TypeReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeReference -> ShowS
showsPrec :: Int -> TypeReference -> ShowS
$cshow :: TypeReference -> String
show :: TypeReference -> String
$cshowList :: [TypeReference] -> ShowS
showList :: [TypeReference] -> ShowS
Show)

_TypeReference :: Name
_TypeReference = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.TypeReference")

-- | A scalar value
data Value = 
  ValueBoolean Bool |
  ValueString String
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Eq Value
Eq Value =>
(Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
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
$ccompare :: Value -> Value -> Ordering
compare :: Value -> Value -> Ordering
$c< :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
>= :: Value -> Value -> Bool
$cmax :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
min :: Value -> Value -> Value
Ord, ReadPrec [Value]
ReadPrec Value
Int -> ReadS Value
ReadS [Value]
(Int -> ReadS Value)
-> ReadS [Value]
-> ReadPrec Value
-> ReadPrec [Value]
-> Read Value
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Value
readsPrec :: Int -> ReadS Value
$creadList :: ReadS [Value]
readList :: ReadS [Value]
$creadPrec :: ReadPrec Value
readPrec :: ReadPrec Value
$creadListPrec :: ReadPrec [Value]
readListPrec :: ReadPrec [Value]
Read, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)

_Value :: Name
_Value = (String -> Name
Core.Name String
"hydra/langs/protobuf/proto3.Value")

_Value_boolean :: Name
_Value_boolean = (String -> Name
Core.Name String
"boolean")

_Value_string :: Name
_Value_string = (String -> Name
Core.Name String
"string")