{-# LANGUAGE OverloadedStrings #-}

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

import Hydra.Sources.Tier3.All
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap
import Hydra.Langs.Tinkerpop.Mappings
import qualified Hydra.Dsl.Terms as Terms
import Hydra.Dsl.Types as Types
import Hydra.Sources.Tier4.Langs.Tinkerpop.PropertyGraph


tinkerpopMappingsModule :: Module
tinkerpopMappingsModule :: Module
tinkerpopMappingsModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements
    [Module
tinkerpopPropertyGraphModule, Module
hydraCoreModule, Module
hydraComputeModule] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
forall a. a -> Maybe a
Just String
"A model for property graph mapping specifications. See https://github.com/CategoricalData/hydra/wiki/Property-graphs"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/langs/tinkerpop/mappings"
    mappings :: String -> Type
mappings = Namespace -> String -> Type
typeref Namespace
ns
    compute :: String -> Type
compute = Namespace -> String -> Type
typeref (Namespace -> String -> Type) -> Namespace -> String -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
hydraComputeModule
    core :: String -> Type
core = Namespace -> String -> Type
typeref (Namespace -> String -> Type) -> Namespace -> String -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
hydraCoreModule
    v3 :: String -> Type
v3 = Namespace -> String -> Type
typeref (Namespace -> String -> Type) -> Namespace -> String -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
tinkerpopPropertyGraphModule
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
    toField :: (Name, String) -> Field
toField (Name
k, String
v) = Name -> Term -> Field
Field Name
k (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ String -> Term
Terms.string String
v

    elements :: [Element]
elements = [

      String -> Type -> Element
def String
"AnnotationSchema" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"Configurable annotation keys for property graph mapping specifications" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"vertexLabel"String -> Type -> FieldType
>: Type
string,
          String
"edgeLabel"String -> Type -> FieldType
>: Type
string,
          String
"vertexId"String -> Type -> FieldType
>: Type
string,
          String
"edgeId"String -> Type -> FieldType
>: Type
string,
          String
"propertyKey"String -> Type -> FieldType
>: Type
string,
          String
"propertyValue"String -> Type -> FieldType
>: Type
string,
          String
"outVertex"String -> Type -> FieldType
>: Type
string,
          String
"outVertexLabel"String -> Type -> FieldType
>: Type
string,
          String
"inVertex"String -> Type -> FieldType
>: Type
string,
          String
"inVertexLabel"String -> Type -> FieldType
>: Type
string,
          String
"outEdge"String -> Type -> FieldType
>: Type
string,
          String
"outEdgeLabel"String -> Type -> FieldType
>: Type
string,
          String
"inEdge"String -> Type -> FieldType
>: Type
string,
          String
"inEdgeLabel"String -> Type -> FieldType
>: Type
string,
          String
"ignore"String -> Type -> FieldType
>: Type
string],

      String -> Type -> Element
def String
"EdgeSpec" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A mapping specification producing edges of a specified label." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"label"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The label of the target edges, which must conform to the edge type associated with that label." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
v3 String
"EdgeLabel",
          String
"id"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A specification of the id of each target edge" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
mappings String
"ValueSpec",
          String
"out"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A specification of the out-vertex reference of each target edge" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
mappings String
"ValueSpec",
          String
"in"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A specification of the in-vertex reference of each target edge" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
mappings String
"ValueSpec",
          String
"properties"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"Zero or more property specifications for each target edge" (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
$ String -> Type
mappings String
"PropertySpec"],

      String -> Type -> Element
def String
"ElementSpec" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"Either a vertex specification or an edge specification" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"vertex"String -> Type -> FieldType
>: String -> Type
mappings String
"VertexSpec",
          String
"edge"String -> Type -> FieldType
>: String -> Type
mappings String
"EdgeSpec"],

      String -> Type -> Element
def String
"PropertySpec" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A mapping specification producing properties of a specified key, and values of the appropriate type." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"key"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The key of the target properties" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
v3 String
"PropertyKey",
          String
"value"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A specification of the value of each target property, which must conform to the type associated with the property key" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
mappings String
"ValueSpec"],

      String -> Type -> Element
def String
"Schema" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A set of mappings which translates between Hydra terms and annotations, and application-specific property graph types" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [String] -> Type -> Type
lambdas [String
"s", String
"t", String
"v"] (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
          [FieldType] -> Type
record [
            String
"vertexIdTypes"String -> Type -> FieldType
>: String -> Type
compute String
"Coder" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ String -> Type
core String
"Type" Type -> Type -> Type
@@ Type
"t",
            String
"vertexIds"String -> Type -> FieldType
>: String -> Type
compute String
"Coder" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ String -> Type
core String
"Term" Type -> Type -> Type
@@ Type
"v",
            String
"edgeIdTypes"String -> Type -> FieldType
>: String -> Type
compute String
"Coder" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ String -> Type
core String
"Type" Type -> Type -> Type
@@ Type
"t",
            String
"edgeIds"String -> Type -> FieldType
>: String -> Type
compute String
"Coder" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ String -> Type
core String
"Term" Type -> Type -> Type
@@ Type
"v",
            String
"propertyTypes"String -> Type -> FieldType
>: String -> Type
compute String
"Coder" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ String -> Type
core String
"Type" Type -> Type -> Type
@@ Type
"t",
            String
"propertyValues"String -> Type -> FieldType
>: String -> Type
compute String
"Coder" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ Type
"s" Type -> Type -> Type
@@ String -> Type
core String
"Term" Type -> Type -> Type
@@ Type
"v",
            String
"annotations"String -> Type -> FieldType
>: String -> Type
mappings String
"AnnotationSchema",
            String
"defaultVertexId"String -> Type -> FieldType
>: Type
"v",
            String
"defaultEdgeId"String -> Type -> FieldType
>: Type
"v"],

      String -> Type -> Element
def String
"ValueSpec" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A mapping specification producing values (usually literal values) whose type is understood in context" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"value"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A trivial no-op specification which passes the entire value"
            Type
unit,
          String
"pattern"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A compact path representing the function, e.g. engine-${engineInfo/model/name}"
            Type
string],

      String -> Type -> Element
def String
"VertexSpec" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A mapping specification producing vertices of a specified label" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"label"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The label of the target vertices, which must conform to the vertex type associated with that label." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
v3 String
"VertexLabel",
          String
"id"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A specification of the id of each target vertex" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
mappings String
"ValueSpec",
          String
"properties"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"Zero or more property specifications for each target vertex" (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
$ String -> Type
mappings String
"PropertySpec"]]