-- Data types to represent different dialect options

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.Dialect
    (Dialect(..)
    ,ansi2011
    ,mysql
    ,postgres
    ,oracle
    ,sqlserver
    ) where

import Data.Text (Text)
import Data.Data (Data,Typeable)

-- | Used to set the dialect used for parsing and pretty printing,
-- very unfinished at the moment.
--
-- The keyword handling works as follows:
--
-- There is a list of reserved keywords. These will never parse as
-- anything other than as a keyword, unless they are in one of the
-- other lists.
--
-- There is a list of \'identifier\' keywords. These are reserved
-- keywords, with an exception that they will parse as an
-- identifier in a scalar expression. They won't parse as
-- identifiers in other places, e.g. column names or aliases.
--
-- There is a list of \'app\' keywords. These are reserved keywords,
-- with an exception that they will also parse in an \'app-like\'
-- construct - a regular function call, or any of the aggregate and
-- window variations.
--
-- There is a list of special type names. This list serves two
-- purposes - it is a list of the reserved keywords which are also
-- type names, and it is a list of all the multi word type names.
--
-- Every keyword should appear in the keywords lists, and then you can
-- add them to the other lists if you want exceptions. Most things
-- that refer to functions, types or variables that are keywords in
-- the ansi standard, can be removed from the keywords lists
-- completely with little effect. With most of the actual SQL
-- keywords, removing them from the keyword list will result in
-- lots of valid syntax no longer parsing (and probably bad parse
-- error messages too).
--
-- In the code, all special syntax which looks identical to regular
-- identifiers or function calls (apart from the name), is treated
-- like a regular identifier or function call.
--
-- It's easy to break the parser by removing the wrong words from
-- the keywords list or adding the wrong words to the other lists.

data Dialect = Dialect
    { -- | reserved keywords
     Dialect -> [Text]
diKeywords :: [Text]
      -- | keywords with identifier exception
    ,Dialect -> [Text]
diIdentifierKeywords :: [Text]
      -- | keywords with app exception
    ,Dialect -> [Text]
diAppKeywords :: [Text]
     -- | keywords with type exception plus all the type names which
     -- are multiple words
    ,Dialect -> [Text]
diSpecialTypeNames :: [Text]
     -- | allow ansi fetch first syntax
    ,Dialect -> Bool
diFetchFirst :: Bool
     -- | allow limit keyword (mysql, postgres,
     -- ...)
    ,Dialect -> Bool
diLimit :: Bool
     -- | allow parsing ODBC syntax
    ,Dialect -> Bool
diOdbc :: Bool
     -- | allow quoting identifiers with \`backquotes\`
    ,Dialect -> Bool
diBackquotedIden :: Bool
     -- | allow quoting identifiers with [square brackets]
    ,Dialect -> Bool
diSquareBracketQuotedIden :: Bool
     -- | allow identifiers with a leading at @example
    ,Dialect -> Bool
diAtIdentifier :: Bool
     -- | allow identifiers with a leading \# \#example
    ,Dialect -> Bool
diHashIdentifier :: Bool
     -- | allow positional identifiers like this: $1 
    ,Dialect -> Bool
diPositionalArg :: Bool
     -- | allow postgres style dollar strings
    ,Dialect -> Bool
diDollarString :: Bool
     -- | allow strings with an e - e"example"
    ,Dialect -> Bool
diEString :: Bool
     -- | allow postgres style symbols
    ,Dialect -> Bool
diPostgresSymbols :: Bool
     -- | allow sql server style symbols
    ,Dialect -> Bool
diSqlServerSymbols :: Bool
     -- | allow sql server style for CONVERT function in format CONVERT(data_type(length), expression, style)
    ,Dialect -> Bool
diConvertFunction :: Bool
     -- | allow creating autoincrement columns
    ,Dialect -> Bool
diAutoincrement :: Bool
     -- | allow omitting the comma between constraint clauses
    ,Dialect -> Bool
diNonCommaSeparatedConstraints :: Bool
    }
               deriving (Dialect -> Dialect -> Bool
(Dialect -> Dialect -> Bool)
-> (Dialect -> Dialect -> Bool) -> Eq Dialect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dialect -> Dialect -> Bool
== :: Dialect -> Dialect -> Bool
$c/= :: Dialect -> Dialect -> Bool
/= :: Dialect -> Dialect -> Bool
Eq,Int -> Dialect -> ShowS
[Dialect] -> ShowS
Dialect -> String
(Int -> Dialect -> ShowS)
-> (Dialect -> String) -> ([Dialect] -> ShowS) -> Show Dialect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dialect -> ShowS
showsPrec :: Int -> Dialect -> ShowS
$cshow :: Dialect -> String
show :: Dialect -> String
$cshowList :: [Dialect] -> ShowS
showList :: [Dialect] -> ShowS
Show,ReadPrec [Dialect]
ReadPrec Dialect
Int -> ReadS Dialect
ReadS [Dialect]
(Int -> ReadS Dialect)
-> ReadS [Dialect]
-> ReadPrec Dialect
-> ReadPrec [Dialect]
-> Read Dialect
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Dialect
readsPrec :: Int -> ReadS Dialect
$creadList :: ReadS [Dialect]
readList :: ReadS [Dialect]
$creadPrec :: ReadPrec Dialect
readPrec :: ReadPrec Dialect
$creadListPrec :: ReadPrec [Dialect]
readListPrec :: ReadPrec [Dialect]
Read,Typeable Dialect
Typeable Dialect =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Dialect -> c Dialect)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Dialect)
-> (Dialect -> Constr)
-> (Dialect -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Dialect))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dialect))
-> ((forall b. Data b => b -> b) -> Dialect -> Dialect)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Dialect -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Dialect -> r)
-> (forall u. (forall d. Data d => d -> u) -> Dialect -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Dialect -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Dialect -> m Dialect)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Dialect -> m Dialect)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Dialect -> m Dialect)
-> Data Dialect
Dialect -> Constr
Dialect -> DataType
(forall b. Data b => b -> b) -> Dialect -> Dialect
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Dialect -> u
forall u. (forall d. Data d => d -> u) -> Dialect -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dialect -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dialect -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dialect -> m Dialect
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dialect -> m Dialect
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dialect
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dialect -> c Dialect
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dialect)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dialect)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dialect -> c Dialect
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dialect -> c Dialect
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dialect
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dialect
$ctoConstr :: Dialect -> Constr
toConstr :: Dialect -> Constr
$cdataTypeOf :: Dialect -> DataType
dataTypeOf :: Dialect -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dialect)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dialect)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dialect)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dialect)
$cgmapT :: (forall b. Data b => b -> b) -> Dialect -> Dialect
gmapT :: (forall b. Data b => b -> b) -> Dialect -> Dialect
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dialect -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dialect -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dialect -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dialect -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Dialect -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Dialect -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Dialect -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Dialect -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dialect -> m Dialect
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dialect -> m Dialect
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dialect -> m Dialect
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dialect -> m Dialect
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dialect -> m Dialect
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dialect -> m Dialect
Data,Typeable)

-- | ansi sql 2011 dialect
ansi2011 :: Dialect
ansi2011 :: Dialect
ansi2011 = Dialect {diKeywords :: [Text]
diKeywords = [Text]
ansi2011ReservedKeywords
                   ,diIdentifierKeywords :: [Text]
diIdentifierKeywords = []
                   ,diAppKeywords :: [Text]
diAppKeywords = [Text
"set"]
                   ,diSpecialTypeNames :: [Text]
diSpecialTypeNames = [Text]
ansi2011TypeNames
                   ,diFetchFirst :: Bool
diFetchFirst = Bool
True
                   ,diLimit :: Bool
diLimit = Bool
False
                   ,diOdbc :: Bool
diOdbc = Bool
False
                   ,diBackquotedIden :: Bool
diBackquotedIden = Bool
False
                   ,diSquareBracketQuotedIden :: Bool
diSquareBracketQuotedIden = Bool
False
                   ,diAtIdentifier :: Bool
diAtIdentifier = Bool
False
                   ,diHashIdentifier :: Bool
diHashIdentifier = Bool
False
                   ,diPositionalArg :: Bool
diPositionalArg = Bool
False
                   ,diDollarString :: Bool
diDollarString = Bool
False
                   ,diEString :: Bool
diEString = Bool
False
                   ,diPostgresSymbols :: Bool
diPostgresSymbols = Bool
False
                   ,diSqlServerSymbols :: Bool
diSqlServerSymbols = Bool
False
                   ,diConvertFunction :: Bool
diConvertFunction = Bool
False                     
                   ,diAutoincrement :: Bool
diAutoincrement = Bool
False
                   ,diNonCommaSeparatedConstraints :: Bool
diNonCommaSeparatedConstraints = Bool
False
                   }

-- | mysql dialect
mysql :: Dialect
mysql :: Dialect
mysql = Dialect -> Dialect
addLimit Dialect
ansi2011 {diFetchFirst = False
                          ,diBackquotedIden = True
                          }

-- | postgresql dialect
postgres :: Dialect
postgres :: Dialect
postgres = Dialect -> Dialect
addLimit Dialect
ansi2011 {diPositionalArg = True
                             ,diDollarString = True
                             ,diEString = True
                             ,diPostgresSymbols = True}

-- | oracle dialect
oracle :: Dialect
oracle :: Dialect
oracle = Dialect
ansi2011 -- {}

-- | microsoft sql server dialect
sqlserver :: Dialect
sqlserver :: Dialect
sqlserver = Dialect
ansi2011 {diSquareBracketQuotedIden = True
                     ,diAtIdentifier = True
                     ,diHashIdentifier = True
                     ,diOdbc = True
                     ,diSqlServerSymbols = True
                     ,diConvertFunction = True}

addLimit :: Dialect -> Dialect
addLimit :: Dialect -> Dialect
addLimit Dialect
d = Dialect
d {diKeywords = "limit": diKeywords d
               ,diLimit = True}


{-
The keyword handling is quite strong - an alternative way to do it
would be to have as few keywords as possible, and only require them
to be quoted when this is needed to resolve a parsing ambiguity.

I don't think this is a good idea for genuine keywords (it probably is
for all the 'fake' keywords in the standard - things which are
essentially function names, or predefined variable names, or type
names, eetc.).

1. working out exactly when each keyword would need to be quoted is
quite error prone, and might change as the parser implementation is
maintained - which would be terrible for users

2. it's not user friendly for the user to deal with a whole load of
special cases - either something is a keyword, then you know you must
always quote it, or it isn't, then you know you never need to quote
it

3. I think not having exceptions makes for better error messages for
the user, and a better sql code maintenance experience.

This might not match actual existing SQL products that well, some of
which I think have idiosyncratic rules about when a keyword must be
quoted. If you want to match one of these dialects exactly with this
parser, I think it will be a lot of work.
-}

ansi2011ReservedKeywords :: [Text]
ansi2011ReservedKeywords :: [Text]
ansi2011ReservedKeywords =
    [--"abs" -- function
     Text
"all" -- keyword only?
    ,Text
"allocate" -- keyword
    ,Text
"alter" -- keyword
    ,Text
"and" -- keyword
    --,"any" -- keyword? and function
    ,Text
"are" -- keyword
    ,Text
"array" -- keyword, and used in some special places, like array[...], and array(subquery)
    --,"array_agg" -- function
    -- ,"array_max_cardinality" -- function
    ,Text
"as" -- keyword
    ,Text
"asensitive" -- keyword
    ,Text
"asymmetric" -- keyword
    ,Text
"at" -- keyword
    ,Text
"atomic" -- keyword
    ,Text
"authorization" -- keyword
    --,"avg" -- function
    ,Text
"begin" -- keyword
    --,"begin_frame" -- identifier
    --,"begin_partition" -- identifier
    ,Text
"between" -- keyword
    ,Text
"bigint" -- type
    ,Text
"binary" -- type
    ,Text
"blob" -- type
    ,Text
"boolean" -- type
    ,Text
"both" -- keyword
    ,Text
"by" -- keyword
    ,Text
"call" -- keyword
    ,Text
"called" -- keyword
    -- ,"cardinality" -- function + identifier?
    ,Text
"cascaded" -- keyword
    ,Text
"case" -- keyword
    ,Text
"cast" -- special function
    -- ,"ceil" -- function
    -- ,"ceiling" -- function
    ,Text
"char"  -- type (+ keyword?)
    --,"char_length" -- function
    ,Text
"character" -- type
    --,"character_length" -- function
    ,Text
"check" -- keyword
    ,Text
"clob" -- type
    ,Text
"close" -- keyword
    -- ,"coalesce" -- function
    ,Text
"collate" -- keyword
    --,"collect" -- function
    ,Text
"column" -- keyword
    ,Text
"commit" -- keyword
    ,Text
"condition" -- keyword
    ,Text
"connect" -- keyword
    ,Text
"constraint" --keyword
    --,"contains" -- keyword?
    --,"convert" -- function?
    --,"corr" -- function
    ,Text
"corresponding" --keyword
    --,"count" --function
    --,"covar_pop" -- function
    --,"covar_samp" --function
    ,Text
"create" -- keyword
    ,Text
"cross" -- keyword
    ,Text
"cube" -- keyword
    --,"cume_dist" -- function
    ,Text
"current" -- keyword
    -- ,"current_catalog" --identifier?
    --,"current_date" -- identifier
    --,"current_default_transform_group"  -- identifier
    --,"current_path"  -- identifier
    --,"current_role"  -- identifier
    -- ,"current_row"  -- identifier
    -- ,"current_schema"  -- identifier
    -- ,"current_time"  -- identifier
    --,"current_timestamp"  -- identifier
    --,"current_transform_group_for_type"  -- identifier, or keyword?
    --,"current_user" -- identifier
    ,Text
"cursor" -- keyword
    ,Text
"cycle" --keyword
    ,Text
"date" -- type
    --,"day" -- keyword? - the parser needs it to not be a keyword to parse extract at the moment
    ,Text
"deallocate" -- keyword
    ,Text
"dec" -- type
    ,Text
"decimal" -- type
    ,Text
"declare" -- keyword
    --,"default" -- identifier + keyword
    ,Text
"delete" -- keyword
    --,"dense_rank" -- functino
    ,Text
"deref" -- keyword
    ,Text
"describe"  -- keyword
    ,Text
"deterministic"
    ,Text
"disconnect"
    ,Text
"distinct"
    ,Text
"double"
    ,Text
"drop"
    ,Text
"dynamic"
    ,Text
"each"
    --,"element"
    ,Text
"else"
    ,Text
"end"
    -- ,"end_frame"  -- identifier
    -- ,"end_partition"  -- identifier
    ,Text
"end-exec" -- no idea what this is
    ,Text
"equals"
    ,Text
"escape"
    --,"every"
    ,Text
"except"
    ,Text
"exec"
    ,Text
"execute"
    ,Text
"exists"
    ,Text
"exp"
    ,Text
"external"
    ,Text
"extract"
    --,"false"
    ,Text
"fetch"
    ,Text
"filter"
    -- ,"first_value"
    ,Text
"float"
    --,"floor"
    ,Text
"for"
    ,Text
"foreign"
    -- ,"frame_row"  -- identifier
    ,Text
"free"
    ,Text
"from"
    ,Text
"full"
    ,Text
"function"
    --,"fusion"
    ,Text
"get"
    ,Text
"global"
    ,Text
"grant"
    ,Text
"group"
    --,"grouping"
    ,Text
"groups"
    ,Text
"having"
    ,Text
"hold"
    --,"hour"
    ,Text
"identity"
    ,Text
"in"
    ,Text
"indicator"
    ,Text
"inner"
    ,Text
"inout"
    ,Text
"insensitive"
    ,Text
"insert"
    ,Text
"int"
    ,Text
"integer"
    ,Text
"intersect"
    --,"intersection"
    ,Text
"interval"
    ,Text
"into"
    ,Text
"is"
    ,Text
"join"
    --,"lag"
    ,Text
"language"
    ,Text
"large"
    --,"last_value"
    ,Text
"lateral"
    --,"lead"
    ,Text
"leading"
    ,Text
"left"
    ,Text
"like"
    ,Text
"like_regex"
    --,"ln"
    ,Text
"local"
    ,Text
"localtime"
    ,Text
"localtimestamp"
    --,"lower"
    ,Text
"match"
    --,"max"
    ,Text
"member"
    ,Text
"merge"
    ,Text
"method"
    --,"min"
    --,"minute"
    --,"mod"
    ,Text
"modifies"
    --,"module"
    --,"month"
    ,Text
"multiset"
    ,Text
"national"
    ,Text
"natural"
    ,Text
"nchar"
    ,Text
"nclob"
    ,Text
"new"
    ,Text
"no"
    ,Text
"none"
    ,Text
"normalize"
    ,Text
"not"
    --,"nth_value"
    ,Text
"ntile"
    --,"null"
    --,"nullif"
    ,Text
"numeric"
    ,Text
"octet_length"
    ,Text
"occurrences_regex"
    ,Text
"of"
    ,Text
"offset"
    ,Text
"old"
    ,Text
"on"
    ,Text
"only"
    ,Text
"open"
    ,Text
"or"
    ,Text
"order"
    ,Text
"out"
    ,Text
"outer"
    ,Text
"over"
    ,Text
"overlaps"
    ,Text
"overlay"
    ,Text
"parameter"
    ,Text
"partition"
    ,Text
"percent"
    --,"percent_rank"
    --,"percentile_cont"
    --,"percentile_disc"
    ,Text
"period"
    ,Text
"portion"
    ,Text
"position"
    ,Text
"position_regex"
    --,"power"
    ,Text
"precedes"
    ,Text
"precision"
    ,Text
"prepare"
    ,Text
"primary"
    ,Text
"procedure"
    ,Text
"range"
    --,"rank"
    ,Text
"reads"
    ,Text
"real"
    ,Text
"recursive"
    ,Text
"ref"
    ,Text
"references"
    ,Text
"referencing"
    --,"regr_avgx"
    --,"regr_avgy"
    --,"regr_count"
    --,"regr_intercept"
    --,"regr_r2"
    --,"regr_slope"
    --,"regr_sxx"
    --,"regr_sxy"
    --,"regr_syy"
    ,Text
"release"
    ,Text
"result"
    ,Text
"return"
    ,Text
"returns"
    ,Text
"revoke"
    ,Text
"right"
    ,Text
"rollback"
    ,Text
"rollup"
    --,"row"
    --,"row_number"
    ,Text
"rows"
    ,Text
"savepoint"
    ,Text
"scope"
    ,Text
"scroll"
    ,Text
"search"
    --,"second"
    ,Text
"select"
    ,Text
"sensitive"
    --,"session_user"
    ,Text
"set"
    ,Text
"similar"
    ,Text
"smallint"
    --,"some"
    ,Text
"specific"
    ,Text
"specifictype"
    ,Text
"sql"
    ,Text
"sqlexception"
    ,Text
"sqlstate"
    ,Text
"sqlwarning"
    --,"sqrt"
    --,"start"
    ,Text
"static"
    --,"stddev_pop"
    --,"stddev_samp"
    ,Text
"submultiset"
    --,"substring"
    ,Text
"substring_regex"
    ,Text
"succeeds"
    --,"sum"
    ,Text
"symmetric"
    ,Text
"system"
    --,"system_time"
    --,"system_user"
    ,Text
"table"
    ,Text
"tablesample"
    ,Text
"then"
    ,Text
"time"
    ,Text
"timestamp"
    ,Text
"timezone_hour"
    ,Text
"timezone_minute"
    ,Text
"to"
    ,Text
"trailing"
    ,Text
"translate"
    ,Text
"translate_regex"
    ,Text
"translation"
    ,Text
"treat"
    ,Text
"trigger"
    ,Text
"truncate"
    --,"trim"
    --,"trim_array"
    --,"true"
    ,Text
"uescape"
    ,Text
"union"
    ,Text
"unique"
    --,"unknown"
    ,Text
"unnest"
    ,Text
"update"
    ,Text
"upper"
    --,"user"
    ,Text
"using"
    --,"value"
    ,Text
"values"
    ,Text
"value_of"
    --,"var_pop"
    --,"var_samp"
    ,Text
"varbinary"
    ,Text
"varchar"
    ,Text
"varying"
    ,Text
"versioning"
    ,Text
"when"
    ,Text
"whenever"
    ,Text
"where"
    --,"width_bucket"
    ,Text
"window"
    ,Text
"with"
    ,Text
"within"
    ,Text
"without"
    --,"year"
    ]


ansi2011TypeNames :: [Text]
ansi2011TypeNames :: [Text]
ansi2011TypeNames =
    [Text
"double precision"
    ,Text
"character varying"
    ,Text
"char varying"
    ,Text
"character large object"
    ,Text
"char large object"
    ,Text
"national character"
    ,Text
"national char"
    ,Text
"national character varying"
    ,Text
"national char varying"
    ,Text
"national character large object"
    ,Text
"nchar large object"
    ,Text
"nchar varying"
    ,Text
"bit varying"
    ,Text
"binary large object"
    ,Text
"binary varying"
        -- reserved keyword typenames:
    ,Text
"array"
    ,Text
"bigint"
    ,Text
"binary"
    ,Text
"blob"
    ,Text
"boolean"
    ,Text
"char"
    ,Text
"character"
    ,Text
"clob"
    ,Text
"date"
    ,Text
"dec"
    ,Text
"decimal"
    ,Text
"double"
    ,Text
"float"
    ,Text
"int"
    ,Text
"integer"
    ,Text
"nchar"
    ,Text
"nclob"
    ,Text
"numeric"
    ,Text
"real"
    ,Text
"smallint"
    ,Text
"time"
    ,Text
"timestamp"
    ,Text
"varchar"
    ,Text
"varbinary"
    ]