{-# LANGUAGE OverloadedStrings #-}

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

import Hydra.Impl.Haskell.Sources.Core

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


tinkerpopFeaturesModule :: Module Meta
tinkerpopFeaturesModule :: Module Meta
tinkerpopFeaturesModule = forall m.
Namespace -> [Element m] -> [Module m] -> Maybe [Char] -> Module m
Module Namespace
ns [Element Meta]
elements [Module Meta
hydraCoreModule] forall a b. (a -> b) -> a -> b
$
    forall a. a -> Maybe a
Just ([Char]
"A model derived from TinkerPop's Graph.Features. See\n" forall a. [a] -> [a] -> [a]
++
      [Char]
"  https://tinkerpop.apache.org/javadocs/current/core/org/apache/tinkerpop/gremlin/structure/Graph.Features.html\n" forall a. [a] -> [a] -> [a]
++
      [Char]
"\n" forall a. [a] -> [a] -> [a]
++
      [Char]
"An interface that represents the capabilities of a Graph implementation.\n" 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" 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" 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/ext/tinkerpop/features"
    core :: [Char] -> Type m
core = forall m. Namespace -> [Char] -> Type m
nsref forall a b. (a -> b) -> a -> b
$ forall m. Module m -> Namespace
moduleNamespace Module Meta
hydraCoreModule
    features :: [Char] -> Type m
features = forall m. Namespace -> [Char] -> Type m
nsref Namespace
ns
    def :: [Char] -> Type m -> Element m
def = forall m. Namespace -> [Char] -> Type m -> Element m
datatype Namespace
ns
    supports :: [Char] -> [Char] -> FieldType Meta
supports [Char]
name [Char]
comment = ([Char]
"supports" forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
capitalize [Char]
name)forall m. [Char] -> Type m -> FieldType m
>: [Char] -> Type Meta -> Type Meta
doc [Char]
comment forall m. Type m
boolean

    elements :: [Element Meta]
elements = [

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

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

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

      forall {m}. [Char] -> Type m -> Element m
def [Char]
"ElementFeatures" forall a b. (a -> b) -> a -> b
$
        [Char] -> Type Meta -> Type Meta
doc [Char]
"Features that are related to Element objects." forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          [Char] -> [Char] -> FieldType Meta
supports [Char]
"addProperty" [Char]
"Determines if an Element allows properties to be added.",
          [Char] -> [Char] -> FieldType Meta
supports [Char]
"anyIds" [Char]
"Determines if an Element any Java object is a suitable identifier.",
          [Char] -> [Char] -> FieldType Meta
supports [Char]
"customIds" [Char]
"Determines if an Element has a specific custom object as their internal representation.",
          [Char] -> [Char] -> FieldType Meta
supports [Char]
"numericIds" [Char]
"Determines if an Element has numeric identifiers as their internal representation.",
          [Char] -> [Char] -> FieldType Meta
supports [Char]
"removeProperty" [Char]
"Determines if an Element allows properties to be removed.",
          [Char] -> [Char] -> FieldType Meta
supports [Char]
"stringIds" [Char]
"Determines if an Element has string identifiers as their internal representation.",
          [Char] -> [Char] -> FieldType Meta
supports [Char]
"userSuppliedIds" [Char]
"Determines if an Element can have a user defined identifier.",
          [Char] -> [Char] -> FieldType Meta
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
            ],

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

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

      forall {m}. [Char] -> Type m -> Element m
def [Char]
"GraphFeatures" forall a b. (a -> b) -> a -> b
$
        [Char] -> Type Meta -> Type Meta
doc [Char]
"Features specific to a operations of a graph." forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          [Char] -> [Char] -> FieldType Meta
supports [Char]
"computer" [Char]
"Determines if the Graph implementation supports GraphComputer based processing.",
          [Char] -> [Char] -> FieldType Meta
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 Meta
supports [Char]
"ioRead" [Char]
"Determines if the Graph implementations supports read operations as executed with the GraphTraversalSource.io(String) step.",
          [Char] -> [Char] -> FieldType Meta
supports [Char]
"ioWrite" [Char]
"Determines if the Graph implementations supports write operations as executed with the GraphTraversalSource.io(String) step.",
          [Char] -> [Char] -> FieldType Meta
supports [Char]
"persistence" [Char]
"Determines if the Graph implementation supports persisting it's contents natively to disk.",
          [Char] -> [Char] -> FieldType Meta
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 Meta
supports [Char]
"transactions" [Char]
"Determines if the Graph implementations supports transactions.",
          [Char]
"variables"forall m. [Char] -> Type m -> FieldType m
>:
            [Char] -> Type Meta -> Type Meta
doc [Char]
"Gets the features related to graph sideEffects operation." forall a b. (a -> b) -> a -> b
$
            forall {m}. [Char] -> Type m
features [Char]
"VariableFeatures"
        ],

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

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

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

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

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