module PostgresqlSyntax.KeywordSet where

import Data.HashSet
import qualified Data.Text as Text
import PostgresqlSyntax.Prelude hiding (expression, fromList, toList)

{-# NOINLINE keyword #-}
{-
From https://github.com/postgres/postgres/blob/1aac32df89eb19949050f6f27c268122833ad036/src/include/parser/kwlist.h
-}
keyword :: HashSet Text
keyword :: HashSet Text
keyword = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList [Text
"abort", Text
"absolute", Text
"access", Text
"action", Text
"add", Text
"admin", Text
"after", Text
"aggregate", Text
"all", Text
"also", Text
"alter", Text
"always", Text
"analyse", Text
"analyze", Text
"and", Text
"any", Text
"array", Text
"as", Text
"asc", Text
"assertion", Text
"assignment", Text
"asymmetric", Text
"at", Text
"attach", Text
"attribute", Text
"authorization", Text
"backward", Text
"before", Text
"begin", Text
"between", Text
"bigint", Text
"binary", Text
"bit", Text
"boolean", Text
"both", Text
"by", Text
"cache", Text
"call", Text
"called", Text
"cascade", Text
"cascaded", Text
"case", Text
"cast", Text
"catalog", Text
"chain", Text
"char", Text
"character", Text
"characteristics", Text
"check", Text
"checkpoint", Text
"class", Text
"close", Text
"cluster", Text
"coalesce", Text
"collate", Text
"collation", Text
"column", Text
"columns", Text
"comment", Text
"comments", Text
"commit", Text
"committed", Text
"concurrently", Text
"configuration", Text
"conflict", Text
"connection", Text
"constraint", Text
"constraints", Text
"content", Text
"continue", Text
"conversion", Text
"copy", Text
"cost", Text
"create", Text
"cross", Text
"csv", Text
"cube", Text
"current", Text
"current_catalog", Text
"current_date", Text
"current_role", Text
"current_schema", Text
"current_time", Text
"current_timestamp", Text
"current_user", Text
"cursor", Text
"cycle", Text
"data", Text
"database", Text
"day", Text
"deallocate", Text
"dec", Text
"decimal", Text
"declare", Text
"default", Text
"defaults", Text
"deferrable", Text
"deferred", Text
"definer", Text
"delete", Text
"delimiter", Text
"delimiters", Text
"depends", Text
"desc", Text
"detach", Text
"dictionary", Text
"disable", Text
"discard", Text
"distinct", Text
"do", Text
"document", Text
"domain", Text
"double", Text
"drop", Text
"each", Text
"else", Text
"enable", Text
"encoding", Text
"encrypted", Text
"end", Text
"enum", Text
"escape", Text
"event", Text
"except", Text
"exclude", Text
"excluding", Text
"exclusive", Text
"execute", Text
"exists", Text
"explain", Text
"expression", Text
"extension", Text
"external", Text
"extract", Text
"false", Text
"family", Text
"fetch", Text
"filter", Text
"first", Text
"float", Text
"following", Text
"for", Text
"force", Text
"foreign", Text
"forward", Text
"freeze", Text
"from", Text
"full", Text
"function", Text
"functions", Text
"generated", Text
"global", Text
"grant", Text
"granted", Text
"greatest", Text
"group", Text
"grouping", Text
"groups", Text
"handler", Text
"having", Text
"header", Text
"hold", Text
"hour", Text
"identity", Text
"if", Text
"ilike", Text
"immediate", Text
"immutable", Text
"implicit", Text
"import", Text
"in", Text
"include", Text
"including", Text
"increment", Text
"index", Text
"indexes", Text
"inherit", Text
"inherits", Text
"initially", Text
"inline", Text
"inner", Text
"inout", Text
"input", Text
"insensitive", Text
"insert", Text
"instead", Text
"int", Text
"integer", Text
"intersect", Text
"interval", Text
"into", Text
"invoker", Text
"is", Text
"isnull", Text
"isolation", Text
"join", Text
"key", Text
"label", Text
"language", Text
"large", Text
"last", Text
"lateral", Text
"leading", Text
"leakproof", Text
"least", Text
"left", Text
"level", Text
"like", Text
"limit", Text
"listen", Text
"load", Text
"local", Text
"localtime", Text
"localtimestamp", Text
"location", Text
"lock", Text
"locked", Text
"logged", Text
"mapping", Text
"match", Text
"materialized", Text
"maxvalue", Text
"method", Text
"minute", Text
"minvalue", Text
"mode", Text
"month", Text
"move", Text
"name", Text
"names", Text
"national", Text
"natural", Text
"nchar", Text
"new", Text
"next", Text
"nfc", Text
"nfd", Text
"nfkc", Text
"nfkd", Text
"no", Text
"none", Text
"normalize", Text
"normalized", Text
"not", Text
"nothing", Text
"notify", Text
"notnull", Text
"nowait", Text
"null", Text
"nullif", Text
"nulls", Text
"numeric", Text
"object", Text
"of", Text
"off", Text
"offset", Text
"oids", Text
"old", Text
"on", Text
"only", Text
"operator", Text
"option", Text
"options", Text
"or", Text
"order", Text
"ordinality", Text
"others", Text
"out", Text
"outer", Text
"over", Text
"overlaps", Text
"overlay", Text
"overriding", Text
"owned", Text
"owner", Text
"parallel", Text
"parser", Text
"partial", Text
"partition", Text
"passing", Text
"password", Text
"placing", Text
"plans", Text
"policy", Text
"position", Text
"preceding", Text
"precision", Text
"prepare", Text
"prepared", Text
"preserve", Text
"primary", Text
"prior", Text
"privileges", Text
"procedural", Text
"procedure", Text
"procedures", Text
"program", Text
"publication", Text
"quote", Text
"range", Text
"read", Text
"real", Text
"reassign", Text
"recheck", Text
"recursive", Text
"ref", Text
"references", Text
"referencing", Text
"refresh", Text
"reindex", Text
"relative", Text
"release", Text
"rename", Text
"repeatable", Text
"replace", Text
"replica", Text
"reset", Text
"restart", Text
"restrict", Text
"returning", Text
"returns", Text
"revoke", Text
"right", Text
"role", Text
"rollback", Text
"rollup", Text
"routine", Text
"routines", Text
"row", Text
"rows", Text
"rule", Text
"savepoint", Text
"schema", Text
"schemas", Text
"scroll", Text
"search", Text
"second", Text
"security", Text
"select", Text
"sequence", Text
"sequences", Text
"serializable", Text
"server", Text
"session", Text
"session_user", Text
"set", Text
"setof", Text
"sets", Text
"share", Text
"show", Text
"similar", Text
"simple", Text
"skip", Text
"smallint", Text
"snapshot", Text
"some", Text
"sql", Text
"stable", Text
"standalone", Text
"start", Text
"statement", Text
"statistics", Text
"stdin", Text
"stdout", Text
"storage", Text
"stored", Text
"strict", Text
"strip", Text
"subscription", Text
"substring", Text
"support", Text
"symmetric", Text
"sysid", Text
"system", Text
"table", Text
"tables", Text
"tablesample", Text
"tablespace", Text
"temp", Text
"template", Text
"temporary", Text
"text", Text
"then", Text
"ties", Text
"time", Text
"timestamp", Text
"to", Text
"trailing", Text
"transaction", Text
"transform", Text
"treat", Text
"trigger", Text
"trim", Text
"true", Text
"truncate", Text
"trusted", Text
"type", Text
"types", Text
"uescape", Text
"unbounded", Text
"uncommitted", Text
"unencrypted", Text
"union", Text
"unique", Text
"unknown", Text
"unlisten", Text
"unlogged", Text
"until", Text
"update", Text
"user", Text
"using", Text
"vacuum", Text
"valid", Text
"validate", Text
"validator", Text
"value", Text
"values", Text
"varchar", Text
"variadic", Text
"varying", Text
"verbose", Text
"version", Text
"view", Text
"views", Text
"volatile", Text
"when", Text
"where", Text
"whitespace", Text
"window", Text
"with", Text
"within", Text
"without", Text
"work", Text
"wrapper", Text
"write", Text
"xml", Text
"xmlattributes", Text
"xmlconcat", Text
"xmlelement", Text
"xmlexists", Text
"xmlforest", Text
"xmlnamespaces", Text
"xmlparse", Text
"xmlpi", Text
"xmlroot", Text
"xmlserialize", Text
"xmltable", Text
"year", Text
"yes", Text
"zone"]

{-# NOINLINE unreservedKeyword #-}
unreservedKeyword :: HashSet Text
unreservedKeyword :: HashSet Text
unreservedKeyword = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList [Text
"abort", Text
"absolute", Text
"access", Text
"action", Text
"add", Text
"admin", Text
"after", Text
"aggregate", Text
"also", Text
"alter", Text
"always", Text
"assertion", Text
"assignment", Text
"at", Text
"attach", Text
"attribute", Text
"backward", Text
"before", Text
"begin", Text
"by", Text
"cache", Text
"call", Text
"called", Text
"cascade", Text
"cascaded", Text
"catalog", Text
"chain", Text
"characteristics", Text
"checkpoint", Text
"class", Text
"close", Text
"cluster", Text
"columns", Text
"comment", Text
"comments", Text
"commit", Text
"committed", Text
"configuration", Text
"conflict", Text
"connection", Text
"constraints", Text
"content", Text
"continue", Text
"conversion", Text
"copy", Text
"cost", Text
"csv", Text
"cube", Text
"current", Text
"cursor", Text
"cycle", Text
"data", Text
"database", Text
"day", Text
"deallocate", Text
"declare", Text
"defaults", Text
"deferred", Text
"definer", Text
"delete", Text
"delimiter", Text
"delimiters", Text
"depends", Text
"detach", Text
"dictionary", Text
"disable", Text
"discard", Text
"document", Text
"domain", Text
"double", Text
"drop", Text
"each", Text
"enable", Text
"encoding", Text
"encrypted", Text
"enum", Text
"escape", Text
"event", Text
"exclude", Text
"excluding", Text
"exclusive", Text
"execute", Text
"explain", Text
"extension", Text
"external", Text
"family", Text
"filter", Text
"first", Text
"following", Text
"force", Text
"forward", Text
"function", Text
"functions", Text
"generated", Text
"global", Text
"granted", Text
"groups", Text
"handler", Text
"header", Text
"hold", Text
"hour", Text
"identity", Text
"if", Text
"immediate", Text
"immutable", Text
"implicit", Text
"import", Text
"include", Text
"including", Text
"increment", Text
"index", Text
"indexes", Text
"inherit", Text
"inherits", Text
"inline", Text
"input", Text
"insensitive", Text
"insert", Text
"instead", Text
"invoker", Text
"isolation", Text
"key", Text
"label", Text
"language", Text
"large", Text
"last", Text
"leakproof", Text
"level", Text
"listen", Text
"load", Text
"local", Text
"location", Text
"lock", Text
"locked", Text
"logged", Text
"mapping", Text
"match", Text
"materialized", Text
"maxvalue", Text
"method", Text
"minute", Text
"minvalue", Text
"mode", Text
"month", Text
"move", Text
"name", Text
"names", Text
"new", Text
"next", Text
"no", Text
"nothing", Text
"notify", Text
"nowait", Text
"nulls", Text
"object", Text
"of", Text
"off", Text
"oids", Text
"old", Text
"operator", Text
"option", Text
"options", Text
"ordinality", Text
"others", Text
"over", Text
"overriding", Text
"owned", Text
"owner", Text
"parallel", Text
"parser", Text
"partial", Text
"partition", Text
"passing", Text
"password", Text
"plans", Text
"policy", Text
"preceding", Text
"prepare", Text
"prepared", Text
"preserve", Text
"prior", Text
"privileges", Text
"procedural", Text
"procedure", Text
"procedures", Text
"program", Text
"publication", Text
"quote", Text
"range", Text
"read", Text
"reassign", Text
"recheck", Text
"recursive", Text
"ref", Text
"referencing", Text
"refresh", Text
"reindex", Text
"relative", Text
"release", Text
"rename", Text
"repeatable", Text
"replace", Text
"replica", Text
"reset", Text
"restart", Text
"restrict", Text
"returns", Text
"revoke", Text
"role", Text
"rollback", Text
"rollup", Text
"routine", Text
"routines", Text
"rows", Text
"rule", Text
"savepoint", Text
"schema", Text
"schemas", Text
"scroll", Text
"search", Text
"second", Text
"security", Text
"sequence", Text
"sequences", Text
"serializable", Text
"server", Text
"session", Text
"set", Text
"sets", Text
"share", Text
"show", Text
"simple", Text
"skip", Text
"snapshot", Text
"sql", Text
"stable", Text
"standalone", Text
"start", Text
"statement", Text
"statistics", Text
"stdin", Text
"stdout", Text
"storage", Text
"stored", Text
"strict", Text
"strip", Text
"subscription", Text
"support", Text
"sysid", Text
"system", Text
"tables", Text
"tablespace", Text
"temp", Text
"template", Text
"temporary", Text
"text", Text
"ties", Text
"transaction", Text
"transform", Text
"trigger", Text
"truncate", Text
"trusted", Text
"type", Text
"types", Text
"unbounded", Text
"uncommitted", Text
"unencrypted", Text
"unknown", Text
"unlisten", Text
"unlogged", Text
"until", Text
"update", Text
"vacuum", Text
"valid", Text
"validate", Text
"validator", Text
"value", Text
"varying", Text
"version", Text
"view", Text
"views", Text
"volatile", Text
"whitespace", Text
"within", Text
"without", Text
"work", Text
"wrapper", Text
"write", Text
"xml", Text
"year", Text
"yes", Text
"zone"]

{-# NOINLINE colNameKeyword #-}
colNameKeyword :: HashSet Text
colNameKeyword :: HashSet Text
colNameKeyword = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList [Text
"between", Text
"bigint", Text
"bit", Text
"boolean", Text
"char", Text
"character", Text
"coalesce", Text
"dec", Text
"decimal", Text
"exists", Text
"extract", Text
"float", Text
"greatest", Text
"grouping", Text
"inout", Text
"int", Text
"integer", Text
"interval", Text
"least", Text
"national", Text
"nchar", Text
"none", Text
"normalize", Text
"nullif", Text
"numeric", Text
"out", Text
"overlay", Text
"position", Text
"precision", Text
"real", Text
"row", Text
"setof", Text
"smallint", Text
"substring", Text
"time", Text
"timestamp", Text
"treat", Text
"trim", Text
"values", Text
"varchar", Text
"xmlattributes", Text
"xmlconcat", Text
"xmlelement", Text
"xmlexists", Text
"xmlforest", Text
"xmlnamespaces", Text
"xmlparse", Text
"xmlpi", Text
"xmlroot", Text
"xmlserialize", Text
"xmltable"]

{-# NOINLINE typeFuncNameKeyword #-}
typeFuncNameKeyword :: HashSet Text
typeFuncNameKeyword :: HashSet Text
typeFuncNameKeyword = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList [Text
"authorization", Text
"binary", Text
"collation", Text
"concurrently", Text
"cross", Text
"current_schema", Text
"freeze", Text
"full", Text
"ilike", Text
"inner", Text
"is", Text
"isnull", Text
"join", Text
"left", Text
"like", Text
"natural", Text
"notnull", Text
"outer", Text
"overlaps", Text
"right", Text
"similar", Text
"tablesample", Text
"verbose"]

{-# NOINLINE reservedKeyword #-}
reservedKeyword :: HashSet Text
reservedKeyword :: HashSet Text
reservedKeyword = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList [Text
"all", Text
"analyse", Text
"analyze", Text
"and", Text
"any", Text
"array", Text
"as", Text
"asc", Text
"asymmetric", Text
"both", Text
"case", Text
"cast", Text
"check", Text
"collate", Text
"column", Text
"constraint", Text
"create", Text
"current_catalog", Text
"current_date", Text
"current_role", Text
"current_time", Text
"current_timestamp", Text
"current_user", Text
"default", Text
"deferrable", Text
"desc", Text
"distinct", Text
"do", Text
"else", Text
"end", Text
"except", Text
"false", Text
"fetch", Text
"for", Text
"foreign", Text
"from", Text
"grant", Text
"group", Text
"having", Text
"in", Text
"initially", Text
"intersect", Text
"into", Text
"lateral", Text
"leading", Text
"limit", Text
"localtime", Text
"localtimestamp", Text
"not", Text
"null", Text
"offset", Text
"on", Text
"only", Text
"or", Text
"order", Text
"placing", Text
"primary", Text
"references", Text
"returning", Text
"select", Text
"session_user", Text
"some", Text
"symmetric", Text
"table", Text
"then", Text
"to", Text
"trailing", Text
"true", Text
"union", Text
"unique", Text
"user", Text
"using", Text
"variadic", Text
"when", Text
"where", Text
"window", Text
"with"]

{-# NOINLINE symbolicBinOp #-}
symbolicBinOp :: HashSet Text
symbolicBinOp :: HashSet Text
symbolicBinOp = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList [Text
"+", Text
"-", Text
"*", Text
"/", Text
"%", Text
"^", Text
"<", Text
">", Text
"=", Text
"<=", Text
">=", Text
"<>", Text
"~~", Text
"~~*", Text
"!~~", Text
"!~~*", Text
"~", Text
"~*", Text
"!~", Text
"!~*"]

{-# NOINLINE lexicalBinOp #-}
lexicalBinOp :: HashSet Text
lexicalBinOp :: HashSet Text
lexicalBinOp = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList [Text
"and", Text
"or"]

{-# NOINLINE colId #-}
colId :: HashSet Text
colId = [HashSet Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [HashSet a] -> HashSet a
unions [HashSet Text
unreservedKeyword, HashSet Text
colNameKeyword]

{-
type_function_name:
  | IDENT
  | unreserved_keyword
  | type_func_name_keyword
-}
{-# NOINLINE typeFunctionName #-}
typeFunctionName :: HashSet Text
typeFunctionName = [HashSet Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [HashSet a] -> HashSet a
unions [HashSet Text
unreservedKeyword, HashSet Text
typeFuncNameKeyword]

-- |
-- As per the following comment from the original scanner definition:
--
-- /*
--  * Likewise, if what we have left is two chars, and
--  * those match the tokens ">=", "<=", "=>", "<>" or
--  * "!=", then we must return the appropriate token
--  * rather than the generic Op.
--  */
{-# NOINLINE nonOp #-}
nonOp :: HashSet a
nonOp = [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList [a
">=", a
"<=", a
"=>", a
"<>", a
"!="] HashSet a -> HashSet a -> HashSet a
forall a. Semigroup a => a -> a -> a
<> HashSet a
forall a. (Hashable a, IsString a) => HashSet a
mathOp

{-# NOINLINE mathOp #-}
mathOp :: HashSet a
mathOp = [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList [a
"<>", a
">=", a
"!=", a
"<=", a
"+", a
"-", a
"*", a
"/", a
"%", a
"^", a
"<", a
">", a
"="]