{-# LANGUAGE OverloadedStrings #-}

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

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


tinkerpopFeaturesModule :: Module
tinkerpopFeaturesModule :: Module
tinkerpopFeaturesModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe [Char] -> Module
Module Namespace
ns [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 derived from TinkerPop's Graph.Features. See\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
"  https://tinkerpop.apache.org/javadocs/current/core/org/apache/tinkerpop/gremlin/structure/Graph.Features.html\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
"An interface that represents the capabilities of a Graph implementation.\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
"By default all methods of features return true and it is up to implementers to disable feature they don't support.\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
"Users should check features prior to using various functions of TinkerPop to help ensure code portability across implementations.\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
"For example, a common usage would be to check if a graph supports transactions prior to calling the commit method on Graph.tx().")
  where
    ns :: Namespace
ns = [Char] -> Namespace
Namespace [Char]
"hydra/langs/tinkerpop/features"
    core :: [Char] -> Type
core = Namespace -> [Char] -> Type
typeref (Namespace -> [Char] -> Type) -> Namespace -> [Char] -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
hydraCoreModule
    features :: [Char] -> Type
features = Namespace -> [Char] -> Type
typeref Namespace
ns
    def :: [Char] -> Type -> Element
def = Namespace -> [Char] -> Type -> Element
datatype Namespace
ns
    supports :: [Char] -> [Char] -> FieldType
supports [Char]
name [Char]
comment = ([Char]
"supports" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
capitalize [Char]
name)[Char] -> Type -> FieldType
>: [Char] -> Type -> Type
doc [Char]
comment Type
boolean

    elements :: [Element]
elements = [

      [Char] -> Type -> Element
def [Char]
"DataTypeFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Base interface for features that relate to supporting different data types." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char] -> [Char] -> FieldType
supports [Char]
"booleanArrayValues" [Char]
"Supports setting of an array of boolean values.",
          [Char] -> [Char] -> FieldType
supports [Char]
"booleanValues" [Char]
"Supports setting of a boolean value.",
          [Char] -> [Char] -> FieldType
supports [Char]
"byteArrayValues" [Char]
"Supports setting of an array of byte values.",
          [Char] -> [Char] -> FieldType
supports [Char]
"byteValues" [Char]
"Supports setting of a byte value.",
          [Char] -> [Char] -> FieldType
supports [Char]
"doubleArrayValues" [Char]
"Supports setting of an array of double values.",
          [Char] -> [Char] -> FieldType
supports [Char]
"doubleValues" [Char]
"Supports setting of a double value.",
          [Char] -> [Char] -> FieldType
supports [Char]
"floatArrayValues" [Char]
"Supports setting of an array of float values.",
          [Char] -> [Char] -> FieldType
supports [Char]
"floatValues" [Char]
"Supports setting of a float value.",
          [Char] -> [Char] -> FieldType
supports [Char]
"integerArrayValues" [Char]
"Supports setting of an array of integer values.",
          [Char] -> [Char] -> FieldType
supports [Char]
"integerValues" [Char]
"Supports setting of a integer value.",
          [Char] -> [Char] -> FieldType
supports [Char]
"longArrayValues" [Char]
"Supports setting of an array of long values.",
          [Char] -> [Char] -> FieldType
supports [Char]
"longValues" [Char]
"Supports setting of a long value.",
          [Char] -> [Char] -> FieldType
supports [Char]
"mapValues" [Char]
"Supports setting of a Map value.",
          [Char] -> [Char] -> FieldType
supports [Char]
"mixedListValues" [Char]
"Supports setting of a List value.",
          [Char] -> [Char] -> FieldType
supports [Char]
"serializableValues" [Char]
"Supports setting of a Java serializable value.",
          [Char] -> [Char] -> FieldType
supports [Char]
"stringArrayValues" [Char]
"Supports setting of an array of string values.",
          [Char] -> [Char] -> FieldType
supports [Char]
"stringValues" [Char]
"Supports setting of a string value.",
          [Char] -> [Char] -> FieldType
supports [Char]
"uniformListValues" [Char]
"Supports setting of a List value."],

      [Char] -> Type -> Element
def [Char]
"EdgeFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Features that are related to Edge operations." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"elementFeatures"[Char] -> Type -> FieldType
>: [Char] -> Type
features [Char]
"ElementFeatures",
          [Char]
"properties"[Char] -> Type -> FieldType
>: [Char] -> Type
features [Char]
"EdgePropertyFeatures",
          [Char] -> [Char] -> FieldType
supports [Char]
"addEdges" [Char]
"Determines if an Edge can be added to a Vertex.",
          [Char] -> [Char] -> FieldType
supports [Char]
"removeEdges" [Char]
"Determines if an Edge can be removed from a Vertex.",
          [Char] -> [Char] -> FieldType
supports [Char]
"upsert" ([Char]
"Determines if the Graph implementation uses upsert functionality as opposed to insert " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"functionality for Vertex.addEdge(String, Vertex, Object...).")],

      [Char] -> Type -> Element
def [Char]
"EdgePropertyFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Features that are related to Edge Property objects." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"propertyFeatures"[Char] -> Type -> FieldType
>: [Char] -> Type
features [Char]
"PropertyFeatures"],

      [Char] -> Type -> Element
def [Char]
"ElementFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Features that are related to Element objects." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char] -> [Char] -> FieldType
supports [Char]
"addProperty" [Char]
"Determines if an Element allows properties to be added.",
          [Char] -> [Char] -> FieldType
supports [Char]
"anyIds" [Char]
"Determines if an Element any Java object is a suitable identifier.",
          [Char] -> [Char] -> FieldType
supports [Char]
"customIds" [Char]
"Determines if an Element has a specific custom object as their internal representation.",
          [Char] -> [Char] -> FieldType
supports [Char]
"numericIds" [Char]
"Determines if an Element has numeric identifiers as their internal representation.",
          [Char] -> [Char] -> FieldType
supports [Char]
"removeProperty" [Char]
"Determines if an Element allows properties to be removed.",
          [Char] -> [Char] -> FieldType
supports [Char]
"stringIds" [Char]
"Determines if an Element has string identifiers as their internal representation.",
          [Char] -> [Char] -> FieldType
supports [Char]
"userSuppliedIds" [Char]
"Determines if an Element can have a user defined identifier.",
          [Char] -> [Char] -> FieldType
supports [Char]
"uuidIds" [Char]
"Determines if an Element has UUID identifiers as their internal representation."
--          , "willAllowId" $
--              doc "Determines if an identifier will be accepted by the Graph." $
--            function (v3 "Id") boolean
            ],

      [Char] -> Type -> Element
def [Char]
"ExtraFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc ([Char]
"Additional features which are needed for the complete specification of language constraints in Hydra, "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"above and beyond TinkerPop Graph.Features") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
lambda [Char]
"a" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          [Char]
"supportsMapKey"[Char] -> Type -> FieldType
>: Type -> Type -> Type
function ([Char] -> Type
core [Char]
"Type") Type
boolean],

      [Char] -> Type -> Element
def [Char]
"Features" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc ([Char]
"An interface that represents the capabilities of a Graph implementation. By default all methods of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"features return true and it is up to implementers to disable feature they don't support. Users should " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"check features prior to using various functions of TinkerPop to help ensure code portability across " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"implementations. For example, a common usage would be to check if a graph supports transactions prior " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"to calling the commit method on Graph.tx().\n\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"As an additional notice to Graph Providers, feature methods will be used by the test suite to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"determine which tests will be ignored and which will be executed, therefore proper setting of these " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"features is essential to maximizing the amount of testing performed by the suite. Further note, that " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"these methods may be called by the TinkerPop core code to determine what operations may be " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"appropriately executed which will have impact on features utilized by users.") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"edge"[Char] -> Type -> FieldType
>: [Char] -> Type -> Type
doc [Char]
"Gets the features related to edge operation." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
features [Char]
"EdgeFeatures",
          [Char]
"graph"[Char] -> Type -> FieldType
>: [Char] -> Type -> Type
doc [Char]
"Gets the features related to graph operation." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
features [Char]
"GraphFeatures",
          [Char]
"vertex"[Char] -> Type -> FieldType
>: [Char] -> Type -> Type
doc [Char]
"Gets the features related to vertex operation." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
features [Char]
"VertexFeatures"],

      [Char] -> Type -> Element
def [Char]
"GraphFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Features specific to a operations of a graph." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char] -> [Char] -> FieldType
supports [Char]
"computer" [Char]
"Determines if the Graph implementation supports GraphComputer based processing.",
          [Char] -> [Char] -> FieldType
supports [Char]
"concurrentAccess" [Char]
"Determines if the Graph implementation supports more than one connection to the same instance at the same time.",
          [Char] -> [Char] -> FieldType
supports [Char]
"ioRead" [Char]
"Determines if the Graph implementations supports read operations as executed with the GraphTraversalSource.io(String) step.",
          [Char] -> [Char] -> FieldType
supports [Char]
"ioWrite" [Char]
"Determines if the Graph implementations supports write operations as executed with the GraphTraversalSource.io(String) step.",
          [Char] -> [Char] -> FieldType
supports [Char]
"persistence" [Char]
"Determines if the Graph implementation supports persisting it's contents natively to disk.",
          [Char] -> [Char] -> FieldType
supports [Char]
"threadedTransactions" [Char]
"Determines if the Graph implementation supports threaded transactions which allow a transaction to be executed across multiple threads via Transaction.createThreadedTx().",
          [Char] -> [Char] -> FieldType
supports [Char]
"transactions" [Char]
"Determines if the Graph implementations supports transactions.",
          [Char]
"variables"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"Gets the features related to graph sideEffects operation." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
features [Char]
"VariableFeatures"
        ],

      [Char] -> Type -> Element
def [Char]
"PropertyFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"A base interface for Edge or Vertex Property features." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"dataTypeFeatures"[Char] -> Type -> FieldType
>: [Char] -> Type
features [Char]
"DataTypeFeatures",
          [Char] -> [Char] -> FieldType
supports [Char]
"properties" [Char]
"Determines if an Element allows for the processing of at least one data type defined by the features."],

      [Char] -> Type -> Element
def [Char]
"VariableFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Features for Graph.Variables." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"dataTypeFeatures"[Char] -> Type -> FieldType
>: [Char] -> Type
features [Char]
"DataTypeFeatures",
          [Char] -> [Char] -> FieldType
supports [Char]
"variables" [Char]
"If any of the features on Graph.Features.VariableFeatures is true then this value must be true."],

      [Char] -> Type -> Element
def [Char]
"VertexFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Features that are related to Vertex operations." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"elementFeatures"[Char] -> Type -> FieldType
>: [Char] -> Type
features [Char]
"ElementFeatures",
--          "getCardinality" $ function (v3 "PropertyKey") (v3 "VertexProperty.Cardinality"),
          [Char]
"properties"[Char] -> Type -> FieldType
>: [Char] -> Type
features [Char]
"VertexPropertyFeatures",
          [Char] -> [Char] -> FieldType
supports [Char]
"addVertices" [Char]
"Determines if a Vertex can be added to the Graph.",
          [Char] -> [Char] -> FieldType
supports [Char]
"duplicateMultiProperties" [Char]
"Determines if a Vertex can support non-unique values on the same key.",
          [Char] -> [Char] -> FieldType
supports [Char]
"metaProperties" [Char]
"Determines if a Vertex can support properties on vertex properties.",
          [Char] -> [Char] -> FieldType
supports [Char]
"multiProperties" [Char]
"Determines if a Vertex can support multiple properties with the same key.",
          [Char] -> [Char] -> FieldType
supports [Char]
"removeVertices" [Char]
"Determines if a Vertex can be removed from the Graph.",
          [Char] -> [Char] -> FieldType
supports [Char]
"upsert" ([Char]
"Determines if the Graph implementation uses upsert functionality as opposed to insert " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"functionality for Graph.addVertex(String).")],

      [Char] -> Type -> Element
def [Char]
"VertexPropertyFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"Features that are related to Vertex Property objects." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"dataTypeFeatures"[Char] -> Type -> FieldType
>: [Char] -> Type
features [Char]
"DataTypeFeatures",
          [Char]
"propertyFeatures"[Char] -> Type -> FieldType
>: [Char] -> Type
features [Char]
"PropertyFeatures",
          -- Note: re-using ElementFeatures here rather than repeating the individual features (which are identical)
          [Char]
"elementFeatures"[Char] -> Type -> FieldType
>: [Char] -> Type
features [Char]
"ElementFeatures",
          [Char] -> [Char] -> FieldType
supports [Char]
"remove" [Char]
"Determines if a VertexProperty allows properties to be removed."]

--          , def "VertexProperty.Cardinality" $
--            enum ["list", "set", "single"]
      ]