{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier4.Langs.Tinkerpop.PropertyGraph where

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

import Hydra.Sources.Core


tinkerpopPropertyGraphModule :: Module
tinkerpopPropertyGraphModule :: Module
tinkerpopPropertyGraphModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe [Char] -> Module
Module Namespace
ns [Element]
elements [] [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 typed property graph data model. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
"Property graphs are parameterized a type for property and id values, " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
"while property graph schemas are parameterized by a type for property and id types")
  where
    ns :: Namespace
ns = [Char] -> Namespace
Namespace [Char]
"hydra/langs/tinkerpop/propertyGraph"
    pg :: [Char] -> Type
pg = Namespace -> [Char] -> Type
typeref Namespace
ns
    def :: [Char] -> Type -> Element
def = Namespace -> [Char] -> Type -> Element
datatype Namespace
ns

    elements :: [Element]
elements = [

      [Char] -> Type -> Element
def [Char]
"Direction" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"The direction of an edge or edge pattern" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
          [[Char]] -> Type
enum [[Char]
"out", [Char]
"in", [Char]
"both", [Char]
"undirected"],

      [Char] -> Type -> Element
def [Char]
"Edge" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"An edge" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"v" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          [Char]
"label"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The label of the edge" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
pg [Char]
"EdgeLabel",
          [Char]
"id"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The unique identifier of the edge"
            Type
"v",
          [Char]
"out"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The id of the out-vertex (tail) of the edge"
            Type
"v",
          [Char]
"in"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The id of the in-vertex (head) of the edge"
            Type
"v",
          [Char]
"properties"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"A key/value map of edge properties" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map ([Char] -> Type
pg [Char]
"PropertyKey") Type
"v"],

      [Char] -> Type -> Element
def [Char]
"EdgeLabel" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"The label of an edge" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        Type
string,

      [Char] -> Type -> Element
def [Char]
"EdgeType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"The type of an edge" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"t" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
            [Char]
"label"[Char] -> Type -> FieldType
>:
              [Char] -> Type -> Type
doc [Char]
"The label of any edge of this edge type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
              [Char] -> Type
pg [Char]
"EdgeLabel",
            [Char]
"id"[Char] -> Type -> FieldType
>:
              [Char] -> Type -> Type
doc [Char]
"The type of the id of any edge of this edge type"
              Type
"t",
            [Char]
"out"[Char] -> Type -> FieldType
>:
              [Char] -> Type -> Type
doc [Char]
"The label of the out-vertex (tail) of any edge of this edge type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
              [Char] -> Type
pg [Char]
"VertexLabel",
            [Char]
"in"[Char] -> Type -> FieldType
>:
              [Char] -> Type -> Type
doc [Char]
"The label of the in-vertex (head) of any edge of this edge type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
              [Char] -> Type
pg [Char]
"VertexLabel",
            [Char]
"properties"[Char] -> Type -> FieldType
>:
              [Char] -> Type -> Type
doc [Char]
"A list of property types. The types are ordered for the sake of applications in which property order is significant." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
              Type -> Type
list ([Char] -> Type
pg [Char]
"PropertyType" Type -> Type -> Type
@@ Type
"t")],

      [Char] -> Type -> Element
def [Char]
"Element" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Either a vertex or an edge" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"v" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
          [Char]
"vertex"[Char] -> Type -> FieldType
>: [Char] -> Type
pg [Char]
"Vertex" Type -> Type -> Type
@@ Type
"v",
          [Char]
"edge"[Char] -> Type -> FieldType
>: [Char] -> Type
pg [Char]
"Edge" Type -> Type -> Type
@@ Type
"v"],

      [Char] -> Type -> Element
def [Char]
"ElementKind" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"The kind of an element: vertex or edge" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> Type
enum [[Char]
"vertex", [Char]
"edge"],

      [Char] -> Type -> Element
def [Char]
"ElementTree" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"An element together with its dependencies in some context" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"v" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          [Char]
"self"[Char] -> Type -> FieldType
>: [Char] -> Type
pg [Char]
"Element" Type -> Type -> Type
@@ Type
"v",
          [Char]
"dependencies"[Char] -> Type -> FieldType
>: Type -> Type
Types.list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
pg [Char]
"ElementTree" Type -> Type -> Type
@@ Type
"v"],

      [Char] -> Type -> Element
def [Char]
"ElementType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"The type of a vertex or edge" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"t" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
          [Char]
"vertex"[Char] -> Type -> FieldType
>: [Char] -> Type
pg [Char]
"VertexType" Type -> Type -> Type
@@ Type
"t",
          [Char]
"edge"[Char] -> Type -> FieldType
>: [Char] -> Type
pg [Char]
"EdgeType" Type -> Type -> Type
@@ Type
"t"],

      [Char] -> Type -> Element
def [Char]
"ElementTypeTree" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"An element type together with its dependencies in some context" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"t" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          [Char]
"self"[Char] -> Type -> FieldType
>: [Char] -> Type
pg [Char]
"ElementType" Type -> Type -> Type
@@ Type
"t",
          [Char]
"dependencies"[Char] -> Type -> FieldType
>: Type -> Type
Types.list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
pg [Char]
"ElementTypeTree" Type -> Type -> Type
@@ Type
"t"],

      [Char] -> Type -> Element
def [Char]
"Graph" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A graph; a self-contained collection of vertices and edges" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"v" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          [Char]
"vertices"[Char] -> Type -> FieldType
>: Type -> Type -> Type
Types.map Type
"v" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
pg [Char]
"Vertex" Type -> Type -> Type
@@ Type
"v",
          [Char]
"edges"[Char] -> Type -> FieldType
>: Type -> Type -> Type
Types.map Type
"v" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
pg [Char]
"Edge" Type -> Type -> Type
@@ Type
"v"],

      [Char] -> Type -> Element
def [Char]
"GraphSchema" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A graph schema; a vertex and edge types for the vertices and edges of a graph conforming to the schema" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"t" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          [Char]
"vertices"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"A unique vertex type for each vertex label which may occur in a graph" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map ([Char] -> Type
pg [Char]
"VertexLabel") ([Char] -> Type
pg [Char]
"VertexType" Type -> Type -> Type
@@ Type
"t"),
          [Char]
"edges"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"A unique edge type for each edge label which may occur in a graph" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map ([Char] -> Type
pg [Char]
"EdgeLabel") ([Char] -> Type
pg [Char]
"EdgeType" Type -> Type -> Type
@@ Type
"t")],

      [Char] -> Type -> Element
def [Char]
"Label" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Either a vertex or edge label" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"vertex"[Char] -> Type -> FieldType
>: [Char] -> Type
pg [Char]
"VertexLabel",
          [Char]
"edge"[Char] -> Type -> FieldType
>: [Char] -> Type
pg [Char]
"EdgeLabel"],

      [Char] -> Type -> Element
def [Char]
"Property" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A key/value property" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"v" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          [Char]
"key"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"They key of the property" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
pg [Char]
"PropertyKey",
          [Char]
"value"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The value of the property"
            Type
"v"],

      [Char] -> Type -> Element
def [Char]
"PropertyKey" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A property key"
        Type
string,

      [Char] -> Type -> Element
def [Char]
"PropertyType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"The type of a property" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"t" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          [Char]
"key"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"A property's key" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
pg [Char]
"PropertyKey",
          [Char]
"value"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The type of a property's value"
            Type
"t",
          [Char]
"required"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"Whether the property is required; values may be omitted from a property map otherwise"
            Type
boolean],

      [Char] -> Type -> Element
def [Char]
"Vertex" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A vertex" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"v" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          [Char]
"label"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The label of the vertex" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
pg [Char]
"VertexLabel",
          [Char]
"id"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The unique identifier of the vertex"
            Type
"v",
          [Char]
"properties"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"A key/value map of vertex properties" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map ([Char] -> Type
pg [Char]
"PropertyKey") Type
"v"],

      [Char] -> Type -> Element
def [Char]
"VertexLabel" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"The label of a vertex. The default (null) vertex is represented by the empty string" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        Type
string,

      [Char] -> Type -> Element
def [Char]
"VertexType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"The type of a vertex" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"t" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          [Char]
"label"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The label of any vertex of this vertex type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
pg [Char]
"VertexLabel",
          [Char]
"id"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"The type of the id of any vertex of this vertex type"
            Type
"t",
          [Char]
"properties"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"A list of property types. The types are ordered for the sake of applications in which property order is significant." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list ([Char] -> Type
pg [Char]
"PropertyType" Type -> Type -> Type
@@ Type
"t")]]