module Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Typed where

import Hydra.Impl.Haskell.Sources.Core

import Hydra.Kernel
import Hydra.Impl.Haskell.Dsl.Types as Types
import Hydra.Impl.Haskell.Dsl.Standard


tinkerpopTypedModule :: Module Meta
tinkerpopTypedModule :: Module Meta
tinkerpopTypedModule = forall m.
Namespace -> [Element m] -> [Module m] -> Maybe String -> Module m
Module Namespace
ns [Element Meta]
elements [Module Meta
hydraCoreModule] forall a. Maybe a
Nothing
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/ext/tinkerpop/typed"
    def :: String -> Type m -> Element m
def = forall m. Namespace -> String -> Type m -> Element m
datatype Namespace
ns
    typed :: String -> Type m
typed = forall m. Namespace -> String -> Type m
nsref Namespace
ns
    core :: String -> Type m
core = forall m. Namespace -> String -> Type m
nsref forall a b. (a -> b) -> a -> b
$ forall m. Module m -> Namespace
moduleNamespace Module Meta
hydraCoreModule

    elements :: [Element Meta]
elements = [

      forall {m}. String -> Type m -> Element m
def String
"CollectionType" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"The type of a collection, such as a list of strings or an optional integer value" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
union [
          String
"list"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"Type",
          String
"map"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"Type",
          String
"optional"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"Type",
          String
"set"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"Type"],

      forall {m}. String -> Type m -> Element m
def String
"CollectionValue" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A collection of values, such as a list of strings or an optional integer value" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
union [
          String
"list"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m
list forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
typed String
"Value",
          String
"map"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m -> Type m
Types.map (forall {m}. String -> Type m
typed String
"Key") (forall {m}. String -> Type m
typed String
"Value"),
          String
"optional"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m
optional forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
typed String
"Value",
          String
"set"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
typed String
"Value"],

      forall {m}. String -> Type m -> Element m
def String
"Edge" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"An edge, comprised of an id, an out-vertex and in-vertex id, and zero or more properties" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          String
"id"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"EdgeId",
          String
"label"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"Label",
          String
"out"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"VertexId",
          String
"in"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"VertexId",
          String
"properties"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m -> Type m
Types.map (forall {m}. String -> Type m
typed String
"Key") (forall {m}. String -> Type m
typed String
"Value")],

      forall {m}. String -> Type m -> Element m
def String
"EdgeId" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A literal value representing an edge id" forall a b. (a -> b) -> a -> b
$
        forall {m}. String -> Type m
core String
"Literal",

      forall {m}. String -> Type m -> Element m
def String
"EdgeIdType" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"The type of a reference to an edge by id" forall a b. (a -> b) -> a -> b
$
        forall {m}. String -> Type m
typed String
"EdgeType",

      forall {m}. String -> Type m -> Element m
def String
"EdgeType" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"The type of an edge, with characteristic id, out-vertex, in-vertex, and property types" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          String
"id"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
core String
"LiteralType",
          String
"out"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"VertexIdType",
          String
"in"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"VertexIdType",
          String
"properties"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m -> Type m
Types.map (forall {m}. String -> Type m
typed String
"Key") (forall {m}. String -> Type m
typed String
"Type")],

      forall {m}. String -> Type m -> Element m
def String
"Id" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A vertex or edge id" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
union [
          String
"vertex"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"VertexId",
          String
"edge"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"EdgeId"],

      forall {m}. String -> Type m -> Element m
def String
"IdType" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"The type of a reference to a strongly-typed element (vertex or edge) by id" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
union [
          String
"vertex"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"VertexType",
          String
"edge"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"EdgeType"],

      forall {m}. String -> Type m -> Element m
def String
"Key" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A property key or map key"
        forall m. Type m
string,

      forall {m}. String -> Type m -> Element m
def String
"Label" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A vertex or edge label"
        forall m. Type m
string,

      forall {m}. String -> Type m -> Element m
def String
"Type" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"The type of a value, such as a property value" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
union [
          String
"literal"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
core String
"LiteralType",
          String
"collection"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"CollectionType",
          String
"element"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"IdType"],

      forall {m}. String -> Type m -> Element m
def String
"Value" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A concrete value such as a number or string, a collection of other values, or an element reference" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
union [
          String
"literal"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
core String
"Literal",
          String
"collection"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"CollectionValue",
          String
"element"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"Id"],

      forall {m}. String -> Type m -> Element m
def String
"Vertex" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A vertex, comprised of an id and zero or more properties" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          String
"id"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"VertexId",
          String
"label"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
typed String
"Label",
          String
"properties"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m -> Type m
Types.map (forall {m}. String -> Type m
typed String
"Key") (forall {m}. String -> Type m
typed String
"Value")],

      forall {m}. String -> Type m -> Element m
def String
"VertexId" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A literal value representing a vertex id" forall a b. (a -> b) -> a -> b
$
        forall {m}. String -> Type m
core String
"Literal",

      forall {m}. String -> Type m -> Element m
def String
"VertexIdType" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"The type of a reference to a vertex by id" forall a b. (a -> b) -> a -> b
$
        forall {m}. String -> Type m
typed String
"VertexType",

      forall {m}. String -> Type m -> Element m
def String
"VertexType" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"The type of a vertex, with characteristic id and property types" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          String
"id"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
core String
"LiteralType",
          String
"properties"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m -> Type m
Types.map (forall {m}. String -> Type m
typed String
"Key") (forall {m}. String -> Type m
typed String
"Type")]]