{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier4.Langs.Protobuf.Proto3 where

import Hydra.Sources.Tier3.All
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap
import Hydra.Dsl.Types as Types


proto3Ns :: Namespace
proto3Ns = [Char] -> Namespace
Namespace [Char]
"hydra/langs/protobuf/proto3"
proto3 :: [Char] -> Type
proto3 = Namespace -> [Char] -> Type
typeref Namespace
proto3Ns

proto3Module :: Module
proto3Module :: Module
proto3Module = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe [Char] -> Module
Module Namespace
proto3Ns [Element]
elements [Module
hydraCoreModule] [Module]
tier0Modules (Maybe [Char] -> Module) -> Maybe [Char] -> Module
forall a b. (a -> b) -> a -> b
$
    [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
"A model for Protocol Buffers v3 enum and message types, designed as a target for transformations."
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"This model is loosely based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/type.proto,"
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" as well as the proto3 reference documentation")
  where
    def :: [Char] -> Type -> Element
def = Namespace -> [Char] -> Type -> Element
datatype Namespace
proto3Ns
    elements :: [Element]
elements = [

      [Char] -> Type -> Element
def [Char]
"Definition" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"enum"[Char] -> Type -> FieldType
>: [Char] -> Type
proto3 [Char]
"EnumDefinition",
          [Char]
"message"[Char] -> Type -> FieldType
>: [Char] -> Type
proto3 [Char]
"MessageDefinition"],

      [Char] -> Type -> Element
def [Char]
"EnumDefinition" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Enum type definition" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"name"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"Enum type name" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
proto3 [Char]
"TypeName",
          [Char]
"values"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"Enum value definitions" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
proto3 [Char]
"EnumValue",
          [Char]
"options"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"Protocol buffer options" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
proto3 [Char]
"Option"],

      [Char] -> Type -> Element
def [Char]
"EnumValue" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Enum value definition" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"name"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"Enum value name" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
proto3 [Char]
"EnumValueName",
          [Char]
"number"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"Enum value number"
            Type
int32,
          [Char]
"options"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"Protocol buffer options" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
proto3 [Char]
"Option"],

      [Char] -> Type -> Element
def [Char]
"EnumValueName" Type
string,

      [Char] -> Type -> Element
def [Char]
"Field" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A single field of a message type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"name"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The field name" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
proto3 [Char]
"FieldName",
          [Char]
"jsonName"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The field JSON name" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional Type
string,
          [Char]
"type"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The datatype of the field" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
proto3 [Char]
"FieldType",
          [Char]
"number"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The field number"
            Type
int32,
          [Char]
"options"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The protocol buffer options" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
proto3 [Char]
"Option"],

      [Char] -> Type -> Element
def [Char]
"FieldName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"The name of a field"
        Type
string,

      [Char] -> Type -> Element
def [Char]
"FieldType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"map"[Char] -> Type -> FieldType
>: [Char] -> Type
proto3 [Char]
"SimpleType",
          [Char]
"oneof"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
proto3 [Char]
"Field",
          [Char]
"repeated"[Char] -> Type -> FieldType
>: [Char] -> Type
proto3 [Char]
"SimpleType",
          [Char]
"simple"[Char] -> Type -> FieldType
>: [Char] -> Type
proto3 [Char]
"SimpleType"],

      [Char] -> Type -> Element
def [Char]
"FileReference" Type
string,

      [Char] -> Type -> Element
def [Char]
"MessageDefinition" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A protocol buffer message type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"name"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The fully qualified message name" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
proto3 [Char]
"TypeName",
          [Char]
"fields"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The list of fields" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
proto3 [Char]
"Field",
          [Char]
"options"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The protocol buffer options" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
proto3 [Char]
"Option"],

      [Char] -> Type -> Element
def [Char]
"Option" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc ([Char]
"A protocol buffer option, which can be attached to a message, field, " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
             [Char]
"enumeration, etc") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"name"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc ([Char]
"The option's name. For protobuf built-in options (options defined in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                 [Char]
"descriptor.proto), this is the short name. For example, `\"map_entry\"`. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                 [Char]
"For custom options, it should be the fully-qualified name. For example, " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                 [Char]
"`\"google.api.http\"`.")
            Type
string,
          [Char]
"value"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc ([Char]
"The option's value") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
proto3 [Char]
"Value"],

      [Char] -> Type -> Element
def [Char]
"PackageName" Type
string,

      [Char] -> Type -> Element
def [Char]
"ProtoFile" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A .proto file, usually containing one or more enum or message type definitions" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"package"[Char] -> Type -> FieldType
>: [Char] -> Type
proto3 [Char]
"PackageName",
          [Char]
"imports"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
proto3 [Char]
"FileReference",
          [Char]
"types"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
proto3 [Char]
"Definition",
          [Char]
"options"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
proto3 [Char]
"Option"],

      [Char] -> Type -> Element
def [Char]
"ScalarType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"One of several Proto3 scalar types" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> Type
enum [
          [Char]
"bool",
          [Char]
"bytes",
          [Char]
"double",
          [Char]
"fixed32",
          [Char]
"fixed64",
          [Char]
"float",
          [Char]
"int32",
          [Char]
"int64",
          [Char]
"sfixed32",
          [Char]
"sfixed64",
          [Char]
"sint32",
          [Char]
"sint64",
          [Char]
"string",
          [Char]
"uint32",
          [Char]
"uint64"],

      [Char] -> Type -> Element
def [Char]
"SimpleType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A scalar type or a reference to an enum type or message type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"reference"[Char] -> Type -> FieldType
>: [Char] -> Type
proto3 [Char]
"TypeName",
          [Char]
"scalar"[Char] -> Type -> FieldType
>: [Char] -> Type
proto3 [Char]
"ScalarType"],

      [Char] -> Type -> Element
def [Char]
"TypeName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"The local name of an enum type or message type"
        Type
string,

      [Char] -> Type -> Element
def [Char]
"TypeReference" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A reference to an enum type or message type"
        Type
string,

      [Char] -> Type -> Element
def [Char]
"Value" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A scalar value" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"boolean"[Char] -> Type -> FieldType
>: Type
boolean,
          [Char]
"string"[Char] -> Type -> FieldType
>: Type
string
          -- Add other scalar value types as needed
        ]]