{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier4.Langs.Cypher.OpenCypher where

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


openCypherModule :: Module
openCypherModule :: Module
openCypherModule = 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 Cypher model based on the OpenCypher specification (version 23), copyright Neo Technology, available at:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
"  https://opencypher.org/resources/")
  where
    ns :: Namespace
ns = [Char] -> Namespace
Namespace [Char]
"hydra/langs/cypher/openCypher"
    def :: [Char] -> Type -> Element
def = Namespace -> [Char] -> Type -> Element
datatype Namespace
ns
    cypher :: [Char] -> Type
cypher = Namespace -> [Char] -> Type
typeref Namespace
ns

    elements :: [Element]
elements = [

-- Cypher = [SP], Statement, [[SP], ';'], [SP], EOI ;
-- 
-- Statement = Query ;
-- 
-- Query = RegularQuery
--       | StandaloneCall
--       ;

      [Char] -> Type -> Element
def [Char]
"Query" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"regular"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"RegularQuery",
          [Char]
"standalone"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"StandaloneCall"],

-- RegularQuery = SingleQuery, { [SP], Union } ;

      [Char] -> Type -> Element
def [Char]
"RegularQuery" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"head"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"SingleQuery",
          [Char]
"rest"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Union"],

-- Union = ((U,N,I,O,N), SP, (A,L,L), [SP], SingleQuery)
--       | ((U,N,I,O,N), [SP], SingleQuery)
--       ;

      [Char] -> Type -> Element
def [Char]
"Union" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"all"[Char] -> Type -> FieldType
>: Type
boolean,
          [Char]
"query"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"SingleQuery"],

-- SingleQuery = SinglePartQuery
--             | MultiPartQuery
--             ;
      [Char] -> Type -> Element
def [Char]
"SingleQuery" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"singlePart"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"SinglePartQuery",
          [Char]
"multiPart"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"MultiPartQuery"],

-- SinglePartQuery = ({ ReadingClause, [SP] }, Return)
--                 | ({ ReadingClause, [SP] }, UpdatingClause, { [SP], UpdatingClause }, [[SP], Return])
--                 ;

      [Char] -> Type -> Element
def [Char]
"SinglePartQuery" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"reading"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"ReadingClause",
          [Char]
"updating"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"UpdatingClause",
          [Char]
"return"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Return"],
          
-- MultiPartQuery = { { ReadingClause, [SP] }, { UpdatingClause, [SP] }, With, [SP] }-, SinglePartQuery ;
          
      [Char] -> Type -> Element
def [Char]
"WithClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"reading"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"ReadingClause",
          [Char]
"updating"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"UpdatingClause",
          [Char]
"with"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"With"],

      [Char] -> Type -> Element
def [Char]
"MultiPartQuery" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"with"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"WithClause",
          [Char]
"body"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"SinglePartQuery"],

-- UpdatingClause = Create
--                | Merge
--                | Delete
--                | Set
--                | Remove
--                ;

      [Char] -> Type -> Element
def [Char]
"UpdatingClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"create"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Create",
          [Char]
"merge"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Merge",
          [Char]
"delete"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Delete",
          [Char]
"set"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Set",
          [Char]
"remove"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Remove"],

-- ReadingClause = Match
--               | Unwind
--               | InQueryCall
--               ;

      [Char] -> Type -> Element
def [Char]
"ReadingClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"match"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Match",
          [Char]
"unwind"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Unwind",
          [Char]
"inQueryCall"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"InQueryCall"],
          
-- Match = [(O,P,T,I,O,N,A,L), SP], (M,A,T,C,H), [SP], Pattern, [[SP], Where] ;

      [Char] -> Type -> Element
def [Char]
"Match" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"optional"[Char] -> Type -> FieldType
>: Type
boolean,
          [Char]
"pattern"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Pattern",
          [Char]
"where"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Where"],

-- Unwind = (U,N,W,I,N,D), [SP], Expression, SP, (A,S), SP, Variable ;

      [Char] -> Type -> Element
def [Char]
"Unwind" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"expression"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression",
          [Char]
"variable"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Variable"],

-- Merge = (M,E,R,G,E), [SP], PatternPart, { SP, MergeAction } ;

      [Char] -> Type -> Element
def [Char]
"Merge" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"patternPart"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PatternPart",
          [Char]
"actions"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"MergeAction"],
          
-- MergeAction = ((O,N), SP, (M,A,T,C,H), SP, Set)
--             | ((O,N), SP, (C,R,E,A,T,E), SP, Set)
--             ;

      [Char] -> Type -> Element
def [Char]
"MatchOrCreate" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> Type
enum [[Char]
"match", [Char]
"create"],
        
      [Char] -> Type -> Element
def [Char]
"MergeAction" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"action"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"MatchOrCreate",
          [Char]
"set"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Set"],
          
-- Create = (C,R,E,A,T,E), [SP], Pattern ;

      [Char] -> Type -> Element
def [Char]
"Create" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Pattern",

-- Set = (S,E,T), [SP], SetItem, { [SP], ',', [SP], SetItem } ;

      [Char] -> Type -> Element
def [Char]
"Set" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"SetItem",

-- SetItem = (PropertyExpression, [SP], '=', [SP], Expression)
--         | (Variable, [SP], '=', [SP], Expression)
--         | (Variable, [SP], '+=', [SP], Expression)
--         | (Variable, [SP], NodeLabels)
--         ;

      [Char] -> Type -> Element
def [Char]
"SetItem" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"property"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PropertyEquals",
          [Char]
"variableEqual"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"VariableEquals",
          [Char]
"variablePlusEqual"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"VariablePlusEquals",
          [Char]
"variableLabels"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"VariableAndNodeLabels"],

      [Char] -> Type -> Element
def [Char]
"PropertyEquals" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"lhs"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PropertyExpression",
          [Char]
"rhs"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression"],

      [Char] -> Type -> Element
def [Char]
"VariableEquals" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"lhs"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Variable",
          [Char]
"rhs"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression"],

      [Char] -> Type -> Element
def [Char]
"VariablePlusEquals" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"lhs"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Variable",
          [Char]
"rhs"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression"],

      [Char] -> Type -> Element
def [Char]
"VariableAndNodeLabels" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"variable"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Variable",
          [Char]
"labels"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"NodeLabels"],

-- Delete = [(D,E,T,A,C,H), SP], (D,E,L,E,T,E), [SP], Expression, { [SP], ',', [SP], Expression } ;

      [Char] -> Type -> Element
def [Char]
"Delete" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"detach"[Char] -> Type -> FieldType
>: Type
boolean,
          [Char]
"expressions"[Char] -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Expression"],

-- Remove = (R,E,M,O,V,E), SP, RemoveItem, { [SP], ',', [SP], RemoveItem } ;

      [Char] -> Type -> Element
def [Char]
"Remove" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"RemoveItem",

-- RemoveItem = (Variable, NodeLabels)
--            | PropertyExpression
--            ;

      [Char] -> Type -> Element
def [Char]
"RemoveItem" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"variableLabels"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"VariableAndNodeLabels",
          [Char]
"property"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PropertyExpression"],

-- InQueryCall = (C,A,L,L), SP, ExplicitProcedureInvocation, [[SP], (Y,I,E,L,D), SP, YieldItems] ;

      [Char] -> Type -> Element
def [Char]
"InQueryCall" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"call"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ExplicitProcedureInvocation",
          [Char]
"yieldItems"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"YieldItems"],

-- StandaloneCall = (C,A,L,L), SP, (ExplicitProcedureInvocation | ImplicitProcedureInvocation), [[SP], (Y,I,E,L,D), SP, ('*' | YieldItems)] ;

      [Char] -> Type -> Element
def [Char]
"ProcedureInvocation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"explicit"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ExplicitProcedureInvocation",
          [Char]
"implicit"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ImplicitProcedureInvocation"],

      [Char] -> Type -> Element
def [Char]
"StarOrYieldItems" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"star"[Char] -> Type -> FieldType
>: Type
unit,
          [Char]
"items"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"YieldItems"],

      [Char] -> Type -> Element
def [Char]
"StandaloneCall" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"call"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ProcedureInvocation",
          [Char]
"yieldItems"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"StarOrYieldItems"],

-- YieldItems = YieldItem, { [SP], ',', [SP], YieldItem }, [[SP], Where] ;

      [Char] -> Type -> Element
def [Char]
"YieldItems" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"items"[Char] -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"YieldItem",
          [Char]
"where"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Where"],

-- YieldItem = [ProcedureResultField, SP, (A,S), SP], Variable ;

      [Char] -> Type -> Element
def [Char]
"YieldItem" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"field"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"ProcedureResultField",
          [Char]
"variable"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Variable"],

-- With = (W,I,T,H), ProjectionBody, [[SP], Where] ;

      [Char] -> Type -> Element
def [Char]
"With" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"projection"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ProjectionBody",
          [Char]
"where"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Where"],

-- Return = (R,E,T,U,R,N), ProjectionBody ;

      [Char] -> Type -> Element
def [Char]
"Return" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type
cypher [Char]
"ProjectionBody",

-- ProjectionBody = [[SP], (D,I,S,T,I,N,C,T)], SP, ProjectionItems, [SP, Order], [SP, Skip], [SP, Limit] ;

      [Char] -> Type -> Element
def [Char]
"ProjectionBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"distinct"[Char] -> Type -> FieldType
>: Type
boolean,
          [Char]
"projectionItems"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ProjectionItems",
          [Char]
"order"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Order",
          [Char]
"skip"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Skip",
          [Char]
"limit"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Limit"],

-- ProjectionItems = ('*', { [SP], ',', [SP], ProjectionItem })
--                 | (ProjectionItem, { [SP], ',', [SP], ProjectionItem })
--                 ;

      [Char] -> Type -> Element
def [Char]
"ProjectionItems" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"star"[Char] -> Type -> FieldType
>: Type
boolean,
          [Char]
"explicit"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"ProjectionItem"],

-- ProjectionItem = (Expression, SP, (A,S), SP, Variable)
--                | Expression
--                ;

        [Char] -> Type -> Element
def [Char]
"ProjectionItem" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
          [FieldType] -> Type
record [
            [Char]
"expression"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression",
            [Char]
"variable"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Variable"],

-- Order = (O,R,D,E,R), SP, (B,Y), SP, SortItem, { ',', [SP], SortItem } ;

      [Char] -> Type -> Element
def [Char]
"Order" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"SortItem",

-- Skip = (S,K,I,P), SP, Expression ;

      [Char] -> Type -> Element
def [Char]
"Skip" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type
cypher [Char]
"Expression",

-- Limit = (L,I,M,I,T), SP, Expression ;

      [Char] -> Type -> Element
def [Char]
"Limit" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type
cypher [Char]
"Expression",

-- SortItem = Expression, [[SP], ((A,S,C,E,N,D,I,N,G) | (A,S,C) | (D,E,S,C,E,N,D,I,N,G) | (D,E,S,C))] ;

      [Char] -> Type -> Element
def [Char]
"SortOrder" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> Type
enum [[Char]
"ascending", [Char]
"descending"],

      [Char] -> Type -> Element
def [Char]
"SortItem" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"expression"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression",
          [Char]
"order"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"SortOrder"],

-- Where = (W,H,E,R,E), SP, Expression ;

      [Char] -> Type -> Element
def [Char]
"Where" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type
cypher [Char]
"Expression",

-- Pattern = PatternPart, { [SP], ',', [SP], PatternPart } ;

      [Char] -> Type -> Element
def [Char]
"Pattern" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"PatternPart",

-- PatternPart = (Variable, [SP], '=', [SP], AnonymousPatternPart)
--             | AnonymousPatternPart
--             ;

      [Char] -> Type -> Element
def [Char]
"PatternPart" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"variable"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Variable",
          [Char]
"pattern"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"AnonymousPatternPart"],

-- AnonymousPatternPart = PatternElement ;

        [Char] -> Type -> Element
def [Char]
"AnonymousPatternPart" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
          [Char] -> Type
cypher [Char]
"PatternElement",

-- PatternElement = (NodePattern, { [SP], PatternElementChain })
--                | ('(', PatternElement, ')')
--                ;

      [Char] -> Type -> Element
def [Char]
"NodePatternChain" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"nodePattern"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"NodePattern",
          [Char]
"chain"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"PatternElementChain"],

      [Char] -> Type -> Element
def [Char]
"PatternElement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"chained"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"NodePatternChain",
          [Char]
"parenthesized"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PatternElement"],

-- RelationshipsPattern = NodePattern, { [SP], PatternElementChain }- ;

      [Char] -> Type -> Element
def [Char]
"RelationshipsPattern" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"nodePattern"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"NodePattern",
          [Char]
"chain"[Char] -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"PatternElementChain"],

-- NodePattern = '(', [SP], [Variable, [SP]], [NodeLabels, [SP]], [Properties, [SP]], ')' ;
      [Char] -> Type -> Element
def [Char]
"NodePattern" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"variable"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Variable",
          [Char]
"labels"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"NodeLabels",
          [Char]
"properties"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Properties"],

-- PatternElementChain = RelationshipPattern, [SP], NodePattern ;

        [Char] -> Type -> Element
def [Char]
"PatternElementChain" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
          [FieldType] -> Type
record [
            [Char]
"relationship"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"RelationshipPattern",
            [Char]
"node"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"NodePattern"],

-- RelationshipPattern = (LeftArrowHead, [SP], Dash, [SP], [RelationshipDetail], [SP], Dash, [SP], RightArrowHead)
--                     | (LeftArrowHead, [SP], Dash, [SP], [RelationshipDetail], [SP], Dash)
--                     | (Dash, [SP], [RelationshipDetail], [SP], Dash, [SP], RightArrowHead)
--                     | (Dash, [SP], [RelationshipDetail], [SP], Dash)
--                     ;

        [Char] -> Type -> Element
def [Char]
"RelationshipPattern" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
          [FieldType] -> Type
record [
            [Char]
"leftArrow"[Char] -> Type -> FieldType
>: Type
boolean,
            [Char]
"detail"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"RelationshipDetail",
            [Char]
"rightArrow"[Char] -> Type -> FieldType
>: Type
boolean],

-- RelationshipDetail = '[', [SP], [Variable, [SP]], [RelationshipTypes, [SP]], [RangeLiteral], [Properties, [SP]], ']' ;

      [Char] -> Type -> Element
def [Char]
"RelationshipDetail" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"variable"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Variable",
          [Char]
"types"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"RelationshipTypes",
          [Char]
"range"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"RangeLiteral",
          [Char]
"properties"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Properties"],

-- Properties = MapLiteral
--            | Parameter
--            ;

      [Char] -> Type -> Element
def [Char]
"Properties" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"map"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"MapLiteral",
          [Char]
"parameter"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Parameter"],

-- RelationshipTypes = ':', [SP], RelTypeName, { [SP], '|', [':'], [SP], RelTypeName } ;

      -- TODO: check whether the slight difference in colon syntax is significant
      [Char] -> Type -> Element
def [Char]
"RelationshipTypes" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"RelTypeName",

-- NodeLabels = NodeLabel, { [SP], NodeLabel } ;

      [Char] -> Type -> Element
def [Char]
"NodeLabels" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"NodeLabel",

-- NodeLabel = ':', [SP], LabelName ;

      [Char] -> Type -> Element
def [Char]
"NodeLabel" Type
string,

-- RangeLiteral = '*', [SP], [IntegerLiteral, [SP]], ['..', [SP], [IntegerLiteral, [SP]]] ;

      [Char] -> Type -> Element
def [Char]
"RangeLiteral" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"start"[Char] -> Type -> FieldType
>: Type -> Type
optional Type
bigint,
          [Char]
"end"[Char] -> Type -> FieldType
>: Type -> Type
optional Type
bigint],

-- LabelName = SchemaName ;
-- 
-- RelTypeName = SchemaName ;

      [Char] -> Type -> Element
def [Char]
"RelTypeName" Type
string,

-- PropertyExpression = Atom, { [SP], PropertyLookup }- ;

      [Char] -> Type -> Element
def [Char]
"PropertyExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"atom"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Atom",
          [Char]
"lookups"[Char] -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"PropertyLookup"],

-- Expression = OrExpression ;

      [Char] -> Type -> Element
def [Char]
"Expression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"OrExpression",

-- OrExpression = XorExpression, { SP, (O,R), SP, XorExpression } ;

      [Char] -> Type -> Element
def [Char]
"OrExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"XorExpression",

-- XorExpression = AndExpression, { SP, (X,O,R), SP, AndExpression } ;

      [Char] -> Type -> Element
def [Char]
"XorExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"AndExpression",

-- AndExpression = NotExpression, { SP, (A,N,D), SP, NotExpression } ;

      [Char] -> Type -> Element
def [Char]
"AndExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"NotExpression",

-- NotExpression = { (N,O,T), [SP] }, ComparisonExpression ;

      [Char] -> Type -> Element
def [Char]
"NotExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"not"[Char] -> Type -> FieldType
>: Type
boolean,
          [Char]
"expression"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ComparisonExpression"],

-- ComparisonExpression = StringListNullPredicateExpression, { [SP], PartialComparisonExpression } ;

      [Char] -> Type -> Element
def [Char]
"ComparisonExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"left"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"StringListNullPredicateExpression",
          [Char]
"right"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"PartialComparisonExpression"],

-- PartialComparisonExpression = ('=', [SP], StringListNullPredicateExpression)
--                             | ('<>', [SP], StringListNullPredicateExpression)
--                             | ('<', [SP], StringListNullPredicateExpression)
--                             | ('>', [SP], StringListNullPredicateExpression)
--                             | ('<=', [SP], StringListNullPredicateExpression)
--                             | ('>=', [SP], StringListNullPredicateExpression)
--                             ;

      [Char] -> Type -> Element
def [Char]
"ComparisonOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> Type
enum [
          [Char]
"eq",
          [Char]
"neq",
          [Char]
"lt",
          [Char]
"gt",
          [Char]
"lte",
          [Char]
"gte"],

      [Char] -> Type -> Element
def [Char]
"PartialComparisonExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"operator"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ComparisonOperator",
          [Char]
"right"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"StringListNullPredicateExpression"],

-- StringListNullPredicateExpression = AddOrSubtractExpression, { StringPredicateExpression | ListPredicateExpression | NullPredicateExpression } ;

      [Char] -> Type -> Element
def [Char]
"StringListNullPredicateExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"left"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"AddOrSubtractExpression",
          [Char]
"right"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"StringListNullPredicateRightHandSide"],

      [Char] -> Type -> Element
def [Char]
"StringListNullPredicateRightHandSide" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"string"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"StringPredicateExpression",
          [Char]
"list"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ListPredicateExpression",
          [Char]
"null"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"NullPredicateExpression"],

-- StringPredicateExpression = ((SP, (S,T,A,R,T,S), SP, (W,I,T,H)) | (SP, (E,N,D,S), SP, (W,I,T,H)) | (SP, (C,O,N,T,A,I,N,S))), [SP], AddOrSubtractExpression ;

      [Char] -> Type -> Element
def [Char]
"StringPredicateExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"operator"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"StringPredicateOperator",
          [Char]
"expression"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"AddOrSubtractExpression"],

      [Char] -> Type -> Element
def [Char]
"StringPredicateOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> Type
enum [
          [Char]
"startsWith",
          [Char]
"endsWith",
          [Char]
"contains"],

-- ListPredicateExpression = SP, (I,N), [SP], AddOrSubtractExpression ;

      [Char] -> Type -> Element
def [Char]
"ListPredicateExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type
cypher [Char]
"AddOrSubtractExpression",

-- NullPredicateExpression = (SP, (I,S), SP, (N,U,L,L))
--                         | (SP, (I,S), SP, (N,O,T), SP, (N,U,L,L))
--                         ;

      [Char] -> Type -> Element
def [Char]
"NullPredicateExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        Type
boolean, -- true: NULL, false: NOT NULL

-- AddOrSubtractExpression = MultiplyDivideModuloExpression, { ([SP], '+', [SP], MultiplyDivideModuloExpression) | ([SP], '-', [SP], MultiplyDivideModuloExpression) } ;

      [Char] -> Type -> Element
def [Char]
"AddOrSubtractExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"left"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"MultiplyDivideModuloExpression",
          [Char]
"right"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"AddOrSubtractRightHandSide"],

      [Char] -> Type -> Element
def [Char]
"AddOrSubtractRightHandSide" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"operator"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"AddOrSubtractOperator",
          [Char]
"expression"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"MultiplyDivideModuloExpression"],

      [Char] -> Type -> Element
def [Char]
"AddOrSubtractOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> Type
enum [
          [Char]
"add",
          [Char]
"subtract"],

-- MultiplyDivideModuloExpression = PowerOfExpression, { ([SP], '*', [SP], PowerOfExpression) | ([SP], '/', [SP], PowerOfExpression) | ([SP], '%', [SP], PowerOfExpression) } ;

      [Char] -> Type -> Element
def [Char]
"MultiplyDivideModuloExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"left"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PowerOfExpression",
          [Char]
"right"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"MultiplyDivideModuloRightHandSide"],

      [Char] -> Type -> Element
def [Char]
"MultiplyDivideModuloRightHandSide" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"operator"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"MultiplyDivideModuloOperator",
          [Char]
"expression"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PowerOfExpression"],

      [Char] -> Type -> Element
def [Char]
"MultiplyDivideModuloOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> Type
enum [
          [Char]
"multiply",
          [Char]
"divide",
          [Char]
"modulo"],

-- PowerOfExpression = UnaryAddOrSubtractExpression, { [SP], '^', [SP], UnaryAddOrSubtractExpression } ;

      [Char] -> Type -> Element
def [Char]
"PowerOfExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"UnaryAddOrSubtractExpression",

-- UnaryAddOrSubtractExpression = NonArithmeticOperatorExpression
--                              | (('+' | '-'), [SP], NonArithmeticOperatorExpression)
--                              ;

      [Char] -> Type -> Element
def [Char]
"UnaryAddOrSubtractExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"operator"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"AddOrSubtractOperator",
          [Char]
"expression"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"NonArithmeticOperatorExpression"],

-- NonArithmeticOperatorExpression = Atom, { ([SP], ListOperatorExpression) | ([SP], PropertyLookup) }, [[SP], NodeLabels] ;

      [Char] -> Type -> Element
def [Char]
"ListOperatorExpressionOrPropertyLookup" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"list"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ListOperatorExpression",
          [Char]
"property"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PropertyLookup"],

      [Char] -> Type -> Element
def [Char]
"NonArithmeticOperatorExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"atom"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Atom",
          [Char]
"listsAndLookups"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"ListOperatorExpressionOrPropertyLookup",
          [Char]
"labels"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"NodeLabels"],

-- ListOperatorExpression = ('[', Expression, ']')
--                        | ('[', [Expression], '..', [Expression], ']')
--                        ;

      [Char] -> Type -> Element
def [Char]
"RangeExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
         [FieldType] -> Type
record [
            [Char]
"start"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Expression",
            [Char]
"end"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Expression"],

      [Char] -> Type -> Element
def [Char]
"ListOperatorExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"single"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression",
          [Char]
"range"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"RangeExpression"],

-- PropertyLookup = '.', [SP], (PropertyKeyName) ;

      [Char] -> Type -> Element
def [Char]
"PropertyLookup" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [Char] -> Type
cypher [Char]
"PropertyKeyName",

-- Atom = Literal
--      | Parameter
--      | CaseExpression
--      | ((C,O,U,N,T), [SP], '(', [SP], '*', [SP], ')')
--      | ListComprehension
--      | PatternComprehension
--      | Quantifier
--      | PatternPredicate
--      | ParenthesizedExpression
--      | FunctionInvocation
--      | ExistentialSubquery
--      | Variable
--      ;

      [Char] -> Type -> Element
def [Char]
"Atom" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"literal"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Literal",
          [Char]
"parameter"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Parameter",
          [Char]
"case"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"CaseExpression",
          [Char]
"countStar"[Char] -> Type -> FieldType
>: Type
unit,
          [Char]
"listComprehension"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ListComprehension",
          [Char]
"patternComprehension"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PatternComprehension",
          [Char]
"quantifier"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Quantifier",
          [Char]
"patternPredicate"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PatternPredicate",
          [Char]
"parenthesized"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ParenthesizedExpression",
          [Char]
"functionInvocation"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"FunctionInvocation",
          [Char]
"existentialSubquery"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ExistentialSubquery",
          [Char]
"variable"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Variable"],

-- CaseExpression = (((C,A,S,E), { [SP], CaseAlternative }-) | ((C,A,S,E), [SP], Expression, { [SP], CaseAlternative }-)), [[SP], (E,L,S,E), [SP], Expression], [SP], (E,N,D) ;

      [Char] -> Type -> Element
def [Char]
"CaseExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"expression"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Expression",
          [Char]
"alternatives"[Char] -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"CaseAlternative",
          [Char]
"else"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Expression"],

-- CaseAlternative = (W,H,E,N), [SP], Expression, [SP], (T,H,E,N), [SP], Expression ;

      [Char] -> Type -> Element
def [Char]
"CaseAlternative" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"condition"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression",
          [Char]
"result"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression"],

-- ListComprehension = '[', [SP], FilterExpression, [[SP], '|', [SP], Expression], [SP], ']' ;

      [Char] -> Type -> Element
def [Char]
"ListComprehension" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"left"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"FilterExpression",
          [Char]
"right"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Expression"],

-- PatternComprehension = '[', [SP], [Variable, [SP], '=', [SP]], RelationshipsPattern, [SP], [Where, [SP]], '|', [SP], Expression, [SP], ']' ;

      [Char] -> Type -> Element
def [Char]
"PatternComprehension" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"variable"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Variable",
          [Char]
"pattern"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"RelationshipsPattern",
          [Char]
"where"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Where",
          [Char]
"right"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression"],

-- Quantifier = ((A,L,L), [SP], '(', [SP], FilterExpression, [SP], ')')
--            | ((A,N,Y), [SP], '(', [SP], FilterExpression, [SP], ')')
--            | ((N,O,N,E), [SP], '(', [SP], FilterExpression, [SP], ')')
--            | ((S,I,N,G,L,E), [SP], '(', [SP], FilterExpression, [SP], ')')
--            ;

      [Char] -> Type -> Element
def [Char]
"Quantifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"operator"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"QuantifierOperator",
          [Char]
"expression"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"FilterExpression"],

      [Char] -> Type -> Element
def [Char]
"QuantifierOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> Type
enum [
          [Char]
"all",
          [Char]
"any",
          [Char]
"none",
          [Char]
"single"],

-- FilterExpression = IdInColl, [[SP], Where] ;

      [Char] -> Type -> Element
def [Char]
"FilterExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"idInColl"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"IdInColl",
          [Char]
"where"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Where"],

-- PatternPredicate = RelationshipsPattern ;

      [Char] -> Type -> Element
def [Char]
"PatternPredicate" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"RelationshipsPattern",

-- ParenthesizedExpression = '(', [SP], Expression, [SP], ')' ;

      [Char] -> Type -> Element
def [Char]
"ParenthesizedExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Expression",

-- IdInColl = Variable, SP, (I,N), SP, Expression ;

      [Char] -> Type -> Element
def [Char]
"IdInColl" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"variable"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Variable",
          [Char]
"expression"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression"],

-- FunctionInvocation = FunctionName, [SP], '(', [SP], [(D,I,S,T,I,N,C,T), [SP]], [Expression, [SP], { ',', [SP], Expression, [SP] }], ')' ;

      [Char] -> Type -> Element
def [Char]
"FunctionInvocation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"name"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"QualifiedName",
          [Char]
"distinct"[Char] -> Type -> FieldType
>: Type
boolean,
          [Char]
"arguments"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Expression"],

-- FunctionName = Namespace, SymbolicName ;

      [Char] -> Type -> Element
def [Char]
"QualifiedName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"namespace"[Char] -> Type -> FieldType
>: Type
string,
          [Char]
"local"[Char] -> Type -> FieldType
>: Type
string],

-- ExistentialSubquery = (E,X,I,S,T,S), [SP], '{', [SP], (RegularQuery | (Pattern, [[SP], Where])), [SP], '}' ;

      [Char] -> Type -> Element
def [Char]
"PatternWhere" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"pattern"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Pattern",
          [Char]
"where"[Char] -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Where"],

      [Char] -> Type -> Element
def [Char]
"ExistentialSubquery" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"regular"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"RegularQuery",
          [Char]
"pattern"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PatternWhere"],

-- ExplicitProcedureInvocation = ProcedureName, [SP], '(', [SP], [Expression, [SP], { ',', [SP], Expression, [SP] }], ')' ;

      [Char] -> Type -> Element
def [Char]
"ExplicitProcedureInvocation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"name"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"QualifiedName",
          [Char]
"arguments"[Char] -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Expression"],
          
-- ImplicitProcedureInvocation = ProcedureName ;

      [Char] -> Type -> Element
def [Char]
"ImplicitProcedureInvocation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"QualifiedName",

-- ProcedureResultField = SymbolicName ;

      [Char] -> Type -> Element
def [Char]
"ProcedureResultField" Type
string,

-- ProcedureName = Namespace, SymbolicName ;
--        
-- Namespace = { SymbolicName, '.' } ;
-- 
-- Variable = SymbolicName ;

      [Char] -> Type -> Element
def [Char]
"Variable" Type
string,

-- Literal = BooleanLiteral
--         | (N,U,L,L)
--         | NumberLiteral
--         | StringLiteral
--         | ListLiteral
--         | MapLiteral
--         ;

      [Char] -> Type -> Element
def [Char]
"Literal" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"boolean"[Char] -> Type -> FieldType
>: Type
boolean,
          [Char]
"null"[Char] -> Type -> FieldType
>: Type
unit,
          [Char]
"number"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"NumberLiteral",
          [Char]
"string"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"StringLiteral",
          [Char]
"list"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"ListLiteral",
          [Char]
"map"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"MapLiteral"],
          
-- BooleanLiteral = (T,R,U,E)
--                | (F,A,L,S,E)
--                ;
-- 
-- NumberLiteral = DoubleLiteral
--               | IntegerLiteral
--               ;

      [Char] -> Type -> Element
def [Char]
"NumberLiteral" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"double"[Char] -> Type -> FieldType
>: Type
float64,
          [Char]
"integer"[Char] -> Type -> FieldType
>: Type
bigint],

-- IntegerLiteral = HexInteger
--                | OctalInteger
--                | DecimalInteger
--                ;
-- 
-- HexInteger = '0x', { HexDigit }- ;
-- 
-- DecimalInteger = ZeroDigit
--                | (NonZeroDigit, { Digit })
--                ;
-- 
-- OctalInteger = '0o', { OctDigit }- ;
-- 
-- HexLetter = (A)
--           | (B)
--           | (C)
--           | (D)
--           | (E)
--           | (F)
--           ;
-- 
-- HexDigit = Digit
--          | HexLetter
--          ;
-- 
-- Digit = ZeroDigit
--       | NonZeroDigit
--       ;
-- 
-- NonZeroDigit = NonZeroOctDigit
--              | '8'
--              | '9'
--              ;
-- 
-- NonZeroOctDigit = '1'
--                 | '2'
--                 | '3'
--                 | '4'
--                 | '5'
--                 | '6'
--                 | '7'
--                 ;
-- 
-- OctDigit = ZeroDigit
--          | NonZeroOctDigit
--          ;
-- 
-- ZeroDigit = '0' ;
-- 
-- DoubleLiteral = ExponentDecimalReal
--               | RegularDecimalReal
--               ;
-- 
-- ExponentDecimalReal = ({ Digit }- | ({ Digit }-, '.', { Digit }-) | ('.', { Digit }-)), (E), ['-'], { Digit }- ;
-- 
-- RegularDecimalReal = { Digit }, '.', { Digit }- ;
-- 
-- StringLiteral = ('"', { ANY - ('"' | '\') | EscapedChar }, '"')
--               | ("'", { ANY - ("'" | '\') | EscapedChar }, "'")
--               ;

      [Char] -> Type -> Element
def [Char]
"StringLiteral" Type
string,

-- EscapedChar = '\', ('\' | "'" | '"' | (B) | (F) | (N) | (R) | (T) | ((U), 4 * HexDigit) | ((U), 8 * HexDigit)) ;
-- 
-- ListLiteral = '[', [SP], [Expression, [SP], { ',', [SP], Expression, [SP] }], ']' ;

      [Char] -> Type -> Element
def [Char]
"ListLiteral" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"Expression",

-- MapLiteral = '{', [SP], [PropertyKeyName, [SP], ':', [SP], Expression, [SP], { ',', [SP], PropertyKeyName, [SP], ':', [SP], Expression, [SP] }], '}' ;

      [Char] -> Type -> Element
def [Char]
"MapLiteral" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
cypher [Char]
"KeyValuePair",

      [Char] -> Type -> Element
def [Char]
"KeyValuePair" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"key"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"PropertyKeyName",
          [Char]
"value"[Char] -> Type -> FieldType
>: [Char] -> Type
cypher [Char]
"Expression"],
          
-- PropertyKeyName = SchemaName ;

      [Char] -> Type -> Element
def [Char]
"PropertyKeyName" Type
string,

-- Parameter = '$', (SymbolicName | DecimalInteger) ;

      [Char] -> Type -> Element
def [Char]
"Parameter" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"symbolic"[Char] -> Type -> FieldType
>: Type
string,
          [Char]
"integer"[Char] -> Type -> FieldType
>: Type
bigint]]

-- SchemaName = SymbolicName
--            | ReservedWord
--            ;
-- 
-- ReservedWord = (A,L,L)
--              | (A,S,C)
--              | (A,S,C,E,N,D,I,N,G)
--              | (B,Y)
--              | (C,R,E,A,T,E)
--              | (D,E,L,E,T,E)
--              | (D,E,S,C)
--              | (D,E,S,C,E,N,D,I,N,G)
--              | (D,E,T,A,C,H)
--              | (E,X,I,S,T,S)
--              | (L,I,M,I,T)
--              | (M,A,T,C,H)
--              | (M,E,R,G,E)
--              | (O,N)
--              | (O,P,T,I,O,N,A,L)
--              | (O,R,D,E,R)
--              | (R,E,M,O,V,E)
--              | (R,E,T,U,R,N)
--              | (S,E,T)
--              | (S,K,I,P)
--              | (W,H,E,R,E)
--              | (W,I,T,H)
--              | (U,N,I,O,N)
--              | (U,N,W,I,N,D)
--              | (A,N,D)
--              | (A,S)
--              | (C,O,N,T,A,I,N,S)
--              | (D,I,S,T,I,N,C,T)
--              | (E,N,D,S)
--              | (I,N)
--              | (I,S)
--              | (N,O,T)
--              | (O,R)
--              | (S,T,A,R,T,S)
--              | (X,O,R)
--              | (F,A,L,S,E)
--              | (T,R,U,E)
--              | (N,U,L,L)
--              | (C,O,N,S,T,R,A,I,N,T)
--              | (D,O)
--              | (F,O,R)
--              | (R,E,Q,U,I,R,E)
--              | (U,N,I,Q,U,E)
--              | (C,A,S,E)
--              | (W,H,E,N)
--              | (T,H,E,N)
--              | (E,L,S,E)
--              | (E,N,D)
--              | (M,A,N,D,A,T,O,R,Y)
--              | (S,C,A,L,A,R)
--              | (O,F)
--              | (A,D,D)
--              | (D,R,O,P)
--              ;
-- 
-- SymbolicName = UnescapedSymbolicName
--              | EscapedSymbolicName
--              | HexLetter
--              | (C,O,U,N,T)
--              | (F,I,L,T,E,R)
--              | (E,X,T,R,A,C,T)
--              | (A,N,Y)
--              | (N,O,N,E)
--              | (S,I,N,G,L,E)
--              ;
-- 
-- UnescapedSymbolicName = IdentifierStart, { IdentifierPart } ;
-- 
-- (* Based on the unicode identifier and pattern syntax
--  *   (http://www.unicode.org/reports/tr31/)
--  * And extended with a few characters.
--  *)IdentifierStart = ID_Start
--                 | Pc
--                 ;
-- 
-- (* Based on the unicode identifier and pattern syntax
--  *   (http://www.unicode.org/reports/tr31/)
--  * And extended with a few characters.
--  *)IdentifierPart = ID_Continue
--                | Sc
--                ;
-- 
-- (* Any character except "`", enclosed within `backticks`. Backticks are escaped with double backticks.
--  *)EscapedSymbolicName = { '`', { ANY - ('`') }, '`' }- ;
-- 
-- SP = { whitespace }- ;
-- 
-- whitespace = SPACE
--            | TAB
--            | LF
--            | VT
--            | FF
--            | CR
--            | FS
--            | GS
--            | RS
--            | US
--            | ' '
--            | '᠎'
--            | ' '
--            | ' '
--            | ' '
--            | ' '
--            | ' '
--            | ' '
--            | ' '
--            | ' '
--            | ' '
--            | ' '
--            | '
'
--            | '
'
--            | ' '
--            | ' '
--            | ' '
--            | ' '
--            | ' '
--            | Comment
--            ;
-- 
-- Comment = ('/*', { ANY - ('*') | ('*', ANY - ('/')) }, '*/')
--         | ('//', { ANY - (LF | CR) }, [CR], (LF | EOI))
--         ;
-- 
-- LeftArrowHead = '<'
--               | '⟨'
--               | '〈'
--               | '﹤'
--               | '<'
--               ;
-- 
-- RightArrowHead = '>'
--                | '⟩'
--                | '〉'
--                | '﹥'
--                | '>'
--                ;
-- 
-- Dash = '-'
--      | '­'
--      | '‐'
--      | '‑'
--      | '‒'
--      | '–'
--      | '—'
--      | '―'
--      | '−'
--      | '﹘'
--      | '﹣'
--      | '-'
--      ;
-- 
-- A = 'A' | 'a' ;
-- B = 'B' | 'b' ;
-- C = 'C' | 'c' ;
-- D = 'D' | 'd' ;
-- E = 'E' | 'e' ;
-- F = 'F' | 'f' ;
-- G = 'G' | 'g' ;
-- H = 'H' | 'h' ;
-- I = 'I' | 'i' ;
-- K = 'K' | 'k' ;
-- L = 'L' | 'l' ;
-- M = 'M' | 'm' ;
-- N = 'N' | 'n' ;
-- O = 'O' | 'o' ;
-- P = 'P' | 'p' ;
-- Q = 'Q' | 'q' ;
-- R = 'R' | 'r' ;
-- S = 'S' | 's' ;
-- T = 'T' | 't' ;
-- U = 'U' | 'u' ;
-- V = 'V' | 'v' ;
-- W = 'W' | 'w' ;
-- X = 'X' | 'x' ;
-- Y = 'Y' | 'y' ;