{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier4.Ext.Cypher.Features where

import Hydra.Sources.Tier3.All
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap
import Hydra.Dsl.Types as Types
import Hydra.Sources.Tier4.Ext.Cypher.Functions

import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Maybe as Y


data FeatureSet = FeatureSet {
  FeatureSet -> [Char]
featureSetName :: String,
  FeatureSet -> [Char]
featureSetDescription :: String,
  FeatureSet -> [FeatureSet]
featureSetChildren :: [FeatureSet]}

openCypherFeaturesModule :: Module
openCypherFeaturesModule :: Module
openCypherFeaturesModule = 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 for characterizing OpenCypher queries and implementations in terms of included features."
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Based on the OpenCypher grammar and the list of standard Cypher functions at "
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"https://neo4j.com/docs/cypher-manual/current/functions."
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" Current as of August 2024.")
  where
    ns :: Namespace
ns = [Char] -> Namespace
Namespace [Char]
"hydra/ext/cypher/features"
    cypherFeatures :: [Char] -> Type
cypherFeatures = Namespace -> [Char] -> Type
typeref Namespace
ns

    elements :: [Element]
elements = FeatureSet -> Element
featureSetToType (FeatureSet -> Element) -> [FeatureSet] -> [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FeatureSet -> [FeatureSet]
flatten FeatureSet
openCypherFeatures
      where
        flatten :: FeatureSet -> [FeatureSet]
flatten FeatureSet
fs = if [FeatureSet] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FeatureSet]
children then [] else (FeatureSet
fsFeatureSet -> [FeatureSet] -> [FeatureSet]
forall a. a -> [a] -> [a]
:([[FeatureSet]] -> [FeatureSet]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (FeatureSet -> [FeatureSet]
flatten (FeatureSet -> [FeatureSet]) -> [FeatureSet] -> [[FeatureSet]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FeatureSet]
children)))
          where
            children :: [FeatureSet]
children = FeatureSet -> [FeatureSet]
featureSetChildren FeatureSet
fs
    featureSetToType :: FeatureSet -> Element
featureSetToType (FeatureSet [Char]
name [Char]
desc [FeatureSet]
children) = Namespace -> [Char] -> Type -> Element
datatype Namespace
ns ([Char] -> [Char]
featureSetName [Char]
name) (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc ([Char] -> [Char]
featureSetDesc [Char]
desc) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record (FeatureSet -> FieldType
toField (FeatureSet -> FieldType) -> [FeatureSet] -> [FieldType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FeatureSet]
children)
      where
        toField :: FeatureSet -> FieldType
toField (FeatureSet [Char]
name1 [Char]
desc1 [FeatureSet]
children1) = ([Char] -> [Char]
decapitalize [Char]
name1)[Char] -> Type -> FieldType
>: if [FeatureSet] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FeatureSet]
children1
          then [Char] -> Type -> Type
doc ([Char] -> [Char]
featureSetDesc [Char]
desc1) Type
boolean
          else [Char] -> Type -> Type
doc ([Char] -> [Char]
featureSetDesc [Char]
desc1) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypherFeatures ([Char] -> Type) -> [Char] -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
featureSetName [Char]
name1
          where
            fieldDesc :: [Char]
fieldDesc = [Char]
"Whether to expect " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
desc1
    featureSetName :: [Char] -> [Char]
featureSetName [Char]
name = [Char] -> [Char]
capitalize [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Features"
    featureSetDesc :: [Char] -> [Char]
featureSetDesc [Char]
desc = [Char] -> [Char]
capitalize [Char]
desc

openCypherFeatures :: FeatureSet
openCypherFeatures :: FeatureSet
openCypherFeatures =  [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Cypher"
  ([Char]
"A set of features which characterize an OpenCypher query or implementation. "
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Any features which are omitted from the set are assumed to be unsupported or nonrequired.") [

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Arithmetic" [Char]
"arithmetic operations" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"plus" [Char]
"the + operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"minus" [Char]
"the - operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"multiply" [Char]
"the * operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"divide" [Char]
"the / operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"modulus" [Char]
"the % operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"powerOf" [Char]
"the ^ operator"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Atom" [Char]
"various kinds of atomic expressions" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"caseExpression" [Char]
"CASE expressions",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"count" [Char]
"the COUNT (*) expression",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"existentialSubquery" [Char]
"existential subqueries",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"functionInvocation" [Char]
"function invocation",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"parameter" [Char]
"parameter expressions",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"patternComprehension" [Char]
"pattern comprehensions",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"patternPredicate" [Char]
"relationship patterns as subexpressions",
      FeatureSet -> FeatureSet
fixed (FeatureSet -> FeatureSet) -> FeatureSet -> FeatureSet
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> FeatureSet
feature [Char]
"variable" [Char]
"variable expressions"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Comparison" [Char]
"comparison operators and functions" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"equal" [Char]
"the = comparison operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"greaterThan" [Char]
"the > comparison operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"greaterThanOrEqual" [Char]
"the >= comparison operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"lessThan" [Char]
"the < comparison operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"lessThanOrEqual" [Char]
"the <= comparison operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"notEqual" [Char]
"the <> comparison operator"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Delete" [Char]
"delete operations" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"delete" [Char]
"the basic DELETE clause",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"detachDelete" [Char]
"the DETACH DELETE clause"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Function" [Char]
"standard Cypher functions" (CypherLibrary -> FeatureSet
libraryToFeatureSet (CypherLibrary -> FeatureSet) -> [CypherLibrary] -> [FeatureSet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CypherLibrary]
cypherLibraries),

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"List" [Char]
"list functionality" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"listComprehension" [Char]
"basic list comprehensions",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"listRange" [Char]
"list range comprehensions (e.g. [1..10])"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Literal" [Char]
"various types of literal values" [
      FeatureSet -> FeatureSet
fixed (FeatureSet -> FeatureSet) -> FeatureSet -> FeatureSet
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> FeatureSet
feature [Char]
"boolean" [Char]
"boolean literals",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"double" [Char]
"double-precision floating-point literals",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"integer" [Char]
"integer literals",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"list" [Char]
"list literals",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"map" [Char]
"map literals",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"null" [Char]
"the NULL literal",
      FeatureSet -> FeatureSet
fixed (FeatureSet -> FeatureSet) -> FeatureSet -> FeatureSet
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> FeatureSet
feature [Char]
"string" [Char]
"string literals"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Logical" [Char]
"logical operations" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"and" [Char]
"the AND operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"not" [Char]
"the NOT operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"or" [Char]
"the OR operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"xor" [Char]
"the XOR operator"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Match" [Char]
"match queries" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"match" [Char]
"the basic (non-optional) MATCH clause",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"optionalMatch" [Char]
"OPTIONAL MATCH"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Merge" [Char]
"merge operations" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"merge" [Char]
"the basic MERGE clause",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"mergeOnCreate" [Char]
"MERGE with the ON CREATE action",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"mergeOnMatch" [Char]
"MERGE with the ON MATCH action"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"NodePattern" [Char]
"node patterns" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"multipleLabels" [Char]
"specifying multiple labels in a node pattern",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"parameter" [Char]
"specifying a parameter as part of a node pattern",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"propertyMap" [Char]
"specifying a key/value map of properties in a node pattern",
      FeatureSet -> FeatureSet
fixed (FeatureSet -> FeatureSet) -> FeatureSet -> FeatureSet
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> FeatureSet
feature [Char]
"variableNode" [Char]
"binding a variable to a node in a node pattern",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"wildcardLabel" [Char]
"omitting labels from a node pattern"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Null" [Char]
"IS NULL / IS NOT NULL checks" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"isNull" [Char]
"the IS NULL operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"isNotNull" [Char]
"the IS NOT NULL operator"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Path" [Char]
"path functions only found in OpenCypher" [
      [Char] -> FeatureSet
function [Char]
"shortestPath"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"ProcedureCall" [Char]
"procedure calls" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"inQueryCall" [Char]
"CALL within a query",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"standaloneCall" [Char]
"standalone / top-level CALL",
      -- Note: additional features are possible around YIELD
      [Char] -> [Char] -> FeatureSet
feature [Char]
"yield" [Char]
"the YIELD clause in CALL"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Projection" [Char]
"projections" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"limit" [Char]
"the LIMIT clause",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"orderBy" [Char]
"the ORDER BY clause",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"projectDistinct" [Char]
"the DISTINCT keyword",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"projectAll" [Char]
"the * projection",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"projectAs" [Char]
"the AS keyword",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"skip" [Char]
"the SKIP clause",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"sortOrder" [Char]
"the ASC/ASCENDING and DESC/DESCENDING keywords"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Quantifier" [Char]
"quantifier expressions" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"all" [Char]
"the ALL quantifier",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"any" [Char]
"the ANY quantifier",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"none" [Char]
"the NONE quantifier",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"single" [Char]
"the SINGLE quantifier"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"RangeLiteral" [Char]
"range literals within relationship patterns" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"bounds" [Char]
"range literals with both lower and upper bounds",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"exactRange" [Char]
"range literals providing an exact number of repetitions",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"lowerBound" [Char]
"range literals with a lower bound (only)",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"starRange" [Char]
"the * range literal",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"upperBound" [Char]
"range literals with an upper bound (only)"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Reading" [Char]
"specific syntax related to reading data from the graph." [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"union" [Char]
"the UNION operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"unionAll" [Char]
"the UNION ALL operator",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"unwind" [Char]
"the UNWIND clause"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"RelationshipDirection" [Char]
"relationship directions / arrow patterns" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"both" [Char]
"the two-headed arrow (<-[]->) relationship direction",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"left" [Char]
"the left arrow (<-[]-) relationship direction",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"neither" [Char]
"the headless arrow (-[]-) relationship direction",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"right" [Char]
"the right arrow (-[]->) relationship direction"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"RelationshipPattern" [Char]
"relationship patterns" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"multipleTypes" [Char]
"specifying a disjunction of multiple types in a relationship pattern",
      FeatureSet -> FeatureSet
fixed (FeatureSet -> FeatureSet) -> FeatureSet -> FeatureSet
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> FeatureSet
feature [Char]
"variableRelationship" [Char]
"binding a variable to a relationship in a relationship pattern",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"wildcardType" [Char]
"omitting types from a relationship pattern"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Remove" [Char]
"REMOVE operations" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"byLabel" [Char]
"REMOVE Variable:NodeLabels",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"byProperty" [Char]
"REMOVE PropertyExpression"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Set" [Char]
"set definitions" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"propertyEquals" [Char]
"defining a set using PropertyExpression = Expression",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"variableEquals" [Char]
"defining a set using Variable = Expression",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"variablePlusEquals" [Char]
"defining a set using Variable += Expression",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"variableWithNodeLabels" [Char]
"defining a set using Variable:NodeLabels"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"String" [Char]
"string functions/keywords only found in OpenCypher" [
      [Char] -> [Char] -> FeatureSet
functionWithKeyword [Char]
"contains" [Char]
"CONTAINS",
      [Char] -> [Char] -> FeatureSet
functionWithKeyword [Char]
"endsWith" [Char]
"ENDS WITH",
      [Char] -> [Char] -> FeatureSet
functionWithKeyword [Char]
"in" [Char]
"IN",
      [Char] -> [Char] -> FeatureSet
functionWithKeyword [Char]
"startsWith" [Char]
"STARTS WITH"],

    [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
"Updating" [Char]
"specific syntax related to updating data in the graph" [
      [Char] -> [Char] -> FeatureSet
feature [Char]
"create" [Char]
"the CREATE clause",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"set" [Char]
"the SET clause",
      [Char] -> [Char] -> FeatureSet
feature [Char]
"with" [Char]
"multi-part queries using WITH"]]
  where
    feature :: [Char] -> [Char] -> FeatureSet
feature [Char]
name [Char]
desc = [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
name [Char]
desc []
    fixed :: FeatureSet -> FeatureSet
fixed (FeatureSet [Char]
name [Char]
desc [FeatureSet]
children)
      = [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
name ([Char]
desc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (note: included by most if not all implementations).") [FeatureSet]
children
    function :: [Char] -> FeatureSet
function [Char]
name = [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
name ([Char] -> Maybe [Char] -> Maybe [Char] -> [Char]
funDesc [Char]
name Maybe [Char]
forall a. Maybe a
Nothing Maybe [Char]
forall a. Maybe a
Nothing) []
    funDesc :: [Char] -> Maybe [Char] -> Maybe [Char] -> [Char]
funDesc [Char]
name Maybe [Char]
mkeyword Maybe [Char]
mdesc = [Char]
"the " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"() function" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
keyword [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
desc
      where
        keyword :: [Char]
keyword = [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe [Char]
"" (\[Char]
k -> [Char]
" / " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
k) Maybe [Char]
mkeyword
        desc :: [Char]
desc = [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe [Char]
"" (\[Char]
d -> [Char]
". " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
d) Maybe [Char]
mdesc
    functionWithKeyword :: [Char] -> [Char] -> FeatureSet
functionWithKeyword [Char]
name [Char]
keyword = [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
name ([Char] -> Maybe [Char] -> Maybe [Char] -> [Char]
funDesc [Char]
name ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
keyword) Maybe [Char]
forall a. Maybe a
Nothing) []
    libraryToFeatureSet :: CypherLibrary -> FeatureSet
libraryToFeatureSet (CypherLibrary [Char]
name [Char]
desc [CypherFunction]
funs) = [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet ([Char] -> [Char]
capitalize [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Function") [Char]
desc (CypherFunction -> FeatureSet
toFeature (CypherFunction -> FeatureSet) -> [CypherFunction] -> [FeatureSet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CypherFunction]
funs)
      where
        toFeature :: CypherFunction -> FeatureSet
toFeature (CypherFunction [Char]
name Maybe [Char]
keyword [CypherFunctionForm]
forms) = [Char] -> [Char] -> [FeatureSet] -> FeatureSet
FeatureSet [Char]
name ([Char] -> Maybe [Char] -> Maybe [Char] -> [Char]
funDesc [Char]
name Maybe [Char]
keyword (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
desc) []
          where
            -- Note: signatures are currently not used
            desc :: [Char]
desc = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Char]
"; " (CypherFunctionForm -> [Char]
cypherFunctionFormDescription (CypherFunctionForm -> [Char]) -> [CypherFunctionForm] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CypherFunctionForm]
forms)

-- | An alternative model of (Open)Cypher features, flattened into an enumeration.
-- Usage:
--   writeProtobuf "/tmp/proto" [openCypherFeaturesEnumModule]
openCypherFeaturesEnumModule :: Module
openCypherFeaturesEnumModule :: Module
openCypherFeaturesEnumModule = 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 with an enumeration of (Open)Cypher features.")
  where
    ns :: Namespace
ns = [Char] -> Namespace
Namespace [Char]
"hydra/org/opencypher/features"
    def :: [Char] -> Type -> Element
def = Namespace -> [Char] -> Type -> Element
datatype Namespace
ns
    elements :: [Element]
elements = [
      [Char] -> Type -> Element
def [Char]
"CypherFeature" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type -> Type
doc [Char]
"An enumeration of (Open)Cypher features."
        Type
openCypherFeaturesEnum]

openCypherFeaturesEnum :: Type
openCypherFeaturesEnum :: Type
openCypherFeaturesEnum = [FieldType] -> Type
union ([FieldType] -> Type) -> [FieldType] -> Type
forall a b. (a -> b) -> a -> b
$ Bool -> [Char] -> FeatureSet -> [FieldType]
gatherFields Bool
True [Char]
"" FeatureSet
openCypherFeatures
  where
    gatherFields :: Bool -> [Char] -> FeatureSet -> [FieldType]
gatherFields Bool
root [Char]
prefix (FeatureSet [Char]
name [Char]
desc [FeatureSet]
children) = if [FeatureSet] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FeatureSet]
children
        then [Name -> Type -> FieldType
FieldType ([Char] -> Name
Name [Char]
selfName) (Type -> FieldType) -> Type -> FieldType
forall a b. (a -> b) -> a -> b
$ [Char] -> Type -> Type
doc ([Char] -> [Char]
capitalize [Char]
desc) Type
unit]
        else [[FieldType]] -> [FieldType]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Bool -> [Char] -> FeatureSet -> [FieldType]
gatherFields Bool
False [Char]
selfName (FeatureSet -> [FieldType]) -> [FeatureSet] -> [[FieldType]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FeatureSet]
children)
      where
        --selfName = capitalize name
        selfName :: [Char]
selfName = if Bool
root
          then [Char]
""
          else [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
stripFunctionSuffix ([Char] -> [Char]
capitalize [Char]
name)
    stripFunctionSuffix :: [Char] -> [Char]
stripFunctionSuffix [Char]
name = if [Char]
"Function" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` [Char]
name Bool -> Bool -> Bool
&& [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Char]
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flen
        then Int -> [Char] -> [Char]
forall {a}. Int -> [a] -> [a]
removeLastN Int
flen [Char]
name
        else [Char]
name
      where
        removeLastN :: Int -> [a] -> [a]
removeLastN Int
n [a]
xs = Int -> [a] -> [a]
forall {a}. Int -> [a] -> [a]
L.take ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) [a]
xs
        flen :: Int
flen = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([Char]
"Function" :: String)